Cod sursa(job #401242)

Utilizator Cristian_BBerceanu Cristian Cristian_B Data 22 februarie 2010 18:04:03
Problema Subsir Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.27 kb
var max,ct,k,ii,jj,i,j,n,m:longint;
    a,b:array[1..500] of char;
    t:string;
    st:array[1..125000] of string;
    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
 k:=0;
 for i:=1 to n do
  for j:=1 to m do
   begin
     if a[i]=b[j] then
      begin
        ii:=i;
        jj:=j;
        t:=a[i];
        while (a[ii]=b[jj]) and (ii<=n) do
         begin
          ii:=ii+1;
          jj:=jj+1;
          if a[ii]=b[jj] then
          t:=t+a[ii];
         end;
       k:=k+1;
       st[k]:=t;
      end;

   end;
end;

procedure init_st;
begin
 for i:=1 to k do
 st[i]:='';
end;

procedure find_all_max;
begin
 max:=length(st[1]);
 for i:=2 to k do
 if max<length(st[i]) then max:=length(st[i]);
 ct:=0;
 for i:=1 to k do
 if length(st[i])=max
 then
 begin
 ct:=ct+1;
  for j:=i+1 to k do
  if st[i]=st[j] then st[j]:=' ';
 end;
end;
BEGIN
load;
init_st;
find_sub;
find_all_max;
write(g,ct mod 666013);
close(g);
END.