Cod sursa(job #360831)

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




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

begin
q:='';
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
B[i]:=q[i];
n:=n+length(q);
end;
readln(f);
while not eoln(f) do
begin
read(f,q);
for i:=1 to length(q) do
A[i]:=q[i];
m:=m+length(q);
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:=1;
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(r);
  v[j]:=i-m+1;
  inc(j);
  if j>1000 then j:=1001;
  q:=urm[q];
  end;
end;
end;




begin
KMP;
assign(g,'strmatch.out');
rewrite(g);
writeln(g,r);
if j=1001 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.