继续问迷宫问题－连连看游戏。

[NowCan]

连连看这个游戏现在好像比较流行，不知道大家有没有玩过。
我现在想写一个自动求解的程序，分析后觉得这实际上是个迷宫问题，只是要求路径最多只能拐弯两次。

各位有什么思路？

不知道这个游戏，请到这里看。
http://www.skycn.com/soft/14029.html

[NowCan]

自己up一下吧。

[BlueSky2008]

好像又是zju题吧，bfs,很简单的啊

[sxtymk]

说明：
输入文件LLKIN.TXT
第一行 三个整数：LONG(地图长) WIDE(宽) N(图案种类数）
以下 WIDE 行，每行 LONG 个整数，表示该位置的图案号码。
输出所有可行解(LLKOUT.TXT)：

I（图案号码）：
操作一、操作二……

例；
3 2 3
1 1 2
3 2 3

输出
1:
1.2-1.1 1.1-1.2
2:

3:
2.1-2.3

程序可能还有问题，敬请指教。

program llk;
const
max=100;
maxn=30;
maxturn=2;
filein='llkin.txt';
var
pmap,map:array [-1..max+2,-1..max+2] of byte;
fa,fb,ea,eb:array [1..5*max] of byte;
sa,sb,long,wide,n,fp,p:integer;

procedure first;
var t:text;
i,j:integer;
begin
assign(t,filein);
reset(t);
read(t,long,wide,n);
fillchar(map,sizeof(map),0);
for i:=1 to wide do
for j:=1 to long do
read(t,map[i,j]);
close(t);
fp:=1;
end;

procedure searchb(a,b,nn,o:integer);forward;
procedure markone();forward;

procedure searcha(a,b,nn,o:integer);
var j:integer;
begin
if (nn>maxturn) then exit;
j:=a+1;
while (map[j,b]= 0)and (j<=long+1) do
begin
if pmap[j,b]>nn then pmap[j,b]:=nn;
searchb(j,b,nn+1,o);
j:=j+1
end;
if map[j,b]=o then
begin
fa[fp]:=j;
fb[fp]:=b;
markone
end;
j:=a-1;
while (map[j,b]= 0)and (j>=0) do
begin
if pmap[j,b]>nn then pmap[j,b]:=nn;
searchb(j,b,nn+1,o);
j:=j-1
end;
if map[j,b]=o then
begin
fa[fp]:=j;
fb[fp]:=b;
markone
end;
end;

[zzwu]

不知道这个游戏，从

http://www.skycn.com/soft/14029.html

下载得到的程序也无法看（一运行就说"该程序执行了非法操作"）。

[sxtymk]

对不起，程序有BUG，更新如下
输出改用文件(LLKOUT.TXT)

program llk;
const
max=10;
maxn=10;
maxturn=2;
filein='llkin.txt';
fileout='llkout.txt';
var
pmap,map:array [-1..max+2,-1..max+2] of byte;
fa,fb,ea,eb:array [1..5*max] of byte;
sa,sb,long,wide,n,fp,p:integer;
tx:text;

procedure first;
var t:text;
i,j:integer;
begin
assign(t,filein);
reset(t);
read(t,long,wide,n);
fillchar(map,sizeof(map),0);
for i:=1 to wide do
for j:=1 to long do
read(t,map[i,j]);
close(t);
fp:=1;
end;

procedure searchb(a,b,nn,o:integer);forward;
procedure markone;forward;

procedure searcha(a,b,nn,o:integer);
var j:integer;
begin
if (nn>maxturn) then exit;
j:=a+1;
while (map[j,b]= 0)and (j<=wide+1) do
begin
if pmap[j,b]>nn then pmap[j,b]:=nn;
searchb(j,b,nn+1,o);
j:=j+1
end;
if map[j,b]=o then
begin
fa[fp]:=j;
fb[fp]:=b;
markone
end;
j:=a-1;
while (map[j,b]= 0)and (j>=0) do
begin
if pmap[j,b]>nn then pmap[j,b]:=nn;
searchb(j,b,nn+1,o);
j:=j-1
end;
if map[j,b]=o then
begin
fa[fp]:=j;
fb[fp]:=b;
markone
end;
end;


procedure searchb(a,b,nn,o:integer);
var i:integer;
begin
if (nn>maxturn) or (fa[fp]>0)and(fb[fp]>0) then exit;
i:=b+1;
while (map[a,i]= 0)and (i<=long+1) do
begin
if pmap[a,i]>nn then pmap[a,i]:=nn;
searcha(a,i,nn+1,o);
i:=i+1
end;
if map[a,i]=o then
begin
fa[fp]:=a;
fb[fp]:=i;
markone
end;
i:=b-1;
while (map[a,i]= 0)and (i>=0) do
begin
if pmap[a,i]>nn then pmap[a,i]:=nn;
searcha(a,i,nn+1,o);
i:=i-1
end;
if map[a,i]=o then
begin
fa[fp]:=a;
fb[fp]:=i;
markone
end;
end;

procedure output(ob:integer);
begin
if fp=0 then exit;
write(tx,ob,' : ');
while fp>1 do
begin
fp:=fp-1;
write(tx,ea[fp],'.',eb[fp],'-',fa[fp],'.',fb[fp],' ')
end;
writeln(tx);
end;

procedure markone;
var fp2:integer;
begin
for fp2:=1 to fp-1 do
if (fa[fp2]=fa[fp])and(fb[fp2]=fb[fp]) then
if (ea[fp2]=sa)and(eb[fp2]=sb) then
begin fa[fp]:=0;fb[fp]:=0;exit end;
ea[fp]:=sa;
eb[fp]:=sb;
fp:=fp+1;
end;
procedure work(point:integer);
begin
for sa:=1 to wide do
for sb:=1 to long do
if map[sa,sb]=point then
begin
searcha(sa,sb,0,point);
searchb(sa,sb,0,point);
{if (fa[fp]=0)or(fb[fp]=0) then exit
else begin
ea[fp]:=sa;eb[fp]:=sb;fp:=fp+1 end;}
end;
output(point);
end;


begin
first;
assign(tx,fileout);
rewrite(tx);
for p:=1 to n do
begin
fillchar(pmap,sizeof(pmap),1);
fillchar(fa,sizeof(fa),0);
fillchar(fb,sizeof(fb),0);
work(p);
end;
close(tx);
end.

[NowCan]

zzwu(未名)：程序无法运行吗？

sxtymk() ，我看看吧，等我翻译成C再说吧。

[zzwu]

NowCan(能量、激情、雨水、彩虹——雷雨云):

程序顺利下载，但无法运行，说‘该程序执行了非法操作’，毫无办法。

[NowCan]

那没办法了,呵呵.也许是兼容性的问题吧.

[zzwu]

也可能是我的PC机感染了病毒的缘故。我什么时候清一清再试。