[Haskell-cafe] Re: Randomized N-Queens
Heinrich Apfelmus
apfelmus at quantentunnel.de
Sat Mar 27 06:45:21 EDT 2010
Ronald Guida wrote:
> Hi,
>
> I'm trying to solve the N-queens problem, but with a catch: I want to
> generate solutions in a random order.
>
> I know how to solve the N-queens problem; my solver (below) generates all
> possible solutions. What I am trying to do is generate solutions in a
> random order by somehow randomizing the order in which "nextRow" considers
> the unused columns. I tried adding a random number generator to the
> solution state; the problem with this approach is that whenever the solver
> backtracks, the state of the random number generator backtracks along with
> it. In effect, I am selecting a random, but fixed, permutation for each
> row, and then I am applying that same set of permutations along all
> computational paths. Whenever I consider row R, regardless of which path I
> have taken, I am applying row R's permutation to the unused columns.
>
> This is not the behavior I want. I want each computational path to use a
> new, different permutation for each row. On the other hand I also want to
> be able to take the first few solutions without waiting for all possible
> solutions to be generated. How might I go about doing this?
>
> [...]
> data (RandomGen g) => SolutionState g = SolutionState
> { solnBoard :: Board
> , solnUnusedColumns :: [Int]
> , solnRandomGen :: g
> }
>
> nextRow :: (RandomGen g) => Int -> Int -> StateT (SolutionState g) [] ()
It's a matter of choosing the right monad stack. In particular, putting
the random number generator into the solution state pretty much forces
the undesired behavior. Random numbers are best put in a separate monad
(transformer), for reasons of abstraction which are outlined here:
http://lukepalmer.wordpress.com/2009/01/17/use-monadrandom/
http://apfelmus.nfshost.com/articles/random-permutations.html
Also, it's not really necessary to use the state monad to store the
solution, using a plain old parameter works just fine, as the following
code illustrates:
import Control.Monad.Random -- from the MonadRandom package
-- generate a random permutation
randomPerm :: MonadRandom r => [a] -> r [a]
randomPerm xs = go (length xs) xs
where
go 0 [] = return []
go n xs = do
k <- getRandomR (0,n-1)
let (x,xs') = select k xs
liftM (x:) $ go (n-1) xs'
select 0 (x:xs) = (x,xs)
select k (x:xs) = let (y,ys) = select (k-1) xs in (y,x:ys)
-- 8 queens
type Pos = (Int,Int)
attacks (x1,y1) (x2,y2) =
x1 == x2
|| y1 == y2
|| x1 - x2 == y1 - y2
|| x2 - x1 == y1 - y2
type Solution = [Pos]
solve :: Rand StdGen [Solution]
solve = solve' 8 []
where
solve' 0 qs = return [qs]
solve' row qs =
liftM concat . mapM putQueen =<< randomPerm [1..8]
where
putQueen col
| any (q `attacks`) qs = return []
| otherwise = solve' (row-1) (q:qs)
where q = (row,col)
test seed = evalRand solve $ mkStdGen seed
Regards,
Heinrich Apfelmus
--
http://apfelmus.nfshost.com
More information about the Haskell-Cafe
mailing list