八皇后问题.pas

八皇后经典问题 输出任一种解

program queen;
var
key,i,j,m,n,z:integer;
a:array [1..8,1..8] of integer;
{占据}
procedure p1(i,j:integer);
var r:integer;
begin
for r:=1 to 8 do
begin
if a[i,j]=0 then a[i,j]:=-i;
if a[r,j]=0 then a[r,j]:=i;
if a[i,r]=0 then a[i,r]:=i;
if (i+r<=8) and (j+r<=8) and (a[i+r,j+r]=0) then a[i+r,j+r]:=i;
if (i-r>=1) and (j-r>=1) and (a[i-r,j-r]=0) then a[i-r,j-r]:=i;
if (i+r<=8) and (j-r>=1) and (a[i+r,j-r]=0) then a[i+r,j-r]:=i;
if (i-r>=1) and (j+r<=8) and (a[i-r,j+r]=0) then a[i-r,j+r]:=i;
end;
end;
{释放}
procedure p2(i:integer);
var
m,n:integer;
begin
for m:=1 to 8 do for n:=1 to 8 do if abs(a[m,n])=i then a[m,n]:=0;
end;
{打印解}
procedure print;
var
x,y:integer;
begin
for x:=1 to 8 do
begin
writeln;
for y:=1 to 8 do if a[x,y]<0 then write(abs(a[x,y]):2) else write(0:2);
end;
writeln
end;
{试探法求解}
procedure p3(step:integer);
var r,h:integer;
begin
h:=0;
if step  < 9 then
begin
for r:=1 to 8 do if a[step,r]=0 then
                                    begin
                                      p1(step,r);
                                      p3(step+1);
                                      p2(step);
                                    end
end
          else
            begin
              for m:=1 to 8 do for n:=1 to 8 do if a[m,n] < 0 then h:=h+1;
              if h=8 then z:=z+1;
              if z=key then print;
            end;
end;
begin
{初始化}
writeln('input the number of xu hao:');
readln(key); {解的序号}
z:=0;
for i:=1 to 8 do for j:=1 to 8 do a[i,j]:=0;
p3(1);
{解法总数}
write(z);
readln;
end.