Cod sursa(job #1485)

Utilizator VmanDuta Vlad Vman Data 13 decembrie 2006 19:54:14
Problema Subsir Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.58 kb
program subsir;
const first=ord('a')-1;
var n,m,i,j,ii,jj,k:integer;
    total:longint;
    a,b:array[0..500]of char;
    aa,bb:array[0..500,1..26]of integer;
    c:array[0..500,0..500]of integer;
    nr:array[0..500,0..500]of longint;
    f:text;
begin
assign(f,'subsir.in');reset(f);
n:=0;
while not seekeoln(f) do begin
      inc(n);
      read(f,a[n]);
end;
m:=0;
readln(f);
while not seekeoln(f) do begin
      inc(m);
      read(f,b[m]);
end;
close(f);

{lungime}
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];
{memorizare}
for i:=1 to n do begin
    for j:=1 to 26 do
      aa[i][j]:=aa[i-1][j];
    aa[i][ord(a[i])-first]:=i;
end;
for i:=1 to m do begin
    for j:=1 to 26 do
      bb[i][j]:=bb[i-1][j];
    bb[i][ord(b[i])-first]:=i;
end;
{nr subsiruri}
for i:=1 to n do
        for j:=1 to m do
                if (a[i]=b[j])and(c[i][j]=1) then nr[i][j]:=1;

for i:=1 to n do
    for j:=1 to m do
        if (a[i]=b[j]) then begin
           for k:=1 to 26 do
               begin
               ii:=aa[i-1][k];
               jj:=bb[j-1][k];
               if c[ii][jj]+1=c[i][j] then
                                      nr[i][j]:=(nr[i][j]+nr[ii][jj])mod 666013;
               end;
          if (c[i][j]=c[n][m])and(aa[n][ord(a[i])-first]=i)and(bb[m][ord(b[j])-first]=j) then
                total:=(total+nr[i][j])mod 666013;
        end;

assign(f,'subsir.out');rewrite(f);
write(f,total);
close(f);
end.