racket/collects/algol60/examples/nqueen.a60
2005-05-27 18:56:37 +00:00

125 lines
3.3 KiB
Plaintext

begin
comment
-- From the NASE A60 distribution --
Find a solution for the `N queen problem.
(got the algorithm from a Modula program from
Martin Neitzel).
;
integer N, MAXN;
MAXN := 9; comment maximum size;
N := 2; comment current size;
tryNextN:
begin
integer array column [1 : N];
Boolean array empcol [1 : N];
Boolean array empup [-N+1 : N-1];
Boolean array empdo [2 : 2*N];
integer i;
procedure print;
comment
print the current solution in a chessboard alike
picture ;
begin
integer i, j;
procedure outframe;
begin
integer i;
for i := 1 step 1 until N do
prints (`+---');
printsln (`+')
end;
for j := 1 step 1 until N do begin
outframe;
prints (`|');
for i := 1 step 1 until N do begin
if N + 1 - j = column [i] then
prints (` Q |')
else
prints (` |')
end;
printsln (`')
end;
outframe;
end;
procedure set (x);
value x;
integer x;
begin
integer y;
for y := 1 step 1 until N do
begin
if empcol [ y ] & empup [ x-y ]
& empdo [ x+y ] then
begin
column [ y ] := x ;
empcol [ y ] := false ;
empup [ x-y ] := false ;
empdo [ x+y ] := false ;
if x = N then
goto gotone
else
set ( x + 1 ) ;
empdo [ x+y ] := true ;
empup [ x-y ] := true ;
empcol [ y ] := true ;
column [ y ] := 0
end
end
end;
comment
main program start
;
prints (`looking onto a ');
printn (N);
prints (` x ');
printn (N);
printsln (` chessboard...');
for i := 1 step 1 until N do
begin
column [ i ] := 0 ;
empcol [ i ] := true
end;
for i := -N+1 step 1 until N-1 do
empup [ i ] := true ;
for i := 2 step 1 until 2*N do
empdo [ i ] := true ;
set ( 1 ) ;
printsln (`NO SOLUTION.');
goto contN;
gotone:
printsln(`SOLVED');
print;
contN:
if N < MAXN then begin
N := N + 1;
goto tryNextN
end;
printsln (`done.')
end
end