Cod sursa(job #203057)

Utilizator cypherMircea Grecu cypher Data 13 august 2008 12:39:59
Problema Substr Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.12 kb
program substr;
var a:array[1..17000] of char;
	p:array[0..15,0..17000] of longint;
	c,r1,r2:array[0..17000] of longint;
	n,k,m,maxp:word;
	
	procedure citire;
	var f:text; i:word;
	begin
		assign(f,'substr.in'); reset(f);
		readln(f,n,k);
		for i:=1 to n do read(f,a[i]);
		close(f);
	end;
	
	procedure suffix;
	var i,j,pas,l,ind,temp,t1,t2:word;
	begin
		fillchar(c,sizeof(c),0);
		for i:=1 to n do c[ord(a[i])]:=1;
		for i:=0 to 255 do inc(c[i],c[i-1]);
		for i:=1 to n do p[0,i]:=c[ord(a[i])];
		
		pas:=1; ind:=c[255]; i:=1;

		while (pas<n) and (ind<n) do begin

			fillchar(c,sizeof(c),0);
			for j:=1 to n do begin
				if j+pas<=n then inc(c[p[i-1,j+pas]])
				else inc(c[0]);
			end;
			for j:=1 to n do inc(c[j],c[j-1]);
			for j:=n downto 1 do begin
				if j+pas<=n then temp:=p[i-1,j+pas] else temp:=0;
				r2[c[temp]]:=j;
				dec(c[temp]);
			end;
			
			fillchar(c,sizeof(c),0);
			for j:=1 to n do inc(c[p[i-1,j]]);
			for j:=1 to n do inc(c[j],c[j-1]);
			for j:=n downto 1 do begin
				r1[c[ p[ i-1,r2[j] ] ]]:=r2[j];
				dec(c[ p[ i-1,r2[j] ] ]);
			end;
			
			ind:=1;
			p[i,r1[1]]:=1;
			if r1[1]+pas<=n then t1:=p[i-1,r1[1]+pas] else t1:=0;
			for j:=2 to n do begin
				if r1[j]+pas<=n then t2:=p[i-1,r1[j]+pas] else t2:=0;
				if (p[i-1,r1[j-1]]<>p[i-1,r1[j]]) or (t1<>t2) then inc(ind);
				p[i,r1[j]]:=ind;
				t1:=t2;
			end;
			
			pas:=pas shl 1;
			inc(i);
		end;
		m:=i-1;
	end;
	
	function lcp(x,y:word):word;
	var i,pref:longint;
	begin
		pref:=0;
		for i:=m-1 downto 0 do begin
			if p[i,x]=p[i,y] then begin
				x:=x+(1 shl i); y:=y+(1 shl i);
				pref:=pref+(1 shl i);
			end;
		end;
		exit(pref);
	end;

	procedure scriere;
	var f:text; i,j,temp:word;
	begin
		maxp:=0;
		for i:=1 to n-k+1 do begin
			temp:=lcp(r1[i],r1[i+k-1]);
			if temp>maxp then maxp:=temp;
		end;
		assign(f,'substr.out'); rewrite(f);
		{for i:=1 to n do write(f,r1[i],' ');
		writeln(f);
		for j:=0 to m do begin
			for i:=1 to n do write(f,p[j,i],' ');
			writeln(f);
		end;}
		writeln(f,maxp);
		close(f);
	end;
	
	
	
BEGIN
	citire;
	suffix;
	scriere;
END.