Dijkstra最短路径（一点到各顶点最短路径）
{本程序解决6个顶点之间的最短路径问题,各顶点间关系的数据文件在sj.txt中}
{如果顶点I到顶点J不能直达就设置距离为30000}
program dijkstra;
type
jihe=set of 0..5;
var
a:array[0..5,0..5] of integer;
dist:array[0..5] of integer;
i,j,k,m,n:integer;
fv:text;
s:jihe;
begin
s:=[0];
assign(fv,'sj.txt');
reset(fv);
for i:=0 to 5 do {从文件中读数据,其中a[i,j]代表从顶点i到顶点j的直达距离,如果不通用30000代替}
begin
for j:=0 to 5 do read(fv,a[i,j]);
readln(fv)
end;
for i:=1 to 5 do {设置DIST数组的初始值,即为顶点0到各顶点的直达距离(算法的第一步)}
dist[i]:=a[0,i];
for i:=1 to 5 do
begin
m:=0;
dist[m]:=30000; {设置DIST[M]的目的是为下面的一步做准备,即在DIST数组中一个最小的值}
for j:=1 to 5 do {算法的第二步,找最小的DIST值}
if (not (j in s)) and (dist[m]>dist[j])
then m:=j ; {用M来记录到底是哪个顶点}
s:=s+[m]; {把顶点加入S中}
for k:=1 to 5 do {算法的第三步,修改后面的DIST值}
if (not (k in s)) and (dist[k]>dist[m]+a[m,k])
then
dist[k]:=dist[m]+a[m,k]
end;
writeln('原各顶点间的路径关系是：（30000代表不通）');
for i:=0 to 5 do
begin
for j:=0 to 5 do write(a[i,j]:6);
writeln
end;
writeln; writeln;
一躺快速排序法
佚名
{快速排序法的一躺排序程序}
program kuaisu(input,output);
type
arr=array[1..7] of integer;
var
a:arr;
i,j,k:integer;
procedure sort(var a:arr;var m,n:integer);
var
x,p,q:integer;
begin
x:=a[m];
repeat
while ((m<n) and (a[n]>x)) do n:=n-1;
p:=a[m];a[m]:=a[n];a[n]:=p;
while ((m<n) and (a[m]<x)) do m:=m+1;
p:=a[m];a[m]:=a[n];a[n]:=p
until m=n
end;
begin
writeln('input 10 integer num:');
i:=1;j:=1;k:=7;
repeat
read(a[i]);
i:=i+1;
until i>7;
sort(a,j,k);
for i:=1 to 7 do
write(a[i]:4);
writeln('j=',j:4,'k:',k:4)
end.
快速排序算法
佚名
快速排序是对冒泡排序的一种改进。它的基本思想是：通过一躺排序将要排序的数据分割成独立的两部分，其中一部分的所有数据都比另外一不部分的所有数据都要小，然后再按次方法对这两部分数据分别进行快速排序，整个排序过程可以递归进行，以此达到整个数据变成有序序列。
假设要排序的数组是A[1]……A[N]，首先任意选取一个数据（通常选用第一个数据）作为关键数据，然后将所有比它的数都放到它前面，所有比它大的数都放到它后面，这个过程称为一躺快速排序。一躺快速排序的算法是：
1）、设置两个变量I、J，排序开始的时候I：=1，J：=N；
2）以第一个数组元素作为关键数据，赋值给X，即X：=A[1]；
3）、从J开始向前搜索，即由后开始向前搜索（J：=J-1），找到第一个小于X的值，两者交换；
4）、从I开始向后搜索，即由前开始向后搜索（I：=I+1），找到第一个大于X的值，两者交换；
5）、重复第3、4步，直到I=J；
例如：待排序的数组A的值分别是：（初始关键数据X：=49）
A[1] A[2] A[3] A[4] A[5] A[6] A[7]：
49 38 65 97 76 13 27
进行第一次交换后： 27 38 65 97 76 13 49
( 按照算法的第三步从后面开始找
进行第二次交换后： 27 38 49 97 76 13 65
( 按照算法的第四步从前面开始找>X的值，65>49,两者交换，此时I：=3 )
进行第三次交换后： 27 38 13 97 76 49 65
( 按照算法的第五步将又一次执行算法的第三步从后开始找
进行第四次交换后： 27 38 13 49 76 97 65
( 按照算法的第四步从前面开始找大于X的值，97>49,两者交换，此时J：=4 )
此时再执行第三不的时候就发现I=J，从而结束一躺快速排序，那么经过一躺快速排序之后的结果是：27 38 13 49 76 97 65，即所以大于49的数全部在49的后面，所以小于49的数全部在49的前面。
快速排序就是递归调用此过程——在以49为中点分割这个数据序列，分别对前面一部分和后面一部分进行类似的快速排序，从而完成全部数据序列的快速排序，最后把此数据序列变成一个有序的序列，根据这种思想对于上述数组A的快速排序的全过程如图6所示：
初始状态 {49 38 65 97 76 13 27}
进行一次快速排序之后划分为 {27 38 13} 49 {76 97 65}
分别对前后两部分进行快速排序 {13} 27 {38}
结束 结束 {49 65} 76 {97}
49 {65} 结束
结束
图6 快速排序全过程
1）、设有N（假设N=10）个数，存放在S数组中；
2）、在S[1。。N]中任取一个元素作为比较基准，例如取T=S[1]，起目的就是在定出T应在排序结果中的位置K，这个K的位置在：S[1。。K-1]<=S[K]<=S[K+1..N]，即在S[K]以前的数都小于S[K]，在S[K]以后的数都大于S[K]；
3）、利用分治思想（即大化小的策略）可进一步对S[1。。K-1]和S[K+1。。N]两组数据再进行快速排序直到分组对象只有一个数据为止。 1 2 3 4 5 6 7 8 9 10
如具体数据如下，那么第一躺快速排序的过程是：
数组下标：
45 36 18 53 72 30 48 93 15 36
（
（
（
（
（
通过一躺排序将
program kuaisu(input,output);
const n=10;
var
s:array[1..10] of integer;
k,l,m:integer;
procedure qsort(lx,rx:integer);
var
I,j,t:integer;
Begin
I:lx;j:rx;t:s[I];
Repeat
While (s[j]>t) and (j>I) do
Begin
k:=k+1;
j:=j-1
end;
if I<j then
begin
s[I]:=s[j];I:=I+1;l:=l+1;
while (s[I]<t) and (I<j) do
begin
k:=k+1;
I:=I+1
End;
If I<j then
begin
S[j]:=s[I];j:=j-1;l:=l+1;
End;
End;
Until I=j;
S[I]:=t;I:=I+1;j:=j-1;l:=l+1;
If lx<j then qsort(lx,j);
If I<rx then qsort(I,rx)
End;{过程qsort结束}
Begin
Writeln('input 10 integer num:');
For m:=1 to n do read(s[m]);
K:=0;l:=0;
Qsort(l,n);
Writeln('排序后结果是：')；
For m:=1 to n do write(s[m]:4)
End.
高精度乘法
{说明：用字符串来存放乘数，最大限制255位乘255位}
program jjzx; {本程序只考虑整数相乘}
var
s1,s2:string;
a,b:array[1..255] of integer;
c:array[1..510] of integer; {数组C用来存放结果，最大510位，为什么？}
i,j,l,m,k1,k2,x,y,z,w:integer;
begin
writeln('input s1:'); readln(s1);
writeln('input s2:'); readln(s2);
l:=length(s1); m:=length(s2); {得到两个字符串的长度}
k1:=0;
for i:=l downto 1 do {S1转换过程，把低位放在A[1]中}
begin
k1:=k1+1;
a[k1]:=ord(s1[i])-48;
end;
k2:=0;
for i:=m downto 1 do {S2转换过程，把低位放在B[1]中}
begin
k2:=k2+1;
b[k2]:=ord(s2[i])-48 ;
end;
for i:=1 to k1 do {开始计算，从低位开始乘}
for j:=1 to k2 do
begin
x:=a[i]*b[j];
y:=x div 10;
z:=x mod 10;
w:=i+j-1;
c[w]:=c[w]+z;
c[w+1]:=c[w+1]+y+c[w] div 10;
c[w]:=c[w]mod 10
end;
w:=k1+k2;
if c[w]=0 then w:=w-1; {判断最高位是否有数}
writeln('相乘结果是 :');
for i:=w downto 1 do write(c[i]);{输出的时候注意顺序}
writeln
end.
高精度减法
{说明：用字符串来存放减数和被减数，最大限制255位减255位}
program jjzx; {本程序没有考虑两负数相减}
var s,s1,s2:string;
a,b,c:array[1..260] of integer;
i,l,m,k1,k2:integer;
d:char; {D用来表示正负号}
begin
writeln('input s1:');readln(s1);
writeln('input s2:');readln(s2);
l:=length(s1); m:=length(s2);
if l
begin
s:=s1; s1:=s2; s2:=s; d:='-'
end;
if l=m then {如果长度一样则直接比较，S1小就要与S2调换}
if s1
begin
s:=s1;s1:=s2;s2:=s;d:='-'
end;
l:=length(s1); m:=length(s2); {为什么要再次得到长度}
k1:=261; {为什么是261}
for i:=l downto 1 do {S1转换过程}
begin
k1:=k1-1;
a[k1]:=ord(s1[i])-48
end;
k2:=261;
for i:=m downto 1 do {S2转换过程}
begin
k2:=k2-1;
b[k2]:=ord(s2[i])-48
end;
for i:=260 downto k1 do {开始计算}
if a[i] begin
c[i]:=a[i]+10-b[i];
a[i-1]:=a[i-1]-1 {为什么下标是I-1}
end
else
c[i]:=a[i]-b[i];
writeln('jie guo shi :');
write(d:2); {首先输出符号位}
for i:=k1 to 260 do write(c[i]);
writeln
end.
高精度阶乘
program jjzx; {本程序最大限制为求N(N<999)的阶乘}
var
a,b,c:array[1..1000] of integer;
i,j,l,m,k1,k2,x,y,z,w,n,t:integer;
procedure chengfa; {高精度乘法}
begin
for l:=1 to k1 do
for m:=1 to k2 do
begin
x:=a[l]*b[m];
y:=x div 10;
z:=x mod 10;
w:=l+m-1;
c[w]:=c[w]+z;
c[w+1]:=c[w+1]+y+c[w] div 10;
c[w]:=c[w]mod 10
end;
k1:=k1+k2; {位数为K1、K2的两数相乘最大只有K1+K2位}
if c[k1]=0 then k1:=k1-1; {如果最高位为0则位数减少一位}
for t:=1 to k1 do a[t]:=c[t]; {把一次高精度相乘的结果放到A数组中，以便下次相乘}
for t:=1 to k1 do c[t]:=0; {同时把数组C清空，以便下次相乘,因为每调用此过程一次都是一次 全新的高精度乘法，所以数组C必须清空}
end;
procedure zhuanhuan; {把I每一位分解开分别赋值给数组B的每一个元素}
begin
if i>=100 then
begin
k2:=3;
b[3]:=i div 100;
b[2]:=(i-b[3]*100) div 10;
b[1]:=i-b[3]*100-b[2]*10
end
else
if i>=10
then
begin
k2:=2;
b[2]:=i div 10;
b[1]:=i-b[2]*10
end
else
begin
k2:=1;
b[1]:=i
end;
end;
begin
writeln('input:');
readln(n);
a[1]:=1; {最后结果放在数组A中}
k1:=1;
for i:=2 to n do
begin
zhuanhuan;
chengfa;
end;
writeln(n:2,'!= ');
for i:=k1 downto 1 do write(a[i])
end.
最简单的动态规划-数塔
有形如图 1.3-8 所示的数塔，从顶部出发，在每一结点可以选择向左走或是向右走，一起走到底层，要求找出一条路径，使路径上的值最大。
图 1.3-8
输入文件(shuta.in)：第一行只有一个数n，代表行数。以下n行每行有i个数，（i）代表相应的行号。(点击此处下载输出文件）
输出文件(shuta.ou)
这道题如果用枚举法，在数塔层数稍大的情况下（如 40 ），则需要列举出的路径条数将是一个非常庞大的数目。 如果用贪心法又往往得不到最优解。 在用动态规划考虑数塔问题时可以自顶向下的分析，自底向上的计算。从顶点出发时到底向左走还是向右走应取决于是从左走能取到最大值还是从右走能取到最大值，只要左右两道路径上的最大值求出来了才能作出决策。同样的道理下一层的走向又要取决于再下一层上的最大值是否已经求出才能决策。这样一层一层推下去，直到倒数第二层时就非常明了。如数字 2 ，只要选择它下面较大值的结点 19 前进就可以了。 所以实际求解时，可从底层开始，层层递进，最后得到最大值。 实际求解时应掌握其编程的一般规律， 通常需要哪几个关键数组来存储变化过程 这一点非常重要。 数塔问题的样例程序如下：
var a:array[1..50,1..50,1..3] of longint;
{ 第一维记原状态，第二维参与计算，第三维记录决策， 0 向左， 1 向右。浪费啊，不如开三个一维，或三元组（指针处理麻烦，类似三角矩阵存储） }
i,j,n:integer;
begin
write( 'please input the number of rows:');
readln(n);
for i:=1 to n do
for j:=1 to i do { 行元素数等于行数 }
begin
read(a[i,j,1]);
a[i,j,2]:=a[i,j,1];
a[i,j,3]:=0
end;
{ 计算 =================================}
for i:=n-1 downto 1 do { 行选择（始于倒数第二行），阶段 }
for j:=1 to i do { 列选择，状态 }
if a[i+1,j,2]>a[i+1,j+1,2] then { 左强 }
begin a[i,j,2]:=a[i,j,2]+a[i+1,j,2];
{ 累计结果（父 + 左） } a[i,j,3]:=0 { 记录决策（选左） }
end
else { 右强 }
begin a[i,j,2]:=a[i,j,2]+a[i+1,j+1,2];
{ 累计结果（父 + 右） } a[i,j,3]:=1 { 记录决策（选右） }
end;
{=== 输出 ==========}
writeln('max=',a[1,1,2]); { 最大值 }
j:=1; for i:=1 to n-1 do
begin write(a[i,j,1],'->');
j:=j+a[i,j,3]
end;
writeln(a[n,j,1]) end.
总结：此题是最为基础的动态规划题目，阶段、状态的划分一目了然。
而决策的记录，充分体现了动态规划即“记忆化搜索”的本质。
常用算法——深度优先搜索
佚名
我们在对一些问题进行求解时，会发现有些问题很难找到规律，或者根本无规律可寻。对于这样的问题，可以利用计算机运算速度快的特点，先搜索查找所有可能出现的情况，再根据题目条件从所有可能的情况中，删除那些不符合条件的解。
【例题1】 有A、B、C、D、E 5本书，要分给张、王、刘、赵、钱5位同学，每人只能选1本。每个人都将自己喜爱的书填写在下表中。请你设计一个程序，打印出让每个人都满意的所有分书方案。
┌──┬───┬───┬───┬───┬───┐
││Ａ │ Ｂ │ Ｃ │ Ｄ │ Ｅ │
├──┼───┼───┼───┼───┼───┤
│张│││√│√││00110
├──┼───┼───┼───┼───┼───┤
│王│√│√│││√│11001
├──┼───┼───┼───┼───┼───┤
│刘││√│√│││01100
├──┼───┼───┼───┼───┼───┤
│赵││││√││00010
├──┼───┼───┼───┼───┼───┤
│钱││√│││√│01001
└──┴───┴───┴───┴───┴───┘
★问题分析
题目中每人喜爱哪本书是随意的，无规律可循，所以用穷举方法解较为合适。按穷举法的一般算法，可以暂不考虑一些条件，先求出满足部分条件的解，即可行解。然后，再加上尚未考虑的条件，从可行解中删除不符合这些条件的解，留下的就是问题的解。具体到本题中，我们可以先不考虑“让每人都满意”这个条件，这样，就只剩“每人选一本且只能选一本”这一个条件了。在这个条件下，可行解是5本书的所有全排列，一共有5!=120种情况。从这120种可行解中删去不符合“每人都满意”这一条件的解，剩下的就是本题的解。
为编程方便，我们用1、2、3、4、5分别表示这5本书。这5个数字的—种全排列就是5本书的一种分法。例如54321就表示第五本书(即E)分给张，第四本书(即D)分给王……，第—本书(即A)分给钱。
每个人“喜爱书表”，在程序中我们用二维数组Like[i,j]来表示，1表示喜爱，0表示不喜爱。排列的产生可以用穷举法，也可以用专门算法。
★算法设计：
第一步：产生5个数字的一个全排列；
第二步：检查所产生的全排列是否符合“喜爱书表”，如果符合就输出；
第三步：检查是否所有排列都产生了，如果没有产生完，则返回第一步；
第四步：结束。
根据题目给出的条件，还可以对上面算法进行一些改进。例如产生一个全排列12345时，第一个数1表示将第一本书给小张。但从表中可以看出，这是不可能的，因为小张只喜欢第三、第四本书。也就是说，１X X X X这一类分法是不符合条件的。由此使我们想到，如果选定第一本书后，就立即检查一下是否符合条件，当发现第一个数的选择不符合条件时，就不必再产生后面的4个数了，这样做可以减少很多的运算量。换句话说，第一个数只在3和4中选择，这样就可以减少3／5的运算量。同理，在选定了第一个数后，其他4个数字的选择也可以用类似的方法处理，即选择第二个数后，立即检查是否符合条件。例如，第一个数选3，第二个数选4后，立即进行检查，发现不符合条件，就另选第二个数。这样就又把34XXX一类的分法删去了，从而又减少了一部分运算量。
综上所述，改进后本题算法应该是：在产生各种排列时，每增加一个数字，就检查一下该数的加入是否符合条件，如不符合，就立刻换一个；若符合条件，则再产生下一个数。因为从第i本书到第i+1本书的寻找过程是相同的，所以可以用递归方法编程。
★算法框图
PROCEDURE TRY(i)；(递归算法)
┌─────────────────────┐
│For j:= 1 to 5 do │
├─┬───────────────────┤
││T＼第I个学生喜爱第j本书／F│
│├────────────┬──────┤
││记录第 i个数││
│├────────────┤│
││＼i= 5／││
││T＼／ F ││
│├─────┬──────┤│
││打印一个解│Try(i+1)││
│├─────┴──────┤│
││删去第i 个数字││
└─┴────────────┴──────┘
我们用二维数组like存放“喜爱书表”，用集合flag存放已分出书的编号，数组book存储各人所分得书的编号，如book[1]=3，则表示第一个同学(小张)分得编号为3的书。
递归程序如下(程序中将小张的喜欢的书改成了ACD)：
Program allot_book(output); type five=1..5; const like: array[five,five] of 0..1 =((1, 0, 1,1 ,0), (1,1,0,0,1),(0,1,1,0,0),(0,0,0,1,0),(0,1,0,0,1)); {个人对各种书的喜好情况} name:array[five] of string[5] = ('zhang', 'wang','liu', 'zhao', 'qian' ); {数组name存放学生姓名} var book: array[1..5] of 0..5;{存放各人分配到的书的编号} flag: set of five; c: integer; procedure print; {打印分配方案} var i: integer; begin inc(c); {计数，统计得到分配方案数} writeln( 'answer', c,':'); for i:=1 to 5 do writeln(name[i]: 10,':', chr(64 + book[i] ) ); end; procedure try(i: integer); {判断第 I 个学生分得书的编号} var j: integer; begin for j:=1 to 5 do if not(j in flag) and (like[i,j]>0) then begin {第j本书未选过，且第I个学生喜爱第j本书} flag:= flag + [j]; {修改已选书编号集合，加入第j本书} book[i]:=j; {记录第 I 个学生分得书的编号} if i= 5 then print {I = 5,5 个学生都分到自己喜爱的书} else try(i + 1); {i<5,继续搜索下一个学生可能分到书的情况} flag:= flag - [j]; {后退一步，以便查找下一种分配方案} book[i]:=0; end end; { main prg } begin flag:= []; c:=0; try(1); readln end.
运行结果为:
zhang: C
wang: A
liu:B
Zhao: D
qian: E
另外，此题也可以用非递归的算法解。非递归算法的基本思想是用栈来存放被选中书的编号。设dep表示搜索深度，r为待选书号，p为搜索成功标志。算法表示如下（非递归算法）。
PROCEDURE dfs；(非递归算法)
┌────────────────────────────┐
│Dep:=0│
├─┬──────────────────────────┤
││dep:=dep+1│
│├──────────────────────────┤
││j:=0; p:=False；│
│├─┬────────────────────────┤
│││j:=j+1│
││├────────────────────────┤
│││T＼子结点mr符合统计／F│
││├──────────────┬─────────┤
│││产生子结点，并记录│T＼Mxar／F│
││├──────────────┼────┬────┤
│││T＼子结点是目标／F│回溯│P:=Fatse│
││├──────┬───────┤││
│││输出并出栈│P:= true│││
│├─┴──────┴───────┴────┴────┤
││UNTIL p=True│
├─┴──────────────────────────┤
│UNTIL dep= 0│
└────────────────────────────┘
尽管深度优先基本算法类似，但在处理不同问题时，在具体处理方法、编程的技巧上，却不尽相同；有时甚至会有很大的差别。
比如，例1的解法还可以这样来设计：从表中看出，赵同学只喜爱D这一本书，无其它选择余地。因此，赵同学得到书的编号在搜索前就确定下来了。为了编程方便，可以把赵钱2人位置交换，这样程序只需对张王刘钱4人情况进行搜索测试。
另外，发现表示“喜爱书表”的数组有多个0，为减少不必要的试探，我们改用链表来表示。例如第三位同学的链表是：Like[3，0]=2.Like[3，2]=3.Like[3，3]=0，其中，Like[3，0]=2表示他喜爱的第一本书编号是2，Like[3，2]=3即表示喜爱的编号为2的书后面是编号为3的书，Like[3，3]=0，表示编号为3的书是其最后1本喜爱的书。
这样基本算法不变，但程序改进如下：
Program allot_book(output); {linking List} type five=1..5;{将小张的喜欢的书改成了ACD} const Link: Array[ 1..5,0..5 ] of 0..5 = ((1,3,0,4,0,0),(1,2,5,0,0,0),(2,0,3,0,0,0),(4,0,0,0,0,0),(2,0,5,0,0,0)); {个人对各种书的喜好情况} name:array[five] of string[5] = ('zhang', 'wang','liu', 'zhao', 'qian' ); {数组name存放学生姓名} var book: array[1..5] of 0..5;{存放各人分配到的书的编号} flag: set of five; c: integer; procedure print; {打印分配方案} var i: integer; begin inc(c); {计数，统计得到分配方案数} writeln( 'answer', c,':'); for i:=1 to 5 do writeln(name[i]: 10,':', chr(64 + book[i] ) ); end; procedure try(i: integer); {判断第 I 个学生分得书的编号} var j: integer; begin j:=0; repeat j:=link[i,j]; { 取链表中喜爱书编号j } If not(j in flag) and (j>0) then Begin flag:= flag+ [j]; book[i]:=j; if i=5 then print else try(i + 1); flag:= flag - [j]; {后退一步，以便查找下一种分配方案} book[i]:=0; End; until j = 0; end; { main prg } begin flag:= []; c:=0; try(1); readln end.
常用算法——广度优先搜索
佚名
在深度优先搜索算法中，是深度越大的结点越先得到扩展。如果在搜索中把算法改为按结点的层次进行搜索， 本层的结点没有搜索处理完时，不能对下层结点进行处理，即深度越小的结点越先得到扩展，也就是说先产生 的结点先得以扩展处理，这种搜索算法称为广度优先搜索法。英语中用Breadth-First-Search表示，所以我们 也把广度优先搜索法简称为BFS。
1、广度优先搜索的基本思想
从图中某一顶点Vo出发，首先访问Vo相邻的所有未被访问过的顶点V1、V2、……Vt；再依次访问与V1、V2、……Vt相邻的且未被访问过的所有顶点。如此继续，直到访问完图中所有的顶点。
如果用广度优先法对下图中结点进行搜索，从结点V1出发，先搜索处理 它的子结点V2和V3，即深度为2的结点；然后搜索深度为3的子结点V4、V5、V6、V7；最后搜索深度为4的 结点V8和V9。整个搜索的次序与结点产生的次序完全一致。
深度
__V1__ 1
/ /
V2 V3 2
/ / / /
V4 V5 V6 V7 3
/ /
V8 V9 4
2.广度优先搜索基本算法：
1）从某个顶点出发开始访问，被访问的顶点作相应的标记，并输出访问顶点号；
2）从被访问的顶点出发，依次搜索与该顶点有边的关联的所有未被访问的邻接点，并作相应的标记。
3）再依次根据2）中所有被访问的邻接点，访问与这些邻接点相关的所有未被访问的邻接点，直到所有顶点被访问为止。
【算法过程】
procedure guangdu(i);
begin
write(i);
v[i]:=true;
insert(q,i);{q是队列，i进队}
repeat
k:=delete(q)；{出队}
for j:=1 to n do
if (a[k,j]=1) and (not v[j]) then
begin
write(j);
v[j]:=true;
insert(q,j);
end;
until 队列q为空;
【实际应用】：实际应用的算法流程图通常如下：
![]()
【问题描述】如下图，找出C1到C6的一条最短路径并求出其路程总长度(采用广度优先搜索的顶点访问序列为C1,C2,C3,C4,C5,C6)。
![]()
【Pascal程序】
program tu3bfs;
type fg=set of 1..6;
const link:array[1..5,1..6] of integer=((0,4,8,0,0,0),
(4,0,3,4,6,0),(8,3,0,2,2,0),(0,4,2,0,4,9),(0,6,2,4,0,4));
var pnt,city:array[1..10] of 0..6;
flag:fg;
r,k,head,tail:integer;
procedure print;
var n, i,cost,y:integer;
s:array[1..7] of 1..6;
begin
y:=tail;n:=0; cost:=0;
while y>0 do begin inc(n);s[n]:=y;y:=pnt[y] end;
writeln('minpath=',n-1);
write('1');
for i:=n-1 downto 1 do
begin
write('->',s[i]);
cost:=cost+link[s[i+1],s[i]];
end;
writeln;
writeln('cost=',cost);
end;
begin
flag:=[1];
pnt[1]:=0; city[1]:=1;
head:=0;tail:=1;
repeat
head:=head+1;
k:=city[head];
for r:=2 to 6 do
if not(r in flag) and (link[k,r]>0) then
begin
inc(tail);city[tail]:=r;
pnt[tail]:=head;
flag:=flag+[r];
if r=6 then begin print;halt end;
end;
until head>=tail;
readln;
end.
广度优先搜索 实例
【例题】八数码难题(Eight-puzzle)。在3X3的棋盘上，摆有 8个棋子，在每个棋子上标有1～8中的某一数字。棋盘中留有一个空格。空格周围的棋子可以移到空格中。要求解的问题是，给出一种初始布局(初始状态)和目标布局(目标状态)，找到一种最少步骤的移动方法，实现从初始布局到目标布局的转变。初始状态和目标状态如下：
初始状态 目标状态 2 8 3 1 2 3 1 6 4 8 4 7 5 7 6 5
求解本题我们可以分3步进行。
问题分析：
由于题目要找的解是达到目标的最少步骤，因此可以这样来设计解题的方法：
初始状态为搜索的出发点，把移动一步后的布局全部找到，检查是否有达到目标的布局，如果没有，再从这些移动一步的布局出发，找出移动两步后的所有布局，再判断是否有达到目标的。依此类推，一直到某布局为目标状态为止，输出结果。由于是按移动步数从少到多产生新布局的，所以找到的第一个目标一定是移动步数最少的一个，也就是最优解。
建立产生式系统：
(1)综合数据库。用3X3的二维数组来表示棋盘的布局比较直观。我们用Ch[i,j]表示第i行第j列格子上放的棋子数字，空格则用0来表示。为了编程方便，还需存储下面3个数据：该布局的空格位置(Si，Sj)；初始布局到该布局的步数，即深度dep；以及该布局的上一布局，即父结点的位置(pnt)。这样数据库每一个元素应该是由上述几个数据组成的记录。
在程序中，定义组成数据库元素的记录型为：
Type
node＝record
ch：array[1..3，1..3] of byte；{存放某种棋盘布局}
si,sj:byte； {记录此布局中空格位置}
dep,pnt：byte；
end；
因为新产生的结点深度(从初始布局到该结点的步数)一般要比数据库中原有的结点深度大(或相等)。按广度优先搜索的算法，深度大(步数多)的结点后扩展，所以新产生的结点应放在数据库的后面。而当前扩展的结点从数据库前面选取，即处理时是按结点产生的先后次序进行扩展。这样广度优先搜索的数据库结构采用队列的结构形式较合适。我们用记录数组data来表示数据库，并设置两个指针：Head为队列的首指针，tail为队列的尾指针。
(2)产生规则。原规则规定空格周围的棋子可以向空格移动。但如果换一种角度观察，也可看作空格向上、下、左、右4个位置移动，这样处理更便于编程。设空格位置在(Si，sj)，则有4条规则：
①空格向上移动： if si-1>=1 then ch[si,sj]:=ch[si-1,sj]；ch[si-1,sj]:=0
②空格向下移动： if si+1<=3 then [si,sj]:=ch[si+1,sj]；ch[si+1,sj]:=0
③空格向左移动： if sj-1<=1 then [si,sj]:=ch[si,sj-1]；ch[si,sj-1]:=0
④空格向右移动： if sj+1<=3 then [si,sj]:=ch[si,sj+1]；ch[si,sj+1]:=0
我们用数组Di和Dj来表示移动时行列的增量，移动后新空格的位置可表示为：
nx:=si+di(r)
ny:=sj+dj(r)
其中，r=1,2,3,4为空格移动方向，且 r 1 2 3 4 方向 左 上 右 下 di 0 -1 0 1 dj -1 0 1 0 (3)搜索策略。按照问题分析中提出的方法，算法设计如下：
program num8；
程序中新布局与队列中已有布局是否重复，用dup函数检查；找到目标结点后，print过程负责打印出从初始态到目标态移动时各步的布局，buf[n)是用来存放待输出的布局在队列中的位置。
procedure print；
根据上述算法编制的程序如下：
program num8_str1；
uses Crt；
type a33：array[1..3，1..3] Of byte；
{3X3的二维数组，用于存放棋盘布局}
a4=array[1..4] of shortint;
node=record {定义数据库中每个元素记录类型结构}
ch: a33;
si, sj: byte;
pnt, dep: byte;
end;
const goal:a33 = ((1,2,3), (8,0,4), (7,6,5)); {目标布局}
start:a33 =((2,8,3), (1,6,4), (7,0,5)); {初始布局}
di:a4=(0,-1, 0, 1);
dj:a4=(-1, 0, 1, 0);
var data:array[1..100] of node;
temp: node;
r, k, ni, nj, Head, Tail, depth: integer;
{变量depth存放当前搜索深度}
function check(k: integer) :boolean; { 检查某步移动是否可行}
begin
hi:=temp.si+di[k] ; nj:=temp.sj+dj[k];
if (ni in [1..3]) and (nj in [1..3]) {~移动后新位置仍在棋盘中}
then check:=true else check:= false;
end;
function dupe: boolean; { 检查队尾新存入布局是否已在队列中存在}
var i,j, k: integer;
buf:boolean;
Begin
buf:= false; i: = 0;
{变量将i依次指向队列中的各个布局(最后一个除外)的位置}
repeat
inc(i) ;buf:= true;
for j:=1 to 3 do
for k:=1 to 3 do
if data[i].ch[j,k] < >data[tail].ch[j,k]
{data[tail]是队列中最后一个元素，即新产生的布局}
then bur:= false;
until buf or (i> = tail-1);
{buf=truee新布局与队列中布局有重复}
dupe:= buf
end;
function goals: boolean; { 比较是否达到目标布局状态}
var i,j :byte;
begin
goals:= true;
for i:=1 to 3 do
for j:=1 to 3 do
if data[tail].ch[i,j] < >goa1[i,j]
then goals:=false {未达到目标布局}
end;
procedure trace;
var i,j :byte;
begin
write( 'cl=', Head,' op=', tail);
writeln('dep=',depth,'k=',k);
fori:=1 to 3 do
begin
for j:= 1 to 3 do write(data[tail], ch[i,j]);
writeln end;
end;
procedure print; {输出移动步骤}
var buf: array[1..100] of integer;
{数组buf存放起始态、目标态以及从起始态到目标态所经过的各态的位置}
i,j, k, n: integer;
begin
n:= 1;
i:= tail;buf[1]:= i; {buf[1]中是目标布局在队列中位置}
repeat
j:=data[i].pnt; {data[I].pnt的值是布局I的父结点的位置}
inc(n); buf[n]:=j; i:=j
until i=0; {根结点(初态)的父结点为0，即I=0}
writeln(' staps:', depth + 1);
for i:= 1 to 3 do {打印棋盘布局}
begin
for k:=n-1 down to 1 do
begin
for j:= 1 to 3 do write(data[buf[k]].ch[i,j]);
if i = 2 then write( ' - > ') else write(' ');
end;
writeln;
end;
readln; halt
end;
{ main program = }
begin
Head:= 0; tail:= 1;
with data[1] do {队列中存入第一个元素(初始状态)}
begin ch:= start; si:= 3; sj:= 2;
pnt:= 0; dep:= 0;
end;
repeat
inc(Head);temp:=data[Head]; {取队首记录}
depth:= temp.dep;
for r:= 1 to 4 do {对取出记录进行扩展}
if check(r) then {布局中空格向某方向移动成功}
begin
inc(tail);data[tail]:= temp; {新产生布局存入队尾}
with data[tail] do
begin ch[si,si]:= ch[nj,nj];
ch[ni,nj]:=0;si:=nj;si:=nj;
pnt:=Head;{记录此布局的上一布局在队列中的位置}
dep:= depth + 1;{记录本布局的搜索深度}
end;
trace;
if dupe then dec(tail) {dec(tail删除新产生的结点)}
else if goals then print;
end;
until Head>=tail; {队列空}
writeln('no solution');readln
end
运行结果：
283 283 283 023 123 123
164—>104—>184—>184—>084—>804
705 765 765 765 765 765
上述程序产生的搜索各个布局图略。
从上面搜索图中可看出，程序执行时先产生深度为1的所有结点，然后再产生深度为2的所有结点……，最后产生含有目标的深度为5的结点结束。先往横向扩展，再往纵向深入，这就是广度优先搜索法搜索过程。
从上例我们看出，广度优先搜索法可以求出步数最少的解，即深度最少的解。因此广度优先搜索法经常用于一些求最优解的问题中。
与深度优先搜索法类似，不同的问题用广度优先搜索法的基本算法都是一样的，但在数据库的表示方法上、在产生的结点是否符合条件上和重复的判断上可以有不同的编程技巧，程序运行效率也会有所不同。以八数码问题为例，上面程序中用3X3的二维数组表示布局比较直观，但在判断有重复布局，判断是否达到目标布局方面，却增加了编程复杂性，同时也影响了运行速度。我们可以改用字符串形式来表示布局。例如初始布局表示为"283164705''，目标布局表示为“123804765”，即按行的顺序排列。
产生规则也必须作相应改动。设空格当前位置是Si，则有：
(1)空格向上移动：空格的位置减3，即交换Si和Si－3的字符；
(2)空格向左移动：空格的位置减1，即交换Si和Si－1的字符；
(3)空格向右移动：空格的位置加1，即交换Si和Si＋1的字符；
(4)空格向下移动：空格的位置加3，即交换Si和Si＋3的字符；
如设规则编号为k，则上述四条规则可归纳为一条：
交换Si和Si+(2*k-5)的字符。
其中，k=1为向上移动；k=2为向左移动；k=3是向右移动；k=4为向下移动。
布局用字符串表示后，使得判断重复和是否目标态变得十分简单，只需判断两个字符串是否相等就可以了。
【思考】试按照上述改进算法，编制出解八数码题的PASCAL程序。
<script src="" type="text/javascript"> </script>
<script src="" type="text/javascript"> </script>
双向广度优先搜索
广度优先搜索遵循从初始结点开始一层层扩展直到找到目标结点的搜索规则，它只能较好地解决状态不是太多的情况，承受力很有限。如果扩展结点较多，而目标结点又处在较深层，采用前文叙述的广度搜索解题，搜索量巨大是可想而知的，往往就会出现内存空间不够用的情况。双向搜索和A算法对广度优先的搜索方式进行了改良或改造，加入了一定的“智能因素”，使搜索能尽快接近目标结点，减少了在空间和时间上的复杂度。
(1)搜索过程
有些问题按照广度优先搜索法则扩展结点的规则，既适合顺序，也适合逆序，于是我们考虑在寻找目标结点或路径的搜索过程中，初始结点向目标结点和目标结点向初始结点同时进行扩展—，直至在两个扩展方向上出现同一个子结点，搜索结束，这就是双向搜索过程。出现的这个同一子结点，我们称为相交点，如果确实存在一条从初始结点到目标结点的最佳路径，那么按双向搜索进行搜索必然会在某层出现“相交”，即有相交点，初始结点一相交点一目标结点所形成的一条路径即是所求路径。
例如：移动一个只含字母A和B的字符串中的字母，给定初始状态为(a)表，目标状态为(b)表，给定移动规则为：只能互相对换相邻字母。请找出一条移动最少步数的办法。
[AABBAA] [BAAAAB] (a) (b)
解题分析：从初始状态和目标状态均按照深度优先搜索扩展结点，当达到以下状态时，出现相交点，如图1(a)，结点序号表示结点生成顺序。
双向扩展结点：
顺序 逆序
1 1
___AABBAA___ BAAAAB
2 / / 3 2 / / 3
__ABABAA__ AABABA ABAAAB BAAABA
4 / |5 / 6 7 / / 8 4 /
ABBAAA BAABAA ABAABA AAABBA AABAAB AABAAB
(a) 图1 (b) 顺序扩展的第8个子结点与逆序扩展得到的第4个子结点就是相交点，问题的最佳路径如图2。
[AABBAA]—[AABABA]—[AABAAB]—[ABAAAB]—[BAAAAB]
图2
从搜索的结点来看，双向广度要简单得多。假设每一个子结点可以扩展的子结点数是X，不计约束条件，以完全X叉树计算，那么用广度优先搜索一个长度为I的最佳路径的解，共需要扩展结点X(XL-1)÷(X-1)。从双向搜索来看，设正个方向的搜索在第y层找到向交点，那么正向共搜索了X(XY-1)÷(X-1)，逆向扩展的结点数为(XL-y-1)÷(X-1)，两个方向共搜索了 X(XY+XL-Y-2)÷(X-1)。我们假设L为偶数，则Y=L/2，双向搜索扩展的结点数约为单向搜索的2÷(XL/2+1)*100％，相对减少(XL/2-1)÷(XL/2+1)*100％。
当然这里只是作个粗略的比较，事实上在其它一般情况下，双向搜索搜索量都要比单向搜索来的少。
(2)结点扩展顺序
双向扩展结点，在两个方向的扩展顺序上，可以轮流交替进行，但由于大部分的解答树并不是棵完全树，在扩展完一层后，下一层则选择结点个数较少的那个方向先扩展，可以克服两个方向结点生成速度不平衡的状态，明显提高搜索效率。
(3)数据结构
单向广度优先搜索需建立两个表OPEN和CLOSED，用来存储生成结点和已扩展结点，双向搜索从两个方向进行扩展，我们建立两个二维表OPEN，CLOSED，OPEN[1]，CLOSED[1]， OPEN[2]，CLOSED[2]分别存储两个方向上的生成结点和已扩展结点，OPEN仍然是具有“先进先出”的队列结构。为编程方便，我们采用基于广度优先搜索算法的双向，建立三个二维指针：Q1，Q2，Q3其作用如下：
Q1[1]，Q1[2]：分别指向两个方向上当前待扩展层的第一个结点。
Q2[1]，Q2[2]：分别指两个方向上队尾新产生的结点。
Q3[1]，Q3[2]：分别指向两个方向上下一层的第一个结点位置。
为了区分当前搜索方向，设方向标志：
t=1表示处于正向搜索，t=2表示处于逆向搜索。
Fail—有一个方向搜索失败时，为真，并且结束搜索过程，否则为假。
I—全局变量，指向当前要扩展的结点。
(4)算法描述
Program DOUBFS；
初始化，初始结点，和目标结点分别进入OPEN[1]和OPEN[2]表；
Q1[1]:=1;Q2[1]:=1;Q1[2]:=1;Q2[2]:=1；
repeat
if (Q2[1]-Q1[1])<=(Q2[2]-Q1[2]) then t:=1
else t:=2；
for I:=Q1[t] to Q2[t] do
EXPEND(t)；{扩展第1个结点}
Q1[t]:=Q3[t]；
until(Q1[t]>Q2[t])；
其中过程EXPEND(t)的结构如下：
Procedure expand(t：integer)；
Var j：integer；
begin
for j:=1 to n do {n为最多后继状态数}
begin
产生i点的第j个后继状态，将它加入到队尾(Q2[t]+1)；
if新结点未与其上一层以上的所有点重复
then if isans(t) then [输出解；halt；] else
else将新点从队列中去掉；(Q2[t]-1)
end； -
end；
判断是否是相交点的过程isans(t)如下：
function isans(t：integer)：Boolean；
var j，t1：integer；
begin
if t=1 then t1:=2 else t1:=1；
isans:=false；
forj:=Q1[t1] to Q2[t1] do
if Q2[t]=j {Q2[t]新结点是相交点}
then [isans:=true；exit]；
end； (5)例题应用
【例1】魔方问题
在魔方风靡全球之后，Rubik先生发明了它的简化版——魔板。魔板由8个同样大小的方块组成，每个方块的颜色均不相同，本题中以数字1—8分别表示，可能出现在魔板的任一位置，任一时刻魔板的状态可以用方块的颜色序列表示：从魔板的左上角开始，按顺时针方向依次写下各方块的颜色代号，得到的数字序列即可表示此时魔板的状态。
例如，序列(1，2，3，4，5，6，7，8)表示题中魔板的初始状态。
1 2 3 4 8 7 6 5
对于魔板，可以施加三种不同的操作，分别以A，B，C标识。
具体操作方法如下：
A：上下行互换，如上图可以变换为状态87654321
B：每行同时循环右移一格，如上图可以变换为41236785
C：中间4个方块顺时针旋转一格，上图可以变换为17245368。
应用这三种基本操作，可以由任一状态达到任意另一状态。
子任务A：
请编一程序，对于输入的一个目标状态，寻找一种操作的序列，使得从初始状态开始，经过此操作序列后使该魔板变为目标状态。
子任务B：
如果你的程序寻找到的操作序列在300步以内，会得到子任务B的分数。
输入数据：
文件名INPUT．TXT，第一行包含8个以一个空格相隔的正整数，表示目标状态。
输出数据：
输出文件名为OUTPUT．TXT，在第一行输出你的程序寻找到的操作序列的步数L，随后L行是相应的操作序列，每行的行首写一个字符，代表相应的操作。
【算法分析】
A．空间复杂度 如果解的步数为n，则状态表示空间约占3n。
B．基本算法 本题是典型的广度优先算法题，很自然的想到能否构造启发算法。但本题不同于八数码，很难找到一个估价函数。因为每一种状态的达到都有三种本质不同的方法，因此在计算某一状态的估价值时，容易将状态各个数字的最少移动步数重复计算，或忽略计算，不能够构造出一个恰当函数f*使得f*< f。因此不宜采用启发算法得出最优解，而只能得可行解。现在考虑双向广度优先搜索。
双向搜索与单向广度搜索相比的优点在于节省了存储空间，避免搜索出更多的无用结点，提高丁搜索速度，如果采用动态数组存储(655 350Byte)可以做到大约21～22步，甚至可以更多。
【参考程序】
Program Rubic；
Uses Crt;
Const
n=8;
input = 'input.txt';
Type
dar = record
f: integer;
d: array[1..n] of Integer;
End;
Var
Cab: array[1..2,1..7500] of ^dat;
dat1,dat2: dat;
Procedure Init;
Var
f: text;
i,i: Integer;
Begin
assign(f, input);
reset(f);
new(cab[1,1]);
for I:=1 To n do
read(f,cab[1,I]^.d[i]);
cab[1,1]^.f := 0;
readln(f);
new(cab[2,1 ] );
for I := 1 tondo
read(f,cab[2,1]^.d[i]);
readln(f);
cab[2,1]^.f := 0;
End;
Function Check(x,y: Integer) :boolean;
Var
i,j,k: Integer;
ok: Boolean;
Begin
for i:= 1 to y-1 do
Begin
forj := 1 to n do
if cab[x,i]^.d[j] < > dat1.d[j] then
Begin
ok := true;
Break;
End else Ok:= false;
if not ok then break;
End;
Check := ok;
End;
Function CheckOut(X,Y: Integer;Var a: Integer): Boolean;
Var
i,j,k: Integer;
ok: Boolean;
Begin
a:=0;
fori := 1 to y do
Begin
for j := 1 to n do
if cab[x,i]A.d[j] < > dat1.d[j] then
Begin
ok := true;
Break;
End else Ok: = false;
if not ok then
Begin
a:= i;
break;
End;
End;
CheckOut := ok;
End;
Procedure Print(a,b,c: Integer);
Var
i,j,k,l: Integer;
s1,s2: array[1..30] of Integer;
x,y: Integer;
Begin
fillchar(s1,sizeof(s1), 0);
fillchar(s2,sizeof(s2) ,0);
if a = 1 then
Begin
i:=1;
j:=2;
End else
Begin
i:=2;
j:=1;
End;
k:= O;
Repeat
inc(k);
s1[k] := b;
b := cab[i,b]^.f;
Until b = 0;
l:= 0;
Repeat
inc(l);
s2[l] := c;
c := cab[j,c]^.f;
Until c = 0;
if a = 1 then
begin
for x := k downto 1 do
Begin
for y := 1 to n do
write(cab[1,s1[x]]^.d[y]: 3);
if y mod 4 = 0 then writeln;
End;
writeln('-----');
Readln;
End;
for x := 2 to l do
Begin
for y := 1 to n do
Begin
write(cab[2,s2[x]]^.d[y]: 3);
if y mod 4 = 0 then writdn;
End;
writeln('-----');
Readln;
End;
End
else
Begin
for x := l downto 1 do
Begin
for y := 1 to n do
write(cah[1,s2[x]]^.d[y]: 3);
if y mod 4 = 0 then writdn;
End;
writeln('-----');
Readln;
End;
for x := 2 to k do
Begin
for y:= 1 to n do
begin
write(cab[2,s1[x]]^.d[y]: 3);
if y mod 4 = 0 then writeln;
End;
writeln('-----');
Readln;
End;
End;
Halt;
End;
Procedure Double;
Var
i,j: array[1..2] of Integer;
Out: Boolean;
k,l,kk,s: Integer;
i[1] := 1;
i[2] := 1;
j[1] := 2;
j[2] := 2;
Out := false;
repeat
kk:=2;
k:=1;
{--1--}
dat1.d := Cab[k,i[k]]^.d;
for l := 1 to 4 do
Begin
dat1.d[l] := dat1.d[l+4];
dat1.d[l+4] := cab[k,i[k]]^.d[l];
End;
dat1.f := i[k];
if Check(k,j[k]) then
Begin
new(mb[kd[k]]);
mb[kd[k]]^:= dat1;
inc(j[k]);
if Not CheckOut(kk,j[kk] - 1,s) then Print(k,j[k] - 1 ,s);
End;
{--2--}
dat1.d := Cab[k,i[k]]^.d;
dat1.d[3]: = dat1.d[2];
dat1.d[2] := dat1.d[5];
dat1.d[5] := dat1.d[6];
dat1.d[6] := cab[k,i[k]]^.d[3];
dat1.f: = i[k];
if Check(k,j[k]) then
Begin
new(cab[k,j[k]]);
cab[k,j[k]]^ := dat1;
inc(j[k]);
if NOt CheckOut(kk,j[kk] - 1,s) then Print(k,j[k] - 1,s);
End;
{--3--}
dat1.d:= Cab[k,i[k] ]^.d;
dat1.d[4]: = dat1.d[3];
dat1.d[3]: = dat1.dj2];
dat1.d[2] := dat1.d[1];
dat1.dj1] := cab[k,i[k]]^.d[4];
dat1.f := i[k];
if Check(k,j[k]) then
Begin
new(cab[k,j[k]]);
cab[k,j[k]]^:= dat1;
inc(j[k]);
if Not CheckOut(kk,j[kk]- 1,s) then Print(k,j[k] - 1,s);
End;
Inc(i[k]);
kk:= 1;
k:=2;
{--1--}
dat1.d := Cab[k,i[k]]^.d;
for l := 1 to 4 do
Begin
dat1.d[l] := dat1.d[l+4];
dat1.d[l+4] := cab[k,i[k]]^.d[l];
End;
dat1.f:= i[k];
if Check(k,j[k]) then
Begin
new(cab[k,j[k] ]);
cab[k,j[k]]^:= dat1;
inc(j[k]);
if Not CheckOut(kk,j[kk] - 1 ,s) then Print(k,j[k] - 1 ,s);
End;
{--2--}
dat1.d := Cab[k,i[k]]^.d;
daft. d[2] : = dat1. d[3];
dat1.d[3] := dat1.d[6];
dat1.d[6]: = dat1.d[5];
dat1.d[5] := cab[k,i[k]]^.d[2];
dat1.f: = i[k];
if Check(k,j[k]) then
Begin
new(cab[k,j[k]]);
cab[k,j[k]]^:= dat1;
ine(j[k]);
if Not CheckOut(kk,j[kk] - 1 ,s) then Print(k,j[k] - 1 ,s);
End;
{---3---}
dad.d:= Cab[k,i[k]]^.d;
dat1.d[1] := dat1.d[2];
dat1.d[2] := dat1.d[3];
dat1.d[3] := dat1. d[4];
dat1.dj4] := cab[k,i[k] ]^.d[1];
dat1.f := i[k];
if Check(k,j[k]) then
Begin
new(cab[k,j[k]]);
cab[k,j[k]]^ := dat1;
inc(j[k]);
if Not CheckOut(kk,j[kk] - 1,s) then Prim(k,j[k] - 1,s);
End;
Inc(i[k]);
until Out;
End;
Begin
INit;
clrscr;
Double;
End． 45放到应该放的位置K，这里K=6，那么再对S[1。。5]和S[6。。10]分别进行快速排序。程序代码如下：<49,两者交换，此时J:=6> 5） 36 36 18 15 30 45 48 93 72 534） 36 36 18 15 45 30 48 93 72 533） 36 36 18 15 72 30 48 93 45 53 2） 36 36 18 45 72 30 48 93 15 53 1） 36 36 18 53 72 30 48 93 15 45
一、插入排序(Insertion Sort)
1. 基本思想：
每次将一个待排序的数据元素，插入到前面已经排好序的数列中的适当位置，使数列依然有序；直到待排序数据元素全部插入完为止。
2. 排序过程：
【示例】：
[初始关键字] [49] 38 65 97 76 13 27 49
J=2(38) [38 49] 65 97 76 13 27 49
J=3(65) [38 49 65] 97 76 13 27 49
J=4(97) [38 49 65 97] 76 13 27 49
J=5(76) [38 49 65 76 97] 13 27 49
J=6(13) [13 38 49 65 76 97] 27 49
J=7(27) [13 27 38 49 65 76 97] 49
J=8(49) [13 27 38 49 49 65 76 97]Procedure InsertSort(Var R : FileType);
//对R[1..N]按递增序进行插入排序, R[0]是监视哨//
Begin
for I := 2 To N Do //依次插入R[2],...,R[n]//
begin
R[0] := R[I]; J := I - 1;
While R[0] < R[J] Do //查找R[I]的插入位置//
begin
R[J+1] := R[J]; //将大于R[I]的元素后移//
J := J - 1
end
R[J + 1] := R[0] ; //插入R[I] //
end
End; //InsertSort //二、选择排序
1. 基本思想：
每一趟从待排序的数据元素中选出最小（或最大）的一个元素，顺序放在已排好序的数列的最后，直到全部待排序的数据元素排完。
2. 排序过程：
【示例】：
初始关键字 [49 38 65 97 76 13 27 49]
第一趟排序后 13 ［38 65 97 76 49 27 49]
第二趟排序后 13 27 ［65 97 76 49 38 49]
第三趟排序后 13 27 38 [97 76 49 65 49]
第四趟排序后 13 27 38 49 [49 97 65 76]
第五趟排序后 13 27 38 49 49 [97 97 76]
第六趟排序后 13 27 38 49 49 76 [76 97]
第七趟排序后 13 27 38 49 49 76 76 [ 97]
最后排序结果 13 27 38 49 49 76 76 97Procedure SelectSort(Var R : FileType); //对R[1..N]进行直接选择排序 //
Begin
for I := 1 To N - 1 Do //做N - 1趟选择排序//
begin
K := I;
For J := I + 1 To N Do //在当前无序区R[I..N]中选最小的元素R[K]//
begin
If R[J] < R[K] Then K := J
end;
If K <> I Then //交换R[I]和R[K] //
begin Temp := R[I]; R[I] := R[K]; R[K] := Temp; end;
end
End; //SelectSort //三、冒泡排序(BubbleSort)
1. 基本思想：
两两比较待排序数据元素的大小，发现两个数据元素的次序相反时即进行交换，直到没有反序的数据元素为止。
2. 排序过程：
设想被排序的数组R［1..N］垂直竖立，将每个数据元素看作有重量的气泡，根据轻气泡不能在重气泡之下的原则，从下往上扫描数组R，凡扫描到违反本原则的轻气泡，就使其向上"漂浮"，如此反复进行，直至最后任何两个气泡都是轻者在上，重者在下为止。
【示例】：
49 13 13 13 13 13 13 13
38 49 27 27 27 27 27 27
65 38 49 38 38 38 38 38
97 65 38 49 49 49 49 49
76 97 65 49 49 49 49 49
13 76 97 65 65 65 65 65
27 27 76 97 76 76 76 76
49 49 49 76 97 97 97 97Procedure BubbleSort(Var R : FileType) //从下往上扫描的起泡排序//
Begin
For I := 1 To N-1 Do //做N-1趟排序//
begin
NoSwap := True; //置未排序的标志//
For J := N - 1 DownTo 1 Do //从底部往上扫描//
begin
If R[J+1]< R[J] Then //交换元素//
begin
Temp := R[J+1]; R[J+1 := R[J]; R[J] := Temp;
NoSwap := False
end;
end;
If NoSwap Then Return//本趟排序中未发生交换，则终止算法//
end
End; //BubbleSort//
四、快速排序（Quick Sort）
1. 基本思想：
在当前无序区R[1..H]中任取一个数据元素作为比较的"基准"(不妨记为X)，用此基准将当前无序区划分为左右两个较小的无序区：R[1..I-1]和R[I+1..H]，且左边的无序子区中数据元素均小于等于基准元素，右边的无序子区中数据元素均大于等于基准元素，而基准X则位于最终排序的位置上，即R[1..I-1]≤X.Key≤R[I+1..H](1≤I≤H)，当R[1..I-1]和R[I+1..H]均非空时，分别对它们进行上述的划分过程，直至所有无序子区中的数据元素均已排序为止。
2. 排序过程：
【示例】：
初始关键字 [49 38 65 97 76 13 27 49］
第一次交换后 ［27 38 65 97 76 13 49 49］
第二次交换后 ［27 38 49 97 76 13 65 49］
J向左扫描，位置不变，第三次交换后 ［27 38 13 97 76 49 65 49］
I向右扫描，位置不变，第四次交换后 ［27 38 13 49 76 97 65 49］
J向左扫描 ［27 38 13 49 76 97 65 49］
（一次划分过程）初始关键字 ［49 38 65 97 76 13 27 49］
一趟排序之后 ［27 38 13］ 49 ［76 97 65 49］
二趟排序之后 ［13］ 27 ［38］ 49 ［49 65］76 ［97］
三趟排序之后 13 27 38 49 49 ［65］76 97
最后的排序结果 13 27 38 49 49 65 76 97
各趟排序之后的状态Procedure Parttion(Var R : FileType; L, H : Integer; Var I : Integer);
//对无序区R[1,H]做划分，I给以出本次划分后已被定位的基准元素的位置 //
Begin
I := 1; J := H; X := R[I] ;//初始化，X为基准//
Repeat
While (R[J] >= X) And (I < J) Do
begin
J := J - 1 //从右向左扫描，查找第1个小于 X的元素//
If I < J Then //已找到R[J] 〈X//
begin
R[I] := R[J]; //相当于交换R[I]和R[J]//
I := I + 1
end;
While (R[I] <= X) And (I < J) Do
I := I + 1 //从左向右扫描，查找第1个大于 X的元素///
end;
If I < J Then //已找到R[I] > X //
begin R[J] := R[I]; //相当于交换R[I]和R[J]//
J := J - 1
end
Until I = J;
R[I] := X //基准X已被最终定位//
End; //Parttion //Procedure QuickSort(Var R :FileType; S,T: Integer); //对R[S..T]快速排序//
Begin
If S < T Then //当R[S..T]为空或只有一个元素是无需排序//
begin
Partion(R, S, T, I); //对R[S..T]做划分//
QuickSort(R, S, I-1);//递归处理左区间R[S,I-1]//
QuickSort(R, I+1,T);//递归处理右区间R[I+1..T] //
end;
End; //QuickSort//五、堆排序(Heap Sort)
1. 基本思想：
堆排序是一树形选择排序，在排序过程中，将R[1..N]看成是一颗完全二叉树的顺序存储结构，利用完全二叉树中双亲结点和孩子结点之间的内在关系来选择最小的元素。
2. 堆的定义: N个元素的序列K1,K2,K3,...,Kn.称为堆，当且仅当该序列满足特性：
Ki≤K2i Ki ≤K2i+1(1≤ I≤ [N/2])
堆实质上是满足如下性质的完全二叉树：树中任一非叶子结点的关键字均大于等于其孩子结点的关键字。例如序列10,15,56,25,30,70就是一个堆，它对应的完全二叉树如上图所示。这种堆中根结点（称为堆顶）的关键字最小，我们把它称为小根堆。反之，若完全二叉树中任一非叶子结点的关键字均大于等于其孩子的关键字，则称之为大根堆。
3. 排序过程：
堆排序正是利用小根堆（或大根堆）来选取当前无序区中关键字小（或最大）的记录实现排序的。我们不妨利用大根堆来排序。每一趟排序的基本操作是：将当前无序区调整为一个大根堆，选取关键字最大的堆顶记录，将它和无序区中的最后一个记录交换。这样，正好和直接选择排序相反，有序区是在原记录区的尾部形成并逐步向前扩大到整个记录区。
【示例】：对关键字序列42，13，91，23，24，16，05，88建堆
![]()
![]()
![]()
![]()
![]()
Procedure Sift(Var R :FileType; I, M : Integer);
//在数组R[I..M]中调用R[I]，使得以它为完全二叉树构成堆。事先已知其左、右子树(2I+1 <=M时)均是堆//
Begin
X := R[I]; J := 2*I; //若J <=M, R[J]是R[I]的左孩子//
While J <= M Do //若当前被调整结点R[I]有左孩子R[J]//
begin
If (J < M) And R[J].Key < R[J+1].Key Then
J := J + 1 //令J指向关键字较大的右孩子//
//J指向R[I]的左、右孩子中关键字较大者//
If X.Key < R[J].Key Then //孩子结点关键字较大//
begin
R[I] := R[J]; //将R[J]换到双亲位置上//
I := J ; J := 2*I //继续以R[J]为当前被调整结点往下层调整//
end;
Else
Exit//调整完毕，退出循环//
end
R[I] := X;//将最初被调整的结点放入正确位置//
End;//Sift//Procedure HeapSort(Var R : FileType); //对R[1..N]进行堆排序//
Begin
For I := N Div Downto 1 Do //建立初始堆//
Sift(R, I , N)
For I := N Downto 2 do //进行N-1趟排序//
begin
T := R[1]; R[1] := R[I]; R[I] := T;//将当前堆顶记录和堆中最后一个记录交换//
Sift(R, 1, I-1) //将R[1..I-1]重成堆//
end
End; //HeapSort//六、几种排序算法的比较和选择
1. 选取排序方法需要考虑的因素：
(1) 待排序的元素数目n；
(2) 元素本身信息量的大小；
(3) 关键字的结构及其分布情况；
(4) 语言工具的条件，辅助空间的大小等。
2. 小结：
(1) 若n较小(n <= 50)，则可以采用直接插入排序或直接选择排序。由于直接插入排序所需的记录移动操作较直接选择排序多，因而当记录本身信息量较大时，用直接选择排序较好。
(2) 若文件的初始状态已按关键字基本有序，则选用直接插入或冒泡排序为宜。
(3) 若n较大，则应采用时间复杂度为O(nlog2n)的排序方法：快速排序、堆排序或归并排序。 快速排序是目前基于比较的内部排序法中被认为是最好的方法。
(4) 在基于比较排序方法中，每次比较两个关键字的大小之后，仅仅出现两种可能的转移，因此可以用一棵二叉树来描述比较判定过程，由此可以证明：当文件的n个关键字随机分布时，任何借助于"比较"的排序算法，至少需要O(nlog2n)的时间。
(5) 当记录本身信息量较大时，为避免耗费大量时间移动记录，可以用链表作为存储结构。
标准快速排序算法
rogram kuaisu(input,output);
const n=10;
var
s:array[1..10] of integer;
k,l,m,o:integer;procedure qsort(lx,rx:integer);
var
I,j,t:integer;
Begin
I:=lx;j:=rx;t:=s[I];
Repeat
While (s[j]>t) and (j>I) do
Begin
k:=k+1;
j:=j-1
end;
if I<j then
begin
s[I]:=s[j];I:=I+1;l:=l+1;
while (s[I]<t) and (I<j) do
beginI:=I+1
End;
If I<j then
begin
S[j]:=s[I];j:=j-1
End;
End;
Until I=j;
S[I]:=t;I:=I+1;j:=j-1; o:=o+1;
writeln('第',o:3,'次排序的结果:');
for m:=1 to 10 do write(s[m]:5);
writeln;
If lx<j then qsort(lx,j);
If I<rx then qsort(I,rx)
End;{过程qsort结束}Begin
Writeln('input 10 integer num:');
For m:=1 to n do read(s[m]);
K:=0;l:=1; o:=0;
Qsort(l,n);
Writeln('shu chu jie guo:');
For m:=1 to n do write(s[m]:4) ;
End.
动态规划-航线设置
阳明
问题描述:美丽的莱茵河畔,每边都分布着N个城市,两边的城市都是唯一对应的友好城市,现需要在友好城市开通航线以加强往来.但因为莱茵河常年大雾,如果开设的航线发生交叉现象就有可能出现碰船的现象.现在要求近可能多地开通航线并且使航线不能相交!
假如你是一个才华横溢的设计师,该如何设置友好城市间的航线使的航线数又最大又不相交呢?
分析:此问题可以演化成求最大不下降序列来完成.源程序如下:
program dongtai; {动态规划之友好城市航线设置问题}
var
d:array[1..1000,1..4] of integer;
i,j,k,n,L,p:integer;procedure print(L:integer); {打印结果}
begin
writeLn('最多可设置的航线数是 : ',k);
repeat
writeLn(d[L,1]:4,d[L,2]:4); {输出可以设置航线的友好城市代码}
L:=d[L,4]
untiL L=0
end;begin
writeLn('输入友好城市对数: ');
readLn(n);
writeLn('输入友好城市对（友好城市放在同一行:'); {输入}
for i:=1 to n do
readLn(d[i,1],d[i,2]); {D[I，1]表示起点，D[I，2]表示终点}
for i:=1 to n do
begin
d[i,3]:=1; {D[I，3]表示可以设置的航线条数}
d[i,4]:=0 {D[I，4]表示后继，即下一条航线从哪里开始设置，为0表示不能设置下一条航线}
end;
for i:=n-1 downto 1 do {从倒数第二个城市开始规划}
begin
L:=0; p:=0; {L表示本城市后面可以设置的航线数，P表示下条航线从哪个城市开始}
for j:=i+1 to n do {找出本城市后面可以设置的最大航线数和小条航线到底从哪个城市开始设置}
if (d[i,2] L) then
{如果本城市I的终点小于后面城市的终点（即不相交）} {并且此城市后面可以设置的航线数大于L}
begin
L:=d[j,3]; {那么L等于城市J的可以设置航线数}
p:=j {P等于可以设置下条航线的城市代码}
end;
if L>0 then {如果本城市后面总共可以设置的航线数>0则}
begin
d[i,3]:=L+1; {本城市可以设置的航线数在下个城市可以设置航线数的基础上加1}
d[i,4]:=p {D[I，4]等于本城市后续城市的代码}
end
end;
k:=d[1,3]; {K为可以设置最大航线数，假设初值为第一个城市可以设置的航线数}
L:=1; {L为城市代码，初值为第一个城市}
for i:=2 to n do {找出可以设置航线的最大值，赋值给K，同时L记下哪个可以设置最大航线数的城市代码}
if d[i,3]>k then
begin
k:=d[i,3];
L:=i
end;
for i:=1 to n do {打印结果，因为有可能有多种方案，所以只要哪个城市可以设置的航线数等于最大值K就打印结果}
if d[i,3]=k then print(i)end.
八皇后问题
<script src="" type="text/javascript"> </script>
{问题描述：在国际象棋8X8的棋盘里摆放8个皇后，使每个皇后都能生存而不互相冲突，即同一行、同一列同对角线（包括主对角线和辅对角线）都只能有一个皇后}
program eightqueen; {本程序可以搜索出所有的解}
var
a,b:array[1..8] of integer;
c:array[-7..7] of integer;
d:array[2..16] of integer;
i,k:integer; {K变量用来存放答案的个数}
fv:text;procedure print;
var
i:integer;
begin
for i:=1 to 8 do
writeln(fv,'第',i:2, '行放在第', a[i]:2,'列'); {结果输出到文件里}
k:=k+1; {每输出一个答案计数加1}
writeln(fv)
end;procedure try(i:integer);
var
j:integer;
begin
for j:=1 to 8 do
if (b[j]=0) and (c[i-j]=0) and (d[i+j]=0) then
begin
a[i]:=j;
b[j]:=1; {宣布占领列、主副对角线}
c[i-j]:=1;
d[i+j]:=1;
if i<8 then try(i+1) else print;
b[j]:=0; {释放占领列、主副对角线}
c[i-j]:=0;
d[i+j]:=0
end
end;begin
for i:=1 to 8 do a[i]:=0;
for i:=-7 to 7 do c[i]:=0;
for i:=2 to 16 do d[i]:=0;
k:=0;
assign(fv,'jieguo.txt'); {指定文件与文件变量相联系}
rewrite(fv); {以写的方式打开文件}
try(1);
close(fv); {一定要记得关闭文件，不然数据有可能丢失}
writeln('共有 ',k:3,' 种摆法')
end.
二分查找法完整版
program jjzx(input,output);
var
a:array[1..10] of integer;
i,j,n,x:integer;
begin
writeln('输入10个从小到大的数：');
for i:=1 to 10 do read(a[i]);
writeln('输入要查找的数：');
readln(x);
i:=1; n:=10; j:=trunc((i+n)/2);
if a[n]
writeln('查找失败，数组中无此元素！')
else
begin
repeat
if a[j]>x then
begin
n:=j; j:=trunc((i+n)/2)
end
else
begin
i:=j+1; j:=trunc((i+n)/2)
end
until (a[j]=x) or (i=j) ;
if a[j]=x then
writeln('查找成功！位置是：',j:3)
else
writeln('查找失败，数组中无此元素！')
end
end.
想想还有其他的方法解决X大于数组中的任何一个数的方法这种情况的方法吗？
地图四色问题
{问题描述：任何一张地图只要用四种颜色进行填涂，就可以保证相邻省份不同色}
program tt;
const num=20;
var a:array [1..num,1..num] of 0..1;
s:array [1..num] of 0..4; {用1-4分别代表RBWY四种颜色;0代表末填进任何颜色}
k1,k2,n:integer;
function pd(i,j:integer):boolean;{判断可行性：第I个省填上第J种颜色}
var k:integer;
begin
for k:=1 to i-1 do {一直从第一个省开始进行比较一直到I省减一的那个省，目的是对已经着色的省份来进行比较，因为>I的省还没 有着色，比较没有意义，着色的顺序是先第一、二、三……I个省}
if (a[i,k]=1) and (j=s[k]) then {省I和省J相邻且将填进的颜色和已有的颜色相同}
begin
pd:=false; {即不能进行着色}
exit; {退出当前函数}
end;
pd:=true; {可以进行着色}
end;procedure print;{打印结果}
var k:integer;
begin
for k:=1 to n do{将数字转为RBWY串}
case s[k] of
1:write('R':4);
2:write('B':4);
3:write('W':4);
4:write('Y':4);
end;
writeln;
end;procedure try(i:integer);
var j:integer;
begin
for j:=1 to 4 do
if pd(i,j) then begin
s[i]:=j;
if i=n then print
else try(i+1); {对下一个省进行着色}
s[i]:=0; {不能进行着色，将当前状态设置0，即不进行着色}
end;
end;BEGIN
write('please input city number: '); readln(n);
writeln('please input the relation of the cities:');
for k1:=1 to n do
begin
for k2:=1 to n do read(a[k1,k2]); {A[K1，K2]=1表示省K1、K2相邻，为0就不相邻}
readln;
end;
for k1:=1 to n do s[k1]:=0; {把所有的颜色设置为0，即还没有进行着色}
try(1);
END.
穿越迷宫
{本程序假设迷宫是一个4 X 4的矩阵，入口在A[1，1]，出口在A[4，4]}
{矩阵数据放在文件shuju3.txt 中}
program mikong;
var
a,b,c:array[1..4,1..4] of integer; {数组A用来存放迷宫路径，约定元素值为0表示通，1表示不通}
{数组B用来存放方向增量}
{数组C用来记录结果，当第I步移到某一元素时，该元素就等于I}
i,j,k,m,n:integer;
fv:text;
q:boolean; {用来标记迷宫是否有出路}procedure print;
var
m,n:integer;
begin
q:=true; {如果打印步骤，表示肯定有出路}
writeln;
writeln;
writeln('穿越迷宫的步骤是：');
for m:=1 to 4 do
begin
for n:=1 to 4 do
write(c[m,n]:4);
writeln;
end
end;procedure try(x,y,i:integer);
var
u,v,k:integer;
begin
for k:=1 to 4 do {可以有4个方向选择}
begin
u:=x+b[k,1]; {当前坐标加上方向增量}
v:=y+b[k,2];
if (u>=1) and (u<=4) and (v>=1) and (v<=4) then {判断是否越界}
if (a[u,v]=0) and (c[u,v]=0) then {判断是否为0，为0就表示通，为1就表示不通}
begin
if (x=2) and (y=3) then writeln('aaaaaaaaaaaa');
c[u,v]:=i; {数组 C打上记号，表示此元素是第I步到达}
if (u<>4) or (v<>4) then {判断是否到出口}
try(u,v,i+1) {没有就继续走}
else print;
c[u,v]:=0 {下一路所有方向都不通，清除本次所做的标记}
end
end
end;
begin
assign(fv,'shuju3.txt');
reset(fv);
for i:=1 to 4 do
begin
for j:=1 to 4 do
read(fv,a[i,j]);
readln(fv)
end;
b[1,1]:=-1; b[1,2]:=0;
b[2,1]:=0; b[2,2]:=1;
b[3,1]:=1; b[3,2]:=0;
b[4,1]:=0; b[4,2]:=-1;
close(fv);
for i:=1 to 4 do {首先标记数组C所有元素全部为0}
for j:=1 to 4 do c[i,j]:=0;
c[1,1]:=1;
for i:=1 to 4 do {显示迷宫具体线路，0表示通，1表示不通}
begin
for j:=1 to 4 do
write(a[i,j]:4);
writeln
end;
q:=false; {假设迷宫没有出路}
try(1,1,2);
if q=false then writeln( '此迷宫没有出路')
end.
数字全排列问题
数字全排列问题：
任意给出从1到N的N个连续的自然数，求出这N个自然数的各种全排列。如N=3时，共有以下6种排列方式：
123，132，213，231，312，321。
注意：数字不能重复，N由键盘输入（N<=9）。解题思路：
应用回溯法，每个数的取法都有N个方向（1——N），当取够N个数时，输出一个排列，然后退后一步，取前一个数的下一个方向（即前一个数+1），并且要保证所有数字不能重复。当前数字的所有方向都取完时，继续退一步，一直重复到第一个数为止。程序代码：
program quanpailie; {数字全排列问题}
var
a:array[1..9] of integer;
k,x,n:integer;function panduan(j,h:integer):boolean; {判断当前数字是否能赋值给当前数组元素}
var
m:integer;
begin
panduan:=true;
for m:=1 to h-1 do
if a[m]=j then panduan:=false {如果当前数字与前面的数组元素相同则不能赋值}
end;procedure try(h:integer);
var
i,j,m:integer;
begin
for j:=1 to n do
if panduan(j,h) then
begin
a[h]:=j; {能够赋值，且长度k加一}
k:=k+1;
if k=n then {如果长度达到N则表示一种组合已经完成，输出结果}
begin
for m:=1 to n do
write(a[m]);
write('':4);
x:=x+1; {每输出一种排列方式加一}
if x mod 5=0 then writeln; {每行输出5种排列方案}
end
else
try(h+1); {对下一个数组元素进行赋值}
k:=k-1 {回溯的时候一定要把长度减一}
end
end;begin
writeln('输入 N:');
readln(n);
k:=0; {k表示长度，长度初始值为0}
x:=0; {x表示总的排列方式}
try(1); {对第一个数组元素赋值}
writeln('共有 ', x ,' 种排列方案')
end.
I J
2362
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
