(**********************************************************************)
(*
** ARIBAS code for the n queens problem
** author: Otto Forster <forster@mathematik.uni-muenchen.de>
** date: 99-04-30
**
** Example calls:
** ==> queens(9).
** ==> queensrand(20).
*)
(*--------------------------------------------------------------------*)
(*
** n-Damenproblem: n Damen sind auf einem n-mal-n-Schachbrett so
** zu plazieren, dass sie sich nicht gegenseitig bedrohen.
** Aufruf: queens(n).
** Dabei ist n die Groesse des Brettes
** (z.B. n = 8; fuer n > 10 dauert die vollstaendige Loesung sehr lange)
** Die Loesungen werden als Vektoren (a1,a2,...,an) ausgegeben.
** Dieser Vektor bezeichnet die Stellung, in der in der i-ten Zeile
** eine Dame auf der ai-ten Spalte steht
*)
(*--------------------------------------------------------------------*)
var
	NbSol: integer;
end;

function queens(n: integer): integer;
external
	NbSol: integer;
var
	i: integer;
        brett, rest: array[n];
begin
	NbSol := 0;
        for i := 0 to n-1 do
                rest[i] := i+1;
        end;
        queenshilf(brett,0,rest,n);
        writeln("number of solutions:");
        return NbSol;
end.
(*--------------------------------------------------------------------*)
function queenshilf(brett: array; n: integer; rest: array; m: integer)
external
	NbSol: integer;
var
        i, j, x: integer;
begin
        if m = 0 then
                inc(NbSol);
                writeln(NbSol:4,": ",brett);
        else
            for i := 0 to m-1 do
                x := rest[i];
                if freediag(x,brett,n) then
                        brett[n] := x;
                        for j := i+1 to m-1 do
                                rest[j-1] := rest[j];
                        end;
                        queenshilf(brett,n+1,rest,m-1);
                        for j := m-1 to i+1 by -1 do
                                rest[j] := rest[j-1];
                        end;
                        rest[i] := x;
                end;
            end;
        end;
end.
(*------------------------------------------------------------------*)
function freediag(x: integer; brett: array; n: integer): boolean;
var
        i: integer;
begin
        for i := 0 to n-1 do
                if abs(x - brett[i]) = n-i then
                        return false;
                end;
        end;
        return true;
end.
(*------------------------------------------------------------------*)
(*
** randomized version of queens
** example call: queensrand(17).
*)
function queensrand(n);
var
	i: integer;
        brett, rest: array[n];
begin
	rest := random_perm(n);
	writeln(n," queens problem;  ... thinking ...");
        queenshilf1(brett,0,rest,n);
        return;
end;
(*------------------------------------------------------------------*)
function random_perm(n: integer): array;
var
    perm: array[n];
    i, x, temp: integer;
begin
    for i := 0 to n-1 do
	perm[i] := i+1;
    end;
    for i := 0 to n-1 do
	x := random(n-i);
	temp := perm[i+x];
	perm[i+x] := perm[i];
	perm[i] := temp;
    end;
    return perm;
end;
(*------------------------------------------------------------------*)
function queenshilf1(brett: array; n: integer; 
		     rest: array; m: integer): integer;
var
        i, j, x, res: integer;
begin
        if m = 0 then
		display_board(brett);
		return 1;
        else
            for i := 0 to m-1 do
                x := rest[i];
                if freediag(x,brett,n) then
                        brett[n] := x;
                        for j := i+1 to m-1 do
                                rest[j-1] := rest[j];
                        end;
                        res := queenshilf1(brett,n+1,rest,m-1);
                        if res > 0 then return 1; end;
                        for j := m-1 to i+1 by -1 do
                                rest[j] := rest[j-1];
                        end;
                        rest[i] := x;
                end;
            end;
        end;
	return 0;
end.
(*------------------------------------------------------------------*)
function display_board(brett: array);
var
	i, n: integer;
begin
	n := length(brett);
	for i := 0 to n-1 do
		display_row(brett[i],n);
	end;
end;
(*------------------------------------------------------------------*)
function display_row(k,n)
var
	i: integer;
begin
	write("    ");
	for i := 1 to k-1 do
		write(" .");
	end;
	write(" D");
	for i := k+1 to n do
		write(" .");
	end;
	writeln();
end;
(*------------------------------------------------------------------*)




