Solving The Eight Queens Problem in ML
The eight queens problem is a classic constraint satisfaction problem. The problem is to place eight queens on a chess board so that no queen is attacking another; each queen must not share a row, column or diagonal with any other queen. An example solution is below.
We can represent the board as a list of integers, where element i is n if and only if there is a queen at (i,n). A full solution therefore consists of a list of length 8.
New queens are added by adding a new integer to the head of the list. To see if this new board is still valid (the new queen doesn't attack any of the others), we need to check for potential row and diagonal clashes (but not column clashes - that is enforced by the list representation). Note that the new queen, in row m is in the same diagonal as queen in position (i,n) if and only if |m - n| = i.
Defining the standard list iteration functions:
fun foldl f a (x::xs) = foldl f (f a x) xs
|foldl f a [] = a
fun filter f (x::xs) = if f x then x :: filter f xs else filter f xs
|filter f [] = []
fun map f (x::xs) = (f x) :: map f xs
|map f [] = []
fun length (x::xs) = 1 + length xs
|length [] = 0
fun iter f (x::xs) = (f x; iter f xs)
|iter f [] = ()
The function canPlaceQueen is implemented by iterating down the board, keeping track of row numbers using an accumulator to check for potential attacks on the diagonals:
exception CannotPlaceQueen
fun canPlaceQueen r board =
((foldl (fn (n,accu) => fn m => if (not (n = m) andalso not (abs(n-m) = accu)) then (n, accu + 1) else raise CannotPlaceQueen) (r, 1) board) ; true)
handle CannotPlaceQueen => false
The search tree containing all solutions is finite, so a depth first search will find all solutions. The search tree rooted at board is represented by queenTreeGen board:
datatype 'a tree = Br of 'a * 'a tree list | Solution of 'a
fun queenTreeGen board =
let fun range(n,m) = if n = m then [n] else n :: range(n+1,m)
in
if(length board = 8) then Solution board
else Br(board, map (fn r => queenTreeGen (r::board))(filter (fn r => canPlaceQueen r board) (range(1,8))))
end
Defining a type for lazy lists and finding all solutions with a depth first search:
datatype 'a seq = Cons of 'a * (unit -> 'a seq) | Nil
fun genAll (Br(a,xs)) = let fun append (Nil, Cons(a,b)) = Cons(a,b)
|append(Cons(a,b),x) = Cons(a, fn () => append ((b()), x))
|append(Nil, Nil) = Nil
in foldl (fn lst => fn newLst => append (lst, (genAll newLst))) Nil xs
end
|genAll (Solution(a)) = Cons(a, fn () => Nil)
The lazy list of solutions is therefore represented by genAll (queenTreeGen [])
Below are images of all 92 solutions found (some are reflections of others in one of the eight axes of symmetry of the chess board):