begin comment 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; TRY NEXT N: 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 OUTSTRING (1, `+---'); OUTSTRING (1, `+\N') end; OUTSTRING (1, `SEE:\N') ; for J := 1 step 1 until N do begin OUTFRAME; OUTSTRING (1, `|'); for I := 1 step 1 until N do begin if N + 1 - J = COLUMN [I] then OUTSTRING (1, ` Q |') else OUTSTRING (1, ` |') end; OUTSTRING (1, `\N') 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 ] and EMPUP [ X-Y ] and 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 ; OUTSTRING (1, `LOOKING ONTO A '); OUTINTEGER (1, N); OUTSTRING (1, ` X '); OUTINTEGER (1, N); OUTSTRING (1, ` CHESSBOARD...\N'); 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 ) ; OUTSTRING (1, `NO SOLUTION.\N'); goto CONTN; GOTONE: PRINT; CONTN: if N < MAXN then begin N := N + 1; goto TRY NEXT N end; OUTSTRING (1, `DONE.\N') end end