回 帖 发 新 帖 刷新版面

主题:八皇后问题怎么做

八皇后问题怎么做
(回溯就免了,来点更简单的)

回复列表 (共9个回复)

沙发

program     eightqueens(input,output);
         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;{print};
        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[i]:=j;
      a[j]:=false;
      b[i+j]:=false;
      c[i-j]:=false;
     if i<8
       then try  (i+1)
       else  priint ;
       a[j]:=true;
      b[i+j]:=true;
      c[i-j]:=true;
   end {if}
     end;
    begin
     for i:=-7 to 16 do 
  begin
     a[i]:=true;
     b[i]:=true;
    c[i]:=true;
     end;
    try(1)
   end.

板凳

虽然我知道一楼的是超的,还用得是回溯,但我还是要感谢你

3 楼

一楼的没超时,用的是递归,你怎么把它看成回溯了???????????

不过,一楼程序写得太杂乱了,我写的程序看起来比你们清楚。

4 楼

我把一楼的程序改了一下,看起来清楚多了:
{$N+}
PROGRAM eightqueens(INPUT,OUTPUT);
TYPE
   {Integer type declare}
   I_ = INTEGER;
   SI_ = SHORTINT;
   LI_ = LONGINT;
   BI_ = BYTE;
   WI_ = WORD;
   {Real type declare}
   R_ = REAL;
   SR_ = SINGLE;
   DR_ = DOUBLE;
   ER_ = EXTENDED;
   CR_ = COMP;
   {Other type declare}
   C_ = CHAR;
   B_ = BOOLEAN;
   S_ = STRING;
VAR
   x: ARRAY[1..8] OF I_;
   a, b, c: ARRAY[-7..16] OF B_;
   i: I_;
PROCEDURE print;
VAR
   k: I_;
BEGIN
    FOR k:=1 TO 8 DO
         WRITE(x[k]:4);
    WRITELN;
END;
PROCEDURE try(i: I_);
VAR
   j: I_;
BEGIN
    FOR j:=1 TO 8 DO
        IF a[j] AND b[i + j] AND c[i - j] THEN BEGIN
           x[i] := 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; {IF}
END;
BEGIN
    FOR i:=-7 TO 16 DO BEGIN
        a[i] := TRUE;
        b[i] := TRUE;
        c[i] := TRUE;
    END;
    try(1);
END.

5 楼

这题干脆用排列做算了。
(注意,因为答案有很多种,屏幕显示不下,所以我把答案写到了文件里。输出文件名为Nqueens.txt。输出文件里每行有8个数对,分别表示八个皇后的位置。)
如果要改变皇后个数,把第三行NNNNN的值改一下就行了。

{$N+}
CONST
    NNNNN = 8;
    KKK2 = NNNNN - 1;
    KKK1 = 0 - KKK2;
    KKK3 = 2;
    KKK4 = NNNNN + NNNNN;
TYPE
   {Integer type declare}
   I_ = INTEGER;
   SI_ = SHORTINT;
   LI_ = LONGINT;
   BI_ = BYTE;
   WI_ = WORD;
   {Real type declare}
   R_ = REAL;
   SR_ = SINGLE;
   DR_ = DOUBLE;
   ER_ = EXTENDED;
   CR_ = COMP;
   {Other type declare}
   C_ = CHAR;
   B_ = BOOLEAN;
   S_ = STRING;

   a1_ = 0..NNNNN;
   a1__ = 1..NNNNN;
   a2_ = KKK1..KKK2;
   a3_ = KKK3..KKK4;
VAR
   isfind: ARRAY[a1__] OF B_;
   kk: ARRAY[a1__] OF a1_;
   s: LI_;
   fo: TEXT;
PROCEDURE p2;
VAR
   i: a1__;
   xx1: ARRAY[a1__] OF a2_;
   yy1: ARRAY[a2_] OF B_;
   xx2: ARRAY[a1__] OF a3_;
   yy2: ARRAY[a3_] OF B_;
BEGIN
    FILLCHAR(yy1, SIZEOF(yy1), FALSE);
    FILLCHAR(yy2, SIZEOF(yy2), FALSE);
    FOR i:=1 TO NNNNN DO BEGIN xx1[i] := i - kk[i]; xx2[i] := i + kk[i]; END;
    FOR i:=1 TO NNNNN DO BEGIN
        IF yy1[xx1[i]] OR yy2[xx2[i]] THEN EXIT;
        yy1[xx1[i]] := TRUE; yy2[xx2[i]] := TRUE;
    END;
    FOR i:=1 TO NNNNN DO WRITE(fo, i, ',', kk[i], '   ');
    WRITELN(fo);
    INC(s);
END;
PROCEDURE p1(i: a1__);
VAR
   k: a1__;
BEGIN
    FOR k:=1 TO NNNNN DO
        IF NOT isfind[k] THEN BEGIN
           kk[i] := k;
           isfind[k] := TRUE;
           IF i = NNNNN THEN p2 ELSE p1(i + 1);
           isfind[k] := FALSE;
        END;
END;
BEGIN
    ASSIGN(fo, 'Nqueens.txt');
    REWRITE(fo);
    FILLCHAR(isfind, SIZEOF(isfind), FALSE);
    FILLCHAR(kk, SIZEOF(kk), 0);
    p1(1);
    WRITELN(fo, s);
    CLOSE(fo);
END.
(我这个程序,八个皇后还可以勉强挺过去,要是十个皇后就要超时了。)

6 楼

同志们 ,我要的不是深度的呀,那个虽然速度快也好理解,但写起来太麻烦了,我要的是代码短的

7 楼

DFS都麻烦了??不至于吧?? -_-!

8 楼

直接8重循环+判断……效果一样!

9 楼

n皇后问题位运算版 0.3s內
program nq (input,output);
  const
    inf='nq.in';
    outf='nq.out';
  var
    upperlim,sum,n:longint;
  procedure text(row,ld,rd:longint);
    var
      pos,p:longint;
    begin
      if row<>upperlim
        then begin
               pos:=upperlim and not(row or ld or rd);
               while pos<>0 do
                 begin
                   p:=pos and (-pos);
                   pos:=pos-p;
                   text(row+p,(ld+p)shl 1,(rd+p)shr 1);
                 end;
             end
        else
          inc(sum);
    end;
  begin
    assign(input,inf);
    reset(input);
    assign(output,outf);
    rewrite(output);
    readln(input,n);
    upperlim:=(1 shl n)-1;
    text(0,0,0);
    write(output,sum);
    close(input);
    close(output);
end.

我来回复

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