Cod sursa(job #1459)

Utilizator VmanDuta Vlad Vman Data 13 decembrie 2006 18:53:02
Problema Subsir Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.5 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] then total:=(total+nr[i][j])mod 666013;
        end;

assign(f,'subsir.out');rewrite(f);
write(f,nr[n][m]);
close(f);
end.