Question

八皇后算法 free pascal

Answer 1

〖问题描述〗
在一个8×8的棋盘里放置8个皇后，要求每个皇后两两之间不相"冲"（在每一横列竖列斜列只有一个皇后）。

〖问题分析〗(聿怀中学吕思博)
这道题可以用递归循环来做，分别一一测试每一种摆法，直到得出正确的答案。主要解决以下几个问题：
1、冲突。包括行、列、两条对角线：
（1）列：规定每一列放一个皇后，不会造成列上的冲突；
（2）行：当第I行被某个皇后占领后，则同一行上的所有空格都不能帆宏再放皇后，要把以I为下标的标记置为被占领状态；
（3）对角线：对角线有两个方向。在同一对角线上的所有点（设下标为(i,j)），要么(i+j)是常数，要么(i-j)是常数。因此，当第I个皇后占领了第J列后，要同时把以(i+j)、(i-j)为下标的标记置为被占领状态。
2、数据结构。
（1）解数组A。A[I]表示第I个皇后放置的列；范围：1..8
（2）行冲突标记数组B。B[I]=0表示第I行空闲；B[I]=1表示第I行被占领；范围：1..8
（3）对角线冲突标记数组C、D。
C[I-J]=0表示第（I-J）条对角线空闲；C[I-J]=1表示第（I-J）条对角线被占领；范围：-7..7
D[I+J]=0表示第（I+J）条对角线空闲；D[I+J]=1表示第（I+J）条对角线被占领；范围：2..16

〖算法流程〗
1、数据初始化。
2、从n列开始摆放第n个皇后（因为这样态铅册便可以符合每一竖列一个皇后的要求），先测试当前位置(n,m)是否等于0（未被占领）:
如果是，摆放第n个皇后，并宣布占领(记得要横列竖列斜列一起来哦)，接着进行递归；
如果不是，测试下一个位置(n,m+1)，但是如果当n<=8,m=8时，却发现此时已经无法摆放时，便要进行回溯。
3、当n>;8时，便一一打印出结果。

〖优点〗逐一测试标准答案，激洞不会有漏网之鱼。

〖参考程序〗queen.pas
----------------------------------------------------------------------------
programtt;
vara:array[1..8]ofinteger;
b,c,d:array[-7..16]ofinteger;
t,i,j,k:integer;
procedureprint;
begin
t:=t+1;
write(t,'');
fork:=1to8dowrite(a[k],'');
writeln;
end;

proceduretry(i:integer);
varj:integer;
begin
forj:=1to8do
if(b[j]=0)and(c[i+j]=0)and(d[i-j]=0)then
begin
a:=j;
b[j]:=1;
c[i+j]:=1;
d[i-j]:=1;
ifi<8thentry(i+1)
elseprint;
b[j]:=0;
c[i+j]:=0;
d[i-j]:=0;
end;
end;
begin
fork:=-7to16do
begin
b[k]:=0;
c[k]:=0;
d[k]:=0;
end;
try(1);
end.

==========================================
这是N皇后问题，看看吧：
在N*N的棋盘上，放置N个皇后，要求每一横行每一列，每一对角线上均只能放置一个皇后，问可能的方案及方案数。
const max=8;
var i,j:integer;
a:array[1..max] of 0..max; //放皇后数组
b:array[2..2*max] of boolean; // ‘/’对角线标志数组}
c:array[-(max-1)..max-1] of boolean;// ‘\’对角线标志数组}
col:array[1..max] of boolean; //列标志数组}
total:integer; //统计总数}

procedure output; //这里是输出过程
var i:integer;
begin
write('No.':4,'[',total+1:2,']');
for i:=1 to max do write(a[i]:3);write(' ');
if (total+1) mod 2 =0 then writeln; inc(total);
end;

function ok(i,dep:integer):boolean; //判断第dep行第i列可放否？
begin
ok:=false;
if ( b[i+dep]=true) and ( c[dep-i]=true) and
(col[i]=true) then ok:=true
end;

procedure try(dep:integer);
var i,j:integer;
begin
for i:=1 to max do //每一行均有max种放法，对吧？xixi~~~~
if ok(i,dep) then begin
a[dep]:=i;
b[i+dep]:=false; // ‘/’对角线已放标志
c[dep-i]:=false; // ‘\’对角线已放标志
col[i]:=false; // 列已放标志
if dep=max then output
else try(dep+1); // 递归下一层
a[dep]:=0; //取走皇后,回溯
b[i+dep]:=true; //恢复标志数组
c[dep-i]:=true;
col[i]:=true;
end;
end;

begin
for i:=1 to max do begin a[i]:=0;col[i]:=true;end;
for i:=2 to 2*max do b[i]:=true;
for i:=-(max-1) to max-1 do c[i]:=true;
total:=0;
try(1);
writeln('total:',total);
end.

Answer 2

programtt;
vara:array[1..8]ofinteger;
b,c,d:array[-7..16]ofinteger;
t,i,j,k:integer;
procedureprint;
begin
t:=t+1;
write(t,'');
fork:=1to8dowrite(a[k],'');
writeln;
end;

proceduretry(i:integer);
varj:integer;
begin
forj:=1to8do
if(b[j]=0)and(c[i+j]=0)and(d[i-j]=0)then
begin
a:=j;
b[j]:=1;
c[i+j]:=1;
d[i-j]:=1;
ifi<8thentry(i+1)
elseprint;
b[j]:=0;
c[i+j]:=0;
d[i-j]:=0;
end;
end;
begin
fork:=-7to16do
begin
b[k]:=0;
c[k]:=0;
d[k]:=0;
end;
try(1);
end.

Answer 3

八皇后问题..我也正在学。算山燃法是回溯算法，首先要使八个皇后不在同一行，同一列，同一对角线上（包括‘\’或‘/’），不妨设每一个皇后各占一列。则有八列(数组a[1..8]:boolean)表示是否安全【有没有皇后占了】，八行(b[1..8]:boolean)，那么，对角线怎么算呢？举个例子：位置[5,5]和位置[8,8]，很明显是相对的，怎么用算法算出来？观察一下：5-5=0 = 8-8=0,明白了吗？
假设位置[1,8]和位置[8,1]是相对的。怎么用算法算消首出来？观察一下：1+8=9 = 8+1=9,明白了吗？测试一个位置是否与皇后的位置对角线不相对，设已占位皇后的位置是[ i,j ]，测试皇后的位置是[ a,b ]，两个位置对角线不相同则必须 (i-j<>a-b) and (i+j<>a+b)。综合起来要想测试两个皇后是否受攻击，则表达式是：If (i<>a) and (j<>b) and (i-j<>a-b) and (i+j<>a+b)。程序请楼主和我一逗桥虚起研究..打了好多字呢，希望楼主能采纳。我编出了程序会和楼主一起探讨。

Answer 4

方案一（深度优先搜索）：
var ans:array[1..8] of integer; //记录答案的数组，记录在第1到第8行皇后所在的列；
lie:array[1..8] of boolean; //记录1到8中某列是否已经被另一个皇后占用；
zx:array[2..16] of boolean; //正斜线（左下向右上）数组，该斜线特点为：斜线上每一格的行加列的和一定，和为从2到16. 9士捎?到16来表示这15条正斜线，于是该数组记录了2到16中某条正斜线是否已经被另一个皇后占用；
fx:array[-7..7] of boolean; //反斜线（左上向右下）数组，该斜线特点为：斜线上每一格的行减列的差一定，差为从-7到7 9士捎?7到7来表示这15条正斜线，于是该数组记录了2到16中某条正斜线是否已经被另一个皇后占用；
temp:integer; //记录总方案数；
procedure print; //该子程序负责输出方案；
var i:integer;
begin
write('zuobiao');
for i:=1 to 8 do
write(' (',i,',',ans[i],')'); //i代表行，ans[i]代表列；
writeln;
end;
procedure search(i:integer); //i为行，即表示放到了第几个皇后（因为一行有且只有1个皇后);
var j:integer;
begin
if i=9 then //递归出口，当搜索到第九行时，便得到一种方案；
begin
print; //输出该方案；
inc(temp); //每输出（得到）一种方案，总方案数变加1；
exit; //退出；
end;
for j:=1 to 8 do if not lie[j] and not zx[i+j] and not fx[i-j] then //当前位置，该列，正斜线，反斜线上均未被另慎首一个皇后占用，即可以摆放一个皇后；
begin
lie[j]:=true; //设置标志，该行
zx[i+j]:=true; // 该正斜线
fx[i-j]:=true; // 该反斜线上已被皇后占用，不可再放皇后；
ans[i]:=j; //记录答顷册案（第i行皇后所在列j）；
search(i+1); //实行下一层递归；
lie[j]:=false; //恢复宽乎数标志（回溯）；
zx[i+j]:=false;
fx[i-j]:=false;
end;
end;
begin //主程序；
temp:=0; //给总方案数设初值为0;
fillchar(lie,sizeof(lie),0); //分别给列;
fillchar(zx,sizeof(zx),0); // 正斜线;
fillchar(fx,sizeof(fx),0); // 反斜线数组设初值为False;
search(1); //从第一行开始进行搜索；
writeln(temp); //再输出总方案数；
end.
方案二（位运算加速）：
var
upperlim,sum:integer;
procedure test(row,ld,rd:integer);
var
pos,p:integer;
begin
if row<>upperlim then
begin
pos:=upperlim and not (row or ld or rd);
while pos<>0 do
begin
p:=pos and -pos;
pos:=pos-p;
test(row+p,(ld+p)shl 1,(rd+p)shr 1);
end;
end
else
inc(sum);
end;
begin
upperlim:=(1 shl 8)-1;
test(0,0,0);
writeln(sum);
end.

Answer 5

我用的是递归式深搜，用一个二维数组作为标志数组。
其中，s为标志数组，f为输出辅助数组。
源程序如下：

program zjt;

type AA=record
s:boolean;
f:integer;
end;

var a:array[1..1000,1..1000] of 0..1;
b:array[1..1000,1..1000] of AA;
yes,no:boolean;
n,i,j:integer;
p:int64;

procedure ql(pd:boolean; x,y:integer);
var i,j:integer;
begin
for i:=1 to n do if (b[i,y].f=0) or (b[i,y].f=x) then
begin if pd then b[i,y].f:=0 else b[i,y].f:=x; b[i,y].s:=pd; end;
for i:=1 to n do if (b[x,i].f=0) or (b[x,i].f=x) then
begin if pd then b[x,i].f:=0 else b[x,i].f:=x; b[x,i].s:=pd; end;
i:=x; j:=y;
while (i>1) and (j>1) do
begin dec(i); dec(j); end;
while (i<=n) and (j<=n) do begin
if (b[i,j].f=0) or (b[i,j].f=x) then begin
if pd then b[i,j].f:=0 else b[i,j].f:=x;
b[i,j].s:=pd;
end;
inc(i); inc(j);
end;
i:=x; j:=y;
while (i<n) and (j>1) do
begin inc(i); dec(j); end;
while (i>=1) and (j<=n) do begin
if (b[i,j].f=0) or (b[i,j].f=x) then begin
if pd then b[i,j].f:=0 else b[i,j].f:=x;
b[i,j].s:=pd;
end;
dec(i); inc(j);
end;
end;

procedure try(i:integer);
var j,x,y:integer;
begin
if i<n then begin
for j:=1 to n do
if b[i,j].s then begin
ql(no,i,j);
a[i,j]:=1;
try(i+1);
a[i,j]:=0;
ql(yes,i,j);
end;
end else
for j:=1 to n do
if b[i,j].s then begin
a[i,j]:=1;
inc(p);
for x:=1 to n do begin
for y:=1 to n do
write(a[x,y]);
writeln;
if x=n then writeln;
end;
a[i,j]:=0;
end;
end;

begin
read(n);
fillchar(a,sizeof(a),0);
for i:=1 to n do
for j:=1 to n do
begin b[i,j].s:=true; b[i,j].f:=0; end;
p:=0;
yes:=true; no:=false;
try(1);
write(p);
end.
运行后输入8即是八皇后问题的解。

注：运唤虽悄空然程序有点长，但绝对是原创启悄瞎！我也刚学深搜。其实深搜并不难，祝楼主早日掌握！