pascal程序走迷宫怎么打

 我来答
听不清啊
高粉答主

推荐于2016-03-11 · 说的都是干货,快来关注
知道顶级答主
回答量:7.8万
采纳率:89%
帮助的人:1.9亿
展开全部
{迷宫问题:有一个N行M列的棋盘,凡标有1的为不可通行,标有0的为可通行.要从左上角
入口处到达右下角出口处,找出一条通路或给出不可通行信息.
本题中采用堆栈实现深度优先搜索,深度优先搜索可减少搜索步数,但找到的不一定是
最短的路径,且具体路径与坐标增量的顺序有关}
PROGRAM Migong;
CONST zlx:ARRAY[1..8]OF integer=(1,0,1, 1,-1, 0,-1,-1); {行坐标增量}
zly:ARRAY[1..8]OF integer=(1,1,0,-1, 1,-1, 0,-1); {列坐标增量}
TYPE sqtype=RECORD x,y,fx:integer; END;
VAR mg:ARRAY[0..25,0..81]OF integer;
sq:ARRAY[0..800]OF sqtype; done:boolean;
i,j,k,m,n,x,y,fx,top:integer;
BEGIN
randomize;
write('请输入迷宫的高度(<=22,宽度(<=77)和障碍度(1~10):'); readln(n,m,i);
IF (n>22)OR(m>77)THEN BEGIN writeln('超出范围!'); exit END;
writeln('图例 禁区:+ 探索过:. 通道:',chr(2)); {randseed:=i;}
fillchar(mg,sizeof(mg),1); done:=false;
FOR i:=1 to n DO FOR j:=1 TO m DO mg[i,j]:=ord(random(20)<i);
mg[n,m]:=0; sq[1].x:=1; sq[1].y:=1; sq[1].fx:=0; {第一个点入栈}
top:=1; mg[1,1]:=-1; {从入口开始探索}
WHILE (top>=1) AND NOT done DO {栈非空时探索}
BEGIN
x:=sq[top].x; y:=sq[top].y; fx:=sq[top].fx+1; {读栈顶,取上一站的下一方向}
REPEAT {向未找过的方向探索}
i:=x+zlx[fx]; j:=y+zly[fx];
IF mg[i,j]=0 THEN {i,j位置可到达且未探索过,入栈}
BEGIN
sq[top].fx:=fx; {保存原结点已探索过的方向}
inc(top); sq[top].x:=i; sq[top].y:=j; sq[top].fx:=0; {新结点入栈}
{write(top:8);}
if top=48 then
write;
mg[i,j]:=-1; {标记新结点i,j已到过}
IF (i=n)AND(j=m) THEN BEGIN done:=true; break END {到出口时退出循环}
ELSE BEGIN x:=i; y:=j; fx:=1 END; {否则从新结点开始探索}
END
ELSE fx:=fx+1;
UNTIL fx>8;
IF NOT done THEN dec(top); {找遍8个方向且不通时才从栈中删除}
END;
IF done THEN {找到通道}
BEGIN
dec(mg[1,1]); k:=1; {计数器}
REPEAT
i:=1; inc(k); dec(mg[sq[top].x,sq[top].y]); {计数,在通道上作标记}
WHILE (abs(sq[i].x-sq[top].x)>1)OR(abs(sq[i].y-sq[top].y)>1) DO inc(i);
top:=i; {找到栈中最前的可达终点的点i,并作为下一次的终点}
UNTIL top=1;
END;
FOR i:=1 to n DO {输出迷宫情况}
BEGIN
IF i=1 THEN write('=>') ELSE write(' ');
FOR j:=1 TO m DO
BEGIN
CASE mg[i,j] OF
1:write('+'); 0:write(' '); -1:write('.'); -2:write(chr(2));
END;
IF m<38 THEN write(' ');
END;
IF i<n THEN writeln
ELSE IF done THEN BEGIN writeln('=>'); writeln('Steps=',k) END
ELSE BEGIN writeln; writeln('迷宫无出路!'); END;
END;
END.
honggaixin
2009-04-21 · TA获得超过1.4万个赞
知道大有可为答主
回答量:1088
采纳率:100%
帮助的人:1385万
展开全部
这题用宽搜比较好。。。
const
wx:array[1..4] of integer=(1,0,-1,0);
wy:array[1..4] of integer=(0,1,0,-1);
var
n,i,j:integer;
a:array[1..20] of string[25];
qu:array[1..400,1..3] of integer;
mark:array[1..20,1..20] of integer;
list:array[1..400,1..2] of integer;
procedure BFS(sx,sy,ex,ey:integer); //广搜
var x,y:integer;
op,cl,m:integer;
r:integer;
begin
fillchar(mark,sizeof(mark),0);
cl:=0;op:=1;
qu[1][1]:=sx;qu[1][2]:=sy;qu[1][3]:=0; //qu[][1]表示x坐标,qu[][2]表示y坐标,qu[][3]表示用于回朔的标记(即他的father)
mark[sx][sy]:=1; //标记搜过,同时记录步数。。。
while(cl<op)and(mark[ex][ey]=0)do begin
inc(cl);
for r:=1 to 4 do
begin
x:=qu[cl][1]+wx[r];
y:=qu[cl][2]+wy[r];
if(x>0)and(y>0)and(x<=n)and(y<=n)and(mark[x][y]=0)and(a[x][y]='0')then
begin
mark[x][y]:=mark[qu[cl][1]][qu[cl][2]]+1;
inc(op);
qu[op][1]:=x;qu[op][2]:=y;
qu[op][3]:=cl;
end;
end;
end;
if(mark[ex][ey]>0)then //输出部分
begin //writeln('It uses ',mark[ex][ey],' steps.');
r:=op;
m:=1;
while(r>0)do
begin
list[m][1]:=qu[r][1];
list[m][2]:=qu[r][2];
inc(m);
r:=qu[r][3];
end;
dec(m);
write('(',list[m][1],',',list[m][2],')');
for r:=m-1 downto 1 do
write('->(',list[r][1],',',list[r][2],')');
writeln;
end
else writeln('No answer!');end;begin
readln(n);
for i:=1 to n do readln(a[i]);
BFS(1,1,n,n);
end.
本回答被提问者采纳
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式