N-queens problem: Difference between revisions
m (moved N-Queens to N-queens problem) |
(Added a version for Heron) |
||
| Line 221: | Line 221: | ||
If you just want one solution, simply take the <code>head</code> of the result of <code>queens n</code>; since Haskell is lazy, it will only do as much work as needed to find one solution and stop. |
If you just want one solution, simply take the <code>head</code> of the result of <code>queens n</code>; since Haskell is lazy, it will only do as much work as needed to find one solution and stop. |
||
=={{header|Heron}}== |
|||
<lang heron>module NQueens |
|||
{ |
|||
inherits |
|||
{ |
|||
Heron.Windows.Console; |
|||
} |
|||
fields |
|||
{ |
|||
n : Int = 4; |
|||
sols : List = new List(); |
|||
} |
|||
methods |
|||
{ |
|||
PosToString(row : Int, col : Int) : String |
|||
{ |
|||
return "row " + row.ToString() + ", col " + col.ToString(); |
|||
} |
|||
AddQueen(b : Board, row : Int, col : Int) |
|||
{ |
|||
//b.Output(); |
|||
//WriteLine(); |
|||
//ReadKey(); |
|||
if (!b.TryAddQueen(row, col)) |
|||
return; |
|||
if (row < n - 1) |
|||
foreach (i in 0..n-1) |
|||
AddQueen(new Board(b), row + 1, i); |
|||
else |
|||
sols.Add(b); |
|||
} |
|||
Main() |
|||
{ |
|||
foreach (i in 0..n-1) |
|||
AddQueen(new Board(), 0, i); |
|||
foreach (b in sols) |
|||
{ |
|||
b.Output(); |
|||
WriteLine(""); |
|||
} |
|||
WriteLine("Found " + sols.Count().ToString() + " solutions"); |
|||
} |
|||
} |
|||
} |
|||
class Board |
|||
{ |
|||
fields |
|||
{ |
|||
rows = new List(); |
|||
} |
|||
methods |
|||
{ |
|||
Constructor() |
|||
{ |
|||
foreach (r in 0..n-1) |
|||
{ |
|||
var col = new List(); |
|||
foreach (c in 0..n-1) |
|||
col.Add(false); |
|||
rows.Add(col); |
|||
} |
|||
} |
|||
Constructor(b : Board) |
|||
{ |
|||
Constructor(); |
|||
foreach (r in 0..n-1) |
|||
foreach (c in 0..n-1) |
|||
SetSpaceOccupied(r, c, b.SpaceOccupied(r, c)); |
|||
} |
|||
SpaceOccupied(row : Int, col : Int) : Bool |
|||
{ |
|||
return rows[row][col]; |
|||
} |
|||
SetSpaceOccupied(row : Int, col : Int, b : Bool) |
|||
{ |
|||
rows[row][col] = b; |
|||
} |
|||
ValidPos(row : Int, col : Int) : Bool |
|||
{ |
|||
return ((row >= 0) && (row < n)) && ((col >= 0) && (col < n)); |
|||
} |
|||
VectorOccupied(row : Int, col : Int, rowDir : Int, colDir : Int) : Bool |
|||
{ |
|||
var nextRow = row + rowDir; |
|||
var nextCol = col + colDir; |
|||
if (!ValidPos(nextRow, nextCol)) |
|||
return false; |
|||
if (SpaceOccupied(nextRow, nextCol)) |
|||
return true; |
|||
return VectorOccupied(nextRow, nextCol, rowDir, colDir); |
|||
} |
|||
TryAddQueen(row : Int, col : Int) : Bool |
|||
{ |
|||
foreach (rowDir in -1..1) |
|||
foreach (colDir in -1..1) |
|||
if (rowDir != 0 || colDir != 0) |
|||
if (VectorOccupied(row, col, rowDir, colDir)) |
|||
return false; |
|||
SetSpaceOccupied(row, col, true); |
|||
return true; |
|||
} |
|||
Output() |
|||
{ |
|||
foreach (row in 0..n-1) |
|||
{ |
|||
foreach (col in 0..n-1) |
|||
{ |
|||
if (SpaceOccupied(row, col)) |
|||
{ |
|||
Write("Q"); |
|||
} |
|||
else |
|||
{ |
|||
Write("."); |
|||
} |
|||
} |
|||
WriteLine(""); |
|||
} |
|||
} |
|||
} |
|||
} |
|||
</lang> |
|||
=={{header|J}}== |
=={{header|J}}== |
||
Revision as of 04:24, 5 March 2010
Solve the eight queens puzzle. You can extend the problem to solve the puzzle with a board of side NxN.
Ada
<lang Ada>with Ada.Text_IO; use Ada.Text_IO;
procedure Queens is
Board : array (1..8, 1..8) of Boolean := (others => (others => False));
function Test (Row, Column : Integer) return Boolean is
begin
for J in 1..Column - 1 loop
if ( Board (Row, J)
or else
(Row > J and then Board (Row - J, Column - J))
or else
(Row + J <= 8 and then Board (Row + J, Column - J))
) then
return False;
end if;
end loop;
return True;
end Test;
function Fill (Column : Integer) return Boolean is
begin
for Row in Board'Range (1) loop
if Test (Row, Column) then
Board (Row, Column) := True;
if Column = 8 or else Fill (Column + 1) then
return True;
end if;
Board (Row, Column) := False;
end if;
end loop;
return False;
end Fill;
begin
if not Fill (1) then
raise Program_Error;
end if;
for I in Board'Range (1) loop
Put (Integer'Image (9 - I));
for J in Board'Range (2) loop
if Board (I, J) then
Put ("|Q");
elsif (I + J) mod 2 = 1 then
Put ("|/");
else
Put ("| ");
end if;
end loop;
Put_Line ("|");
end loop;
Put_Line (" A B C D E F G H");
end Queens;</lang> Sample output:
8|Q|/| |/| |/| |/| 7|/| |/| |/| |Q| | 6| |/| |/|Q|/| |/| 5|/| |/| |/| |/|Q| 4| |Q| |/| |/| |/| 3|/| |/|Q|/| |/| | 2| |/| |/| |Q| |/| 1|/| |Q| |/| |/| | A B C D E F G H
ALGOL 68
<lang Algol68>INT ofs = 1, # Algol68 normally uses array offset of 1 #
dim = 8; # dim X dim chess board #
[ofs:dim+ofs-1]INT b;
PROC unsafe = (INT y)BOOL:(
INT i, t, x; x := b[y]; FOR i TO y - LWB b DO t := b[y - i]; IF t = x THEN break true ELIF t = x - i THEN break true ELIF t = x + i THEN break true FI OD; FALSE EXIT
break true:
TRUE
);
INT s := 0;
PROC print board = VOID:(
INT x, y;
print((new line, "Solution # ", s+:=1, new line));
FOR y FROM LWB b TO UPB b DO
FOR x FROM LWB b TO UPB b DO
print("|"+(b[y]=x|"Q"|: ODD(x+y)|"/"|" "))
OD;
print(("|", new line))
OD
);
main: (
INT y := LWB b;
b[LWB b] := LWB b - 1;
FOR i WHILE y >= LWB b DO
WHILE
b[y]+:=1;
# BREAK # IF b[y] <= UPB b THEN unsafe(y) ELSE FALSE FI
DO SKIP OD;
IF b[y] <= UPB b THEN
IF y < UPB b THEN
b[y+:=1] := LWB b - 1
ELSE
print board
FI
ELSE
y-:=1
FI
OD
)</lang>
C
There is a solution on wikipedia.
Clojure
This produces all solutions by essentially a backtracking algorithm. The heart is the extends? function, which takes a partial solution for the first k<size columns and sees if the solution can be extended by adding a queen at row n of column k+1. The extend function takes a list of all partial solutions for k columns and produces a list of all partial solutions for k+1 columns. The final list solutions is calculated by starting with the list of 0-column solutions (obviously this is the list [ [] ], and iterates extend for size times. <lang lisp>(def size 8)
(defn extends? [v n]
(let [k (count v)]
(not-any? true?
(for [i (range k) :let [vi (v i)]]
(or
(= vi n) ;check for shared row
(= (- k i) (Math/abs (- n vi)))))))) ;check for shared diagonal
(defn extend [vs]
(for [v vs
n (range 1 (inc size)) :when (extends? v n)]
(conj v n)))
(def solutions
(nth (iterate extend [[]]) size))
(doseq [s solutions]
(println s))
(println (count solutions) "solutions")</lang>
Forth
<lang forth>variable solutions variable nodes
- bits ( n -- mask ) 1 swap lshift 1- ;
- lowBit ( mask -- bit ) dup negate and ;
- lowBit- ( mask -- bits ) dup 1- and ;
- next3 ( dl dr f files -- dl dr f dl' dr' f' )
invert >r 2 pick r@ and 2* 1+ 2 pick r@ and 2/ 2 pick r> and ;
- try ( dl dr f -- )
dup if
1 nodes +!
dup 2over and and
begin ?dup while
dup >r lowBit next3 recurse r> lowBit-
repeat
else 1 solutions +! then
drop 2drop ;
- queens ( n -- )
0 solutions ! 0 nodes ! -1 -1 rot bits try solutions @ . ." solutions, " nodes @ . ." nodes" ;
8 queens \ 92 solutions, 1965 nodes</lang>
Haskell
<lang haskell>import Control.Monad
-- given n, "queens n" solves the n-queens problem, returning a list of all the -- safe arrangements. each solution is a list of the columns where the queens are -- located for each row queens :: Int -> Int queens n = foldM oneMoreQueen [] [1..n] -- foldM folds in the list monad, which is convenient for "nondeterminstically" -- finding "all possible solutions" of something. the initial value [] corresponds -- to the only safe arrangement of queens in 0 rows
where -- given a safe arrangement y of queens in the first i rows,
-- "add_queen y _" returns a list of all the safe arrangements of queens
-- in the first (i+1) rows
oneMoreQueen y _ = [ x : y | x <- [1..n], safe x y 1]
-- "safe x y n" tests whether a queen at column x would be safe from previous -- queens in y where the first element of y is n rows away from x, the second -- element is (n+1) rows away from x, etc. safe x [] n = True safe x (c:y) n = and [ x /= c , x /= c + n , x /= c - n , safe x y (n+1)] -- we only need to check for queens in the same column, and the same diagonals; -- queens in the same row are not possible by the fact that we only pick one -- queen per row
-- prints what the board looks like for a solution; with an extra newline printSolution y = do mapM_ (\x -> putStrLn [if z == x then 'Q' else '.' | z <- [1..n]]) y
putStrLn "" where n = length y
-- prints all the solutions for 6 queens main = mapM_ printSolution $ queens 6</lang>
If you just want one solution, simply take the head of the result of queens n; since Haskell is lazy, it will only do as much work as needed to find one solution and stop.
Heron
<lang heron>module NQueens {
inherits
{
Heron.Windows.Console;
}
fields
{
n : Int = 4;
sols : List = new List();
}
methods
{
PosToString(row : Int, col : Int) : String
{
return "row " + row.ToString() + ", col " + col.ToString();
}
AddQueen(b : Board, row : Int, col : Int)
{
//b.Output();
//WriteLine();
//ReadKey();
if (!b.TryAddQueen(row, col))
return;
if (row < n - 1)
foreach (i in 0..n-1)
AddQueen(new Board(b), row + 1, i);
else
sols.Add(b);
}
Main()
{
foreach (i in 0..n-1)
AddQueen(new Board(), 0, i);
foreach (b in sols)
{
b.Output();
WriteLine("");
}
WriteLine("Found " + sols.Count().ToString() + " solutions");
}
}
}
class Board {
fields
{
rows = new List();
}
methods
{
Constructor()
{
foreach (r in 0..n-1)
{
var col = new List();
foreach (c in 0..n-1)
col.Add(false);
rows.Add(col);
}
}
Constructor(b : Board)
{
Constructor();
foreach (r in 0..n-1)
foreach (c in 0..n-1)
SetSpaceOccupied(r, c, b.SpaceOccupied(r, c));
}
SpaceOccupied(row : Int, col : Int) : Bool
{
return rows[row][col];
}
SetSpaceOccupied(row : Int, col : Int, b : Bool)
{
rows[row][col] = b;
}
ValidPos(row : Int, col : Int) : Bool
{
return ((row >= 0) && (row < n)) && ((col >= 0) && (col < n));
}
VectorOccupied(row : Int, col : Int, rowDir : Int, colDir : Int) : Bool
{
var nextRow = row + rowDir;
var nextCol = col + colDir;
if (!ValidPos(nextRow, nextCol))
return false;
if (SpaceOccupied(nextRow, nextCol))
return true;
return VectorOccupied(nextRow, nextCol, rowDir, colDir);
}
TryAddQueen(row : Int, col : Int) : Bool
{
foreach (rowDir in -1..1)
foreach (colDir in -1..1)
if (rowDir != 0 || colDir != 0)
if (VectorOccupied(row, col, rowDir, colDir))
return false;
SetSpaceOccupied(row, col, true);
return true;
}
Output()
{
foreach (row in 0..n-1)
{
foreach (col in 0..n-1)
{
if (SpaceOccupied(row, col))
{
Write("Q");
}
else
{
Write(".");
}
}
WriteLine("");
}
}
}
} </lang>
J
This is one of several J solutions shown and explained on this J wiki page
<lang j>perm =: ! A.&i. ] NB. all permutations of integers 0 to y comb2 =: (, #: I.@,@(</)&i.)~ NB. all size 2 combinations of integers 0 to y mask =: [ */@:~:&(|@-/) { queenst=: comb2 (] #"1~ mask)&.|: perm</lang>
Java
<lang java>public class NQueens {
private static int[] b = new int[8]; private static int s = 0;
static boolean unsafe(int y) {
int x = b[y];
for (int i = 1; i <= y; i++) {
int t = b[y - i];
if (t == x ||
t == x - i ||
t == x + i) {
return true;
}
}
return false; }
public static void putboard() {
System.out.println("\n\nSolution " + (++s));
for (int y = 0; y < 8; y++) {
for (int x = 0; x < 8; x++) {
System.out.print((b[y] == x) ? "|Q" : "|_");
}
System.out.println("|");
}
}
public static void main(String[] args) {
int y = 0;
b[0] = -1;
while (y >= 0) {
do {
b[y]++;
} while ((b[y] < 8) && unsafe(y));
if (b[y] < 8) {
if (y < 7) {
b[++y] = -1;
} else {
putboard();
}
} else {
y--;
}
}
}
}</lang>
Logo
<lang logo>to try :files :diag1 :diag2 :tried
if :files = 0 [make "solutions :solutions+1 show :tried stop] localmake "safe (bitand :files :diag1 :diag2) until [:safe = 0] [ localmake "f bitnot bitand :safe minus :safe try bitand :files :f ashift bitand :diag1 :f -1 (ashift bitand :diag2 :f 1)+1 fput bitnot :f :tried localmake "safe bitand :safe :safe-1 ]
end
to queens :n
make "solutions 0 try (lshift 1 :n)-1 -1 -1 [] output :solutions
end
print queens 8 ; 92</lang>
Mathematica
This code recurses through the possibilities, using the "safe" method to check if the current set is allowed. The recursive method has the advantage that finding all possibilities is about as hard (code-wise, not computation-wise) as finding just one. <lang Mathematica>safe[q_List, n_] :=
With[{l = Length@q},
Length@Union@q == Length@Union[q + Range@l] ==
Length@Union[q - Range@l] == l]
nQueen[q_List:{}, n_] :=
If[safe[q, n],
If[Length[q] == n, q,
Cases[Flatten[{nQueen[Append[q, #], n]}, 2] & /@ Range[n],
Except[{Null} | {}]]], Null]</lang>
This returns a list of valid permutations by giving the queen's column number for each row. It can be displayed in a list of chess-board tables like this: <lang Mathematica>matrixView[n_] :=
Grid[Normal@
SparseArray[MapIndexed[{#, First@#2} -> "Q" &, #], {n, n}, "."],
Frame -> All] & /@ nQueen[n]
matrixView[6] // OutputForm</lang>
{. . . Q . ., . . . . Q ., . Q . . . ., . . Q . . .}
Q . . . . . . . Q . . . . . . Q . . . . . . . Q
. . . . Q . Q . . . . . . . . . . Q . Q . . . .
. Q . . . . . . . . . Q Q . . . . . . . . . Q .
. . . . . Q . . . Q . . . . Q . . . Q . . . . .
. . Q . . . . Q . . . . . . . . Q . . . . Q . .
OCaml
<lang ocaml>(* Authors: Nicolas Barnier, Pascal Brisset
Copyright 2004 CENA. All rights reserved. This code is distributed under the terms of the GNU LGPL *)
open Facile open Easy
(* Print a solution *) let print queens =
let n = Array.length queens in
if n <= 10 then (* Pretty printing *)
for i = 0 to n - 1 do
let c = Fd.int_value queens.(i) in (* queens.(i) is bound *)
for j = 0 to n - 1 do
Printf.printf "%c " (if j = c then '*' else '-')
done;
print_newline ()
done
else (* Short print *)
for i = 0 to n-1 do
Printf.printf "line %d : col %a\n" i Fd.fprint queens.(i)
done;
flush stdout;
(* Solve the n-queens problem *) let queens n =
(* n decision variables in 0..n-1 *) let queens = Fd.array n 0 (n-1) in
(* 2n auxiliary variables for diagonals *) let shift op = Array.mapi (fun i qi -> Arith.e2fd (op (fd2e qi) (i2e i))) queens in let diag1 = shift (+~) and diag2 = shift (-~) in
(* Global constraints *) Cstr.post (Alldiff.cstr queens); Cstr.post (Alldiff.cstr diag1); Cstr.post (Alldiff.cstr diag2);
(* Heuristic Min Size, Min Value *) let h a = (Var.Attr.size a, Var.Attr.min a) in let min_min = Goals.Array.choose_index (fun a1 a2 -> h a1 < h a2) in
(* Search goal *) let labeling = Goals.Array.forall ~select:min_min Goals.indomain in
(* Solve *) let bt = ref 0 in if Goals.solve ~control:(fun b -> bt := b) (labeling queens) then begin Printf.printf "%d backtracks\n" !bt; print queens end else prerr_endline "No solution"
let _ =
if Array.length Sys.argv <> 2
then raise (Failure "Usage: queens <nb of queens>");
Gc.set ({(Gc.get ()) with Gc.space_overhead = 500}); (* May help except with an underRAMed system *)
queens (int_of_string Sys.argv.(1));;</lang>
Oz
A pretty naive solutions, using constraint programming: <lang oz>declare
fun {Queens N}
proc {$ Board}
%% a board is a N-tuple of rows
Board = {MakeTuple queens N}
for Y in 1..N do
%% a row is a N-tuple of values in [0,1]
%% (0: no queen, 1: queen)
Board.Y = {FD.tuple row N 0#1}
end
{ForAll {Rows Board} SumIs1}
{ForAll {Columns Board} SumIs1}
%% for every two points on a diagonal
for [X1#Y1 X2#Y2] in {DiagonalPairs N} do
%$ at most one of them has a queen
Board.Y1.X1 + Board.Y2.X2 =<: 1
end
%% enumerate all such boards
{FD.distribute naive {FlatBoard Board}}
end
end
fun {Rows Board}
{Record.toList Board}
end
fun {Columns Board}
for X in {Arity Board.1} collect:C1 do
{C1
for Y in {Arity Board} collect:C2 do
{C2 Board.Y.X}
end}
end
end
proc {SumIs1 Xs}
{FD.sum Xs '=:' 1}
end
fun {DiagonalPairs N}
proc {Coords Root}
[X1#Y1 X2#Y2] = Root
Diff
in
X1::1#N Y1::1#N
X2::1#N Y2::1#N
%% (X1,Y1) and (X2,Y2) are on a diagonal if {Abs X2-X1} = {Abs Y2-Y1}
Diff::1#N-1
{FD.distance X2 X1 '=:' Diff}
{FD.distance Y2 Y1 '=:' Diff}
%% enumerate all such coordinates
{FD.distribute naive [X1 Y1 X2 Y2]}
end
in
{SearchAll Coords}
end
fun {FlatBoard Board}
{Flatten {Record.toList {Record.map Board Record.toList}}}
end
Solutions = {SearchAll {Queens 8}}
in
{Length Solutions} = 92 %% assert
{Inspect {List.take Solutions 3}}</lang>
There is a more concise and much more efficient solution in the Mozart documentation.
Python
This solution, originally by [Raymond Hettinger] for demonstrating the power of the itertools module, generates all solutions.
<lang python>from itertools import permutations
n = 8 cols = range(n) for vec in permutations(cols):
if n == len(set(vec[i]+i for i in cols)) \
== len(set(vec[i]-i for i in cols)):
print ( vec )</lang>
The output is presented in vector form (each number represents the column position of a queen on consecutive rows). The vector can be pretty printed by substituting a call to board instead of print, with the same argument, and where board is pre-defined as:
<lang python>def board(vec):
print ("\n".join('.' * i + 'Q' + '.' * (n-i-1) for i in vec) + "\n===\n")</lang>
Raymond's description is:
- With the solution represented as a vector with one queen in each row, we don't have to check to see if two queens are on the same row. By using a permutation generator, we know that no value in the vector is repeated, so we don't have to check to see if two queens are on the same column. Since rook moves don't need to be checked, we only need to check bishop moves.
- The technique for checking the diagonals is to add or subtract the column number from each entry, so any two entries on the same diagonal will have the same value (in other words, the sum or difference is unique for each diagonal). Now all we have to do is make sure that the diagonals for each of the eight queens are distinct. So, we put them in a set (which eliminates duplicates) and check that the set length is eight (no duplicates were removed).
- Any permutation with non-overlapping diagonals is a solution. So, we print it and continue checking other permutations.
One disadvantage with this solution is that we can't simply "skip" all the permutations that start with a certain prefix, after discovering that that prefix is incompatible. For example, it is easy to verify that no permutation of the form (1,2,...) could ever be a solution, but since we don't have control over the generation of the permutations, we can't just tell it to "skip" all the ones that start with (1,2).
Alternative Solution
<lang python># From: http://wiki.python.org/moin/SimplePrograms, with permission from the author, Steve Howell BOARD_SIZE = 8
def under_attack(col, queens):
return col in queens or \
any(abs(col - x) == len(queens)-i for i,x in enumerate(queens))
def solve(n):
solutions = [[]]
for row in range(n):
solutions = [solution+[i+1]
for i in range(BOARD_SIZE)
for solution in solutions
if not under_attack(i+1, solution)]
return solutions
for answer in solve(BOARD_SIZE): print(list(enumerate(answer, start=1)))</lang>
Ruby
This implements the heuristics found on the wikipedia page to return just one solution <lang ruby># 1. Divide n by 12. Remember the remainder (n is 8 for the eight queens
- puzzle).
- 2. Write a list of the even numbers from 2 to n in order.
- 3. If the remainder is 3 or 9, move 2 to the end of the list.
- 4. Append the odd numbers from 1 to n in order, but, if the remainder is 8,
- switch pairs (i.e. 3, 1, 7, 5, 11, 9, …).
- 5. If the remainder is 2, switch the places of 1 and 3, then move 5 to the
- end of the list.
- 6. If the remainder is 3 or 9, move 1 and 3 to the end of the list.
- 7. Place the first-column queen in the row with the first number in the
- list, place the second-column queen in the row with the second number in
- the list, etc.
def n_queens(n)
if n == 1
return "Q"
elsif n < 4
puts "no solutions for n=#{n}"
return ""
end
evens = (2..n).step(2).to_a odds = (1..n).step(2).to_a
rem = n % 12 # (1) nums = evens # (2)
nums.push(nums.shift) if rem == 3 or rem == 9 # (3)
# (4)
if rem == 8
odds = odds.each_slice(2).inject([]) {|ary, (a,b)| ary += [b,a]}
end
nums.concat(odds)
# (5)
if rem == 2
idx = []
[1,3,5].each {|i| idx[i] = nums.index(i)}
nums[idx[1]], nums[idx[3]] = nums[idx[3]], nums[idx[1]]
nums.slice!(idx[5])
nums.push(5)
end
# (6)
if rem == 3 or rem == 9
[1,3].each do |i|
nums.slice!( nums.index(i) )
nums.push(i)
end
end
# (7)
board = Array.new(n) {Array.new(n) {"."}}
n.times {|i| board[i][nums[i] - 1] = "Q"}
board.inject("") {|str, row| str << row.join(" ") << "\n"}
end
(1 .. 15).each {|n| puts "n=#{n}"; puts n_queens(n); puts}</lang>
Output:
n=1 Q n=2 no solutions for n=2 n=3 no solutions for n=3 n=4 . Q . . . . . Q Q . . . . . Q . n=5 . Q . . . . . . Q . Q . . . . . . Q . . . . . . Q n=6 . Q . . . . . . . Q . . . . . . . Q Q . . . . . . . Q . . . . . . . Q . n=7 . Q . . . . . . . . Q . . . . . . . . Q . Q . . . . . . . . Q . . . . . . . . Q . . . . . . . . Q n=8 . Q . . . . . . . . . Q . . . . . . . . . Q . . . . . . . . . Q . . Q . . . . . Q . . . . . . . . . . . . . Q . . . . . Q . . . n=9 . . . Q . . . . . . . . . . Q . . . . . . . . . . Q . . Q . . . . . . . . . . . Q . . . . . . . . . . Q . . . . . . . . . . Q Q . . . . . . . . . . Q . . . . . . n=10 . Q . . . . . . . . . . . Q . . . . . . . . . . . Q . . . . . . . . . . . Q . . . . . . . . . . . Q Q . . . . . . . . . . . Q . . . . . . . . . . . Q . . . . . . . . . . . Q . . . . . . . . . . . Q . n=11 . Q . . . . . . . . . . . . Q . . . . . . . . . . . . Q . . . . . . . . . . . . Q . . . . . . . . . . . . Q . Q . . . . . . . . . . . . Q . . . . . . . . . . . . Q . . . . . . . . . . . . Q . . . . . . . . . . . . Q . . . . . . . . . . . . Q n=12 . Q . . . . . . . . . . . . . Q . . . . . . . . . . . . . Q . . . . . . . . . . . . . Q . . . . . . . . . . . . . Q . . . . . . . . . . . . . Q Q . . . . . . . . . . . . . Q . . . . . . . . . . . . . Q . . . . . . . . . . . . . Q . . . . . . . . . . . . . Q . . . . . . . . . . . . . Q . n=13 . Q . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . Q . Q . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . Q n=14 . Q . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . Q . . Q . . . . . . . . . . . Q . . . . . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . Q . . . . . Q . . . . . . . . . n=15 . . . Q . . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . . Q . . Q . . . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . . Q . . . . . . . . . . . . . . . . Q Q . . . . . . . . . . . . . . . . Q . . . . . . . . . . . .
Scala
The algorithm below is lazy. It returns an iterator, and each solution is computed as you ask for the next element of the iterator. If you ask for one element, it will only compute one solution.
The test for legal moves is a bit redundant, as the algorithm can never generate two positions in the same row.
<lang scala>case class Pos(row: Int, column: Int) {
def sameRow(p: Pos) = row == p.row def sameColumn(p: Pos) = column == p.column def sameDiag(p: Pos) = (p.column - column).abs == (p.row - row).abs def illegal(p: Pos) = sameRow(p) || sameColumn(p) || sameDiag(p) def legal(p: Pos) = !illegal(p)
}
def rowSet(size: Int, row: Int) = Iterator.tabulate(size)(column => Pos(row, column))
def expand(solutions: Iterator[List[Pos]], size: Int, row: Int) =
for {
solution <- solutions
pos <- rowSet(size, row)
if solution forall (_ legal pos)
} yield pos :: solution
def seed(size: Int) = rowSet(size, 0) map (sol => List(sol))
def solve(size: Int) = (1 until size).foldLeft(seed(size)) (expand(_, size, _))</lang>
Tcl
This solution is based on the C version on wikipedia. By default it solves the 8-queen case; to solve for any other number, pass N as an extra argument on the script's command line (see the example for the N=6 case, which has anomalously few solutions).
<lang tcl>package require Tcl 8.5
proc unsafe {y} {
global b
set x [lindex $b $y]
for {set i 1} {$i <= $y} {incr i} {
set t [lindex $b [expr {$y - $i}]] if {$t==$x || $t==$x-$i || $t==$x+$i} { return 1 }
} return 0
}
proc putboard {} {
global b s N
puts "\n\nSolution #[incr s]"
for {set y 0} {$y < $N} {incr y} {
for {set x 0} {$x < $N} {incr x} { puts -nonewline [expr {[lindex $b $y] == $x ? "|Q" : "|_"}] } puts "|"
}
}
proc main {n} {
global b N
set N $n
set b [lrepeat $N 0]
set y 0
lset b 0 -1
while {$y >= 0} {
lset b $y [expr {[lindex $b $y] + 1}] while {[lindex $b $y] < $N && [unsafe $y]} { lset b $y [expr {[lindex $b $y] + 1}] } if {[lindex $b $y] >= $N} { incr y -1 } elseif {$y < $N-1} { lset b [incr y] -1; } else { putboard }
}
}
main [expr {$argc ? int(0+[lindex $argv 0]) : 8}]</lang> Sample output:
$ tclsh8.5 8queens.tcl 6 Solution #1 |_|Q|_|_|_|_| |_|_|_|Q|_|_| |_|_|_|_|_|Q| |Q|_|_|_|_|_| |_|_|Q|_|_|_| |_|_|_|_|Q|_| Solution #2 |_|_|Q|_|_|_| |_|_|_|_|_|Q| |_|Q|_|_|_|_| |_|_|_|_|Q|_| |Q|_|_|_|_|_| |_|_|_|Q|_|_| Solution #3 |_|_|_|Q|_|_| |Q|_|_|_|_|_| |_|_|_|_|Q|_| |_|Q|_|_|_|_| |_|_|_|_|_|Q| |_|_|Q|_|_|_| Solution #4 |_|_|_|_|Q|_| |_|_|Q|_|_|_| |Q|_|_|_|_|_| |_|_|_|_|_|Q| |_|_|_|Q|_|_| |_|Q|_|_|_|_|
Ursala
This is invoked as a command line application by queens -n, where n is a number greater than 3. Multiple solutions may be reported but reflections and rotations thereof are omitted. <lang Ursala>#import std
- import nat
remove_reflections = ^D(length@ht,~&); ~&K2hlPS+ * ^lrNCCs/~&r difference*D remove_rotations = ~&K2hlrS2S+ * num; ~&srlXSsPNCCs
- executable <'par',>
- optimize+
queens =
%np+~command.options.&h.keyword.&iNC; -+
~&iNC+ file$[contents: --<>+ mat` *+ %nP*=*],
remove_rotations+ remove_reflections+ ~&rSSs+ nleq-<&l*rFlhthPXPSPS,
~&i&& ~&lNrNCXX; ~&rr->rl ^/~&l ~&lrrhrSiF4E?/~&rrlPlCrtPX @r ^|/~& ^|T\~& -+
-<&l^|*DlrTS/~& ~&iiDlSzyCK9hlPNNXXtCS,
^jrX/~& @rZK20lrpblPOlrEkPK13lhPK2 ~&i&& nleq$-&lh+-,
^/~&NNXS+iota -<&l+ ~&plll2llr2lrPrNCCCCNXS*=irSxPSp+ ^H/block iota; *iiK0 ^/~& sum+-</lang>
The output shows one solution on each line. A solution is reported as a sequence of numbers with the -th number being the index of the occupied row in the -th column.
$ queens -4 2 3 0 1 $ queens -5 0 2 1 3 4 2 4 3 0 1 1 3 2 4 0 $ queens 6 4 3 0 2 1 5