Cod sursa(job #46930)

Utilizator andrewgPestele cel Mare andrewg Data 3 aprilie 2007 11:07:13
Problema Subsir Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.41 kb
const maxn = 501;
      modul = 666013;

type sir = array[1..maxn]of char;

var f:text;
    n,m,i,j,max,sol,k,x:longint;
    a,b:sir;
    c,d:array[0..maxn,0..maxn]of longint;
    pa,pb:array[1..26,0..maxn]of longint;

procedure readdata;
begin
   assign(f,'subsir.in');
   reset(f);
   for i:=1 to 26 do
   begin
      pa[i,0]:=0;
      pb[i,0]:=0;
   end;
   i:=0;
   while not eoln(f) do
   begin
      inc(i);
      read(f,a[i]);
      for j:=1 to 26 do
      begin
         pa[j,i]:=pa[j,i-1];
         if ord(a[i])-96=j then pa[j,i]:=i;
      end;
   end;
   m:=i;
   readln(f);
   i:=0;
   while not eoln(f) do
   begin
      inc(i);
      read(f,b[i]);
      for j:=1 to 26 do
      begin
         pb[j,i]:=pb[j,i-1];
         if ord(b[i])-96=j then pb[j,i]:=i;
      end;
   end;
   n:=i;
   close(f);
end;

procedure solve;
begin
   for i:=1 to n do
   begin
      c[0,i]:=0;
      d[0,i]:=0;
   end;
   for i:=1 to m do
   begin
      c[i,0]:=0;
   end;
   max:=0;
   for i:=1 to m do
   begin
      for j:=1 to n do
      begin
         if a[i]=b[j] then
         begin
            c[i,j]:=c[i-1,j-1]+1;
            if c[i,j]>max then
            begin
               max:=c[i,j];
            end;
         end
            else
         begin
            c[i,j]:=c[i-1,j];
            if c[i,j-1]>c[i,j] then
            begin
               c[i,j]:=c[i,j-1];
            end;
         end;
      end;
   end;
   for i:=1 to m do
   begin
      for j:=1 to n do
      begin
         if (a[i]=b[j]) then
         begin
            for x:=1 to 26 do
            begin
               if c[i,j]=c[pa[x,i-1],pb[x,j-1]]+1 then
               begin
                  d[i,j]:=(d[i,j]+d[pa[x,i-1],pb[x,j-1]]) mod modul;
                  if c[i,j]=1 then d[i,j]:=1;
                  if (c[i,j]=max){ and (pa[x,i-1]=pa[x,m]) and (pb[x,j-1]=pb[x,n])} then
                  begin
                     if (i=pa[ord(a[i])-96,m]) and (j=pb[ord(b[j])-96,n]) then
                     begin
                        sol:=(sol+d[pa[x,i-1],pb[x,j-1]]) mod modul;
                     end;
                  end;
               end;
            end;
         end;
      end;
   end;
end;

procedure writedata;
begin
   assign(f,'subsir.out');
   rewrite(f);
   writeln(f,sol mod 666013);
   close(f);
end;

begin
   readdata;
   solve;
   writedata;
end.