Cod sursa(job #177497)

Utilizator tomatarosie cu buletin tomata Data 13 aprilie 2008 09:07:33
Problema Subsir Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.32 kb
var a,b:array[1..500] of char;
    f,g:text;
    c,nr:array[0..500,0..500] of longint;
    coma,comb,apa,apb:array['a'..'z'] of longint;
    ch:char;
    maxim,sol,k,nra,nrb,i,j:longint;
    ok:boolean;

function max(x,y:longint):longint;
 begin
  if x>y then max:=x
  else max:=y;
 end;

begin
 assign(f,'subsir.in'); reset(f);
 assign(g,'subsir.out'); rewrite(g);
 while not(eoln(f)) do begin
  inc(nra);
  read(f,a[nra]);
 end;
 readln(f);
 maxim:=0;
 while not(eoln(f)) do begin
  inc(nrb);
  read(f,b[nrb]);
 end;
 for i:=1 to nra do
  for j:=1 to nrb do
   if a[i]=b[j] then
    c[i,j]:=c[i-1,j-1]+1
   else
    c[i,j]:=max(c[i-1,j],c[i,j-1]);
 for i:=1 to nra do begin
  for ch:='a' to 'z' do
   apb[ch]:=0;
  for j:=1 to nrb do begin
   for ch:='a' to 'z' do
    if c[i,j]=c[apa[ch],apb[ch]]+1 then
     nr[i,j]:=(nr[i,j]+nr[apa[ch],apb[ch]]) mod 666013;
   if nr[i,j]=0 then
    nr[i,j]:=1;
   apb[b[j]]:=j;
  end;
  apa[a[i]]:=i;
 end;
 sol:=0;
 for i:=1 to nra do
  for j:=1 to nrb do
   if (a[i]=b[j]) and (c[i,j]=c[nra,nrb]) then begin
    ok:=true;
    for k:=i+1 to nra do
     if a[i]=a[k] then
      ok:=false;
    for k:=j+1 to nrb do
     if b[j]=b[k] then
      ok:=false;
    if ok then
     sol:=(sol+nr[i,j]) mod 666013;
   end;
 writeln(g,sol);
 close(f); close(g);
end.