Cod sursa(job #678513)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 11 februarie 2012 20:56:08
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.82 kb
Program Subsir_comun_distincte;
var fi,fo :text;
    a,b:array[0..500] of char;
    i,j,k,l1,l2,m2:integer;
    c:array[0..500,0..500] of integer;

Function max(a,b : integer):integer;
begin
    if a>b then max:=a
           else max:=b;
end;

begin
     assign(fi,'subsir.in'); reset(fi);
     assign(fo,'subsir.out'); rewrite(fo);
     l1:=0;
     while not(eoln(fi)) do begin l1:=l1+1; read(fi,a[l1]); end; readln(fi);
     l2:=0;
     while not(eoln(fi)) do begin l2:=l2+1; read(fi,b[l2]); end;

     for i:=1 to l1 do
         for j:=1 to l2 do
              if a[i]=b[j] then c[i,j]:=c[i-1,j-1]+1
                           else c[i,j]:=max(c[i-1,j],c[i,j-1]);

     m2:=c[l1,l2]; k:=0;
     for i:=1 to l2 do if c[l1,i]=m2 then k:=(k+1) mod 666013;
     write(fo,k);
     close(fi); close(fo);
end.