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