Cod sursa(job #537261)

Utilizator catalin.stStanciu Catalin catalin.st Data 20 februarie 2011 15:16:38
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.75 kb
var n,s:array[1..500]of char;a:array[0..250,0..250]of byte;m,m1,x,y,max,nr:byte;

procedure citire;
var g:text;
begin assign(g,'subsir.in');reset(g);
m:=0;
while not(eoln(g)) do begin inc(m); read(g,n[m]); end; readln(g);
m1:=0;
while not(eoln(g)) do begin inc(m1); read(g,s[m1]); end;
close(g);end;
procedure rez;
var i,j,k,l:byte;f:text;
begin
assign(f,'subsir.out');rewrite(f);
for i:=1 to m do
for j:=1 to m1 do if n[i]=s[j] then a[j,i]:=1+a[j-1,i-1];
max:=0;
for i:=1 to m do
 for j:=1 to m1 do if max<a[i,j] then begin max:=a[i,j];a[i,j]:=0;x:=i;y:=j;end;
if max<>0 then nr:=1;
for i:=1 to m do for j:=1 to m1 do
if (a[i,j]=max) then if (j>=y+max) then begin inc(nr);y:=j;end;
writeln(f,nr);
close(f);
end;
begin
citire;
rez;
end.