Cod sursa(job #298175)

Utilizator AndreiDumaAndrei Duma AndreiDuma Data 5 aprilie 2009 21:47:40
Problema Potrivirea sirurilor Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.38 kb
var c,d:array[1..2000005] of char;
    a,b:array[0..2000005] of char;

	pi:array[0..2000005] of longint;
	sol:array[1..1024] of longint;

    m,n,nr:longint;

procedure citire;
var f:text;
begin
	assign(f,'strmatch.in');reset(f);
	readln(f,c);
	readln(f,d);
	n:=1;
	m:=1;
	a[1]:=c[1];
	b[1]:=d[1];
	while ord(c[m+1])<>0 do
	begin
		inc(m);
		a[m]:=c[m];
	end;
	while ord(d[n+1])<>0 do
	begin
		inc(n);
		b[n]:=d[n];
	end;
	a[0]:=' '; b[0]:=' ';
end;

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

procedure KMP;
var q,i:longint;
begin
	q:=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 inc(q);
		if q=m then
		begin
		        q:=pi[m];
                        inc(nr);
                        if nr<=1000 then sol[nr]:= i-m;
		end;
	end;
end;

procedure afisare;
var g:text;
    i:integer;
begin
	assign(g,'strmatch.out'); rewrite(g);
	writeln(g,nr);
	if nr<=1000 then
	begin
		for i:=1 to nr-1 do write(g,sol[i],' ');
		if nr <> 0 then writeln(g,sol[nr]);
	end
		else
	begin
		for i:=1 to 999 do write(g,sol[i],' ');
		writeln(g,sol[1000]);
	end;
	close(g);
end;

begin

citire;
make_prefix;
KMP;
afisare;

end.