Cod sursa(job #33753)

Utilizator petrePajarcu Alexandru-Petrisor petre Data 19 martie 2007 19:41:50
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.05 kb
var f,g:text;
a,b:array[0..500] of char;
com:array[0..500,0..500] of longint;
n,i,j,k,l,t,max,nr,poz:longint;
begin
assign(f,'subsir.in');
assign(g,'subsir.out');
reset(F);
rewrite(G);
n:=0;
while not eoln(f) do begin
 inc(N);
 read(f,a[n]);
 end;  readln(F);
while not eof(F) do
 begin
 inc(K);
 read(f,b[k]);
 end;
 nr:=0;
 max:=0;
for i:=1 to n do
for j:=1 to k do
if a[i]=b[j] then
                begin
                com[i,j]:=com[i-1,j-1]+1;
                if com[i,j]>max then
                begin
                max:=com[i,j];
                nr:=1;
                poz:=j;
                end
                else if (com[i,j]=max)and(poz<>j) then
                begin
                                        inc(Nr );
                                        poz:=j;
                end;
                end
                else
                 if com[i,j-1]>com[i-1,j] then
                        com[i,j]:=com[i,j-1]
                        else com[i,j]:=com[i-1,j];
writeln(g,nr);
close(F);
close(G);
end.