92

[url]http://upload.programfan.com/upfile/200711242244628.zip[/url]

深度优先搜索
program queen;{8皇后问题参考程序}
const n=8;
var a,b:array [1..n] of integer;{数组a存放解：a[i]表示第i个皇后放在第a[i]列；}
c:array [1-n,n-1] of integer;
d:array [2..n+n] ofinteger;
{数组b，c，d表示棋盘的当前情况：b[k]为1表示第k行已被占领为0表示为空；c、d表示对角线}k:integer;
procedure print;{打印结果}
var j:integer;
begin 
for j:=1 to n do 
write(a[j]:4);
writeln;
end;
procedrue try(i:integer); {递归搜索解}
varj:integer;{每个皇后的可放置位置。注意：一定要在过程中定义；否则当递归时会覆盖掉它的值，不能得到正确结果}
begin
for j:=1 to n do
begin
if (b[j]=0) and (c[i-j]=0) and (d[i+j]=0) then{检查位置是否合法}
begin
a[i]:=j;{置第i个皇后的位置是第j行}
b[j]:=1;{宣布占领行、对角线}
c[i-j]:=1;
d[i+j]:=1;
if i<n then try(i+1) else print;{如果末达目标则放置下一皇后，否则打印结果}
b[j]:=0;{清空被占行、对角线，回溯}
c[i-j]:=0;
d[i+j]:=0;
end;
end;
end;
begin
for k:=1 to n do b[k]:=0;{初始化数据}
for k:=1-n to n-1 do c[k]:=0;
for k:=2 to n+n do d[k]:=0;try(1);
end. 

{$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.