Question

PASCAL问题 迷宫 迷宫问题

题目：有一个n*m（不超过10）的迷宫，小明从左上角走到右下角，其中有些是墙壁（能走的用0表示，不能走的用1表示，走的规则是不能走回头路，试求最短的路径。

这个题怎么用PASCAL的广度搜索和深度搜索做？？？急急急！！！求代码！！
对的再加30分！！
试求最短的路径!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

形式:(1,1)-(2,1)-(2,2)-(3,2)-(3,3)

Answer 1

深度搜索:
var i,j,n,m,ans:longint;
a:array[1..100,1..100] of longint;

procedure f(x,y,step:longint);
begin
if (x=n)and(y=m) then begin
if step<ans then ans:=step;
exit;
end;

if (x<1)or(y<1)or(x>n)or(y>m) then exit;
if a[x,y]=1 then exit;

f(x+1,y,step+1);
f(x,y+1,step+1);
end;

begin
readln(n,m);

for i:=1 to n do for j:=1 to m do read(a[i,j]);

ans:=maxlongint;
f(1,1,1);

writeln(ans);
end.
宽度搜索:
var i,j,n,m,len,k:longint;
a:array[1..100,1..100] of longint;
sta:array[1..1000,1..3] of longint;

procedure add(x,y,step:longint);
begin
if (x<1)or(y<1)or(x>n)or(y>m) then exit;

if a[x,y]=1 then exit;
a[x,y]:=1;

inc(len);
sta[len,1]:=x;
sta[len,2]:=y;
sta[len,3]:=step;
end;

begin
readln(n,m);

for i:=1 to n do for j:=1 to m do read(a[i,j]);

len:=1;
sta[1,1]:=1;
sta[1,2]:=1;
sta[1,3]:=1;

repeat
inc(k);

if k>len then break;

if (sta[k,1]=n)and(sta[k,2]=m) then break;

add(sta[k,1]+1,sta[k,2],sta[k,3]+1);
add(sta[k,1],sta[k,2]+1,sta[k,3]+1);
until false;

writeln(sta[k,3]);
end.

Answer 2

const dx:array[1..4]of integer=(-1,0,1,0);
dy:array[1..4]of integer=(0,1,0,-1);
var can:array[-1..102,-1..102]of boolean;
dist:array[1..100,1..100]of integer;
q:array[1..10000,1..3]of integer;
n,i,j,x,y,m,s,js:integer;procedure print(k:integer);
begin
if q[k,3]<>0 then
begin
print(q[k,3]);
write('-->','(',q[k,1],',',q[k,2],')');
end
else begin
write('(',q[k,1],',',q[k,2],')');
end;
end;procedure zhang;
var h,t,k,x1,y1,x2,y2:integer;
begin
for i:=1 to n do
for j:=1 to m do dist[i,j]:=-1;
h:=0;t:=1;
dist[x,y]:=0;q[1,1]:=x;q[1,2]:=y;q[1,3]:=0;
while h<t do
begin
inc(h);x:=q[h,1];y:=q[h,2];
for k:=1 to 4 do
begin
x1:=x+dx[k];y1:=y+dy[k];
if (can[x1,y1])and(dist[x1,y1]=-1)then
begin
dist[x1,y1]:=dist[x,y]+1;
inc(t);
q[t,1]:=x1;q[t,2]:=y1;
q[t,3]:=h;
if (x1=n)and(y1=m) then
begin
writeln(dist[n,m]+1);
print(t);
exit;
end;
end;
end;
end;
end;begin
readln(n,m);
fillchar(can,sizeof(can),false);
for i:=1 to n do
begin
for j:=1 to m do
begin
read(s);
if s=0 then can[i,j]:=true;
end;
end;
x:=1;y:=1;
zhang;
if dist[n,m]=-1 then writeln('No way')
else writeln;
end.

Answer 3

宽搜：
const d:array[1..8,1..2]of -1..1=((0,1),(0,-1),(1,0),(-1,0),(1,1),(1,-1),(-1,1),(-1,-1));
var
b:array[1..10000]of record x,y,f:integer;end;
ans:array[1..10000]of integer;
n,m,op,cl,s1,s2,t1,t2:integer;
flag,a:array[1..100,1..100]of 0..1;

procedure prog;
var i,j,nx,ny,top:integer;ch:char;
begin
{Input}
for i:=1 to n do
begin
for j:=1 to m do begin read(ch);a[i][j]:=ord(ch='1');end;
readln;
end;
readln(s1,s2);readln(t1,t2);if (s1=0)and(s2=0)then begin s1:=1;s2:=1;end;
{WFS}
flag[s1,s2]:=1;op:=1;cl:=1;b[op].x:=s1;b[op].y:=s2;
repeat
for i:=1 to 8 do
begin
nx:=b[op].x+d[i,1];ny:=b[op].y+d[i,2];//next_x,next_y
if (nx in[1..n])and(ny in[1..m])and(a[nx,ny]=0)and(flag[nx,ny]=0)then
begin
inc(cl);b[cl].f:=op;b[cl].x:=nx;b[cl].y:=ny;flag[nx,ny]:=1;
end;
end;
inc(op);
until (op>cl)or(flag[t1,t2]=1);
{Output}
for i:=cl downto 1 do if (b[i].x=t1)and(b[i].y=t2)then break;
top:=0;
while b[i].f<>0 do begin inc(top);ans[top]:=i;i:=b[i].f;end;
write('(1,1)');
for i:=top downto 1 do write('--(',b[ans[i]].x,',',b[ans[i]].y,')');
writeln;
end;

begin
readln(n,m); {Main}
prog;
end.
做熟了其实很简单

Answer 4

BFS：

const dx:array[1..4]of integer=(1,0,-1,0);
dy:array[1..4]of integer=(0,-1,0,1);
max=100;
var i,j,m,n,h,l:integer;
a,d:array[1..10,1..10]of integer;
z:array[1..100,1..2]of integer;
b:array[1..10,1..10]of boolean;
procedure bfs;
var x,y,v:integer;
begin
for i:=1 to n do
for j:=1 to m do
d[i,j]:=max;
d[1,1]:=0;h:=0;l:=1;b[1,1]:=true;
z[1,1]:=1;z[1,2]:=1;
while h<>l do
begin
h:=(h+1) mod 100;
x:=z[h,1];y:=z[h,2];
b[x,y]:=false;
for i:=1 to 4 do
if (x+dx[i]>=1)and(x+dx[i]<=n)and(y+dy[i]>=1)and(y+dy[i]<=m) then
begin
if (a[x+dx[i],y+dy[i]]=0)and(d[x+dx[i],y+dy[i]]>d[x,y]+1) then
begin
d[x+dx[i],y+dy[i]]:=d[x,y]+1;
if not b[x+dx[i],y+dy[i]] then
begin
l:=(l+1) mod 100;
b[x+dx[i],y+dy[i]]:=true;
z[l,1]:=x+dx[i];z[l,2]:=y+dy[i];
end;
end;
end;
end;
writeln(d[n,m]);
end;
begin
fillchar(b,sizeof(b),false);
readln(n,m);
for i:=1 to n do
for j:=1 to m do
read(a[i,j]);
bfs;
end.

Answer 5

我告诉你网址，朋友的博客，自己上去看
http://wtswu95.blog.163.com/blog/static/14042559020103179159732/