Cod sursa(job #14778)

Utilizator floringh06Florin Ghesu floringh06 Data 9 februarie 2007 19:22:27
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.51 kb

type as=ansistring;
var fi,fo:text;
    i,j,m,max,n,sub,jmax,imax:integer;
    opt:array[0..500,0..500] of integer;
    s1,s2:as;
    d:array[0..500] of integer;

  procedure solve;
   var i,j,k:integer;
    begin
     for i:=1 to length(s1) do
      for j:=1 to length(s2) do
       if s1[i]=s2[j] then opt[i,j]:=opt[i-1,j-1]+1
          else
           begin
             max:=opt[1,j];
             for k:=2 to i-1 do
              if opt[k,j]>max then max:=opt[k,j];
             for k:=1 to j-1 do
              if opt[i,k]>max then max:=opt[i,k];
             opt[i,j]:=max;
           end;
     end;

  procedure search;
    var i,j:integer;
     begin
      sub:=1;

      for i:=length(s1) downto 1 do
       for j:=length(s2) downto 1 do
         begin
           if (opt[i,j]=opt[i-1,j-1]+1) and (opt[i,j]=opt[i-1,j]+1) and (opt[i,j]=opt[i,j-1]+1)
           and (s1[i]<>s2[j]) then
                inc(d[opt[i,j]])
              else if opt[i,j]<>0 then d[opt[i,j]]:=1;
         end;
      for i:=1 to max do
        begin
         sub:=sub*d[i];
         sub:=sub mod 666013;
        end;
     end;

begin
 assign(fi,'subsir.in'); reset(fi);
 assign(fo,'subsir.out'); rewrite(fo);
 readln(fi,s1);
 readln(fi,s2);
 solve;
{ for i:=1 to length(s1) do
 begin
  for j:=1 to length(s2) do
   write(fo,opt[i,j],' ');
  writeln(fo);
 end;}
 search;
{ writeln(fo,max);
for i:=1 to max do
 write(fo,d[i],' ');
 writeln(fo);      }
 writeln(fo,sub);
close(fi);
close(fo);
end.