According to wikipedia

The eight queens puzzle is the problem of placing eight chess queens on an 8×8 chessboard so that no two queens threaten each other.

The task is to implement the extended version, queens :: Int -> [[Int]]; given an integer specifying the dimension of the chess board, it returns all valid solutions.

Since it’s a well-established problem, many standard techniques exist, such as those listed at https://rosettacode.org/wiki/N-queens_problem#Haskell. I have reprinted two versions I am quite fond of. Now that there are multiple versions available, I am curious about their performance, so I used the following main function, compiled with -O, to do simple evaluation, and the result is attached along with the corresponding source code.

1
2
3
4
5
6
7
-- driver
import Data.Time
main = do
  start <- getCurrentTime
  print $ length $ queens 13
  stop <- getCurrentTime
  print $ diffUTCTime stop start
1
2
3
4
5
6
7
import Control.Monad
import Data.List (delete)
queens n = map fst $ foldM oneMorequeens ([],[1..n]) [1..n]  where
  oneMorequeens (y,d) _ = [(x:y, delete x d) | x <- d, safe x]  where
    safe x = and [x /= c + n && x /= c - n | (n,c) <- zip [1..] y]
-- 73712
-- 3.256558s
1
2
3
4
5
6
7
8
9
10
import Control.Monad (foldM)
import Data.List ((\\))

queens :: Int -> [[Int]]
queens n = foldM f [] [1..n]
    where
      f qs _ = [q:qs | q <- [1..n] \\ qs, q `notDiag` qs]
      q `notDiag` qs = and [abs (q - qi) /= i | (qi,i) <- qs `zip` [1..]]
-- 73712
-- 7.787397s

Here is the solution from wikipedia

1
2
3
4
5
6
7
8
9
import Control.Monad

queens n = foldM (\y _ -> [ x : y | x <- [1..n], safe x y 1]) [] [1..n]
  where
    safe x [] _ = True
    safe x (c:y) n = and [ x /= c , x /= c + n , x /= c - n , safe x y (n+1)]

-- 73712
-- 11.298376s

In the process of trying to understand such concise solutions, I have attempted to craft two versions without using foldM.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
type Board = [Int]

queens :: Int -> [Board]
queens n = loop [[]] 0
  where
    loop :: [Board] -> Int -> [Board]
    loop boards counter
      | counter == n = boards
      | otherwise = loop (concatMap expand boards) (counter+1)

    expand :: Board -> [Board]
    expand board = [x : board | x <- [1..n], safe x board 1]

    safe x [] _ = True
    safe x (c:y) n = and [x /= c , x /= c + n , x /= c - n , safe x y (n+1)]
-- 73712
-- 2.569084s
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
import Data.List (delete)
type Board = [Int]

queens :: Int -> [Board]
queens n = map fst $ loop [([], [1..n])] 0
  where
    loop :: [(Board, [Int])] -> Int -> [(Board, [Int])]
    loop boards counter
      | counter == n = boards
      | otherwise = loop (concatMap expand boards) (counter+1)

    expand :: (Board, [Int]) -> [(Board, [Int])]
    expand (board, candidates) =
      [(x : board, delete x candidates) | x <- candidates, safe x board]

    safe x board = and [ x /= c + n && x /= c - n  | (n,c) <- zip [1..] board]
73712
1.378314s

I am quite happy to see that they both perform better than existing ones. (Actually, I like the one without using tuple best, even though it’s not the fastest.)