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