[Haskell-cafe] Fun with Haskell, runST, MArray, and a few queens.

[David Sankel]

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