Cod sursa(job #3314)

Utilizator dany_dangerDani Ilinca dany_danger Data 23 decembrie 2006 15:58:22
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.02 kb
var x,y,a:array[1..100] of char;
    lcs:array[0..100,0..100] of integer;
    i,m,n,j,k:integer;
    f:text;
begin
     assign(f,'subsir.in');reset(f);
     i:=0;
     while not seekeoln(f) do
                    begin
                        inc(i);
                        read(f,x[i]);
                    end;
     readln(f);
     m:=i;
     i:=0;
     k:=0;
     while not seekeoln(f) do
                    begin
                        inc(i);
                        read(f,y[i]);
                    end;
     n:=i;
     assign(f,'subsir.out');rewrite(f);
     for i:=1 to m do
         for j:=1 to n do
             if x[i]=y[j] then lcs[i,j]:=lcs[i-1,j-1]+1
                          else if lcs[i-1,j]>lcs[i,j-1] then lcs[i,j]:=lcs[i-1,j]
                                                        else lcs[i,j]:=lcs[i,j-1];
   for i:=1 to m do
       for j:=1 to n do if (x[i]=y[j]) and (lcs[i,j]=lcs[m,n]) then
                            k:=k+1;
                   write(f,k);
     close(f)
end.