主题:八女皇问题
rz
[专家分:0] 发布于 2003-08-21 10:37:00
国际象棋棋盘上有八只皇后,如何摆放使其不能互吃?
[marquee]HELP!!![/marquee][b]HELP!!![/b]
回复列表 (共14个回复)
11 楼
QQ331373582 [专家分:1500] 发布于 2005-06-04 15:18:00
program eightqueens;
var
x:array[1..8] of integer;
a,b,c:array[-7..16] of boolean;
i:integer;
procedure print;
var k:integer;
begin
for k:=1 to 8 do write(x[k]:4);
writeln;
end;
procedure try(i:integer);
var j:integer;
begin
for j:=1 to 8 do
if a[j] and b[i+j] and c[i-j]
then begin
x:=j;
a[j]:=false;
b[i+j]:=false;
c[i-j]:=false;
if i<8 then try(i+1)
else print;
a[j]:=true;
b[i+j]:=true;
c[i-j]:=true
end
end;
begin
for i:=-7 to 16 do
begin
a:=true;
b:=true;
c:=true
end;
try(1);
end.
12 楼
hs3180 [专家分:530] 发布于 2005-11-10 10:21:00
用图论可以解决,但是我不知道怎么做
13 楼
michaellyz [专家分:270] 发布于 2005-12-04 19:40:00
var
a:array [1..9] of 1..9;
n,t:word;
procedure print;
var
j:byte;
begin
t:=t+1;
write('No. ',t,' ');
for j:=1 to n do
write('(',j,',',a[j],') ');
writeln;
if t mod 24=0 then readln;
end;
function check(s,i:byte):boolean;
var
j:byte;
begin
check:=false;
for j:=1 to s-1 do
if (i=a[j]) or (abs(s-j)=abs(i-a[j])) then exit;
check:=true;
end;
procedure sub(s:byte);
var
i:byte;
begin
if s>n then
print
else
for i:=1 to n do
if check(s,i) then
begin
a[s]:=i;
sub(s+1);
end;
end;
begin
repeat
write('Queen Number: ');
readln(n);
until n in [4..9];
t:=0;
sub(1);
readln;
end.
14 楼
michaellyz [专家分:270] 发布于 2005-12-04 19:40:00
以上为递归
我来回复