资源简介

【题目1】排球队员站位问题
┏━━━━━━━━┓图为排球场的平面图，其中一、二、三、四、五、六为位置编号，
┃　　　　　　　　┃二、三、四号位置为前排，一、六、五号位为后排。某队比赛时，
┃　　　　　　　　┃一、四号位放主攻手，二、五号位放二传手，三、六号位放副攻
┠──┬──┬──┨手。队员所穿球衣分别为１，２，３，４，５，６号，但每个队
┃ 四 │ 三 │ 二 ┃员的球衣都与他们的站位号不同。已知１号、６号队员不在后排，
┠──┼──┼──┨２号、３号队员不是二传手，３号、４号队员不在同一排，５号、
┃ 五 │ 六 │ 一 ┃６号队员不是副攻手。
┗━━┷━━┷━━┛ 编程求每个队员的站位情况。
【算法分析】本题可用一般的穷举法得出答案。也可用回溯法。以下为回溯解法。
type sset=set of 1..6;
var a:array[1..6]of 1..6;
d:array[1..6]of sset;
i:integer;
procedure output; {输出}
begin
if not( (a[3]in [2,3,4])= (a[4] in[2,3,4])) then
begin { 3,4号队员不在同一排 }
write('number:');for i:=1 to 6 do write(i:8);writeln;
write('weizhi:');for i:=1 to 6 do write(a[i]:8);writeln;
end;
end;
procedure try(i:integer;s:sset); {递归过程 i:第i个人,s:哪些位置已安排人了}
var
j,k:integer;
begin
for j:=1 to 6 do begin {每个人都有可能站1-6这6个位置}
if (j in d[i]) and not(j in s) then begin
{j不在d[i]中,则表明第i号人不能站j位. j如在s集合中,表明j位已排人了}
a[i]:=j; {第 i 人可以站 j 位}
if i<6 then try(i+1,s+[j]) {未安排妥,则继续排下去}
else output; {6个人都安排完,则输出}
end;
end;
end;
begin
for i:=1 to 6 do d[i]:=[1..6]-[i]; {每个人的站位都与球衣的号码不同}
d[1]:=d[1]-[1,5,6];
d[6]:=d[6]-[1,5,6]; {1,6号队员不在后排}
d[2]:=d[2]-[2,5];
d[3]:=d[3]-[2,5]; {2,3号队员不是二传手}
d[5]:=d[5]-[3,6];
d[6]:=d[6]-[3,6]; {5,6号队员不是副攻手}
try(1,[]);
end.
【题目2】把自然数Ｎ分解为若干个自然数之和。
【参考答案】
n │ total 5 │ 7
6 │ 11
7 │ 15
10 │ 42
100 │ 190569291
var n:byte; num:array[0..255] of byte; total:word;
procedure output(dep:byte);
var j:byte;
begin
for j:=1 to dep do write(num[j]:3);writeln; inc(total);
end;
procedure find(n,dep:byte); {N:待分解的数,DEP:深度}
var i,j,rest:byte;
begin
for i:=1 to n do {每一位从N到1去试}
if num[dep-1]<=i then {保证选用的数大于前一位}
begin
num[dep]:=i;
rest:=n - i; {剩余的数进行下一次递归调用}
if (rest>0) then begin find(rest,dep+1);end
else if rest=0 then output(dep);{刚好相等则输出}
num[dep]:=0;
end;
end;
begin {主程序}
writeln('input n:');readln(n);
fillchar(num,sizeof(num),0);
total:=0; num[0]:=0;
find(n,1);
writeln('sum=',total);
end.
【题目3】火车调度问题：编号为1，2，……，n的n辆列车顺序进入一个栈式结构的站台。 试给出这n辆列车开出车站的所有可能次序的总数。（ 栈结构为后进先出）
输入文件共一行：一个整数n，表示火车的数量；(N < =10)
输出文件内容：可能出现的情况总数。
const max=10;
type shuzu=array[1..max] of 0..max;
var stack,exitout:shuzu;
n,total:integer;
procedure output(exitout:shuzu);
var i:integer;
begin
for i:=1 to n do write(exitout[i]:2);writeln;
inc(total);
end;
procedure find(dep,have,rest,exit_weizhi:integer;stack,exitout:shuzu);
{dep:步数,have:入口处有多少辆车;rest:车站中有多少车;}
{exit_weizhi:从车站开出后,排在出口处的位置;}
{stack:车站中车辆情况数组;exitout:出口处车辆情况数组}
var i:integer;
begin {分入站,出站两种情况讨论}
if have>0 then begin {还有车未入站}
stack[rest+1]:=n+1-have; {入站}
if dep=2*n then output(exitout)
else find(dep+1,have-1,rest+1,exit_weizhi,stack,exitout);
end;
if rest>0 then begin {还有车可出站}
exitout[exit_weizhi+1]:=stack[rest]; {出站}
if dep=2*n then output(exitout) {经过2n步后,输出一种方案}
else find(dep+1,have,rest-1,exit_weizhi+1,stack,exitout);
end;
end;
begin
writeln('input n:');
readln(n);
fillchar(stack,sizeof(stack),0);
fillchar(exitout,sizeof(exitout),0);
total:=0;
find(1,n,0,0,stack,exitout);
writeln('total:',total);
readln;
end.
【解法2】用穷举二进制数串的方法完成.
uses crt;
var i,n,m,t:integer;
a,s,c:array[1..1000] of integer;
procedure test;
var t1,t2,k:integer;
notok:boolean;
begin
t1:=0;k:=0;t2:=0;
i:=0;
notok:=false;
repeat {二进制数串中,0表示出栈,1表示入栈}
i:=i+1; {数串中第I位}
if a[i]=1 then begin {第I位为1,则表示车要入栈}
inc(k); {栈中车数}
inc(t1); {入栈记录,T1为栈指针,S为栈数组}
s[t1]:=k;
end
else {第I位为0,车要出栈}
if t1<1 then notok:=true {已经无车可出,当然NOT_OK了}
else begin inc(t2);c[t2]:=s[t1];dec(t1);end;
{栈中有车,出栈,放到C数组中去,T2为C的指针,栈指针T1下调1}
until (i=2*n) or notok; {整个数串均已判完,或中途出现不OK的情况}
if (t1=0) and not notok then begin {该数串符合出入栈的规律则输出}
inc(m);write('[',m,']');
for i:=1 to t2 do write(c[i]:2);
writeln;
end;
end;
begin
clrscr; write('N=');readln(n);
m:=0;
for i:=1 to 2*n do a[i]:=0; {
repeat {循环产生N位二进制数串}
test; {判断该数串是否符合车出入栈的规律}
t:=2*n;
a[t]:=a[t]+1; {产生下一个二进制数串}
while (t>1) and (a[t]>1) do begin
a[t]:=0;dec(t);a[t]:=a[t]+1;
end;
until a[1]=2;
readln;
end.
N: 4 6 7 8
TOTAL: 14 132 429 1430(共43张PPT)
起点
终点
1
2
3
1
2
3
1
2
3
1
2
3
在8行8列的棋盘上，如果两个皇后位于棋盘上的同一行或者同一列或者同一对角线上，则称他们为互相攻击。现要求找出使棋盘上的8个皇后互不攻击的所有布局。
1
2
3
4
5
6
7
8
1
2
3
4
5
6
7
8
1、每行放一个皇后，避免行攻击。
2、避免列攻击
b[j]=1就表示第j列已占。
3、避免对角线攻击
c[i-j]=1表示i-j这条对角线已占
d[i+j]=1表示i+j这条对角线已占
i+j=10
i , j
i-j=-2
var
a:array[1..8] of integer;
b,c,d:array[-7..16] of integer;
t,k:integer;
procedure print;
var k:integer;
begin
t:=t+1;
for k:=1 to 8 do write(a[k],' ');
writeln;
end;
procedure try(i:integer);
begin
for k:=-7 to 16 do
begin b[k]:=0; c[k]:=0; d[k]:=0; end;//三个标记数组清零
try(1);
writeln(t);
end.
procedure try(i:integer);
var j:integer;
begin
if i>8 then print；//摆好八个皇后输出
for j:=1 to 8 do //判断每个皇后都有的8种可能
if (b[j]=0) and (c[i-j]=0) and (d[i+j]=0) then //该位置未被占用
begin a[i]:=j; //摆放第i个皇后于第j列
b[j]:=1; //占领第j列
c[i-j]:=1; //占领两个对角线
d[i+j]:=1;
try(i+1); //递归摆放下一皇后
b[j]:=0; c[i-j]:=0; d[i+j]:=0; //回溯，清除占用标记
end;
end;
i=1
1 2 3 4
5 6 7 8
j
a[1]=1
b[1]=1
c[0]=1
d[2]=1
try(i+1)
i=2
1 2 3 4
5 6 7 8
j
a[2]=3
b[3]=1
c[-1]=1
d[5]=1
try(i+1)
i=3
1 2 3 4
5 6 7 8
a[3]=5
b[5]=1
c[-2]=1
d[5]=1
try(i+1)
i=4
1 2 3 4
5 6 7 8
a[4]=2
b[2]=1
c[2]=1
d[6]=1
try(i+1)
i=5
1 2 3 4
5 6 7 8
a[5]=4
b[4]=1
c[1]=1
d[9]=1
try(i+1)
i=6
1 2 3 4
5 6 7 8
此路
不通
回溯
b[4]=0
c[1]=0
d[9]=0
procedure try(i:integer);
var j:integer;
begin
if i>8 then print；//摆好八个皇后输出
for j:=1 to 8 do //判断每个皇后都有的8种可能
if (b[j]=0) and (c[i-j]=0) and (d[i+j]=0) then //该位置未被占用
begin a[i]:=j; //摆放第i个皇后于第j列
b[j]:=1; //占领第j列
c[i-j]:=1; //占领两个对角线
d[i+j]:=1;
try(i+1); //递归摆放下一皇后
b[j]:=0; c[i-j]:=0; d[i+j]:=0; //回溯，清除占用标记
end;
end;
i=1
1 2 3 4
5 6 7 8
j
a[1]=1
b[1]=1
c[0]=1
d[2]=1
try(i+1)
i=2
1 2 3 4
5 6 7 8
j
a[2]=3
b[3]=1
c[-1]=1
d[5]=1
try(i+1)
i=3
1 2 3 4
5 6 7 8
a[3]=5
b[5]=1
c[-2]=1
d[5]=1
try(i+1)
i=4
1 2 3 4
5 6 7 8
a[4]=2
b[2]=1
c[2]=1
d[6]=1
try(i+1)
i=5
1 2 3 4
5 6 7 8
a[5]=8
b[8]=1
c[-3]=1
d[13]=1
try(i+1)
i=6
1 2 3 4
5 6 7 8
此路
不通
回溯
b[8]=0
c[-3]=0
d[13]=0
b[2]=0
c[2]=0
d[6]=0
procedure try(i:integer);
var j:integer;
begin
if i>8 then print；//摆好八个皇后输出
for j:=1 to 8 do //判断每个皇后都有的8种可能
if (b[j]=0) and (c[i-j]=0) and (d[i+j]=0) then //该位置未被占用
begin a[i]:=j; //摆放第i个皇后于第j列
b[j]:=1; //占领第j列
c[i-j]:=1; //占领两个对角线
d[i+j]:=1;
try(i+1); //递归摆放下一皇后
b[j]:=0; c[i-j]:=0; d[i+j]:=0; //回溯，清除占用标记
end;
end;
i=1
1 2 3 4
5 6 7 8
j
a[1]=1
b[1]=1
c[0]=1
d[2]=1
try(i+1)
i=2
1 2 3 4
5 6 7 8
j
a[2]=3
b[3]=1
c[-1]=1
d[5]=1
try(i+1)
i=3
1 2 3 4
5 6 7 8
a[3]=5
b[5]=1
c[-2]=1
d[5]=1
try(i+1)
i=4
1 2 3 4
5 6 7 8
a[4]=7
b[7]=1
c[-3]=1
d[11]=1
try(i+1)
i=5
1 2 3 4
5 6 7 8
a[5]=2
b[2]=1
c[3]=1
d[7]=1
try(i+1)
1
2
3
4
5
6
7
8
1
2
3
4
5
6
7
8
Procedure try (当前状态);
var i:integer;
Begin
if 当前状态为边界 then
begin if 当前状态为最佳目标状态 then 记下最优结果;
exit;(回溯)
end;
For i:=1 算符最小值 to 算符最大值 do
begin
算符i作用于当前状态,扩展出一个子状态;
if (子状态满足状态条件) and (子状态满足最优性要求)
then try (递归调用子状态);
end;
End;
枚举该状态下的可能性
生成长度为n的字串，其字符从26个英文字母的前p(p<=26)个字母中选取，使得没有相邻的子序列相等。例如p=3，n=5时
‘a b c b a’满足条件
‘a b c b c’不满足条件
输入：n p 输出：满足条件的字串
3 2
aba
bab
2
生成长度为n的字串，其字符从26个英文字母的前p(p<=26)个字母中选取，使得没有相邻的子序列相等。例如p=3，n=5时
‘a b c b a’满足条件
‘a b c b c’不满足条件
输入：n p 输出：满足条件的字串
Procedure try (当前状态);
var i:integer;
Begin
if 当前状态为边界 then
begin if 当前状态为最佳目标状态 then 记下最优结果;
exit;(回溯)
end;
For i:=1 算符最小值 to 算符最大值 do
begin
算符i作用于当前状态,扩展出一个子状态;
if (子状态满足状态条件) and (子状态满足最优性要求)
then try (递归调用子状态);
end;
End;
1状态
状态定义为串长度
2边界
长度达到规定长度
3目标
没有相邻子序列且长度为n的串
3
从a字母到 chr(97+p)
p=3，n=5
S:=
a
a
b
a
a
b
c
a
生成第一个串：abaca
b
生成第二个串：abacb
c
b
c
a
a
b
生成第三个串：abcab
字串有没有达到规定长度
for j:=？ to Do 枚举该状态下的可能性
如果没有相邻子序列相等
就递归搜索下一个状态
回溯
写一下程序（除相邻子序列的判断外）
c
S:=
c
a
b
a
b
如何判断一个字串有没有相邻字序列
S:=
a
b
c
a
b
i:=1;
while (i <= at div 2 ) and
(copy(s,length(s)-i+1,i)<>copy(s,length(s)-2*i+1,i))
do inc(i);
i=1 c b
i=2 b c ca
i=3 ab c abc
var
n,p:integer;
tl:longint;
ed:char;
s:string;
begin
readln(n,p);
ed:=chr(ord('a')+p-1);
s:=''; tl:=0;
solve(1);
writeln('total=',tl);
end.
procedure solve(at:integer);
var ch:char;
i:integer;
begin
if at=n+1 then begin writeln(s); inc(tl); exit; end;
for ch:='a' to ed do
begin s:=s+ch;
i:=1;
while (i <= at div 2 ) and
(copy(s,length(s)-i+1,i)<>copy(s,length(s)-2*i+1,i))
do inc(i);
if i>at div 2 then solve(at+1);
delete(s,length(s),1);
end;
end;
某乡有n个村庄(1【输入】
村庄数n和各村之间的路程(均是整数)。
【输出】
最短的路程。
输入3 {村庄数}
0 2 l {村庄1到各村的路程}
1 0 2 {村庄2到各村的路程}
2 1 0 {村庄3到各村的路程}
输出 3
1
2
3
1
2
1
2
2
1
分析如何搜索
1
2
3
4
5
第一次搜索：1 2 3 4 5
第二次搜索：1 2 3 5 4
第三次搜索：1 2 4 3 5
第四次搜索：1 2 4 5 4
1
2
3
4
5
i=1
2 3 4 5
j
b[j]=false
s:=s+a[i,j]
try(j,p+1)
i=2
2 3 4 5
j
b[j]=false
s:=s+a[i,j]
try(j,p+1)
i=3
2 3 4 5
j
b[j]=false
s:=s+a[i,j]
try(j,np+1)
i=4
2 3 4 5
j
b[j]=false
s:=s+a[i,j]
try(j,p+1)
i=5
p=n
s:=s+a[i,1]
if smin:=s
b[j]:=true
s:=s-a[i,j]
var
a:array[1..40,1..40] of byte;
n,i,j:byte;
min,m:longint;
bj:array[1..40] of boolean;
begin
readln(n);
for i:=1 to n do
for j:=1 to n do read(a[i,j]);
fillchar(bj,sizeof(bj),true);
min:=99999999; m:=0;
road(1,1);
writeln(min);
end.
procedure road(step,be:byte);
var i,j,k:byte;
begin
if step=n then
begin
if m+a[be,1]min:=m+a[be,1];
exit;
end;
for i:=2 to n do
if (i<>be) and bj[i] then
begin
m:=m+a[be,i];
bj[i]:=false;
if mm:=m-a[be,i];
bj[i]:=true;
end;
end;
单词接龙是一个与我们经常玩的成语接龙相类似的游戏，现在我们己知一组单词，且
给定一个开头的字母，要求出以这个字母开头的最长的“龙”（每个单词都最多在“龙" 中
出现两次），在两个单词相连时，其重合部分合为一部分，例如beast和astonish，如果接成一条龙则变为beastonish，另外相邻的两部分不能存在包含关系，例如at和atide间不能相连。
输入:
输入的第一行为一个单独的整数n(n<=20）表示单词数，以下n行每行有一个单词，输
入的最后一行为一个单个字符，表来“龙”开头的字母。你可以假定以此字母开头的“龙"
一定存在。
输出:
只需输出以此字母开头的最长的“龙”的长度
样例:
输入
5
at
touch
cheat
choose
tact
a
输出
23 （连成的“龙”为atoucheatactactouchoose）
const
maxn=20;
var
s:array[1..maxn] of string; //存放单词
head:char; // 龙头
best,i,n:integer;
add:array[1..maxn,1..maxn] of integer;
//存放预处理结果
used:array[1..maxn] of integer;
//记录使用次数
Begin // 主程序
readln(n);
for i:=1 to n do
readln(s[i]);
readln(head);
calcadd; //预处理程序
best:=0;
fillchar(used,sizeof(used),0);
for i:=1 to n do
if s[i,1]=head then
begin
used[i]:=1;
search(i,length(s[i]));
used[i]:=0;
end;
writeln(best);
end.
procedure calcadd;
var
i,j,k,t,min:integer; ok:boolean;
begin
for i:=1 to n do
for j:=1 to n do
begin
if length(s[i])for k:=1 to min-1 do
begin
ok:=true;
if copy(s[j],1,k)<>copy(s[i],length(s[i])-k+1,k) then
ok:=false;
if ok then break;
end;
if ok then add[i,j]:=length(s[j])-k else add[i,j]:=0;
end;
end;
0 4 0 0 3
0 0 3 4 0
0 4 0 0 3
0 0 0 0 0
0 4 0 0 3
at
touch
cheat
choose
tact
procedure search(last,len:integer);
var
i:integer;
begin
if len>best then
best:=len;
for i:=1 to n do
if (add[last,i]>0)and(used[i]<2) then
begin
inc(used[i]);
search(i,len+add[last,i]);
dec(used[i]);
end;
end;
0 4 0 0 3
0 0 3 4 0
0 4 0 0 3
0 0 0 0 0
0 4 0 0 3
at
touch
cheat
choose
tact
例6．装箱问题（NOIP2001初中组复赛第四题）
问题描述
有一个箱子容量为V（正整数，0≤V≤20000），同时有n个物品（0要求从n个物品中，任取若干个装入箱内，使箱子的剩余空间最小。
输入：一行整数，第一个数表示箱子的容量，第二个数表示有n个物品，后面n个数分别表示这n个物品各自的体积。
输出：一个整数，表示箱子剩余空间。
样例
输入：
24 6 8 3 12 7 9 7
输出： 方案:放入3 12 9
0
var v,n,i,j,k,min:longint;
a:array[1..30] of integer;
b:array[1..30] of boolean;
procedure try(p:longint);
var i,j:longint;
begin
if pfor i:=1 to n do
if (p>=a[i])and(b[i]) then
begin
b[i]:=false;
try(p-a[i]);
b[i]:=true;
end;
end;
begin
read(v);
read(n);
for i:=1 to n do
begin read(a[i]); b[i]:=true; end;
min:=v;
try(v);
writeln(min);
end.
搜索方法一：5个测试点能过2点
8 3 12 9 7 9
T T T T T T
b
var v,n,i,j,k,min,p:longint;
a:array[1..30] of integer;
b:array[1..30] of boolean;
procedure try;
var i,j:longint;
begin
if pfor i:=1 to n do
if (p>=a[i])and(b[i]) then
begin
b[i]:=false;
p:=p-a[i]
try;
b[i]:=true;
p:=p+a[i];
end;
end;
begin
read(v);
read(n);
for i:=1 to n do
begin read(a[i]); b[i]:=true; end;
min:=v;
p:=v;
try;
writeln(min);
end.
搜索方法一：5个测试点能过2点
8 3 12 9 7 9
T T T T T T
b
F
p
16
F
13
F
1
F
4
F
6
F
4
F
4
var v,n,i,j,k,min,p:longint;
a:array[1..30] of integer;
b:array[1..30] of boolean;
procedure try;
var i,j:longint;
begin
if pfor i:=1 to n do
if (p>=a[i])and(b[i]) then
begin
b[i]:=false;
p:=p-a[i]
try;
b[i]:=true;
p:=p+a[i];
end;
end;
begin
read(v);
read(n);
for i:=1 to n do
begin read(a[i]); b[i]:=true; end;
min:=v;
p:=v;
try;
writeln(min);
end.
搜索方法一：5个测试点能过2点
8 3 12 9 7 9
T T T T T T
b
p
F
21
F
13
F
1
var v,n,i,j,k,min:longint;
a:array[1..30] of integer;
b:array[1..30] of boolean;
procedure try(be,p:longint);
var i,j:longint;
begin
if pfor i:=be+1 to n do
if (p>=a[i])and(b[i])
then begin b[i]:=false;
try(be,p-a[i]);
b[i]:=true;
end;
end;
begin
read(v);
read(n);
for i:=1 to n do
begin
read(a[i]);
b[i]:=true;
end;
min:=v;
try(0,v);
writeln(min);
end.
从i个物品开始搜索
V-a[i]表示箱子剩余体积
搜索方法二：5个测试点能过3点
var
v,n,i,best:integer;
box,s:array[0..30] of longint;
begin
readln(v);
readln(n);
s[0]:=0;
for i:=1 to n do
begin
readln(box[i]);
s[i]:=s[i-1]+box[i];
end;
best:=v;
if s[n]<=v then best:=v-s[n]
else search(1,v);
writeln(best);
end.
box1 box2 box3 box4 box5 box6
8 3 12 7 9 7
s1 s2 s3 s4 s5 s6
8 11 23 30 39 46
V=24
搜索方法三：5个测试点能全过
procedure search(k,v:integer);
begin
if vif v-(s[n]-s[k-1])>=best then exit; 剩余物品全装入后，箱子体积仍比best大
if k<=n then
begin
if v>=box[k]
then search(k+1,v-box[k]);
search(k+1,v);
end;
end;
box1 box2 box3 box4 box5 box6
8 3 12 7 9 7
s1 s2 s3 s4 s5 s6
8 11 23 30 39 46
V=24
procedure search(k,v:integer);
begin
if vif v-(s[n]-s[k-1])>=best then exit; 剩余物品全装入后，箱子体积仍比best大
if k<=n then
begin
if v>=box[k]
then search(k+1,v-box[k]);
search(k+1,v);
end;
end;
box1 box2 box3 box4 box5 box6
8 3 12 7 9 7
s1 s2 s3 s4 s5 s6
8 11 23 30 39 46
V=24
16
放
13
放
1
放
1
不
1
不
1
不
procedure search(k,v:integer);
begin
if vif v-(s[n]-s[k-1])>=best then exit; 剩余物品全装入后，箱子体积仍比best大
if k<=n then
begin
if v>=box[k]
then search(k+1,v-box[k]);
search(k+1,v);
end;
end;
box1 box2 box3 box4 box5 box6
8 3 12 7 9 7
s1 s2 s3 s4 s5 s6
8 11 23 30 39 46
V=24
16
放
13
放
13
不
6
放
6
不
6
不
procedure search(k,v:integer);
begin
if vif v-(s[n]-s[k-1])>=best then exit; 剩余物品全装入后，箱子体积仍比best大
if k<=n then
begin
if v>=box[k]
then search(k+1,v-box[k]);
search(k+1,v);
end;
end;
box1 box2 box3 box4 box5 box6
8 3 12 7 9 7
s1 s2 s3 s4 s5 s6
8 11 23 30 39 46
V=24
16
放
13
放
13
不
13
不
4
放
4
不
procedure search(k,v:integer);
begin
if vif v-(s[n]-s[k-1])>=best then exit; 剩余物品全装入后，箱子体积仍比best大
if k<=n then
begin
if v>=box[k]
then search(k+1,v-box[k]);
search(k+1,v);
end;
end;
box1 box2 box3 box4 box5 box6
8 3 12 7 9 7
s1 s2 s3 s4 s5 s6
8 11 23 30 39 46
V=24
16
放
13
放
13
不
13
不
13
不
6
放
13
不
procedure search(k,v:integer);
begin
if vif v-(s[n]-s[k-1])>=best then exit; 剩余物品全装入后，箱子体积仍比best大
if k<=n then
begin
if v>=box[k]
then search(k+1,v-box[k]);
search(k+1,v);
end;
end;
box1 box2 box3 box4 box5 box6
8 3 12 7 9 7
s1 s2 s3 s4 s5 s6
8 11 23 30 39 46
V=24
16
放
16
不
4
放
4
不
4
不
4
不
procedure search(k,v:integer);
begin
if vif v-(s[n]-s[k-1])>=best then exit;
if k<=n then
begin
if v>=box[k]
then search(k+1,v-box[k])
else search(k+1,v);
end;
end;
procedure search(k,v:integer);
begin
if vif v-(s[n]-s[k-1])>=best then exit;
if k<=n then
begin
if v>=box[k]
then search(k+1,v-box[k]);
search(k+1,v);
end;
end;
box1 box2 box3 box4 box5 box6
8 3 12 7 9 7
16
放
13
放
1
放
1
不
1
不
1
不
辰辰是个天资聪颖的孩子，他的梦想是成为世界上最伟大的医师。为此，他想拜附近最有威望的医师为师。医师为了判断他的资质，给他出了一个难题。医师把他带到一个到处都是草药的山洞里对他说：“孩子，这个山洞里有一些不同的草药，采每一株都需要一些时间，每一株也有它自身的价值。我会给你一段时间，在这段时间里，你可以采到一些草药。如果你是一个聪明的孩子，你应该可以让采到的草药的总价值最大。” 　　如果你是辰辰，你能完成这个任务吗？ 输入的第一行有两个整数T（1 <= T <= 1000）和M（1 <= M <= 100），用一个空格隔开，T代表总共能够用来采药的时间，M代表山洞里的草药的数目。接下来的M行每行包括两个在1到100之间（包括1和100）的整数，分别表示采摘某株草药的时间和这株草药的价值。
输入 70 3
71 100
69 1
1 2
输出 3
var
max,i,n,ti:longint;
t,v,f:array[1..1000] of integer;
procedure fa(x,y:longint);
begin
fillchar(f,sizeof(f),0);
max:=0;
read(ti,n);
for i:=1 to n do
read(t[i],v[i]);
fa(0,0);
writeln(max);
end.
procedure fa(x,y:longint);
var
ii,jj,kk,ll:longint;
begin
if y>max then max:=y;
for ii:=1 to n do
if (f[ii]<>1)and(t[ii]<=ti-x)
then begin
f[ii]:=1;
fa(x+t[ii],y+v[ii]);
f[ii]:=0;
end;
end;
四色问题：
设有下列形状：有n个区域（1 ≤ n≤100 ），各区域的相邻关系用0（不相邻），1（相邻）表示。例如下表的邻接矩阵对应于右图。
0 1 0 0 0 0 1 1
1 0 1 0 0 1 1 0
0 1 0 1 0 1 0 0
0 0 1 0 1 1 0 0
0 0 0 1 0 1 0 0
0 1 1 1 1 0 1 0
1 1 0 0 0 1 0 1
1 0 0 0 0 0 1 0
1 2 3 4 5 6 7 8
1
2
3
4
5
6
7
8
1
2
3
4
8
7
6
5
4
0 1 1 0
1 0 0 1
1 0 0 1
0 1 1 0
84
var
ys:array[1..100] of integer;
//记录每个国家的颜色
d:array[1..100,1..100] of integer;
n,i,j,:integer;
total:longint;
procedure print; // 打印方案
var i:integer;
begin
for i:=1 to n do
write(ys[i],‘ ’); writeln; total:=total+1;
end;
begin
readln(n);
total:=0;
for i:=1 to n do
for j:=1 to n do
read(d[i,j]);
fillchar(ys,sizeof(ys),0);
try(1); //搜索第一个国家的颜色
writeln(total);
end.
procedure try(setp:integer);
var f:boolean;
i,j:integer;
begin
if setp>n then begin print; exit; end;
for i:=1 to 4 do
begin
ys[setp]:=i;
f:=true;
for j:=1 to n do
if (d[setp,j]<>0) and (ys[setp]=ys[j]) then begin f:=false; break; end;
if f then try(setp+1);
ys[setp]:=0;
end;
end;
走迷宫
【问题描述】
有一个m*n格的迷宫(表示有m行、n列)，其中有可走的也有不可走的，如果用1表示可以走，0表示不可以走，文件读入这m*n个数据和起始点、结束点(起始点和结束点都是用两个数据来描述的，分别表示这个点的行号和列号)。现在要你编程找出所有可行的道路，要求所走的路中没有重复的点，走时只能是上下左右四个方向。如果一条路都不可行，则输出相应信息(用-l表示无路)。
【输入】
第一行是两个数m，n(1<(m，n)<15)，接下来是m行n列由1和0组成的数据，最后两行是起始点和结束点。
【输出】
所有可行的路径，描述一个点时用(x，y)的形式，除开始点外，其他的都要用“一>”表示方向。
如果没有一条可行的路则输出-1。
输入 5 6
1 0 0 1 0 1
1 1 1 1 1 1
0 0 1 1 1 0
1 1 1 1 1 0
1 1 1 0 1 1
1 1
5 6
输出 8
3 3
1 1 1
1 1 1
1 1 1
2 2
3 3
输入
输出 12
文件名：mg.pas 输入：mg.in 输出：mg.out
5 6
1 0 0 1 0 1
1 1 1 1 1 1
0 0 1 1 1 0
1 1 1 1 1 0
1 1 1 0 1 1
1 1
5 6
1 0 0 1 0 1
1 1 1 1 1 1
0 0 1 1 1 0
1 1 1 1 1 0
1 1 1 0 1 1
1 2 3 4 5 6
1
2
3
4
5
0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 0 0
1 2 3 4 5 6
1
2
3
4
5
ro
bj
1
1
dx
dy
1
4 x,y 2
3
这个查找过程用search来描述如下：
procedure search(x, y, b, p)；{x，y表示某一个点，b是已经过的点的情况，p是已走过的路}
begin
for i:＝1 to 4 do{分别对4个点进行试探}
begin
先记住当前点的位置，已走过的情况和走过的路；如果第i个点(xl，y1)
可以走，则走过去；如果已达终点，则输出所走的路径并置有路可走的信息，
否则继续从新的点往下查找search(xl，y1，b1，p1)；
end；
end；回溯法
回溯法是一种选优搜索法，按选优条件向前搜索，以达到目标。但当探索到某一步时，发现原先选择并不优或达不到目标，就退回一步重新选择，这种走不通就退回再走的技术为回溯法，而满足回溯条件的某个状态的点称为“回溯点”。
一般操作包括：
1.用栈保存好前进中的某些状态。
2.制定好约束条件。
3.以深度优先方式搜索解空间，并在搜索过程中用剪枝函数避免无效搜索。
例.n个皇后问题:
program hh;
const n=8;
var i,j,k:integer;
x:array[1..n] of integer; //用来记录第n个皇后的位置
function place(k:integer):boolean; //判断第k个皇后是否和前面的皇后冲突
var i:integer;
begin
place:=true;
for i:=1 to k-1 do
if (x[i]=x[k]) or (abs(x[i]-x[k])=abs(i-k)) then
place:=false ;
end;
procedure print; //输出一组解
var i:integer;
begin
for i:=1 to n do write(x[i]:4);
writeln;
end;
begin
k:=1;x[k]:=0;
while k>0 do
begin
x[k]:=x[k]+1;
while (x[k]<=n) and (not place(k)) do x[k]:=x[k]+1;
if x[k]>n then k:=k-1 //第k个到n时还没找到合适位置，回溯到上一个皇后的位置。
else if k=n then print //n个皇后都找到位置了，就输出方案。
else begin k:=k+1;x[k]:=0 end //否则，继续探究下一个皇后的位置。
end ;
end.
回溯算法的公式如下:
回溯算法的递归实现
由于回溯算法用一栈数组实现的,用到栈一般可用递归实现。
例：n皇后问题的递归算法如下：
程序1：
program hh;
const n=8;
var i,j,k:integer;
x:array[1..n] of integer;
function place(k:integer):boolean;
var i:integer;
begin
place:=true;
for i:=1 to k-1 do
if (x[i]=x[k]) or (abs(x[i]-x[k])=abs(i-k)) then
place:=false ;
end;
procedure print;
var i:integer;
begin
for i:=1 to n do write(x[i]:4);
writeln;
end;
procedure try(k:integer);
var i:integer;
begin
if k=n+1 then begin print; exit end;
for i:= 1 to n do //对于每个皇后分别占据1..n的位置进行递归探究。
begin
x[k]:=i;
if place(k) then try(k+1);
end;
end ;
begin
try(1);
end.
程序2：
说明:当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 //表示皇后可以占用j位置。
begin
a[i]:=j;c[j]:=false;l[i-j]:=false; r[i+j]:=false; //占用j位置后棋盘状态改变
if i 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.
练习：
外星生命
地球上的科学家收到了来自外星的信号：000023*000011=002093，科学家猜想这是某个外星人的年龄。但有人指出，这些外星人好像不怎么聪明，因为23*11=253，而非2093。但是科学家们发现，如果把000011改成00091的话算式就成立了。他们认为这是接收信号的时候出了差错的缘故。
现在给你这样一个算式，问最少改动几个数字就能使得算式成立？（格式是 * = ，忽略进位）
数的划分
将整数n分成k份，且每份不能为空，任意两种分法不能相同(不考虑顺序)，例如：n=7，k=3，下面三种分法被认为是相同的：1，1，5；1，5，1；5，1，1。问有多少种不同的分法。
提示：很清楚，这是一道整数分解的问题。这种分解，较为直接的思路是递归。我们在本题可以采用深度优先搜索的方法。
我们定义一个过程，使其反复递归穷举第1份、第2份……第k份，然后寻找出可行的路径，时间复杂度O(nk)。这种方法思路十分便捷，但也许会超时。
我们有两个很好的剪枝：
剪枝1：如果剩余的够不上最小的则剪去。这是显而易见的常理，但是可以加快速度。剪枝2：枚举到剩余1个盘子时判断是否可行。也是加快速度的方法，使在题目所描述的n和k的范围之中完全可行。
重复的只算一种，我们怎么样处理有关重复的呢？我们可以引入一个参数min，作为至少每一个要达到min，顺序由小而大，逐层递归。

展开更多......

收起↑