# Haskell Solution to the Eight Queens Problem

by Brian Shourd on **October 12, 2014**

A friend of mine at work was talking about the so-called “Eight Queens” problem. It is a fun problem, easily stated, but not so easily solved. The problem is to place eight queens on a chessboard in such a way that no two can attack each other.

While walking home, I came across the idea that if we represent a board as a 64-bit word, we can easily mask out bits that are threatened. After a bit of fiddling, my solution is explained below (which removes duplicates up to symmetry). The full source can be found on Github.

## Data

We represent a `Move`

as an integer 0-63. This is distinct from a `BoardPosition`

, which is a tuple (a, b), where a and b are between 0 and 7, inclusive. We can convert back and forth with `moveToBoardPosition`

and `boardPositionToMove`

```
type Move = Int
type BoardPosition = (Int, Int)
moveToBoardPosition :: Move -> BoardPosition
moveToBoardPosition n = (n `quot` 8, n `mod` 8)
boardPositionToMove :: BoardPosition -> Move
boardPositionToMove (row, col) = row * 8 + col
```

As I hinted before, We represent threatened squares on a board with a `Word64`

, where 0 represents threatened and 1 represents unthreatened. This allows simple bitwise `.&.`

operations for combining `ThreatMask`

s.

We also represent a collection of moves as a `Word64`

, with 1 as an empty space and 0 as a space with a queen in it. We convert back and forth from a list of moves to a `MoveMask`

as well (though order is not preserved).

```
type ThreatMask = Word64
type MoveMask = Word64
-- The empty board state, where nothing is threatened, and no moves are
-- made. Can serve as both a MoveMask and a ThreatMask
emptyMask :: Word64
emptyMask = (complement 0)
movesToMoveMask :: [Move] -> MoveMask
movesToMoveMask = foldr (flip clearBit) emptyMask
moveMaskToMoves :: MoveMask -> [Move]
moveMaskToMoves mmask = filter (not . testBit mmask) [0..63]
```

## Utility functions

One of the tasks we’ll need to tackle is deduplication. That is, if we have a bunch of possible solutions (`[MoveMask]`

), we want to eliminate any that are the “same” solution. By “same”, of course, I mean “the same up to some symmetry”.

```
deduplicate :: [MoveMask] -> [MoveMask]
deduplicate = nub . map canonical
-- Get the "canonical" move, for deduplication purposes. In this case,
-- "canonical" means "apply all symmetries and take the smallest".
canonical :: MoveMask -> MoveMask
canonical moves = minimum . map ($moves) $ squareSymmetries
-- All symmetries of the square
squareSymmetries :: [(MoveMask -> MoveMask)]
squareSymmetries = map applyOnMasks [id, r1, r2, r3, m1, m2, m3, m4]
where
r1 (a, b) = (7 - b, a)
r2 (a, b) = (7 - a, 7 - b)
r3 (a, b) = (b, 7 - a)
m1 (a, b) = (7 - a, b)
m2 (a, b) = (a, 7 - b)
m3 (a, b) = (b, a)
m4 (a, b) = (7 - b, 7 - a)
applyOnMasks :: (BoardPosition -> BoardPosition) -> MoveMask -> MoveMask
applyOnMasks f = movesToMoveMask . map (boardPositionToMove . f . moveToBoardPosition) . moveMaskToMoves
```

## Core Algorithm ==

`qMImpl`

is a simple recurse with storage of current state. It keeps track of the `ThreatMask`

of which squares are currently threatened, the `MoveMask`

of which moves have been taken, and the number of moves have been taken. Technically, we could easily recreate the threatened squares and the number of moves from the list of moves, but it is more efficient (not to mention clearer) to keep the values than to recalculate them.

```
queensMoves :: [MoveMask]
queensMoves = deduplicate $ qMImpl emptyMask emptyMask 0
qMImpl :: ThreatMask -> MoveMask -> Int -> [MoveMask]
qMImpl tmask mmask numMoves
| numMoves < 0 = []
| numMoves > 8 = []
| numMoves == 8 = [mmask]
| otherwise = concat . map recurse $ openMovesInRow tmask numMoves
where
recurse :: Move -> [MoveMask]
recurse move = qMImpl (doMove tmask move) (clearBit mmask move) (numMoves + 1)
-- Get all the unthreatened moves for a mask in the given row
openMovesInRow :: ThreatMask -> Int -> [Move]
openMovesInRow tmask n = filter (testBit tmask) $ take 8 [8*n..]
-- Given a move and a mask of threatened spaces, return a new mask of
-- threatened spaces
doMove :: ThreatMask -> Move -> ThreatMask
doMove tmask move = (getThreatMask move) .&. tmask
-- For a given move, get the corresponding mask of threatened spaces
getThreatMask :: Move -> ThreatMask
getThreatMask move = foldr (flip clearBit) emptyMask threatened
where
threatened = filter (isThreatened move) [0..63]
-- Determine if two moves threaten each other
isThreatened :: Move -> Move -> Bool
isThreatened a b =
(cola == colb) ||
(rowa == rowb) ||
(cola + rowa == colb + rowb) ||
(cola - rowa == colb - rowb)
where
(rowa, cola) = moveToBoardPosition a
(rowb, colb) = moveToBoardPosition b
main :: IO ()
main = mapM_ (putStrLn . show . map moveToBoardPosition . moveMaskToMoves) queensMoves
```

And that is all there is to it. It’s a pretty fun solution, and while probably not the most performant, it is more than fast enough (finds the 12 fundamental solutions in under 70ms on my Macbook Air).