[Haskell-cafe] Fun with Haskell, runST, MArray, and a few queens.
David Sankel
camio at yahoo.com
Thu Mar 4 12:19:29 EST 2004
Hello Enthusiasts,
My fiancee was assigned the n-queens problem in her Data Structures class.
It was a study in backtracking. For those unfamiliar with the problem: one
is given a grid of n x n. Return a grid with n queens on it where no queen
can be attacked by another.
Anyway, I decided to try an implementation in Haskell (as I often do with
her assignments). Instead of the imperative approach (adding a queen and
then getting rid of it), I opted for a functional one (the grid is passed to
recursive calls, etc.).
The interesting thing about this assignment is the runtimes:
(n=10)
ghc 58.749s
ghc -O 12.580s
javac 1.088s
The Haskell version takes significantly longer (and it gets worse for
larger inputs). So it seems that imperative algorithms are much better for
certain problems.
Since Haskell is supposed to have the ability to run imperative algorithms,
I was wondering if any of you could explain how runST and MArray could be
used to solve this problem (or is there a better way?). I am also interested
in the run times you get with these two implementations of the n-queens
problem.
David
-------------- next part --------------
A non-text attachment was scrubbed...
Name: nQueens.java
Type: text/x-java
Size: 4392 bytes
Desc: nQueens.java
Url : http://www.haskell.org//pipermail/haskell-cafe/attachments/20040304/5d774388/nQueens.bin
-------------- next part --------------
module Main where
import Array
import Maybe
boardSizeToTest = 10
main = print $ fromJust $ solution (emptyBoard boardSizeToTest) boardSizeToTest
--The Board datatype. A n x n array indexed starting with 1.
data Board = Board Int (Array (Int,Int) Int) deriving Eq
instance Show Board where
show (Board n b) = concat [ (printLine b a) ++ "\n" | a <- [n,n-1..1] ]
where
printLine board row = concat [ (str (board ! (row,a))) | a <- [1..n] ]
str (-1) = "q" --It's a queen
str 0 = "." --It's an empty spot
str a = show a --It's a spot that can be attacked by a queen
--Helper function from Gentle Introduction to Haskell
mkArray :: (Ix a) => (a -> b) -> (a,a) -> Array a b
mkArray f bnds = array bnds [(i, f i) | i <- range bnds]
--Another helper function to update arrays
(/-) :: (Ix a) => Array a b -> [(a, (b -> b))] -> Array a b
(/-) array s = array // (map (\ (a, f) -> (a,f (array!a))) s)
--An empty chessboard
emptyBoard :: Int -> Board
emptyBoard n = Board n $ mkArray (\_->0) ((1,1),(n,n))
--Adds a queen to the board and adds 1 in all the positions the queen
--could feasible move.
addQueen :: Board -> (Int,Int) -> Board
addQueen b@(Board n board) c = Board n $ newBoard // [(c, -1)]
where
Board _ newBoard = queenHelper b (+1) c
--Removes a queen from the board and subtracts 1 in all the positions the queen
--could have feasible moved.
removeQueen :: Board -> (Int,Int) -> Board
removeQueen b@(Board n board) c = Board n $ newBoard // [(c, 0)]
where
Board _ newBoard = queenHelper b ((-)1) c
queenHelper :: Board -> (Int->Int) -> (Int, Int) -> Board
queenHelper (Board n board) f (row,column) =
Board n $ board /- horizontal /- vertical
/- negPosDiag /- posNegDiag /- negNegDiag /- posPosDiag
where
vertical = [ ((r,column),f) | r <- [1..n] ]
horizontal = [ ((row,c),f) | c <- [1..n] ]
negPosDiag = [ ((row-i,column+i),f)| i <- [1..(min (n-column) (row-1))]]
posNegDiag = [ ((row+i,column-i),f)| i <- [1..(min (column-1) (n-row))]]
negNegDiag = [ ((row-i,column-i),f)| i <- [1..(min (column-1) (row-1))]]
posPosDiag = [ ((row+i,column+i),f)| i <- [1..(min (n-column) (n-row))]]
--Returns all the positions on the board that do not have a queen and cannot
--be attacked by a queen already on the board.
possiblePositions (Board n board) =
filter (\a -> board ! a == 0) [ (row,column) | row <- [1..n], column <- [1..n] ]
--Finds a solution given a board and a number of queens to put on it
solution :: Board -> Int -> Maybe Board
solution board 0 = Just board
solution board i =
let
solutions = catMaybes $
[ solution (addQueen board c) (i-1) | c <- (possiblePositions board) ]
in
if solutions == [] then Nothing
else Just $ head solutions
More information about the Haskell-Cafe
mailing list