Cod sursa(job #64232)

Utilizator floringh06Florin Ghesu floringh06 Data 2 iunie 2007 09:37:24
Problema Subsir Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.24 kb
//100 puncte
{$IFDEF NORMAL}
  {$I-,Q-,R-,S-}
{$ENDIF NORMAL}
{$IFDEF DEBUG}
  {$I+,Q+,R+,S-}
{$ENDIF DEBUG}
{$IFDEF RELEASE}
  {$I-,Q-,R-,S-}
{$ENDIF RELEASE}


const  nmax=505;
       mode=666013;

type   vector = array[1..nmax] of char;

var opt,nr:array[0..nmax,0..nmax] of longint;
    pa,pb:array['a'..'z',0..nmax] of integer;
    n,m:integer;
    fi,fo:text;
    a,b:vector;
    sol:longint;

 procedure preprocesare;

  var i,crt:integer;
      c:char;
  begin
  fillchar(pa,sizeof(pa),0);
  fillchar(pb,sizeof(pb),0);
  for c:='a' to 'z' do
  begin
   crt:=0;
   for i:=1 to n do
    begin
     if (a[i]=c) then crt:=i;
     pa[c,i]:=crt;
    end;
  end;
  for c:='a' to 'z' do
  begin
   crt:=0;
   for i:=1 to m do
    begin
     if (b[i]=c) then crt:=i;
     pb[c,i]:=crt;
    end;
   end;
  end;




 procedure read_data;
 var i:integer;
  begin
  assign(fi,'subsir.in'); reset(fi);i:=1;
  while not eoln (fi) do
   begin  read(fi,a[i]); inc(i); end;
  readln(fi);  n:=i-1; i:=1;
  read(fi,b[1]);
  while b[i] in ['a'..'z'] do
   begin inc(i); read(fi,b[i]); end;
  m:=i-1;
  while not (a[n] in ['a'..'z']) do dec(n);
  while not (b[m] in ['a'..'z']) do dec(m);
  close(fi);
  preprocesare;
 end;

 function max(a,b:integer): integer;
  begin if a>b then max:=a else max:=b; end;

 procedure lcs;
  var i,j,ii,jj:integer;
      c:char;
  begin
   for i:=1 to n do
    for j:=1 to m do
     if a[i]=b[j] then begin
      opt[i,j]:=opt[i-1,j-1]+1;
      if (opt[i,j]=1) then nr[i,j]:=1
       else
        begin
         for c:='a' to 'z' do
          begin
           ii:=pa[c,i-1]; jj:=pb[c,j-1];
           if (ii>0) and (jj>0) then
           if (opt[ii,jj]+1=opt[i,j]) then nr[i,j]:=(nr[i,j]+nr[ii,jj]) mod mode;
          end;
        end;
     end
     else
      opt[i,j]:=max(opt[i-1,j],opt[i,j-1]);

  end;




 procedure work;

  var c:char;
  begin
  lcs;
  for c:='a' to 'z' do
   if opt[pa[c,n],pb[c,m]]=opt[n,m] then
    begin
     sol:=(sol+nr[pa[c,n],pb[c,m]]) mod mode;
    end;
  end;

 procedure write_data;
  begin
  assign(fo,'subsir.out'); rewrite(fo);
  writeln(fo,sol);
  close(fo);
  end;



begin
read_data;
work;
write_data;
end.