Cod sursa(job #18292)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 18 februarie 2007 11:17:22
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.61 kb
Program cel;
Type matrice=array[0..500,0..500] of word;
     matrice1=array[1..500,1..500] of char;
     matrice2=array[0..500,0..500] of shortint;
     vector=array[1..500] of char;
var f,g:text;
    a,b:vector;
    x:matrice1;
    c:matrice;
    e:matrice2;
    h:char;
    n,m,i,j,nr,k:word;
    ok:boolean;

function comparare(k,nr:word):boolean;
var i:word;
Begin
i:=1;
While i<=c[n,m] do
 Begin
  If x[k,i]<>x[nr,i] then Begin
                           comparare:=false;
                           i:=n+1;
                          end;
  inc(i);
 end;
If i=n+1 then comparare:=true;
end;

procedure cmlsc(i,j,nr:word);
var q:word;
Begin
If (i=0) or (j=0) then q:=0
                  else If e[i,j]=1 then Begin
                                         cmlsc(i-1,j-1,nr);
                                         inc(q);
                                         x[nr,q]:=a[i];
                                        end
                                    else If e[i,j]=-1 then cmlsc(i-1,j,nr)
                                                      else cmlsc(i,j-1,nr);
end;

Begin
Assign(f,'subsir.in');Reset(f);
Assign(g,'subsir.out');Rewrite(g);
n:=0;
While not eoln(f) do
 Begin
  inc(n);
  Read(f,h);
  a[n]:=h;
 end;
Readln(f);
m:=0;
While not eoln(f) do
 Begin
  inc(m);
  Read(f,h);
  b[m]:=h;
 end;
For i:=1 to n do c[i,0]:=0;
For j:=1 to m do c[0,j]:=0;
For i:=1 to n do
 For j:=1 to m do
   If a[i]=b[j] then Begin
                      c[i,j]:=c[i-1,j-1]+1;
                      e[i,j]:=1;
                     end
                else If c[i-1,j]>=c[i,j-1] then Begin
                                                 c[i,j]:=c[i-1,j];
                                                 e[i,j]:=-1;
                                                end
                                           else Begin
                                                 c[i,j]:=c[i,j-1];
                                                 e[i,j]:=0;
                                                end;
nr:=1;
cmlsc(n,m,nr);
For i:=1 to n do
 For j:=1to m-1 do
  If c[i,j]=c[n,m] then Begin
                         inc(nr);
                         cmlsc(i,j,nr);
                         For k:=1 to nr-1 do
                          If comparare(k,nr)=false then Begin
                                                         nr:=nr-1;
                                                         break;
                                                        end;
                        end;
Write(g,nr mod 666013);
Close(f);
Close(g);
end.