广搜练习（一）
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.
