排除对称、旋转，八皇后问题的基本解其实只有12种。 (*       求八皇后问题排除对称、旋转后的基本摆法。 *) const  N=8; type      queentype=array[1..N] of integer; var    x,y:queentype;    sum: longint; function place(k: integer):boolean; var    i: integer; begin     for i:=1 to k-1 do        if (k-i=abs(x[k]-x[i])) or (x[k]=x[i]) then          begin              place:=false;              exit;          end;      place:=true; end; function trialed:boolean; var     i: integer; begin     for i:=1 to N do        if y[i]<x[i] then          begin             trialed:=true;             exit;          end         else if y[i]>x[i] then           begin               trialed:=false;               exit;           end;     trialed :=false; end; function same : boolean; var    i:integer; begin     same:=true;     for i:=1 to N do  y[i]:=N+1-x[i];     (*检查左右对称*)     if trialed then exit;     for i:=1 to N do  y[N+1-i]:=x[i];     (*检查上下对称*)     if trialed then exit;     for i:=1 to N do  y[x[i]]:= N+1-i;    (*检查顺时针90度旋转*)     if trialed then exit;     for i:=1 to N do  y[N+1-i]:=N+1-x[i]; (*检查中心对称(180度旋转)*)     if trialed then exit;     for i:=1 to N do  y[N+1-x[i]]:=i;     (*检查逆时针90度旋转*)     if trialed then exit;      for i:=1 to N do  y[x[i]]:=i;        (*检查左上、右下对角线对称*)      if trialed then exit;      for i:=1 to N do y[N+1-x[i]]:=N+1-i;  (*检查右上、左下对角线对称*)      if trialed then exit;      same:=false; end; procedure PrintChessboard; var     i,j:integer; begin     writeln('No. ',sum, ' :');     for i:=1 to N do       begin           for j:=1 to N do               if j=x[i] then write('Q':2)                    else write('.':2);            writeln;       end;     readln;  end; procedure backtrack(k: integer); var    i: integer; begin     if k>N then        begin            if same then exit;            sum:=sum+1;            PrintChessboard;            exit;        end;      for i:=1 to N do        begin            x[k]:=i;            if place(k) then backtrack(k+1);        end; end; BEGIN     sum:=0;     backtrack(1);     writeln('Sum = ',sum); END.

评论