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.
再探索四色问题：
算法：
- 6 -
采取另一个数组s，用这个数组表示某一省已经涂过颜色。 procedure (涂色过程)； begin
{初始化工作}
{对第一个省涂色}
while x<=n do {还有省份没有涂色}
while (y<=4) and (x<=n) do {选取颜色} begin
if k {检查相邻区域，如果不是当前颜色区域} then
k:=k+1; {试探下一个区域}；
if {当前颜色不能填涂} then y:=y+1; {试探下一种颜色} else {本区域涂色，准备试探下一区域} if {试探不成功} then {回溯}
x:=x-1; {返回上一个省，同时修正y颜色的值} end; end;
上面的算法中，如何检测相邻区域是否涂色以及涂什么颜色的计算机表示方法：用S数组表示某区域所涂的颜色，R数组表示省之间的信息，用0，1表示。因此检查相邻区域是否涂色或涂的颜色是否相同用：s[k]*r[x,k]<>x表示。 四色问题参考程序：
program color;
const max=100; p:array[1..4]of string=('red','yellow','blue','white'); var r:array[1..max,1..max] of 0..1; s:array[1..max] of 0..4; n,a,b:integer; fi,fo:text; procedure map; var x,y,k:integer; begin
s[1]:=1; x:=2; y:=1; {初始化} while (y<=4)and(x<=n) do begin k:=1;
while (k s[x]:=y; {给本区域涂颜色} x:=x+1; {准备试探下一个区域} y:=1; {颜色重新赋值} end; if y>4 then begin x:=x-1; {回溯到上一个省} y:=s[x]+1; {修正颜色的值} end; end; end; begin assign(fi,'color.in'); reset(fi);readln(fi,n); for a:=1 to n do for b:=1 to n do read(fi,r[a,b]); close(fi); {输入省之间的信息} assign(fo,'color.out'); rewrite(fo); map; - 7 - for a:=1 to n do writeln(fo,a,'-',p[s[a]],' '); {输出解} close(fo); end. 售票员的烦恼 有2*n个人排队买一件价格为0.5元的商品，其中一半人拿一张1元人民币，另一半人拿一张0.5元的人民币，要使售票员在售票中，不发生找零钱的困难，问这2*n个人应该如何排队？找出所有排队的方案（售票员一开始的时候就没有准备零钱）。 分析： ① 要是售票员在售票时不发生找钱的困难，则在排队中，应该是在任何一种情况下：拿0.5元的排在前面的人数多余拿1元的人数。 ② 该问题用0，1表示：用0表示拿0.5元的人，用1表示拿1元的人，那么2n个人就转化为有2n个0，1的排列问题。我们可以采取b[1..2n]表示存放拿币的情况。 ③ 设k是b数组下标指针，b[k]=0或b[k]=1,另外用数组d[0]、d[1]记录0与1的个数，n>d[0]>=d[1] ④ 回溯搜索 1>、先将b[1],b[2],…,b[2*n]置-1，从第一个元素开始搜索，每个元素先取0，再取1，即b[k]:=b[k]+1,试探新的值，若符合规则，增加一个新元素； 2>、若k<2*n，则k:=k+1，试探下一个元素，若k=2*n，则输出b[1],b[2],…,b[2*n]。 3>、如果b[k]的值不符合要求，则b[k]+1,试探新的值，如果b[k]=2，表示第k个元素的所有值都搜索过，不符合条件，返回上一个元素b[k-1]。 4>、返回到上一个元素k:=k-1，同时修改d[0]、d[1]. 参考程序： const max=100; var b:array[1..2*max] of -1..2; d:array[0..1] of 0..max; done:boolean; i,j,x,y,total,n,k:integer; procedure suan; {统计0和1的个数} var i:integer; begin d[0]:=0; d[1]:=0; for i:=1 to 2*n do if b[i]=0 then inc(d[0]) else if b[i]=1 then inc(d[1]) end; procedure print; {输出一组解} var x:integer; begin inc(total); {total表示方案数} write('No.',total,':'); for x:=1 to 2*n do write(b[x]:2); writeln; end; - 8 - begin {主程序} readln(n); for k:=1 to 2*n do b[k]:=-1; {初始化} total:=0; k:=1; d[0]:=0; d[1]:=0; repeat repeat { 按照问题的要求，产生一组解或回溯到上一个元素} done:=false; inc(b[k]); x:=0; y:=0; for i:=1 to 2*n do if b[i]=0 then inc(x) else if b[i]=1 then inc(y); if (b[k]=0) and (x<=n) then done:=true; {不能超过n} if (b[k]=1) and (x>=y) then done:=true; {0的数量要多于1的数量} until done or (b[k]=2); {要么出界，要么所有元素都便历过} if done then suan; if done then if (k=2*n) and (d[0]=d[1]) then print {满足要求输出}else inc(k) {k<2*n} else begin {如果b[k]=2，则表示第k个元素所有值已经试探过，均不符合条件，此时要回溯到上一个元素} suan; b[k]:=-1; {回溯后要重新赋初值} dec(k); {返回上一个点} end; until k=0; {一直向上回溯，到k=0时终止} writeln; end. 程序执行后的结果： 输入：n=3 输出： NO.1：0 0 0 1 1 1 NO.2：0 0 1 0 1 1 NO.3：0 0 1 1 0 1 NO.4：0 1 0 0 1 1 NO.5：0 1 0 1 0 1 下面是n=3时产生的第一个解以及从第一个解最后一位开始回溯到产生第二个解的情况，请同学们自己分析一下回溯算法的实际含义： k 1 2 3 4 5 6 b[k] 0 0 0 1 1 1 d[0] 1 2 3 3 3 3 d[1] 0 0 0 1 2 3 上表是第一个解： 0 0 0 1 1 1 k 1 2 3 4 5 6 b[k] 0 0 0 1 1 2 d[0] 1 2 3 3 3 3 d[1] 0 0 0 1 2 3 上表是：b[6] 加1，需要回溯 - 9 - k 1 2 3 4 5 b[k] 0 0 0 1 2 d[0] 1 2 3 3 3 d[1] 0 0 0 1 2 上表是：回溯，k=5，b[5]加1，再回溯 k 1 2 3 4 5 b[k] 0 0 0 2 -1 d[0] 1 2 3 3 d[1] 0 0 0 1 上表是：回溯k=4，b[4]加1，再回溯 k 1 2 3 4 5 b[k] 0 0 1 -1 -1 d[0] 1 2 2 d[1] 0 0 1 上表是：回溯k=3，b[3]加1，再回溯 k 1 2 3 4 5 b[k] 0 0 1 0 -1 d[0] 1 2 2 3 d[1] 0 0 1 1 上表是：k加1，k=4，b[4]加1 k 1 2 3 4 5 b[k] 0 0 1 0 1 d[0] 1 2 2 3 3 d[1] 0 0 1 1 2 上表是：k=5，b[5]加1，d[0]>=b[5]再加1 k 1 2 3 4 5 b[k] 0 0 1 0 1 d[0] 1 2 2 3 3 d[1] 0 0 1 1 2 上表是：k=6，b[6]加1，d[0]>=b[6]再加1，此时得到第二组解：0 0 1 0 1 1 【拆分自然数N之和】 任何一个大于1的自然数n，总可以拆分成若干个小于n的自然数之和。（n<=100） 【样例】 输入n=7 输出： 7=1+6 7=1+1+5 7=1+1+1+4 7=1+1+1+1+3 7=1+1+1+1+1+2 7=1+1+1+1+1+1+1 7=1+1+1+2+2 - 10 - 6 -1 6 -1 6 -1 6 -1 6 -1 6 1 3 3