1 2(********************************************************************) 3(* *) 4(* queen.sd7 Solve the n queen problem *) 5(* Copyright (C) 2006 Thomas Mertes *) 6(* *) 7(* This program is free software; you can redistribute it and/or *) 8(* modify it under the terms of the GNU General Public License as *) 9(* published by the Free Software Foundation; either version 2 of *) 10(* the License, or (at your option) any later version. *) 11(* *) 12(* This program is distributed in the hope that it will be useful, *) 13(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) 14(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) 15(* GNU General Public License for more details. *) 16(* *) 17(* You should have received a copy of the GNU General Public *) 18(* License along with this program; if not, write to the *) 19(* Free Software Foundation, Inc., 51 Franklin Street, *) 20(* Fifth Floor, Boston, MA 02110-1301, USA. *) 21(* *) 22(********************************************************************) 23 24 25$ include "seed7_05.s7i"; 26 include "keybd.s7i"; 27 28 29const integer: MAXBOARDSIZE is 15; 30const type: chessBoard is array array integer; 31var chessBoard: board is 0 times 0 times 0; 32var integer: boardSize is 0; 33var integer: nSolution is 0; 34 35 36const proc: initialize (in integer: col) is func 37 local 38 var integer: i is 0; 39 var integer: j is 0; 40 begin 41 (*zero all rows and columns from column no. 'col'*) 42 for i range 1 to boardSize do 43 for j range col to boardSize do 44 board[i][j] := 0; 45 end for; 46 end for; 47 end func; 48 49 50const proc: display (inout chessBoard: board, in integer: size) is func 51 local 52 var integer: i is 0; 53 var integer: j is 0; 54 begin 55 (*increment no. of current solution*) 56 incr(nSolution); 57 58 (*display the board*) 59 (* clear; *) 60 writeln("Solution No: " <& nSolution <& "."); 61 for i range 1 to boardSize do (*all rows*) 62 for j range 1 to boardSize do (*all columns*) 63 if board[i][j] = 1 then 64 write("Q") 65 else 66 write(" "); 67 end if; 68 end for; 69 writeln; 70 end for; 71 writeln; 72 writeln("Press any key to continue or ESC to exit."); 73 if getc(KEYBOARD) = KEY_ESC then 74 exit(PROGRAM); (*if ESC then exit*) 75 end if; 76 writeln; 77 end func; 78 79 80const func boolean: canPlace (in integer: row, in integer: col) is func 81 result 82 var boolean: okay is TRUE; 83 local 84 var integer: i is 0; 85 var integer: j is 0; 86 begin 87 (*initialize the boolean variable*) 88 okay := TRUE; 89 90 (*any queen in the same row*) 91 for j range 1 to pred(col) do 92 if board[row][j] = 1 then 93 okay := FALSE; 94 end if; 95 end for; 96 97 (*diagonal up*) 98 i := row; 99 j := col; 100 while i > 1 and j > 1 and okay do 101 decr(i); (*previous row*) 102 decr(j); (*previous column*) 103 if board[i][j] = 1 then 104 okay := FALSE; 105 end if; 106 end while; 107 108 (*diagonal down*) 109 i := row; 110 j := col; 111 while i < boardSize and j > 1 and okay do 112 incr(i); (*next row*) 113 decr(j); (*previous column*) 114 if board[i][j] = 1 then 115 okay := FALSE; 116 end if; 117 end while; 118 end func; 119 120 121const proc: place (inout chessBoard: board, in var integer: row, in integer: col) is func 122 begin 123 if col > boardSize then (*done one solution*) 124 display(board, boardSize); 125 else 126 repeat (*repeat for all rows in a column*) 127 initialize(col); (*clear all columns after 'col'*) 128 if canPlace(row, col) then (*check for conflicts*) 129 board[row][col] := 1; (*place the queen*) 130 place(board, 1, succ(col)); (*go to next column*) 131 end if; 132 incr(row); (*after returning, proceed to next row*) 133 until row > boardSize; 134 end if; 135 end func; 136 137 138const proc: main is func 139 begin 140 (*Read the size of the board and call place*) 141 repeat 142 write("Enter board size (4.." <& MAXBOARDSIZE <& "): "); 143 readln(boardSize); 144 writeln; 145 until boardSize >= 4 and boardSize <= MAXBOARDSIZE; 146 board := boardSize times boardSize times 0; 147 place(board, 1, 1); 148 end func; 149