Cod sursa(job #401273)

Utilizator Cristian_BBerceanu Cristian Cristian_B Data 22 februarie 2010 18:30:55
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.11 kb
var min,max,ct,k,ii,jj,i,j,n,m:longint;
    a,b:array[1..500] of char;
    t:array[1..500] of char;
    f,g:text;
procedure load;
begin
assign(f,'subsir.in');
reset(f);
n:=0;m:=0;
while not eof(f) do
 begin
  while not eoln(f) do
   begin
    n:=n+1;
    read(f,a[n]);
   end;

   readln(f);

  while not eoln(f) do
   begin
    m:=m+1;
    read(f,b[m]);
   end;

end;
closE(f);
assign(g,'subsir.out');
rewrite(g);
end;
procedure find_sub;
begin

min:=501;
if min>n then min:=n;
if min>m then min:=m;
ct:=0;max:=-1;
 for i:=1 to n do
  for j:=1 to m do
   begin
     if a[i]=b[j] then
      begin
        k:=0;
        ii:=i;
        jj:=j;
        k:=k+1;
        t[k]:=a[i];
        while (a[ii]=b[jj]) and (ii<=min) do
         begin
          ii:=ii+1;
          jj:=jj+1;
          if a[ii]=b[jj] then
          k:=k+1;
          t[k]:=a[ii];
         end;
        if max<k then
        begin
        max:=k;
        ct:=0;
        end;
        if max=k then ct:=ct+1;
      end;

   end;
end;


BEGIN
load;
find_sub;
write(g,ct mod 666013);
close(g);
END.