Cod sursa(job #710061)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 8 martie 2012 21:29:27
Problema Subsir Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.91 kb
Program subsir;
 var s1,s2:ansistring;
      a,nr:array [0..501,0..501] of longint;
      i,j,n,m,md:longint;
      fi,fo:text;
begin
 assign(fi,'subsir.in');
  assign(fo,'subsir.out');
 reset(fi); rewrite(fo);  md:=666013;
  readln(fi,s1); read(fi,s2); n:=length(s1); m:=length(s2);
 for i:=0 to n do nr[i,0]:=1;
 for i:=0 to m do nr[0,i]:=1;
  for i:=1 to n do
   for j:=1 to m do
    if s1[i]=s2[j] then begin a[i,j]:=a[i-1,j-1]+1; nr[i,j]:=nr[i-1,j-1]; end
     else if a[i-1,j]=a[i,j-1] then begin
                           a[i,j]:=a[i-1,j]; nr[i,j]:=(nr[i,j-1]+nr[i-1,j]) mod md;
                           if a[i-1,j-1]=a[i,j-1] then nr[i,j]:=(nr[i,j]-nr[i-1,j-1]+md) mod md;
                               end
     else if a[i,j-1]>a[i-1,j] then begin a[i,j]:=a[i,j-1]; nr[i,j]:=nr[i,j-1]; end
      else begin a[i,j]:=a[i-1,j]; nr[i,j]:=nr[i-1,j]; end;
   write(fo,nr[n,m]);
  close(fo);
end.