p1118(2).pas.bak

www.vijos.cn上一些习题的参考源码

program p1118;
const
	MAXS=6;
	MAXK=40;
var
	str,line:string;
	word:array[1..MAXS] of string;
	i,j,m,p,k,s:integer;
	f:array[0..200,0..MAXK] of integer;
	b:array[1..200,1..200] of integer;
	len:array[1..200] of integer;
	
function min(a,b:integer):integer;
begin
	if a<=b then min:=a
	else min:=b;
end;
	
function work(str:string):integer;
var
	tot,i,j,ll:integer;
	st:string;
	used:array[1..200] of boolean;
	
begin
	tot:=0;
	fillchar(used,sizeof(used),false);
	
	for i:=1 to s do begin
		st:=str;
		ll:=0;
		j:=pos(word[i],st);
		while j<>0 do begin
			if not used[ll+j] then inc(tot);
			delete(st,1,j);
			used[ll+j]:=true;
			ll:=ll+j;
			j:=pos(word[i],st);
		end;
	end;
	work:=tot;
end;


procedure solve;
var
	i,j,ll,u:integer;
begin
	fillchar(f,sizeof(f),0);
	for i:=1 to 20*p do begin
		for j:=1 to min(i-1,k) do begin
			for u:=j to i do begin
				{ll:=work(copy(str,u,i-u+1));}
				ll:=b[u,i-u+1];
				if f[u-1,j-1]+ll>f[i,j] then
					f[i,j]:=f[u-1,j-1]+ll;
			end;
		end;
	end;
end;
	
begin
	readln(p,k);
	str:='';
	for i:=1 to p do begin
		readln(line);
		str:=str+line;
	end;
	readln(s);
	for i:=1 to s do
		readln(word[i]);
	
	for i:=1 to 20*p do begin
		len[i]:=maxint;
		for j:=1 to s do begin
			if (word[j]=copy(str,i,length(word[j]))) and (length(word[j])<len[i]) then
				len[i]:=length(word[j]);
		end;
	end;
	for i:=1 to 20*p do begin
		for j:=i to 20*p do begin
			b[i,j]:=0;
			for m:=i to j do
				if (len[m]<maxint) and (len[m]<=j-m+1) then inc(b[i,j]);
		end;
	end;
	
	solve;	
	writeln(f[20*p,k]);
	
end.