[Haskell-cafe] Re: Fun with Haskell, runST, MArray, and a few queens. (Imperative Haskell Version)

I say this is a case of bad code. Of course language <foo> is faster and better if you write horribly bad code in language <bar>.
Taking the first solution found by searching with google I get times around 0.015s (real) for the Haskell version and 1.7s for your Java solution (which also seems to be overcomplicated to me).
That's cool. Although the java algorithm is beyond any doubt overcomplicated, I'd like to reproduce it using Haskell's imperative constructs because not all backtracking algorithms have a simple closed form solution. What I've done using monads is a little better in speed, but not the huge improvement I was expecting. Any comments as to what I'm doing wrong here? Updated Table: ghc������ 58.749s ghc -O��� 12.580s ghc -O (monad version) 8.284s javac����� 1.088s David module Main where import Control.Monad.ST import GHC.Arr import Maybe import Ix main = print $ runST something n = 10 -- Used only for output 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 --Finds a solution given a board and a number of queens to put on it solution board 0 = return True solution board i = do possibleP <- (possiblePositions board) trySolution possibleP where trySolution [] = return False trySolution (c:cs) = do addQueen board c good <- solution board (i-1) if good then return True else do removeQueen board c trySolution cs --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 = -- do -- p <- sequence [ readSTArray board (row,column) >>= -- (\a -> return (a == 0,(row,column))) -- | row <- [1..n], column <- [1..n] ] -- return $ map (\(_,b)->b) $ filter (\(a,_)-> a) p possiblePositions board = do -- let indices = range $! boundsSTArray board let indices = [ (row,column) | row <- [1..n], column <- [1..n] ] p <- sequence $ map (\i -> readSTArray board i >>= (\a -> if a == 0 then return $ Just i else return Nothing )) indices -- return $ map (\(_,b)->b) $ filter fst p return $ catMaybes p arrayToBoard board = do it <- sequence [ readSTArray board (a,b) >>= (\s -> return ((a,b),s)) | a <- [1..n], b <- [1..n] ] return (Board n (array ((1,1),(n,n)) it)) emptyBoard = newSTArray ((1,1),(n,n)) 0 something = do board <- emptyBoard solution board n arrayToBoard board --Adds a queen to the board and adds 1 in all the positions the queen --could feasible move. addQueen b c = do queenHelper b (+1) c writeSTArray b c (-1) --Removes a queen from the board and subtracts 1 in all the positions the queen --could have feasibly moved. removeQueen b c = do queenHelper b (\a -> a - 1) c writeSTArray b c 0 --Helper function to update arrays (/-) array s = do sequence_ [ readSTArray array b >>= \n -> writeSTArray array b $! (c n) | (b,c) <- s ] return array queenHelper board f (row,column) = do 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))]]
participants (1)
-
David Sankel