[Haskell-cafe] Randomized N-Queens

[Ronald Guida]

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?

-- Ron

------------------------------------------------------------
module Main
where

import Control.Monad.State
import Data.List
import System.Environment
import System.Random
import System.Random.Shuffle -- from package random-shuffle

newtype Location = Location {unLocation :: (Int, Int)}
  deriving (Show)

isAttacked :: Location -> Location -> Bool
isAttacked (Location (row1, column1)) (Location (row2, column2)) =
    or [ (row1 == row2)
       , (column1 == column2)
       , ((row1 - row2) == (column1 - column2))
       , ((row1 - row2) == (column2 - column1))
       ]

newtype Board = Board {unBoard :: [Location]}
  deriving (Show)

data (RandomGen g) => SolutionState g = SolutionState
    { solnBoard :: Board
    , solnUnusedColumns :: [Int]
    , solnRandomGen :: g
    }

nextRow :: (RandomGen g) => Int -> Int -> StateT (SolutionState g) [] ()
nextRow n row  = do
  (SolutionState (Board locs) unusedColumns gen) <- get
  let (ps, gen') = randShuffleSeq (length unusedColumns) gen
  column <- lift $ shuffle unusedColumns ps
  let loc = Location (row, column)
  guard $ all (not . isAttacked loc) locs
  let remainingCols = unusedColumns \\ [column]
  put $ (SolutionState (Board (loc : locs)) remainingCols gen')

randShuffleSeq :: (RandomGen g) => Int -> g -> ([Int], g)
randShuffleSeq 0 g = ([], g)
randShuffleSeq 1 g = ([], g)
randShuffleSeq n g = (x:xs, g2)
    where
      (x, g1) = randomR (0, n-1) g
      (xs, g2) = randShuffleSeq (n-1) g1

allRows :: (RandomGen g) => Int -> StateT (SolutionState g) [] ()
allRows n = mapM_ (nextRow n) [1..n]

solve :: (RandomGen g) => Int -> g -> [Board]
solve n gen = map solnBoard $
              execStateT (allRows n) (SolutionState (Board []) [1..n] gen)

formatSolution :: Board -> String
formatSolution = show . map unLocation . unBoard

main :: IO ()
main = do
  args <- getArgs
  let boardSize = read $ args !! 0
      maxSolns = if length args > 1 then read (args !! 1) else 10
      allSolns = solve boardSize (mkStdGen 42)
  putStrLn $ unlines $ map formatSolution $ take maxSolns allSolns
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20100326/a4ecc0c5/attachment.html