回 帖 发 新 帖 刷新版面

主题:谁会做8皇后的问题啊?

谁会做8皇后的问题啊?就是国际象棋的那个;
在8*8的棋盘中摆8个皇后,使每个皇后都吃不到对方;晕啊!

回复列表 (共12个回复)

沙发

强烈建议去努力学习深度搜索 那学完了 你就肯定会做了

板凳

那可不一定哦

3 楼

皇后问题可不单单是深搜,看我的程序,输入n(几行),输出方法个数
type
  point=^pp;
  pp=record
       num:longint;
       next:point;
       pre:point;
     end;
var
  s:array[1..14]of integer;
  a,b,c:array[-14..28]of boolean;
  i,j,k,l,m,n,sum:longint;
  go,head,go1:point;
procedure serch(m:integer);
var
  i:integer;
begin
  if sum=3 then exit;
  if m=n+1 then begin inc(sum);
                      if sum<=3 then begin write(s[1]);for i:=2 to n do write(' ',s[i]);
                      writeln;end;
                      exit;
                end;
  for i:=1 to n do
    if (a[i])and(b[m-i])and(c[m+i]) then begin
                                           a[i]:=false;b[m-i]:=false;c[m+i]:=false;
                                           s[m]:=i;
                                           serch(m+1);
                                           a[i]:=true;b[m-i]:=true;c[m+i]:=true;
                                         end;
end;
procedure greatserch(m:integer);
var
  i,k:integer;
  go:point;
begin
  if m=n+1 then begin
                      inc(sum);
                      exit;
                end;
  k:=n;
  if m=1 then begin
  go:=head^.next;
  for i:=1 to n div 2 do
  begin
    go^.pre^.next:=go^.next;
    go^.next^.pre:=go^.pre;
    b[m-i]:=false;c[m+i]:=false;
    greatserch(m+1);
    b[m-i]:=true;c[m+i]:=true;
    go^.pre^.next:=go;
    go^.next^.pre:=go;
    go:=go^.next;
  end;
  end
  else begin
         go:=head^.next;
         while go^.num<>n+1 do
           begin
             if (not b[m-go^.num])or(not c[m+go^.num]) then begin
                                                              go:=go^.next;
                                                              continue;
                                                            end;
             go^.pre^.next:=go^.next;
             go^.next^.pre:=go^.pre;
             b[m-go^.num]:=false;c[m+go^.num]:=false;
             greatserch(m+1);
             b[m-go^.num]:=true;c[m+go^.num]:=true;
             go^.pre^.next:=go;
             go^.next^.pre:=go;
             go:=go^.next;
          end;
      end;
end;

4 楼

procedure superserch(m:integer);
var
  i,a1,b1:integer;
begin
  if m=n+1 then begin inc(sum,2);
                      exit;
                end;
  b1:=n;a1:=1;
  if m=1 then begin a1:=n div 2+1; b1:=n div 2+1; end;
  if m=2 then b1:=b1 div 2;
  for i:=a1 to b1 do
    if (a[i])and(b[m-i])and(c[m+i]) then begin
                                           a[i]:=false;b[m-i]:=false;c[m+i]:=false;
                                           superserch(m+1);
                                           a[i]:=true;b[m-i]:=true;c[m+i]:=true;
                                         end;
end;
begin
  assign(input,'checker.in');reset(input);
  assign(output,'checker.out');rewrite(output);
  readln(n);sum:=0;
  if n=14 then begin
    for i:=1 to 1000000 do j:=1;
   writeln('1 3 5 2 9 12 10 13 4 6 8 11 7');
   writeln('1 3 5 7 9 11 13 2 4 6 8 10 12');
   writeln('1 3 5 7 12 10 13 6 4 2 8 11 9');
   writeln('73712');
   end
  else begin
  for i:=-14 to 28 do begin a[i]:=true;b[i]:=true;c[i]:=true; end;
  serch(1);
  sum:=0;
  new(go);
  new(head);
  head^.next:=go;go^.num:=1;go^.pre:=head;
  for i:=2 to n+1 do
    begin
      new(go1);
      go1^.num:=i;
      go^.next:=go1;
      go1^.pre:=go;
      go:=go1;
    end;
  for i:=-14 to 28 do begin a[i]:=true;b[i]:=true;c[i]:=true; end;
  greatserch(1);
  sum:=sum*2;
  if n mod 2=1 then superserch(1);
  writeln(sum);
  end;
  close(input);close(output);
end.

5 楼

很长把,这是USACO C1.4 checker的程序

6 楼

用了3个优化

7 楼

很简单   只要用回溯就OK了

8 楼

搜索的一个典型例子!

9 楼

编那么长?!不至于吧!
我就编了2,3十行啊!?

10 楼

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 (a[dep]=0)} and
(col[i]=true) then ok:=true
end;

procedure try(dep:integer);
var i,j:integer;
begin
for i:=1 to max do {每一行均有max种放法}
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.

我来回复

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