回 帖 发 新 帖 刷新版面

主题:八女皇问题

国际象棋棋盘上有八只皇后,如何摆放使其不能互吃?
[marquee]HELP!!![/marquee][b]HELP!!![/b]

回复列表 (共14个回复)

沙发

拿不就是一个矩阵问题吗 让他们任何两个不再同一行和同一列???

板凳

对不起哈 我国际象棋不懂 是不是斜着也能吃????

3 楼

回溯法:八皇后问题,一个经典问题

     在程序设计中还有一种方法叫做"回溯法".他不是按照某种公式或确定的法则,求问题的解,而是通过试探和纠正错误的策略,找到问题的街.这种方法一般是从一个原始状态出发,通过若干步试探,最后达到目标状态终止.
    回溯法在理论上来说,就是在一棵搜索树中从根结点出发,找到一条达到满足某条件的子结点的路径.在搜索过程中,对于每一个中间结点,他的位置以及向下搜索过程是相似的,因此完全可以用递归来处理.典型的例子就是著名的"八皇后问题".
    "八皇后问题"是在国际象棋棋盘上放置八个皇后,使她们不能相吃.国际象棋中的皇后可以吃掉与她处于同一行,同一列,同一对角线上的棋子.因此每一行只能摆放一个皇后.因共有八行,所以每行有且只有一个皇后.
    在本例中皇后的位置有一个一维数组来存放A(I)=J表示第I行皇后放在第J列.下面主要来看看怎么样判断皇后是否安全的问题.(1)首先,用一维数组来表示,已经解决了不在同一行的问题.(2)对于列可以引进一个标志数组C[J],若J列上已放了皇后,则C[J]=FALSE.(3)对于左上右下的对角线I-J为一常量,位于[-7,+7]之间,再此引入标志数组L[-7..7];对于左下右上的对角线,类似的有I+J等于常量,用数组R[2..16]来表示.当在第I行,第J列上放置了皇后,则只需设置:C[J]:=FALSE; L[I-J]:=FLASE; R[I+J]:=FALSE就可以解决皇后的安全问题了.
源程序如下:
Program eightqueens;
   var cont,i:integer;
       a:array[1..8] of byte;
      c:array[1..8] of boolean;
       l:array[-7..7] of boolean;
        r:array[2..16] of boolean;
       q:boolean;
procedure pr;
   var i:integer;
begin
   for i:=1 to 8 do write(a[i]:4);
   inc(cont);writeln('cont=',cont);
end;
procedure try(i:integer);
var j:integer;
  procedure erase(i:integer);
   begin
    c[j]:=true;l[i-j]:=true;r[i+j]:=true;
   end;
begin
    for j:=1 to 8 do
  begin
     if c[j] and l[i-j] and r[i+j] then
begin
   a[i]:=j;c[j]:=false;l[i-j]:=false;
   r[i+j]:=false;
    if i<8 then try(i+1)
     else pr;
   erase(i);
   end;
  end;
end;
{***************************main*******************************}
begin
for i:=1 to 8 do c[i]:=true;
for i:=-7 to 7 do l[i]:=true;
for i:=2 to 16 do r[i]:true;
cont:=0;
i:=1;
try(i);
readln;
end.

用递归算法编制的程序具有结构清晰和移读性高的特点,但是也有执行效率不高的缺点.但当能够找到明显的递推公式用迭代法求解时,迭代法的效率会比递归方法高很多.还请大家根据情况来选择使用!

4 楼

这个跟走迷宫的情况差不多!

5 楼

一共有92中方案

6 楼

我们学的一个程序
program eightqueens(input,output);
var
x:array[1..8] of integer;
a,b,c:array[-7..16]of boolean;
i:integer;
procedur print;
  var k:integer;
  begin
   for k:=1 to 8 do  
    write(x[k]:4);
   writeln
  end;{print}
procedur 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]:=fasle;
     b[i+j]:=fasle;
     c[i-j]:=fasle;
     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[i]:=true;
    b[i]:=true;
    c[i]:=true
   end;
try(1)
end.

7 楼

好复杂呀~~
我放弃~~~

8 楼

回溯法有这么繁吗?
program zuizhi;
var
    b:array[1..50] of integer;
    x,i,j,k,n,s,y:integer;
function p(k:integer):boolean;
  begin
    p:=true;
    for y:=1 to k-1 do
      if (b[y]=b[k])or(abs(b[y]-b[k])=abs(y-k)) then
      begin
        p:=false;
        exit;
      end
  end;
begin
  x:=0;
  write('n=');
  readln(n);
  s:=1;b[1]:=0;k:=1;
  while k>0 do
    begin
      b[k]:=b[k]+1;
      while (b[k]<=n) and (p(k)=false) do b[k]:=b[k]+1;
        if b[k]<=n then
          if k=n then
          begin
             writeln;
             write('No.',s,':');
             for j:=1 to n do write(b[j],' ');
             s:=s+1;
          end
          else begin k:=k+1; b[k]:=0; end
        else k:=k-1
    end;

end.
这样不就可以吗?

9 楼

试探法也一样的
利用一个二维数据就行了

10 楼

试试递归

我来回复

您尚未登录,请登录后再回复。点此登录或注册