meira -
回溯算法
搜索与回溯是计算机解题中常用的算法，很多问题无法根据某种确定的计算法则来求解，可以利用搜索与回溯的技术求解。回溯是搜索算法中的一种控制策略。它的基本思想是：为了求得问题的解，先选择某一种可能情况向前探索，在探索过程中，一旦发现原来的选择是错误的，就退回一步重新选择，继续向前探索，如此反复进行，直至得到解或证明无解。 如迷宫问题：进入迷宫后，先随意选择一个前进方向，一步步向前试探前进,如果碰到死胡同，说明前进方向已无路可走，这时，首先看其它方向是否还有路可走，如果有路可走，则沿该方向再向前试探；如果已无路可走，则返回一步，再看其它方向是否还有路可走；如果有路可走，则沿该方向再向前试探。按此原则不断搜索回溯再搜索，直到找到新的出路或从原路返回入口处无解为止。
递归回溯法算法框架[一]
procedure Try(k:integer);
begin
for i:=1 to 算符种数 Do
if 满足条件 then
begin
保存结果
if 到目的地 then 输出解
else Try(k+1);
恢复：保存结果之前的状态{回溯一步}
end;
end;
递归回溯法算法框架[二]
procedure Try(k:integer);
begin
if 到目的地 then 输出解
else
for i:=1 to 算符种数 Do
if 满足条件 then
begin
保存结果
Try(k+1);
end;
end;
例 1：素数环： 把从1到20这20个数摆成一个环，要求相邻的两个数的和是一个素数。
【算法分析】 非常明显，这是一道回溯的题目。从1 开始，每个空位有 20（19）种可能，只要填进去的数合法：与前面的数不相同；与左边相邻的数的和是一个素数。第 20个数还要判断和第1个数的和是否素数。
〖算法流程〗1、数据初始化； 2、递归填数：
判断第J种可能是否合法；
A、如果合法：填数；判断是否到达目标（20个已填完）：是，打印结果；不是，递归填下一个；
B、如果不合法：选择下一种可能；
【参考程序】
program z74;框架[一]
var a:array[0..20]of byte;
b:array[0..20]of boolean;
total:integer;
function pd(x,y:byte):boolean;
var k,i:byte;
begin
k:=2; i:=x+y; pd:=false;
while (k<=trunc(sqrt(i)))and(i mod k<>0) do inc(k);
if k>trunc(sqrt(i)) then pd:=true;
end;
procedure print;
var j:byte;
begin
inc(total);write("<",total,">:");
for j:=1 to 20 do write(a[j]," ");
writeln;
end;
procedure try(t:byte);
var i:byte;
begin
for i:=1 to 20 do
if pd(a[t-1],i)and b[i] then
begin
a[t]:=i; b[i]:=false;
if t=20 then begin if pd(a[20],a[1]) then print;end
else try(t+1);
b[i]:=true;
end;
end;
BEGIN
fillchar(b,sizeof(b),#1);
total:=0;
try(1);
write("total:",total);
END.
通过观察，我们可以发现实现回溯算法的特性：在解决过程中首先必须要先为问题定义一个解的空间．这个空间必须包含问题的一个解。在搜索路的同时也就产生了新的解空间。在搜索期间的任何时刻．仅保留从起始点到当前点的路径。
例 2：设有 n 个整数的集合｛1,2,…,n｝，从中取出任意 r 个数进行排列（r<n），试列出所有的排列。
解法一：
program it15; 框架[一]
type se=set of 1..100;
VAR s:se;n,r,num:integer;
b:array [1..100] of integer;
PROCEDURE print;
var i:integer;
begin
num:=num+1;
for i:=1 to r do
write(b[i]:3);
writeln;
end;
PROCEDURE try(k:integer);
VAR i:integer;
begin
for i:=1 to n do
if i in s then
begin
b[k]:=i;
s:=s-[i];
if k=r then print
else try(k+1);
s:=s+[i];
end;
end;
BEGIN
write("Input n,r:");readln(n,r);
s:=[1..n];num:=0;
try(1);
writeln("number=",num);
END.
解法二：
program it15; 框架[二]
type se=set of 1..100;
VAR
s:se;
n,r,num,k:integer;
b:array [1..100] of integer;
PROCEDURE print;
var i:integer;
begin
num:=num+1;
for i:=1 to r do
write(b[i]:3);
writeln;
end;
PROCEDURE try(s:se;k:integer);
VAR i:integer;
begin
if k>r then print
else
for i:=1 to n do
if i in s then
begin
b[k]:=i;
try(s-[i],k+1);
end;
end;
BEGIN
write("Input n,r:");
readln(n,r);
s:=[1..n];num:=0;
try(s,1);
writeln("number=",num);
readln;
END.
例3、任何一个大于1的自然数n,总可以拆分成若干个小于n 的自然数之和.
当n=7共14种拆分方法：
7=1+1+1+1+1+1+1
7=1+1+1+1+1+2
7=1+1+1+1+3
7=1+1+1+2+2
7=1+1+1+4
7=1+1+2+3
7=1+1+5
7=1+2+2+2
7=1+2+4
7=1+3+3
7=1+6
7=2+2+3
7=2+5
7=3+4
total=14
{参考程序}
program jjj;
var a:array[0..100]of integer;n,t,total:integer;
procedure print(t:integer);
var i:integer;
begin
write(n,"=");
for i:=1 to t-1 do write(a[i],"+");
writeln(a[t]);
total:=total+1;
end;
procedure try(s,t:integer);
var i:integer;
begin
for i:=1 to s do
if (a[t-1]<=i)and(i<n) then
begin
a[t]:=i;
s:=s-a[t];
if s=0 then print(t)
else try(s,t+1);
s:=s+a[t];
end;
end;
begin
readln(n);
try(n,1);
writeln("total=",total);
readln;
end.
例 4、八皇后问题：要在国际象棋棋盘中放八个皇后，使任意两个皇后都不能互相吃。（提示：皇后能吃同一行、同一列、同一对角线的任意棋子。）
放置第i个皇后的算法为：
procedure Try(i)；
begin
for 第i 个皇后的位置=1 to 8 do；
if 安全 then
begin
放置第 i个皇后；
对放置皇后的位置进行标记；
if i=8 then 输出
else Try(i+1)；{放置第 i+1个皇后}
对放置皇后的位置释放标记，尝试下一个位置是否可行；
end；
end；
【算法分析】
显然问题的键在于如何判定某个皇后所在的行、列、斜线上是否有别的皇后；可以从矩阵的特点上找到规律，如果在同一行，则行号相同；如果在同一列上，则列号相同；如果同在／斜线上的行列值之和相同；如果同在＼ 斜线上的行列值之差相同；如果斜线不分方向，则同一斜线上两皇后的行号之差的绝对值与列号之差的绝对值相同。从下图可验证：
对于一组布局我们可以用一个一维数组来表示：A:ARRAY [1..8] OF INTEGER;A[I]的下标I表示第I个皇后在棋盘的第I行，A[I]的内容表示在第 I行的第 A[I]列，例如：A[3]=5就表示第3个皇后在第3行的第5列。在这种方式下，要表示两个皇后 I和 J不在同一列或斜线上的条件可以描述为：A[I]<>A[J] AND ABS(I-J)<>ABS(A[I]-A[J]){I和 J分别表示两个皇后的行号}
考虑每行有且仅有一个皇后，设一维数组A[1..8]表示皇后的放置：第i行皇后放在第j列，用A[i]＝j来表示，即下标是行数，内容是列数。
判断皇后是否安全，即检查同一列、同一对角线是否已有皇后，建立标志数组b[1..8]控制同一列只能有一个皇后，若两皇后在同一对角线上，则其行列坐标之和或行列坐标之差相等，故亦可建立标志数组c[1..16]、d[-7..7]控制同一对角线上只能有一个皇后。
从分析中，我们不难看出，搜索前进过程实际上是不断递归调用的过程，当递归返回时
即为回溯的过程。
program ex1;
var a:array[1..8] of byte;
b:array[1..8] of boolean;
c:array[1..16] of boolean;
d:array[-7..7] of boolean;
sum:byte;
procedure pr;
var i:byte;
begin
for i:=1 to 8 do write(a[i]:4);
inc(sum);writeln(" sum=",sum);
end;
procedure try(t:byte);
var j:byte;
begin
for j:=1 to 8 do{每个皇后都有8种可能位置}
if b[j] and c[t+j] and d[t-j] then {寻找放置皇后的位置}
begin {放置皇后,建立相应标志值}
a[t]:=j;{摆放皇后}
b[j]:=false;{宣布占领第j列}
c[t+j]:=false;{占领两个对角线}
d[t-j]:=false;
if t=8 then pr {8个皇后都放置好,输出}
else try(t+1);{继续递归放置下一个皇后}
b[j]:=true; {递归返回即为回溯一步,当前皇后退出}
c[t+j]:=true;
d[t-j]:=true;
end;
end;
BEGIN
fillchar(b,sizeof(b),#1);
fillchar(c,sizeof(c),#1);
fillchar(d,sizeof(d),#1);
sum:=0;
try(1);{从第1个皇后开始放置}
END.
例 5：马的遍历
中国象棋半张棋盘如图 4（a）所示。马自左下角往右上角跳。今规定只许往右跳，不许往左跳。比如图 4（a）中所示为一种跳行路线，并将所经路线打印出来。打印格式为：
0，0->2,1->3,3->1,4->3,5->2,7->4,8…
分析：如图4（b）,马最多有四个方向，若原来的横坐标为j、纵坐标为i,则四个方向的移动可表示为：
1： （i,j）→（i+2,j+1）； (i<3,j<8)
2: （i,j）→（i+1,j+2）； (i<4,j<7)
3: （i,j）→（i-1,j+2）； (i>0,j<7)
4: （i,j）→（i-2,j+1）； (i>1,j<8)
搜索策略：
S1:A[1]:=(0,0);
S2:从A[1]出发，按移动规则依次选定某个方向，如果达到的是（4,8）则转向 S3,否
则继续搜索下一个到达的顶点；
S3:打印路径。
program exam2;
const x:array[1..4,1..2] of integer=((2,1),(1,2),(-1,2),(-2,1)); {四种移动规则}
var t:integer; {路径总数}
a:array[1..9,1..2] of integer; {路径}
procedure print(ii:integer); {打印}
var i:integer;
begin
inc(t); {路径总数}
for i:=1 to ii-1 do
write(a[i,1],",",a[i,2],"-->");
writeln("4,8",t:5);
readln;
end;
procedure try(i:integer); {搜索}
var j:integer;
begin
for j:=1 to 4 do
if (a[i-1,1]+x[j,1]>=0) and (a[i-1,1]+x[j,1]<=4) and
(a[i-1,2]+x[j,2]>=0) and (a[i-1,2]+x[j,2]<=8) then
begin
a[i,1]:=a[i-1,1]+x[j,1];
a[i,2]:=a[i-1,2]+x[j,2];
if (a[i,1]=4) and (a[i,2]=8) then print(i)
else try(i+1); {搜索下一步}
a[i,1]:=0;a[i,2]:=0
end;
end;
BEGIN {主程序}
try(2);
END.
【例 6】设有一个连接n个地点①—⑥的道路网，找出从起点①出发到达终点⑥的一切
路径，要求在每条路径上任一地点最多只能通过一次。
【算法分析】
从①出发，下一点可到达②或③，可以分支。
具体步骤为：
⑴假定从起点出发数起第 k 个点 Path[k]， 如果该点是终点n就打印一条路径;
⑵如果不是终点 n，且前方点是未曾走过的点，则走到前方点，定(k+1)点为到达路径，转步骤⑴;
(3)如果前方点已走过，就选另一分支点;
(4)如果前方点已选完，就回溯一步，选另一分支点为出发点;
(5)如果已回溯到起点，则结束。
为了表示各点的连通关系，建立如下的关系矩阵：
第一行表示与①相通点有②③，0 是结束标志;以后各行依此类推。
集合b是为了检查不重复点。
Program Exam68;
const n=6;
roadnet: array[1..n, 1..n] of 0..n=( (2,3,0,0,0,0),
(1,3,4,0,0,0),
(1,2,4,5,0,0),
(2,3,5,6,0,0),
(3,4,6,0,0,0),
(4,5,0,0,0,0) );
var b: set of 1..n;
path: array[1..n] of 1..n;
p: byte;
procedure prn(k: byte);
var i: byte;
begin
inc(p); write("<", p:2, ">", " ":4)
write (path[1]:2);
for I:=2 to k do
write ("--", path[ i ]:2);
writeln
end;
procedure try(k: byte);
var j: byte;
begin
j:=1;
repeat
path[k]:=roadnet [path [k-1], j ];
if not (path [k] in b) then
begin
b:=b+[path [k] ];
if path [k]=n then prn (k)
else try(k+1);
b:=b-[path [k] ];
end;
inc(j);
until roadnet [path [k-1], j ]=0
end;
BEGIN
b:=[1]; p=0; path[1]:=1;
try(2);
readln
END.
u投在线 -
www.bashu.com.cn
www.vijos.cn
www.oifans.cn
www.wzoi.org/usaco/
172.16.32.3/doj/
苏萦 -
http://172.16.32.3/doj/
北有云溪 -
1.背包问题
问题：假设有n件质量分配为w1，w2，...，wn的物品和一个最多能装载总质量为T的背包，能否从这n件物品中选择若干件物品装入背包，使得被选物品的总质量恰好等于背包所能装载的最大质量，即wi1+wi2+...+wik=T。若能，则背包问题有解，否则无解。
算法思想：首先将n件物品排成一列，依次选取；若装入某件物品后，背包内物品的总质量不超过背包最大装载质量时，则装入（进栈）；否则放弃这件物品的选择，选择下一件物品试探，直至装入的物品总和正好是背包的最大转载质量为止。这时我们称背包装满。
若装入若干物品的背包没有满，而且又无其他物品可以选入背包，说明已装入背包的物品中有不合格者，需从背包中取出最后装入的物品（退栈），然后在未装入的物品中挑选，重复此过程，直至装满背包（有解），或无物品可选（无解）为止。
具体实现：设用数组weight[1..N]，stack[1,N]分别存放物品重量和已经装入背包（栈）的物品序号，MaxW表示背包的最大装载量。每进栈一个物品，就从MaxW中减去该物品的质量,设i为待选物品序号,若MaxW-weight[i]>=0，则该物品可选；若MaxW-weight[i] < 0，则该物品不可选,且若i>n，则需退栈，若此时栈空，则说明无解。
排序二叉树
排序二叉树：每一个参加排列的数据对应二叉树的一个结点，且任一结点如果有左（右）子树，则左（右）子树各结点的数据必须小（大）于该结点的数据。中序遍历排序二叉树即得排序结果。程序如下：
program pxtree;
const
a:array[1..8] of integer=(10,18,3,8,12,2,7,3);
type point=^nod;
nod=record
w:integer;
right,left:point ;
end;
var root,first:point;k:boolean;i:integer;
procedure hyt(d:integer;var p:point);
begin
if p=nil then
begin
new(p);
with p^ do begin w:=d;right:=nil;left:=nil end;
if k then begin root:=p; k:=false end;
end
else with p^ do if d>=w then hyt(d,right) else hyt(d,left);
end;
procedure hyt1(p:point);
begin
with p^ do
begin
if left<>nil then hyt1(left);
write(w:4);
if right<>nil then hyt1(right);
end
end;
begin
first:=nil;k:=true;
for i:=1 to 8 do hyt(a[i],first);
hyt1(root);writeln;
end.
3.堆排序
堆：设有数据元素的集合（R1,R2,R3,...Rn)它们是一棵顺序二叉树的结点且有
Ri<=R2i 和Ri<=R2i+1(或>=)
堆的性质：堆的根结点上的元素是堆中的最小元素，且堆的每一条路径上的元素都是有序的。
堆排序的思想是：
1）建初始堆（将结点[n/2],[ n/2]-1,...3,2,1分别调成堆）
2）当未排序完时
输出堆顶元素，删除堆顶元素，将剩余的元素重新建堆。
程序如下：
program duipx;
const n=8;
type arr=array[1..n] of integer;
var a:arr;i:integer;
procedure sift(var a:arr;l,m:integer);
var i,j, t:integer;
begin
i:=l;j:=2*i;t:=a[i];
while j<=m do
begin
if (j<m) and (a[j]>a[j+1]) then j:=j+1;
if t>a[j] then
begin a[i]:=a[j];i:=j;j:=2*i; end
else exit;
end;
a[i]:=t;
end;
begin
for i:=1 to n do read(a[i]);
for i:=(n div 2) downto 1 do
sift(a,i,n);
for i:=n downto 2 do
begin
write(a[1]:4);
a[1]:=a[i];
sift(a,1,i-1);
end;
writeln(a[1]:4);
end.
说明:当n=8 时有30条对角线分别用了l和r数组控制，
用c数组控制列.当(i,j)点放好皇后后相应的对角线和列都为false.递归程序如下:
program nhh;
const n=8;
var s,i:integer;
a:array[1..n] of byte;
c:array[1..n] of boolean;
l:array[1-n..n-1] of boolean;
r:array[2..2*n] of boolean;
procedure output;
var i:integer;
begin
for i:=1 to n do write(a[i]:4);
inc(s);writeln(" total=",s);
end;
procedure try(i:integer);
var j:integer;
begin
for j:=1 to n do
begin
if c[j] and l[i-j] and r[i+j] then
begin
a[i]:=j;c[j]:=false;l[i-j]:=false; r[i+j]:=false;
if i<n then try(i+1) else output;
c[j]:=true;l[i-j]:=true;r[i+j]:=true;
end;
end;
end;
begin
for i:=1 to n do c[i]:=true;
for i:=1-n to n-1 do l[i]:=true;
for i:=2 to 2*n do r[i]:=true;
s:=0;try(1);
writeln;
end.
说明:当n=8 时有30条对角线分别用了l和r数组控制，
用c数组控制列.当(i,j)点放好皇后后相应的对角线和列都为false.递归程序如下:
program nhh;
const n=8;
var s,i:integer;
a:array[1..n] of byte;
c:array[1..n] of boolean;
l:array[1-n..n-1] of boolean;
r:array[2..2*n] of boolean;
procedure output;
var i:integer;
begin
for i:=1 to n do write(a[i]:4);
inc(s);writeln(" total=",s);
end;
procedure try(i:integer);
var j:integer;
begin
for j:=1 to n do
begin
if c[j] and l[i-j] and r[i+j] then
begin
a[i]:=j;c[j]:=false;l[i-j]:=false; r[i+j]:=false;
if i<n then try(i+1) else output;
c[j]:=true;l[i-j]:=true;r[i+j]:=true;
end;
end;
end;
begin
for i:=1 to n do c[i]:=true;
for i:=1-n to n-1 do l[i]:=true;
for i:=2 to 2*n do r[i]:=true;
s:=0;try(1);
writeln;
end.
说明:当n=8 时有30条对角线分别用了l和r数组控制，
用c数组控制列.当(i,j)点放好皇后后相应的对角线和列都为false.递归程序如下:
program nhh;
const n=8;
var s,i:integer;
a:array[1..n] of byte;
c:array[1..n] of boolean;
l:array[1-n..n-1] of boolean;
r:array[2..2*n] of boolean;
procedure output;
var i:integer;
begin
for i:=1 to n do write(a[i]:4);
inc(s);writeln(" total=",s);
end;
procedure try(i:integer);
var j:integer;
begin
for j:=1 to n do
begin
if c[j] and l[i-j] and r[i+j] then
begin
a[i]:=j;c[j]:=false;l[i-j]:=false; r[i+j]:=false;
if i<n then try(i+1) else output;
c[j]:=true;l[i-j]:=true;r[i+j]:=true;
end;
end;
end;
begin
for i:=1 to n do c[i]:=true;
for i:=1-n to n-1 do l[i]:=true;
for i:=2 to 2*n do r[i]:=true;
s:=0;try(1);
writeln;
end.
说明:当n=8 时有30条对角线分别用了l和r数组控制，
用c数组控制列.当(i,j)点放好皇后后相应的对角线和列都为false.递归程序如下:
program nhh;
const n=8;
var s,i:integer;
a:array[1..n] of byte;
c:array[1..n] of boolean;
l:array[1-n..n-1] of boolean;
r:array[2..2*n] of boolean;
procedure output;
var i:integer;
begin
for i:=1 to n do write(a[i]:4);
inc(s);writeln(" total=",s);
end;
procedure try(i:integer);
var j:integer;
begin
for j:=1 to n do
begin
if c[j] and l[i-j] and r[i+j] then
begin
a[i]:=j;c[j]:=false;l[i-j]:=false; r[i+j]:=false;
if i<n then try(i+1) else output;
c[j]:=true;l[i-j]:=true;r[i+j]:=true;
end;
end;
end;
begin
for i:=1 to n do c[i]:=true;
for i:=1-n to n-1 do l[i]:=true;
for i:=2 to 2*n do r[i]:=true;
s:=0;try(1);
writeln;
end.
说明:当n=8 时有30条对角线分别用了l和r数组控制，
用c数组控制列.当(i,j)点放好皇后后相应的对角线和列都为false.递归程序如下:
program nhh;
const n=8;
var s,i:integer;
a:array[1..n] of byte;
c:array[1..n] of boolean;
l:array[1-n..n-1] of boolean;
r:array[2..2*n] of boolean;
procedure output;
var i:integer;
begin
for i:=1 to n do write(a[i]:4);
inc(s);writeln(" total=",s);
end;
procedure try(i:integer);
var j:integer;
begin
for j:=1 to n do
begin
if c[j] and l[i-j] and r[i+j] then
begin
a[i]:=j;c[j]:=false;l[i-j]:=false; r[i+j]:=false;
if i<n then try(i+1) else output;
c[j]:=true;l[i-j]:=true;r[i+j]:=true;
end;
end;
end;
begin
for i:=1 to n do c[i]:=true;
for i:=1-n to n-1 do l[i]:=true;
for i:=2 to 2*n do r[i]:=true;
s:=0;try(1);
writeln;
end.
CarieVinne -
去online judge 吧:
http://acm.pku.edu.cn/JudgeOnline/
奇石珠宝真君 -
www.vijos.cn