搜索与回溯练习（一）

回溯算法_排列问题

AYYZOJ p1415

思路：简单的全排列

type arr=array[0..500] of longint;
var  n,m,i:integer;
     a,ans:arr;
         s:set of 0..9;
        s1:string;
procedure print(a:arr);
  begin
    for i:=1 to m do write(ans[i],' '); writeln;
  end;
Procedure DFS(k:integer);
  Var i:integer;
  Begin
     If k>M then begin print(Ans);exit;end;
     For i:=1 to N do
       If not(a[i] in S) then begin
         S:=S+[a[i]];
         Ans[k]:=a[i];
         DFS(k+1);
         S:=S-[a[i]];
       End;
  End;
begin
  readln(s1);n:=length(s1); m:=n;
  for i:=1 to length(s1) do
   a[i]:=ord(s1[i])-48;
  dfs(1);
end.

var 
a:array[0..10]of integer;
  b:array[0..10]of boolean;
  st:string;
  n:integer;
procedure print;                    //打印
 var i:integer;
begin
 for i:=1 to n-1 do
  write(st[a[i]],' ');              //输出该排列方式下的字串st
  write(st[a[n]]);
 writeln;
end;
procedure find(s:integer);           //搜索第s个位置填入的序号i
 var i:integer;
begin
 for i:=1 to n do
  if b[i] then
    begin
     a[s]:=i;
     b[i]:=false;
     if s=n then print
            else find(s+1);
     b[i]:=true;
    end;
end;
begin
 readln(st); n:=length(st);
 fillchar(b,sizeof(b),#1);
 find(1);
end.

type se=set of 1..100;
var
 ss:string;
 s:se;
 n,m,num:integer;
 ans:array[1..100]of integer;
procedure print;
var  i:integer;
begin
 for i:=1 to n do write(ans[i]:3);
  writeln;
end;
procedure DFS(k:integer);
 var i:integer;
begin
 if k>n then begin print;exit;end;
  for i:=1 to n do
   if not(ord(ss[i])-48 in s) then begin
                            s:=s+[ord(ss[i])-48];
                            ans[k]:=ord(ss[i])-48;
                            dfs(k+1);
                            s:=s-[ord(ss[i])-48];
                          end;
end;
begin
 readln(ss);
 n:=length(ss);
 s:=[];                //初始集合为空
 dfs(1);
end.

回溯算法_皇后问题

AYYZOJ p1416

思路：同经典问题“八皇后”。搜索时判断该位置是否能放置皇后。找到一种解则输出，此路不通则返回上一结点。

var 
a:array[1..9] of integer;
 b:array[1..9] of boolean;
 c:array[1..20] of boolean;
 d:array[-8..8] of boolean;
 sum,n:integer;
procedure print;
var  i:integer;
begin
for i:=1 to n do write(a[i]:2);writeln   //输出一种方案
end;
procedure Search(t:integer);
var j:integer;
begin
for j:=1 to n do              //每个皇后都有8位置(列)可以试放
 if b[j] and c[t+j] and d[t-j] then  //寻找放置皇后的位置
 begin                               //放置皇后,建立相应标志值
  a[t]:=j;                       //摆放皇后
  b[j]:=false;                   //宣布占领第j列
  c[t+j]:=false; d[t-j]:=false;  //占领两个对角线
  if t=n then print              //n个皇后都放置好,输出
         else Search(t+1);       //继续递归放置下一个皇后
  b[j]:=true;                 //递归返回即为回溯一步,当前皇后退出
  c[t+j]:=true;  d[t-j]:=true;
 end;
end;
begin
fillchar(b,sizeof(b),#1);    //数组b、c、d初始化，赋初值True
fillchar(c,sizeof(c),#1);
fillchar(d,sizeof(c),#1);
readln(n);                  
search(1);                   //从第1个皇后开始放置
end.

N皇后问题

COGS p640

var
 b:array[1..12] of boolean;
 c:array[1..24] of boolean;
 d:array[-11..11] of boolean;
 n,ans:integer;
procedure Search(t:integer);
var j:integer;
begin
for j:=1 to n do
 if b[j] and c[t+j] and d[t-j] then //寻找放置皇后的位置
 begin                           //放置皇后,建立相应标志值
   b[j]:=false;                  //宣布占领第j列
   c[t+j]:=false; d[t-j]:=false;  //占领两个对角线
   if t=n then inc(ans)
    else Search(t+1);    //继续递归放置下一个皇后
   b[j]:=true;         //递归返回即为回溯一步,当前皇后退出
   c[t+j]:=true;  d[t-j]:=true;
 end;
end;
begin
assign(input,'queen.in');
reset(input);
assign(output,'queen.out');
rewrite(output);
  fillchar(b,sizeof(b),#1);     //数组b、c、d初始化，赋初值True
  fillchar(c,sizeof(c),#1);
  fillchar(d,sizeof(c),#1);
  readln(n);
   search(1);  //从第1个皇后开始放置
  writeln(ans);
end.