N-queens problem in Haskell by bruteforce

Question

I wrote a Haskell program to solve the N-queens problem by bruteforce. It works and I find it reasonably readable

But it is pretty slow:

• 5 seconds for one solution of 8 queens.
• 1 minute for one solution for 9 queens.
• Crash for 10 queens. I fear that allFalseOneTrue gives memory problems as it uses permutations.

I would like to hear both improvements on readability and performance:

import Control.Monad
import Data.List

-- True indicates that there is a queen, False that there is not.
type QueenBoard = [[Bool]]

count   :: Eq a => a -> [a] -> Int
count x =  length . filter (==x)

fAnd :: (a -> Bool) -> (a -> Bool) -> (a -> Bool)
fAnd = liftM2 (&&)

rotate90 :: [[a]] -> [[a]]
rotate90 = map reverse . transpose

noQueensinSameRow :: QueenBoard -> Bool
noQueensinSameRow board = not (any (\row -> count True row > 1) board)

noQueensinSameColumn :: QueenBoard -> Bool
noQueensinSameColumn = noQueensinSameRow . rotate90

-- Attribution to http://stackoverflow.com/questions/32465776/getting-all-the-diagonals-of-a-matrix-in-haskell
diagonals :: [[a]] -> [[a]]
diagonals []       = []
diagonals ([]:xss) = xss
diagonals xss      = zipWith (++) (map ((:[]) . head) xss ++ repeat [])
                                  ([]:(diagonals (map tail xss)))

allDiagonals :: [[a]] -> [[a]]
allDiagonals xss = (diagonals xss) ++ (diagonals (rotate90 xss))

noQueensinSameDiagonal :: QueenBoard -> Bool
noQueensinSameDiagonal = noQueensinSameRow . allDiagonals

isQueenSolution :: QueenBoard -> Bool
isQueenSolution = (noQueensinSameRow `fAnd` noQueensinSameColumn `fAnd` noQueensinSameDiagonal)

allFalseOneTrue :: Int -> [[Bool]]
allFalseOneTrue length = nub $ permutations ( [True] ++ (replicate (length - 1) False) )

allProduct = sequence :: [[a]] -> [[a]]

allPossibleBoards :: Int -> [QueenBoard]
allPossibleBoards size = allProduct (replicate size (allFalseOneTrue size))

solveQueens :: Int -> [QueenBoard]
solveQueens = (filter isQueenSolution) . allPossibleBoards

main :: IO()
main = mapM_ putStrLn $ map show $ head $ solveQueens 8

Answer 1

The standard way to solve this is to:

1. Only keep track of the positions of the queens - not whether a square has a queen.
2. Since only each column may have one queen (and must have one queen), a solution is a [Int] indicating the row positions of the placed queens, e.g. [0,2,4] is a solution for a board having 3 columns (and at least 5 rows) where the queens are at (0,0), (1,2) and (2,4).

So build up the solution iteratively. If you have the placement [r1] how can it be extended to a valid placement [r1, r2]? Clearly r2 can't equal r1 and (0,r1) can't be on the same diagonal as (1,r2). And, of course, r2 has to be a valid row number.

Answer 2

Core performance issue

There are two reasons the performance is so poor.

1. As ErikR points out, you are calculating much more information for each row than you need. Only the queen's placing in each row need be kept.
2. You are explicitly calculating (almost) every possible placement and then filtering out the illegal ones.

Point 2 is actually the more important one. To choose an apt analogy, you know the story of the peasant who asked the emperor to place one grain of rice on the first square of a chessboard, two on the next, four on the next and so on through powers of two? And the whole empire is bankrupt before square 64? That's what you're doing. You are forcing Haskell to consider every possible variation, which would be costly even in an imperative language but is more so here.

In an imperative language, you would use lots of tricks to detect when you can abandon one branch of the permutations and track back. The advantage of lazy Haskell is that you can greatly simplify such code by "creating" large or even infinite structures, but only every evaluating small sections of them. The trick is to only ask for what you need.

Here's part of a much more idiomatic and also much more performant n-queens solution:

solutions :: Int -> [[Int]]
solutions 0 = [[]]
solutions n = go $ take n $ repeat [1..n]
where go [] = [[]]
      go (row:rest) = [ q : qs | q <- row, qs <- go (safe q rest) ]
      safe = ???????

take n $ repeat [1..n] generates an n * n board as a list of columns 1 to n. So each element in the list is a row, containing a list of column places.

safe is a function (implementation not shown yet) which filters rows to remove any squares which are threatened by a queen in a specific position. For the moment, it doesn't matter how it is implemented.

go is a recursive function where for each square in a row, that position is prepended to go applied again to a filtered version of the remaining rows (filtered to remove any squares threatened by a queen in the current position).

So this is a recursive function which pursues a lot of branches. The top left corner of the board alone generates 6 branches (it can only threaten 2 squares in the next row), the first row as a whole generates 42 branches, each of which subdivides again and again. That's a lot of branches. Yet this function is simple and performs fast. Why?

It's simple because it doesn't need any special logic to backtrack if it hits a dead end. If at any point there are no more valid moves, then safe q rest will return []. Which means the next iteration of go will effectively be

[ q : qs | q <- [], qs <- go (safe q rest) ]

at which point lazy Haskell short-circuits, because this can only generate [] and so there is no point evaluating qs <- go (safe q rest). And the whole branch that led us to this point also collapses back to [], because

[ q : qs | q <- row, qs <- [] ]

also evaluates to []. So any invalid branch will not return a list of positions and not become part of the final list. So the final list can only contain valid solutions - if there are any.

Haskell allows n-queens to be solved in a very compact and expressive fashion but still be performant. Although it appears to require a huge number of combinations to be assessed, invalid branches are discarded immediately. So this means that my solution is also brute force. I just let lazy Haskell not bother being brutal for no gain.

Placing queens recursively, filtering out any threatened squares at each step, is also much simpler than your "build it all, examine every solution" approach. Here's how safe could be done:

      safe q = notDiagonal q . notSameColumn q
      notSameColumn q = map (filter (/= q))
      notDiagonal q = (map (\(x, r) -> filter (\y -> abs(y - q) /= x) r)) . (zip [1..])

Filtering out the diagonals threatened by this queen is a hell of a lot simpler than your noQueensInSameDiagonal. Note that it also contains an infinite list of numbers (1 to infinity) but laziness means it doesn't crash.

I'll save comments on idiom/style in your code for a separate answer. This answer is to explain why the whole approach is not Haskellish. Laziness for the win.