各位高手,有没有PASCAL的题?给题也行,给网页自己寻找也行(循环最好),很多最好,最佳答案付赠十分!
參考答案:回溯算法
搜索与回溯是计算机解题中常用的算法，很多问题无法根据某种确定的计算法则来求解，可以利用搜索与回溯的技术求解。回溯是搜索算法中的一种控制策略。它的基本思想是：为了求得问题的解，先选择某一种可能情况向前探索，在探索过程中，一旦发现原来的选择是错误的，就退回一步重新选择，继续向前探索，如此反复进行，直至得到解或证明无解。 如迷宫问题：进入迷宫后，先随意选择一个前进方向，一步步向前试探前进,如果碰到死胡同，说明前进方向已无路可走，这时，首先看其它方向是否还有路可走，如果有路可走，则沿该方向再向前试探；如果已无路可走，则返回一步，再看其它方向是否还有路可走；如果有路可走，则沿该方向再向前试探。按此原则不断搜索回溯再搜索，直到找到新的出路或从原路返回入口处无解为止。
递归回溯法算法框架[一]
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.
