广搜练习（一）

1、  迷宫问题（maze.pas/.in/.out）
【问题描述】

0 1 1 1 0 1 1 1

1 0 1 0 1 0 1 0

0 1 0 0 1 1 1 1

0 1 1 1 0 0 1 1

1 0 0 1 1 0 0 0

0 1 1 0 0 1 1 0

如上所示的迷宫图，其中1表示不通，0表示通，处于迷宫中的每个位置都可以有 8个方向探索可行路径前进，假设入口设在最左上角，出口位置设在最右下角，编写一个程序，找出一条从入口到出口的最短路径。注意，由于搜索方案可能不唯一，我们假设搜索的顺序优先从所在点的右侧开始搜索，然后搜索右下方，然后是正下方，依次搜索到该点的右上方，这样可以确保输出方案和测试数据一致。

输入格式

第一行两个整数m和n，表示行和列（n<=10)

第二行开始，每行n个0或1共m行，0表示通，1表示不通。

输出格式

输出一条最短的路径

输入样例

6 8

0 1 1 1 0 1 1 1

1 0 1 0 1 0 1 0

0 1 0 0 1 1 1 1

0 1 1 1 0 0 1 1

1 0 0 1 1 0 0 0

0 1 1 0 0 1 1 0

输出样例

(1,1)-->(2,2)-->(3,3)-->(3,4)-->(4,5)-->(4,6)-->(5,7)-->(6,8)

 1 const maxn=10;
 2       maxm=10;
 3       dx:array[1..8] of -1..1=(0,1,1,1,0,-1,-1,-1);
 4       dy:array[1..8] of -1..1=(1,1,0,-1,-1,-1,0,1);
 5 type
 6   data=record
 7          x,y,pre:integer;
 8        end;
 9 var
10   m,n,i,j,head,tail,x,y,k:integer;
11   map:array[0..maxm+1,0..maxn+1] of 0..1;
12   a:array[1..maxm*maxn] of data;
13 procedure print(k:integer);
14   begin
15     if k=1 then begin write('(',a[1].x,',',a[1].y,')');exit;end;
16     print(a[k].pre);
17     write('-->(',a[k].x,',',a[k].y,')');
18   end;
19 
20 begin
21   readln(m,n);
22   for i:=0 to m+1 do begin map[i,0]:=1;map[i,n+1]:=1;end;
23   for i:=1 to n do begin map[0,i]:=1;map[m+1,i]:=1;end;
24   for i:=1 to m do
25     for j:=1 to n do
26       read(map[i,j]);
27   a[1].x:=1; a[1].y:=1;
28   a[1].pre:=0;
29   head:=0;tail:=1;
30   repeat
31     inc(head);
32     for i:=1 to 8 do begin
33       if map[a[head].x+dx[i],a[head].y+dy[i]]=0 then
34         begin
35           inc(tail);
36           a[tail].x:=a[head].x+dx[i];
37           a[tail].y:=a[head].y+dy[i];
38           a[tail].pre:=head;
39           map[a[head].x+dx[i],a[head].y+dy[i]]:=1;
40           if (a[head].x+dx[i]=m) and (a[head].y+dy[i]=n) then begin print(tail);writeln;halt;end;
41         end;   
42     end;
43   until head>=tail;
44 end.

参考程序

2.奇怪的电梯

AYYZOJ p1768

COGS p364

这题提交了五次才过。。

  1 program p1768;
  2 var
  3  n,a,b,i,ans,head,tail:longint;
  4  k:array[1..200] of longint;
  5  s,x:array[1..200,1..2] of longint;
  6  f:boolean;
  7  pd:set of 1..200;
  8   procedure out(d:longint);
  9   begin
 10    //write(x[d,1]);
 11    repeat
 12     d:=x[d,2];
 13     inc(ans);//write('--',x[d,1]);
 14    until x[d,2]=0;
 15   end;
 16  procedure bfs(a1,b1:longint);
 17  begin
 18   head:=0; tail:=1; x[1,1]:=a; x[1,2]:=0; pd:=[a];
 19   repeat
 20    inc(head);
 21    for i:=1 to 2 do
 22     if (x[head,1]+s[x[head,1],i]>0)and(x[head,1]+s[x[head,1],i]<=n)
 23         and(not(x[head,1]+s[x[head,1],i] in pd)) then
 24      begin
 25       inc(tail);
 26       x[tail,1]:=x[head,1]+s[x[head,1],i];
 27       x[tail,2]:=head;
 28       pd:=pd+[ x[head,1]+s[x[head,1],i] ];
 29       //inc(ans);
 30       if x[tail,1]=b then begin f:=true; out(tail); exit;  {writeln(ans); exit;} end;
 31      end;
 32   until(head>=tail);
 33  end;
 34 begin
 35  readln(n,a,b);
 36  if a=b then begin writeln(0); halt; end;
 37  for i:=1 to n do
 38  begin
 39   read(k[i]);
 40   s[i,1]:=k[i];
 41   s[i,2]:=-k[i];
 42  end;
 43  ans:=0; f:=false;
 44  bfs(a,b);
 45  if not(f) then writeln(-1)
 46  else writeln(ans);
 47 end.//100!
 48 
 49 -------------------------------
 50 program p1768;
 51 var
 52  n,a,b,i,ans,head,tail:longint;
 53  k:array[1..200] of longint;
 54  s,x:array[1..200,1..2] of longint;
 55  f:boolean;
 56  pd:set of 1..200;
 57   procedure out(d:longint);
 58   begin
 59    //write(x[d,1]);
 60    repeat
 61     d:=x[d,2];
 62     inc(ans);//write('--',x[d,1]);
 63    until x[d,2]=0;
 64   end;
 65  procedure bfs(a1,b1:longint);
 66  begin
 67   head:=0; tail:=1; x[1,1]:=a; x[1,2]:=0; pd:=[a];
 68   repeat
 69    inc(head);
 70    for i:=1 to 2 do
 71     if (x[head,1]+s[x[head,1],i]>0)and(x[head,1]+s[x[head,1],i]<=n)
 72         and(not(x[head,1]+s[x[head,1],i] in pd)) then
 73      begin
 74       inc(tail);
 75       x[tail,1]:=x[head,1]+s[x[head,1],i];
 76       x[tail,2]:=head;
 77       pd:=pd+[ x[head,1]+s[x[head,1],i] ];
 78       //inc(ans);
 79       if x[tail,1]=b then begin f:=true; out(tail); exit;  {writeln(ans); exit;} end;
 80      end;
 81   until(head>=tail);
 82  end;
 83 begin
 84  readln(n,a,b);
 85  for i:=1 to n do
 86  begin
 87   read(k[i]);
 88   s[i,1]:=k[i];
 89   s[i,2]:=-k[i];
 90  end;
 91  ans:=0; f:=false;
 92  bfs(a,b);
 93  if not(f) then writeln(-1)
 94  else writeln(ans);
 95 end.//90
 96 
 97 --------------------------------
 98 program p1768;
 99 var
100  n,a,b,i,ans,head,tail:longint;
101  k:array[1..200] of longint;
102  s,x:array[1..200,1..2] of longint;
103  f:boolean;
104  pd:set of 1..200;
105   {procedure out(d:longint);
106   begin
107    write(x[d,1]);
108    repeat
109     d:=x[d,2]; write('--',x[d,1]);
110    until x[d,2]=0;
111   end;       }
112  procedure bfs(a1,b1:longint);
113  begin
114   head:=0; tail:=1; x[1,1]:=a; x[1,2]:=0; pd:=[a];
115   repeat
116    inc(head);
117    for i:=1 to 2 do
118     if (x[head,1]+s[x[head,1],i]>0)and(x[head,1]+s[x[head,1],i]<=n)
119         and(not(x[head,1]+s[x[head,1],i] in pd)) then
120      begin
121       inc(tail);
122       x[tail,1]:=x[head,1]+s[x[head,1],i];
123       //x[tail,2]:=head;
124       pd:=pd+[ x[head,1]+s[x[head,1],i] ];
125       inc(ans);
126       if x[tail,1]=b then begin {out(tail); break;} f:=true; writeln(ans); exit; end;
127      end;
128   until(head>=tail);
129  end;
130 begin
131  readln(n,a,b);
132  for i:=1 to n do
133  begin
134   read(k[i]);
135   s[i,1]:=k[i];
136   s[i,2]:=-k[i];
137  end;
138  ans:=0; f:=false;
139  bfs(a,b);
140  if not(f) then writeln(-1);
141 end.//40
142 
143 -------------------------
144 
145 begin
146 writeln(-1);
147 end.
148 //30 
149 -----------------------
150 
151 program p1768;
152 var
153  n,a,b,i,ans,head,tail:longint;
154  k:array[1..2000] of longint;
155  s,x:array[1..2000,1..2] of longint;
156  f:boolean;
157   {procedure out(d:integer);
158   begin
159    write(x[d,1]);
160    repeat
161     d:=x[d,2]; write('--',x[d,1]);
162    until x[d,2]=0;
163   end;       }
164  procedure bfs(a1,b1:integer);
165  begin
166   head:=0; tail:=1; x[1,1]:=a; x[1,2]:=0;
167   repeat
168    inc(head);
169    for i:=1 to 2 do
170     if (x[head,1]+s[x[head,1],i]>0)and(x[head,1]+s[x[head,1],i]<=n) then
171      begin
172       inc(tail);
173       x[tail,1]:=x[head,1]+s[x[head,1],i];
174       x[tail,2]:=head;
175       inc(ans);
176       if x[tail,1]=b then begin {out(tail); break;} f:=true; writeln(ans); exit; end;
177      end;
178   until(head>=tail);
179  end;
180 begin
181  readln(n,a,b);
182  for i:=1 to n do
183  begin
184   read(k[i]);
185   s[i,1]:=k[i];
186   s[i,2]:=-k[i];
187  end;
188  ans:=0; f:=false;
189  bfs(a,b);
190  if not(f) then writeln(-1);
191 end.
192 //10

我的广搜

 1 const max=200;
 2         d:array[1..2] of integer=(-1,1);
 3 var
 4   q,pre,k:array[1..max] of integer;
 5   value:array[1..max] of boolean;
 6   n,a,b,i,ans:integer;
 7 procedure bfs;
 8   var head,tail,t,j:integer;
 9   begin
10     head:=0;tail:=1;
11     q[1]:=a;pre[1]:=0;value[a]:=false;
12     repeat
13       inc(head);
14       for i:=1 to 2 do
15         begin
16           t:=q[head]+d[i]*k[q[head]];
17           if (t>=1) and (t<=n) and value[t] then begin
18             inc(tail);
19             q[tail]:=t;
20             pre[tail]:=head;
21             value[t]:=false;
22             if t=b then begin
23               ans:=0;
24               j:=tail;
25               while pre[j]<>0 do begin inc(ans);j:=pre[j];end;
26             end;
27           end;
28         end;
29     until head>=tail;
30   end;
31 begin
32   readln(n,a,b);
33   for i:=1 to n do read(k[i]);
34   fillchar(value,sizeof(value),true);
35   ans:=maxint;
36   if a=b then ans:=0 else bfs;
37   if ans=maxint then ans:=-1;
38   writeln(ans);
39 end.

广搜

 1 const max=200;
 2 var
 3   k:array[1..max] of integer;
 4   value:array[1..max] of boolean;
 5   n,a,b,i,ans:integer;
 6 procedure dfs(s,step:integer);
 7   begin
 8   if s=b then begin  if step<ans then ans:=step;exit;end;
 9   if (step<ans)and(s>=1)and(s<=n) and value[s] then begin
10     value[s]:=false;
11     dfs(s+k[s],step+1);
12     dfs(s-k[s],step+1);
13     value[s]:=true;
14   end;
15 end;
16 begin
17   readln(n,a,b);
18   for i:=1 to n do read(k[i]);
19   fillchar(value,sizeof(value),true);
20   ans:=maxint;
21   dfs(a,0);
22   if ans=maxint then ans:=-1;
23   writeln(ans);
24 end.

深搜

3.最少转弯问题

AYYZOJ p1460

COGS p1123

分析：这个题我感觉非常好啊，与COGS 524激光电话类似，有空做一做。

广搜的框架，注意在扩展时有深搜的思想，朝一个方向扩展到底，参考程序中用了while循环，再回到扩展起点，很棒的想法。这样就可以用双尾指针法来统计步数（转弯次数），双尾指针法见此课件。

 1 const dx:array[1..4] of integer=(0,1,0,-1);
 2       dy:array[1..4] of integer=(1,0,-1,0);
 3 var
 4   m,n,i,j,x1,y1,x2,y2,h,t,t2,ans,x,y:integer;
 5   map:array[1..100,1..100] of integer;
 6   xx,yy,pre:array[1..100] of integer;
 7 begin
 8 assign(input,'turn.in');
 9 reset(input);
10 assign(output,'turn.out');
11 rewrite(output);
12   readln(n,m);
13   for i:=1 to n do begin
14    for j:=1 to m do
15     read(map[i,j]);
16     readln; end;
17    readln(x1,y1,x2,y2);
18    h:=0; t:=1; ans:=0; t2:=1;
19    xx[1]:=x1; yy[1]:=y1;
20    while h<t do
21    begin
22      inc(h);
23      for i:=1 to 4 do
24       begin
25         x:=xx[h]+dx[i];
26         y:=yy[h]+dy[i];
27         while (x<=n)and(y<=m)and(x>=1)and(y>=1)and((map[x,y]=0)or(map[x,y]=2)) do
28         begin
29           if map[x,y]=0 then
30           begin
31             inc(t);
32             xx[t]:=x; yy[t]:=y;
33             map[x,y]:=2;
34             pre[t]:=h;
35             if (x=x2)and(y=y2) then begin writeln(ans); halt; end;
36           end;
37          x:=x+dx[i]; y:=y+dy[i];
38         end;
39       end;
40    if h=t2 then begin inc(ans); t2:=t; end;
41    end;
42 end.

参考程序