荔园在线
荔园之美，在春之萌芽，在夏之绽放，在秋之收获，在冬之沉淀
[回到开始]
[上一篇][下一篇]
发信人: Version (无题), 信区: Program
标 题: 用“综合优化”解决黄金图形源程序：{ backtracking
发信站: 荔园晨风BBS站 (Wed Jun 11 23:18:46 2003), 站内信件
【程 序】
一、用“综合优化”解决黄金图形源程序：{ backtracking method }
Const
input = 'golygon.dat';
output= 'golygon.out';
path : Array [1..4, 1..2] of integer =
((1, 0), (0, -1), (-1, 0), (0, 1));
head : Array [1..4] of char =
('e', 's', 'w', 'n');
clogs = 50; { m <= clogs }
ways = 24; { n <= ways }
Var
fp : text;
n, { 最长步数 }
m, { 障碍物数 }
o { 路径指针 }
: byte;
clog : Array [1..clogs] of { 储存障碍物坐标 }
Record x, y : integer End;
way : Array [0..ways] of byte;{ 储存路径 }
results : integer; { 路径数 }
Procedure _init; { 初始化 }
Var i : byte;
Begin
Assign(fp, input); Reset(fp);
Readln(fp, n); Readln(fp, m);
for i := 1 to m do
Readln(fp,clog[i].x, clog[i].y);
Close(fp);
Assign(fp, output); Rewrite(fp)
End;
Procedure _out; { 输出路径 }
Var i, j, t : byte; x, y : integer;
b : boolean;
Begin
for j := 1 to 4 do
Begin
x := 0; y := 0; b := TRUE;
for i := 1 to o do
Begin
x := x+path[way[i]][1]*i;
y := y+path[way[i]][2]*i;
for t := 1 to m do
if(x=clog[t].x) and((y-path[way[i]][2]*i<clog[t].y)
and(y >= clog[t].y) or (y-path[way[i]][2]*i >
clog[t].y)
and(y <= clog[t].y)) or (y = clog[t].y)
and((x-path[way[i]][1]*i < clog[t].x)
and(x >= clog[t].x) or (x-path[way[i]][1]*i >
clog[t].x)
and(x <= clog[t].x))
{ 如果通过障碍物 }
then Begin b := FALSE; Break End;
if not b then Break
End;
if b then
Begin
Inc(results);
for i := 1 to o do Write(fp, head[way[i]]);
Writeln(fp)
End;
for i := 1 to o do way[i] := way[i] mod 4 + 1 { 旋转路径 }
End
End;
Function _sum(step : integer) : integer;
Var i, r : integer;
Begin
r := 0;
for i := step+1 to n do Inc(r, i);
_sum := r
End;
Function _is_able_to_pass (x, y, i, step : integer) : boolean;
Var t : integer;
Begin
_is_able_to_pass := TRUE;
if (abs(x) > _sum(step)) or
(abs(y) > _sum(step)) or { 不能“回头”了？ }
(i = way[o]) { 重复走同一个方向了？ }
or (abs(i-way[o]) = 2){ 折返了？ }
then _is_able_to_pass := FALSE
End;
Procedure _main(step, x, y : integer);
{ step – 第几步 x, y – 当前坐标 }
Var i : byte;
Begin
if (x = 0) and (y = 0) and (step = n+1)then
Begin
_out; { 若到达（0,0）则输出，回溯 } Exit
End;
if step > n then Exit; { 如果超过步数没有回到起点就回溯 }
for i := 1 to 4 do { 尝试每个方向 }
if _is_able_to_pass { 如果通行 }(x+path[i][1]*step,
y+path[i][2]*step, i, step) then
Begin
Inc(o); way[o] := i; { 存下路径 }
_main(step+1, { 走下一步 }
x+path[i][1]*step, y+path[i][2]*step); { 改变坐标
}
Dec(o) { 恢复原来的路径 }
End
End;
Procedure _exit;
Begin
Writeln(fp, 'Found ', results, ' golygon(s).');
Close(fp)
End;
Begin
_init;
o := 1; way[1] := 1;
_main(2, 1, 0);
_exit
End.
二、用动态规划求上界再搜索的迷宫问题源程序：(为了便于测试，没有输出路径
)
Const
input = 'trip.dat';
output= 'trip.out';
path : Array [1..4, 1..2] of shortint =
((-1, 0), (1, 0), (0, -1), (0, 1));
maxn = 30;
maxm = 30;
Var
fp : text;
n, m, x0, y0, x1, y1, all, o, results, xx : longint;
{ all – 路径总数；results – 上界 }
r : Array [1..maxn, 1..maxm] of shortint;
{ 迷宫，0-可行，-1 –障碍 }
way : Array [1..1000] of byte;{ 储存路径 }
l : Array [1..maxn, 1..maxm] of integer; { 动态规划的数组 }
Procedure _init;
Var a, b, x : byte;
Begin
Assign(fp, input); Reset(fp);
Readln(fp, n, m, x);
for x := x downto 1 do
Begin
Readln(fp, a, b);
r[a,b] := -1
End;
Readln(fp, x0, y0, x1, y1);
Close(fp);
Assign(fp, output); Rewrite(fp)
End;
Procedure _solve; { 动态规划 }
Var i, j, k : integer; b : boolean;
Begin
l[x0,y0] := 1;
Repeat
b:= TRUE;
for i := 1 to n do
for j := 1 to m do
for k := 1 to 4 do
if (l[i,j] > 0) then
if (i+path[k][1] > 0)
and (i+path[k][1] <= n)
and (j+path[k][2] > 0)
and (j+path[k][2] <= m) then { 没越界 }
if (r[i+path[k][1],j+path[k][2]] <>
-1) then { 不是障碍 }
if (l[i,j]+1 < l[i+path[k][1],
j+path[k][2]]) or
(l[i+path[k][1],
j+path[k][2]] = 0) then
Begin
l[i+path[k][1],
j+path[k][2]] := l[i,j] + 1;
{ 填数组，l[I,j]表示该
格的“估价值” }
b := FALSE
End
Until b; { 一直循环到不再修改数组 }
results := abs(l[x1,y1] - l[x0,y0]){ 得出上界 }
End;
Procedure _main(x, y : byte);
Var i : byte;
Begin
if abs(l[x1,y1]-l[x,y]) > results then Exit; { 如果超出上界就立刻回
溯 }
if (x = x1) and (y = y1) then
Begin Inc(all); Exit End; { 到达终点，输出 }
for i := 1 to 4 do
if (x+path[i][1] > 0) and (x+path[i][1] <= n)
and (y+path[i][2] > 0) and (y+path[i][2] <= m)
and (r[x+path[i][1],y+path[i][2]] <> -1)
{ 不越界，而且不遇到障碍 }
and (abs(l[x1,y1]-l[x+path[i][1],y+path[i][2]]) < abs(l[x1,
y1]-l[x,y]))
{如果那一格的“估价值”比当前这一格好才往那个方向走 }
then Begin
Inc(o);
way[o] := i; r[x,y] := -1; { 存储路径，把走过的格置成障碍 }
_main(x+path[i][1], y+path[i][2]);{ 搜索下一格 }
Dec(o); r[x,y] := 0
End
End;
Procedure _exit;
Var i, j : byte;
Begin
Writeln(fp, all);
Close(fp)
End;
Begin
_init;
_solve;
_main(x0, y0);
_exit
End.
--
*
* *
* *
no more to say
★ just wish you ★
good luck
※ 来源:·荔园晨风BBS站 bbs.szu.edu.cn·[FROM: 192.168.1.50]
[回到开始]
[上一篇][下一篇]
荔园在线首页 友情链接：深圳大学 深大招生 荔园晨风BBS S-Term软件 网络书店