Cod sursa(job #890772)

Utilizator andrei_toaderToader Andrei Sorin andrei_toader Data 25 februarie 2013 11:48:51
Problema Subsir Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.95 kb
program bla;
var f,g:text;
    d,e:array[0..500,0..500] of longint;
    n,m,i,j:byte;
    a,b:ansistring;

function max (a,b:longint):longint;
begin
 if a> b then max:=a
 else max:=b;
end;

begin
 assign (f,'subsir.in'); reset(F);
 assign (g,'subsir.out'); rewrite (g);
 readln (f,a);
 readln (f,b);
 n:=length(a); m:=length(b);
 for i:=0 to m do
  e[1,i]:=1;
 for i:=2 to n+1 do
 begin
  e[i,1]:=1;
  for j:=2 to m+1 do
  begin
   if a[i-1]=b[j-1] then
    d[i,j]:=d[i-1,j-1]+1
   else
    d[i,j]:=max(d[i-1,j], d[i,j-1]);
    if a[i-1]=b[j-1] then
    begin
     e[i,j]:=e[i-1,j-1];
     end
    else
    begin
     e[i,j]:=0;
     if d[i,j]=d[i-1,j] then
      e[i,j]:=(e[i,j]+e[i-1,j]) mod 666013;
    end;
    if d[i,j]=d[i,j-1] then
     e[i,j]:=(e[i,j]+e[i,j-1]) mod 666013;
    if d[i,j]=d[i-1,j-1] then
     e[i,j]:=(e[i,j]-e[i-1,j-1]+666013) mod 666013;
 end;
 end;

 write (g,e[n+1,m+1]);
 close (F); close (G);
end.