PASCAL 题目,不难,希望各位高手能帮帮菜鸟,急急急急急、跪求

摘自网上的.. 这是noip提高组题目呀.. 真不难.. =.=

const aa:array [1..2,1..2] of byte=((0,1),(1,0));
var a:array [1..10,1..10] of longint;
b:array [1..10,1..10] of boolean;
i,n,max,t,t1,t2:longint;

procedure try(x,y,z,c,tot:longint);
var j,k,nx,ny,nz,na,s,t:longint;
begin
if (x=n) and (y=n) and (z=n) and (c=n) then
begin
if tot>max then max:=tot;
exit;
end;
for j:=1 to 2 do
begin
nx:=x+aa[j,1];
ny:=y+aa[j,2];
if (nx>n) or (ny>n) then continue;
if b[nx,ny] then s:=a[nx,ny]
else s:=0;
b[nx,ny]:=false;
for k:=1 to 2 do
begin
nz:=z+aa[k,1];
na:=c+aa[k,2];
if (nz<=n) and (na<=n) then
begin
if b[nz,na] then t:=a[nz,na]
else t:=0;
b[nz,na]:=false;
try(nx,ny,nz,na,tot+s+t);
b[nz,na]:=true;
end;
end;
b[nx,ny]:=true;
end;
end;

begin
fillchar(b,sizeof(b),TRUE);
readln(n);
readln(t,t1,t2);
while (t<>0) and (t1<>0) and (t2<>0) do
begin
a[t,t1]:=t2;
readln(t,t1,t2);
end;
try(1,1,1,1,a[1,1]);
writeln(max);
end.

测试数据：

（3分）第1组：输入：
1
ENVELOPE
E

输出：
15

（3分）第2组：输入：
2
ABABABAB
ABABABC
A

输出：
19

（4分）第3组：输入：
4
ABABABC
ABABABD
ABABABA
CDABABA
A

输出：
43

（5分）第4组：输入：
8
NO
NEW
NAME
NEVER
NATIONAL
NECESSARY
EVER
ME
N

输出：
9

（7分）第5组：输入：
6
ACT
TOUCH
CHEAT
CHOOSE
TACT
SENCITIVE
A

输出：
31

（5分）第6组：输入：
6
MANY
YOUTH
THIS
SYSTEM
MAIN
NAVY
M

输出：
38追问

谢谢你的程序,但是,我在电脑上运行的结果是不对的,只输了一个
5
at 就出现了错误代码106,请您再帮忙看一下.

追答

呃..106是缺字符表达式..
其实呢.这条程序不是我写的,我找的时候就直接 c&p了. 刚才看了下,发现这个程序貌似牛头不对马嘴..
好了,很无耻得再 c&p一条.

var
add:array[1..20,1..20] of integer;
y:array[1..20] of integer;
a:array[1..20] of string;
n,i,h,j:integer;
head:char;
function min(x,y:integer):integer;
begin
if x>y then min:=y else min:=x;
end;
procedure calcadd;
var i,j,k,t:integer;
ifx:boolean;
begin
for i:=1 to n do
for j:=1 to n do begin
for k:=1 to min(length(a[i]),length(a[j]))-1 do begin
ifx:=true;
for t:=1 to k do
if a[j,t]a[i,length(a[i])-k+t] then begin
ifx:=false;
break;
end;
if ifx then break;
end;
if ifx then add[i,j]:=length(a[j])-k else
add[i,j]:=0;
end;

end;
procedure dfs(l,len:integer);
var i:integer;
begin
if len>h then h:=len;
for i:=1 to n do
if (add[l,i]>0)and(y[i]<2) then begin
inc(y[i]);
dfs(i,len+add[l,i]);
dec(y[i]);
end;
end;

begin
readln(n);
for i:=1 to n do readln(a[i]);
calcadd;
h:=0;
readln(head);
for i:=1 to n do begin
if a[i,1]=head then begin
y[i]:=1;
dfs(i,length(a[i]));
y[i]:=0;
end;
end;
writeln(h);
end.

参考资料：http://hi.baidu.com/zhyfzy/blog/item/17cd5a33c69eaaf61b4cfff2.html

追问

回答是13，不是23

追答

什么意思? 这条程序应该能通过的?. 你说哪个值?

题目描述似乎短了点,有些地方没说清楚
1."相邻的两部分不能存在包含关系"这个不管它
2.相邻的单词必须有重叠部分
3.样例中,tact+tact=tactact
4.121212+121212=1212121212而不是12121212
5.n达不到20
注意到这些,只要DFS就可以AC了
丑陋的代码:
var
a:array[1..20,1..20] of longint;
word:array[1..20] of string;
len,count:array[1..20] of longint;
n,ans,i,j,k,tt:longint;
beg:char;
procedure work(cur,tot_len:longint);//DFS
var
next:longint;
begin
if tot_len>ans then ans:=tot_len;
for next:=1 to n do
if (a[cur,next]<>-1)and(count[next]<2) then
begin
inc(count[next]);
work(next,tot_len+a[cur,next]);
dec(count[next]);
end;
end;
begin
readln(n);
for i:=1 to n do
begin
readln(word[i]);
len[i]:=length(word[i]);
end;
readln(beg);
for i:=1 to n do//预处理
for j:=1 to n do
begin
if len[i]<len[j] then tt:=len[i] else tt:=len[j];
a[i,j]:=-1;
for k:=tt downto 1 do
if copy(word[i],len[i]-k+1,k)=copy(word[j],1,k) then a[i,j]:=len[j]-k;
if a[i,j]=0 then a[i,j]:=-1;
end;
ans:=-maxlongint;
for i:=1 to n do
if word[i,1]=beg then
begin
count[i]:=1;
work(i,len[i]);
count[i]:=0;
end;
writeln(ans);
end.
不过如果n真的到20可能这样还不太行

其实上那些做题网找不更吗？追问

答案13，不是23