[Haskell-cafe] Fun with Haskell, runST, MArray, and a few queens.
Michael Wang
Michael.Wang at synopsys.com
Thu Mar 4 12:50:33 EST 2004
Try this Queens.hs
module Main where
main = print $ queens 10
boardSize = 10
queens 0 = [[]]
queens n = [ x : y | y <- queens (n-1), x <- [1..boardSize], safe x y 1]
where
safe x [] n = True
safe x (c:y) n = and [ x /= c , x /= c + n , x /= c - n , safe x y
(n+1)]
Copied from somebody else.
-----Original Message-----
From: haskell-cafe-bounces at haskell.org
[mailto:haskell-cafe-bounces at haskell.org]On Behalf Of David Sankel
Sent: Thursday, March 04, 2004 12:19 PM
To: haskell-cafe at haskell.org
Subject: [Haskell-cafe] Fun with Haskell, runST, MArray, and a few
queens.
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
More information about the Haskell-Cafe
mailing list