Cod sursa(job #166145)

Utilizator adalLica Adela adal Data 27 martie 2008 15:07:49
Problema Potrivirea sirurilor Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.23 kb
program kmp;
 var a,b:array[0..2000001] of char;
//var a,b:ansistring;
    v:array[0..2000001] of longint;
    c:array[0..1050] of longint;
    i,n,m:longint;
    f,g:text;
procedure pi;
var i,k:longint;
begin
   v[1]:=0; k:=0;
   for i:=2 to n do begin
      while (k>0) and (a[k+1]<>a[i]) do k:=v[k];
      if a[k+1]=a[i] then inc(k);
      v[i]:=k;
   end;
end;

procedure kmp;
var q,i:longint;
begin
   q:=0;
   for i:=1 to m do begin
       while (q>0) and(a[q+1]<>b[i]) do q:=v[q];
       if(a[q+1]=b[i]) then inc(q);
       if q=n then begin
          inc(c[0]);
          if c[0]<1000 then begin c[c[0]]:=i-n; end;
   //       q:=v[q];
       end;
   end;
end;

begin
   assign(f,'strmatch.in'); reset(f);
   assign(g,'strmatch.out'); rewrite(g);
   n:=0; m:=0;
//   readln(f, a);
//   readln(f, b);
   while not(eoln(f)) do begin inc(n); read(f,a[n]); end;
   readln(f);
   while not(eoln(f)) do begin inc(m); read(f,b[m]); end;
//   n:=length(a);
//   m:=length(b);
   pi;
   c[0]:=0;
   kmp;
   if c[0]>0 then begin
   writeln(g,c[0]);
   if c[0]>1000 then c[0]:=1000;
   for i:=1 to c[0]-1 do write(g,c[i],' ');
   writeln(g,c[c[0]]);
   end else writeln(g,0);
   close(f); close(g);
end.