八数码问题 n皇后问题

九宫格中有8个数码，其中只有一个空，规则是只能把一个数码移动到空的格子中，要求从一个初始状态移动到一个目标状态所要花费的最少步数。如下图

初始状态
2	8	3
1	6	4
7		5

 

目标状态
1	2	3
8	6	4
7	5

【算法分析】
    解决此类问题的办法是宽度搜索，深度搜索耗时太大无法接受。当需要移动的步数很多时，普通的宽度搜索仍旧无法满足需要，需要对其进行优化。
    这个问题也可以推广到流行的拼图游戏。

【具体步骤】
一、确定问题规模（考虑搜索的时间代价）
二、确定产生式规则（如果规则太多，则时间代价会很大）
三、套用经典宽度搜索框架写程序

【参考样例】
【输入】8no.in
2 0 3
1 4 6
7 5 8

1 2 3
4 5 6
7 8 0
【输出】8no.out
5       {下面为移动步骤}
2 0 3
1 4 6
7 5 8

0 2 3
1 4 6
7 5 8

1 2 3
0 4 6
7 5 8

1 2 3
4 0 6
7 5 8

1 2 3
4 5 6
7 0 8

1 2 3
4 5 6
7 8 0

【参考程序】

program eightno_bfs;
const
  dir:array[1..4,1..2] of -1..1=((1,0),(-1,0),(0,1),(0,-1));   {产生式规则：0向四个方向移动}
  max=200000;
type
  t8no=array[1..3,1..3] of 0..8;      {八数码数据结构，0表示空格}
  tlist=record                        {结点类型}
     father:longint;
     dep:byte;
     x0,y0:byte;
     state:t8no;
  end;
var
  source,target:t8no;                 {初始结点和目标结点}
  list:array[0..max] of tlist;        {扩展出的中间结点序列}
  head,foot,best,i:longint;
  answer:longint;
  found:boolean;
procedure init;                      {初始化过程}
  var
    x,y:byte;
  begin
    assign(input,'8no.in');
    reset(input);
    assign(output,'8no.out');
    rewrite(output);
    fillchar(list,sizeof(list),0);
      for x:=1 to 3 do               {读入初始结点}
      begin
       for y:=1 to 3 do
          read(source[x,y]);
        readln;
      end;
    readln;
    for x:=1 to 3 do                 {目标结点}
      begin
       for y:=1 to 3 do
          read(target[x,y]);
       readln;
      end;
    found:=false;
    head:=0;                         {队列初始化,队首指针head,队尾指针foot}
    foot:=1;
    with list[1] do                  {初始结点作为队列第一个结点}
      begin
        state:=source;
        dep:=0;
        father:=0;
        for x:=1 to 3 do
          for y:=1 to 3 do
            if state[x,y]=0
               then begin
                      x0:=x;
                      y0:=y;
                    end;
      end;
   end;
procedure writea(a:t8no);      {输出八数码矩阵过程}
  var i,j:integer;
  begin
    for i:=1 to 3 do
      begin
       for j:=1 to 3 do
         write(a[i,j],' ');
       writeln;
      end;
    writeln;
  end;
function same(a,b:t8no):boolean;  {比较八数码是否相同函数}
  var
    i,j:byte;
  begin
    same:=false;
    for i:=1 to 3 do
      for j:= 1 to 3 do
        if a[i,j]<>b[i,j]
          then exit;
    same:=true;
  end;
function notappear(newv:tlist):boolean;  {判断扩展出的结点是否已在队列中的函数}
  var
    i:longint;
  begin
    notappear:=false;
    for i:=1 to foot do
      if same(newv.state,list[i].state)
        then exit;
    notappear:=true;
  end;
procedure add(newv:tlist);      {往队列中加入新结点过程}
  begin
    if notappear(newv)
      then begin
            inc(foot);
            list[foot]:=newv;
           end;
   end;
procedure expand(index:longint;var n:tlist);  {扩展结点过程}
  var
    i,x,y:integer;
    newv:tlist;
  begin
    for i:=1 to 4 do
     begin
       x:=n.x0+dir[i,1];               {应用规则计算新的 0 的位置}
       y:=n.y0+dir[i,2];
       if (x>0) and (x<4) and (y>0) and (y<4)   {判断应用规则后 0 的坐标是否超出范围,超过则放弃该规则,否则扩展出新结点}
       then begin
             newv.state:=n.state;
             newv.state[x,y]:=0;
             newv.state[n.x0,n.y0]:=n.state[x,y];
             newv.x0:=x;
             newv.y0:=y;
             newv.father:=index;
             newv.dep:=n.dep+1;
             add(newv);
            end;
     end;
  end;
procedure print(index:longint);   {递归打印路径}
  var
    i,j:byte;
  begin
    if index=0  then exit;
    print(list[index].father);
    writea(list[index].state);
  end;
begin{main}
  init;
  repeat
    inc(head);
    if same(list[head].state,target)   {比较是否跟目标相同,相同则找到,否则扩展新结点}
      then begin
             found:=true;
             best:=list[head].dep;
             answer:=head;
             break;
            end;
      if list[foot].dep>15             {如果搜索树的层数大于15层，时间会变得非常慢，出超时提示}
         then begin
                writeln('OverTime!');
                break;
              end;
    expand(head,list[head]);
  until (head>=foot) or (foot>max) or found;
 { writeln(head,' ',foot);
     for i:=1 to foot do
      writea(list[i].state);  看队列情况}
  if found
     then begin
           writeln(best);
           print(answer);
          end
     else writeln('No Answer');
  close(input);
  close(output);
end.

 

【n皇后问题】
    一个n×n（1<=n<=100）的国际象棋棋盘上放置n个皇后，使其不能相互攻击，即任何两个皇后都不能处在棋盘的同一行、同一列、同一斜线上，试问共有多少种摆法？ 
【输入】nqueen.in
n
【输出】nqueen.out
方案数

【算法分析】
   

【参考样例】
【输入】nqueen.in
8
【输出】nqueen.out
92

【参考程序】

PROGRAM nqueen(input,output);
CONST
  nmax=100;
VAR
  x:ARRAY[1..nmax] OF integer;     {存放每个皇后位置的数组}
  a:ARRAY[1..nmax] OF boolean;     {用于表示该列是否可放置的数组}
  b:ARRAY[2..nmax*2] OF boolean;   {用于表示正对角线位置是否可放置的数组}
  c:ARRAY[-nmax..nmax] OF boolean; {用于表示反对角线位置是否可放置的数组}
  count,n:integer;
PROCEDURE print;
  VAR
    k:integer;
  BEGIN
    count:=count+1;
    FOR k:= 1 TO n DO
      write(x[k]:4);
    writeln;
  END;
PROCEDURE try(i:integer);
  VAR
    j:integer;
  BEGIN
    FOR j:= 1 TO n DO
      IF a[j] AND b[i+j] and c[i-j]   {只有当三个位置都没有冲突时才可放置}
         THEN BEGIN
               x[i]:=j;
               a[j]:=false;
               b[i+j]:=false;
               c[i-j]:=false;
               IF i<n                 {若n个皇后没有放满，则递归放下一个}
                  THEN try(i+1)
                  ELSE print;
                a[j]:=true;           {出栈时恢复状态}
                b[i+j]:=true;
                c[i-j]:=true;
               END{if}
   END;{try}
BEGIN{mian}
  assign(input,'nqueen.in');
  reset(input);
  assign(output,'nqueen.out');
  rewrite(output);
  readln(n);
  count:=0;
  fillchar(a,sizeof(a),true);
  fillchar(b,sizeof(b),true);
  fillchar(c,sizeof(c),true);
  try(1);
  writeln(count);
  close(input);
  close(output);
END.