搜索与回溯练习（一）

回溯算法_排列问题

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

 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.

参考程序2

回溯算法_皇后问题

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.

参考程序