Question

pascal八皇后问题

国际象棋棋盘上8个皇后，怎样才能保证皇后不在同一行、列、对角线。

Answer 1

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.

Answer 2

别人放程序,我一般不看的,好长...
所以我也不放了,告诉你几种方法吧....

1:普通方法:搜索(貌似12皇后还是13皇后就一秒钟出不来了...)

2:利用棋盘的对称,加快搜索

3:位运算(算是用2进制模拟搜索,只不过判断和操作速度很快...)

具体请CALL我....

Answer 3

program bahuanghou;
var a:array[0..100]of integer;
n,i,k:integer;
procedure start;
begin
assign(input,'bahuanghou.in');
reset(input);
assign(output,'bahuanghou.out');
rewrite(output);
end;
procedure print;
begin
for i:=1 to n do write(a[i]);
writeln;
k:=k+1;
end;
procedure trying(i:integer);
var j,k:integer;
f:boolean;
begin
for j:=1 to n do
begin
f:=true;
for k:=1 to i-1 do
if(a[k]=j)or(k+a[k]=i+j)or(k-a[k]=i-j)then
begin f:=false;break;end;
if f then begin
a[i]:=j;
if i=n then print
else trying(i+1);
end;
end;
end;
begin
start;
readln(n);
for i:=1 to n do a[i]:=0;
trying(1);
write(k);
close(input);close(output);
end.