Cod sursa(job #289501)

Utilizator punkistBarbulescu Dan punkist Data 26 martie 2009 19:32:44
Problema Potrivirea sirurilor Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.32 kb
var solutii,m,n:longint;
    a,b:array[0..2000005] of char;
    pi:array[0..2000005] of longint;
    pos:array[1..1024] of longint;

procedure Citeste;
 var f:text;
 begin
  assign(f,'strmatch.in');
  reset(f);
  m:=1;n:=1;
  while not eoln(f) do
   begin
    read(f,a[m]);
    m:=m+1;
   end;
  readln(f);
  while not eoln(f) do
   begin
    read(f,b[n]);
    n:=n+1;
   end;
  close(f);
  m:=m-1;n:=n-1;
  a[0]:=' ';b[0]:=' ';
 end;

procedure make_prefix;
 var i,q:longint;
 begin
  q:=0;
  pi[1]:=0;
  for i:=2 to m do
   begin
    while (q<>0) and (a[q+1] <> a[i]) do q:=pi[q];
    if A[q+1] = A[i] then q:=q+1;
    pi[i]:=q;
   end;
 end;

procedure KMP;
 var i,q:longint;
 begin
  q:=0;
  solutii:=0;
  for i:=1 to n do
   begin
    while (q<>0) and (a[q+1] <> b[i]) do q := pi[q];
    if (A[q+1] = b[i]) then q:=q+1;
    if (q=M) then
     begin
      q:=pi[m];
      solutii:=solutii+1;
      if (solutii <= 1000) then pos[solutii] := i-m;
     end;
   end;
 end;

procedure Scrie;
 var i,min:longint;
     f:text;
 begin
  if solutii<1000 then min:=solutii
  else min:=1000;
  assign(f,'strmatch.out');
  rewrite(f);
  writeln(f,solutii);
  for i:=1 to min do
   begin
    write(f,pos[i],' ');
   end;
  close(f);
 end;
begin
Citeste;
Make_Prefix;
KMP;
Scrie;
end.