Cod sursa(job #1006713)

Utilizator hungntnktpHungntnktp hungntnktp Data 7 octombrie 2013 16:51:31
Problema Subsir Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.07 kb
{$INLINE ON}
{$H+}
uses math ;
const p = 666013 ;
var
   n,m:longint;
   a,b:string ;
   f,g:array[0..510,0..510] of longint ;
procedure process;
var i,j,k:longint;
begin
   readln(a); m := length(a);
   readln(b); n := length(b);
   for i := 1 to m do
    for j := 1 to n do if (a[i] = b[j])  then
    begin
      f[i][j] := f[i-1][j-1] + 1 ;
      g[i][j] := g[i-1][j-1] ;
      if f[i][j] = 1 then g[i][j] := 1 ;
    end  else
    begin
      if (f[i-1][j]<>f[i][j-1]) then
       begin
         if f[i-1][j] > f[i][j-1] then
                    g[i][j] := g[i-1][j]
               else g[i][j] := g[i][j-1] ;
         f[i][j] := max(f[i-1][j],f[i][j-1]) ;
       end else begin
         f[i][j] := f[i-1][j] ;
         g[i][j] := (g[i][j-1] + g[i-1][j]) mod p ;
         if (f[i-1][j-1] = f[i][j]) then
                 g[i][j] := (g[i][j]-g[i-1][j-1]+p) mod p ;
       end;

    end ;
    writeln(g[m][n]) ;
end;
begin
        assign(input,'subsir.in') ;reset(input);
        assign(output,'subsir.out') ; rewrite(output) ;
        process;
end .