回溯算法_排列问题
AYYZOJ p1415
思路：简单的全排列
1 type arr=array[0..500] of longint; 2 var n,m,i:integer; 3 a,ans:arr; 4 s:set of 0..9; 5 s1:string; 6 procedure print(a:arr); 7 begin 8 for i:=1 to m do write(ans[i],' '); writeln; 9 end; 10 Procedure DFS(k:integer); 11 Var i:integer; 12 Begin 13 If k>M then begin print(Ans);exit;end; 14 For i:=1 to N do 15 If not(a[i] in S) then begin 16 S:=S+[a[i]]; 17 Ans[k]:=a[i]; 18 DFS(k+1); 19 S:=S-[a[i]]; 20 End; 21 End; 22 begin 23 readln(s1);n:=length(s1); m:=n; 24 for i:=1 to length(s1) do 25 a[i]:=ord(s1[i])-48; 26 dfs(1); 27 end.
1 var 2 a:array[0..10]of integer; 3 b:array[0..10]of boolean; 4 st:string; 5 n:integer; 6 procedure print; //打印 7 var i:integer; 8 begin 9 for i:=1 to n-1 do 10 write(st[a[i]],' '); //输出该排列方式下的字串st 11 write(st[a[n]]); 12 writeln; 13 end; 14 procedure find(s:integer); //搜索第s个位置填入的序号i 15 var i:integer; 16 begin 17 for i:=1 to n do 18 if b[i] then 19 begin 20 a[s]:=i; 21 b[i]:=false; 22 if s=n then print 23 else find(s+1); 24 b[i]:=true; 25 end; 26 end; 27 begin 28 readln(st); n:=length(st); 29 fillchar(b,sizeof(b),#1); 30 find(1); 31 end.
1 type se=set of 1..100; 2 var 3 ss:string; 4 s:se; 5 n,m,num:integer; 6 ans:array[1..100]of integer; 7 procedure print; 8 var i:integer; 9 begin 10 for i:=1 to n do write(ans[i]:3); 11 writeln; 12 end; 13 procedure DFS(k:integer); 14 var i:integer; 15 begin 16 if k>n then begin print;exit;end; 17 for i:=1 to n do 18 if not(ord(ss[i])-48 in s) then begin 19 s:=s+[ord(ss[i])-48]; 20 ans[k]:=ord(ss[i])-48; 21 dfs(k+1); 22 s:=s-[ord(ss[i])-48]; 23 end; 24 end; 25 begin 26 readln(ss); 27 n:=length(ss); 28 s:=[]; //初始集合为空 29 dfs(1); 30 end.
回溯算法_皇后问题
AYYZOJ p1416
思路：同经典问题“八皇后”。搜索时判断该位置是否能放置皇后。找到一种解则输出，此路不通则返回上一结点。
1 var 2 a:array[1..9] of integer; 3 b:array[1..9] of boolean; 4 c:array[1..20] of boolean; 5 d:array[-8..8] of boolean; 6 sum,n:integer; 7 procedure print; 8 var i:integer; 9 begin 10 for i:=1 to n do write(a[i]:2);writeln //输出一种方案 11 end; 12 procedure Search(t:integer); 13 var j:integer; 14 begin 15 for j:=1 to n do //每个皇后都有8位置(列)可以试放 16 if b[j] and c[t+j] and d[t-j] then //寻找放置皇后的位置 17 begin //放置皇后,建立相应标志值 18 a[t]:=j; //摆放皇后 19 b[j]:=false; //宣布占领第j列 20 c[t+j]:=false; d[t-j]:=false; //占领两个对角线 21 if t=n then print //n个皇后都放置好,输出 22 else Search(t+1); //继续递归放置下一个皇后 23 b[j]:=true; //递归返回即为回溯一步,当前皇后退出 24 c[t+j]:=true; d[t-j]:=true; 25 end; 26 end; 27 begin 28 fillchar(b,sizeof(b),#1); //数组b、c、d初始化，赋初值True 29 fillchar(c,sizeof(c),#1); 30 fillchar(d,sizeof(c),#1); 31 readln(n); 32 search(1); //从第1个皇后开始放置 33 end.
N皇后问题
COGS p640
1 var 2 b:array[1..12] of boolean; 3 c:array[1..24] of boolean; 4 d:array[-11..11] of boolean; 5 n,ans:integer; 6 procedure Search(t:integer); 7 var j:integer; 8 begin 9 for j:=1 to n do 10 if b[j] and c[t+j] and d[t-j] then //寻找放置皇后的位置 11 begin //放置皇后,建立相应标志值 12 b[j]:=false; //宣布占领第j列 13 c[t+j]:=false; d[t-j]:=false; //占领两个对角线 14 if t=n then inc(ans) 15 else Search(t+1); //继续递归放置下一个皇后 16 b[j]:=true; //递归返回即为回溯一步,当前皇后退出 17 c[t+j]:=true; d[t-j]:=true; 18 end; 19 end; 20 begin 21 assign(input,'queen.in'); 22 reset(input); 23 assign(output,'queen.out'); 24 rewrite(output); 25 fillchar(b,sizeof(b),#1); //数组b、c、d初始化，赋初值True 26 fillchar(c,sizeof(c),#1); 27 fillchar(d,sizeof(c),#1); 28 readln(n); 29 search(1); //从第1个皇后开始放置 30 writeln(ans); 31 end.