Cod sursa(job #18030)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 17 februarie 2007 22:58:34
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.05 kb
Program cel;
Type matrice=array[0..500,0..500] of word;
     vector=array[1..500] of char;
var f,g:text;
    a,b:vector;
    c:matrice;
    h:char;
    n,m,i,j,nr:word;
    ok:boolean;
Begin
Assign(f,'subsir.in');Reset(f);
Assign(g,'subsir.out');Rewrite(g);
n:=0;
While not eoln(f) do
 Begin
  inc(n);
  Read(f,h);
  a[n]:=h;
 end;
Readln(f);
m:=0;
While not eoln(f) do
 Begin
  inc(m);
  Read(f,h);
  b[m]:=h;
 end;
For i:=1 to n do c[i,0]:=0;
For j:=1 to m do c[0,j]:=0;
For i:=1 to n do
 For j:=1 to m do
   If a[i]=b[j] then c[i,j]:=c[i-1,j-1]+1
                else If c[i-1,j]>=c[i,j-1] then c[i,j]:=c[i-1,j]
                                           else c[i,j]:=c[i,j-1];
i:=n;
nr:=0;
ok:=true;
While (i>=1) and (ok) do
 Begin
  For j:=m downto 1 do
    If c[i,j]=c[n,m] then nr:=nr+1
                     else begin
                           ok:=false;
                           break;
                          end;
  dec(i);
 end;
Write(g,nr mod 666013);
Close(f);
Close(g);
end.