Cod sursa(job #360856)

Utilizator ScriamTertiuc Afanasie Scriam Data 2 noiembrie 2009 13:45:43
Problema Potrivirea sirurilor Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.22 kb
Program seti;
var r,j,l,n,m : longint;
    v : array[1..1500] of longint;
    g : text;
    A,B : array[1..2000002] of char;
    urm : array[1..1000000] of longint;




Procedure Citire;
var f : text;
    i : integer;
    q : string;

begin

n:=0;
m:=0;
assign(f,'strmatch.in');
reset(f);
while not eoln(f) do
begin

read(f,q);
for i:=1 to length(q) do
begin
inc(m);
B[m]:=q[i];
end;

end;
readln(f);
while not eoln(f) do
begin
read(f,q);
for i:=1 to length(q) do
begin
inc(n);
A[n]:=q[i];
end;
end;
close(f);
end;





Procedure urmatorul;
var k,q : integer;

begin
k:=0;
urm[1]:=0;
for q:=2 to m do
begin
while (k>0) and (B[k+1]<>B[q]) do k:=urm[k];
if B[k+1]=B[q] then inc(k);
urm[q]:=k;
end;
end;




Procedure KMP;
var q,i : longint;

begin
j:=0;
q:=0;
urmatorul;
for i:=1 to n do
begin
  while (q>0) and (B[q+1]<>A[i]) do q:=urm[q];
  if B[q+1]=A[i] then inc(q);
  if q=m then
  begin
  inc(j);
  if j<1001 then v[j]:=i-m;
  q:=urm[q];
  end;
end;
end;




begin
Citire;
KMP;
assign(g,'strmatch.out');
rewrite(g);
writeln(g,j);
if j>1000 then for l:=1 to 1000 do write(g,v[l],' ') else
for l:=1 to j do
write(g,v[l],' ');


close(g);
end.