N Queens with Haskell

Question

I tried to solve the N Queens problem in Haskell using backtracking. Here is my approach:

type Solution = [Int]
extend :: Solution -> Int -> Maybe Solution
extend b new = go 0 b
 where
 n = length b
 go _ [] = Just (b ++ [new])
 go i (x:xs)
 | x == new = Nothing
 | abs (i - n) == abs (x - new) = Nothing
 | otherwise = go (i+1) xs
fullExtend :: Int -> Solution -> Maybe Solution
fullExtend n partialSolution
 | length partialSolution == n = Just partialSolution
 | otherwise = foldr propose Nothing [0..(n-1)]
 where
 propose _ (Just xs) = Just xs
 propose x Nothing = extend partialSolution x >>= fullExtend n
nQueens :: Int -> Maybe Solution
nQueens n = fullExtend n []

Can the propose function be expressed in a more elegant way? I am only happy to get one solution here, and shortcircuiting the evaluation is fine.

I also experimented a bit more to find out all the solutions. Here is how I did so:

extend' :: Solution -> Int -> [Solution]
extend' b new = go 0 b
 where
 n = length b
 go _ [] = [b ++ [new]]
 go i (x:xs)
 | x == new = []
 | abs (i - n) == abs (x - new) = []
 | otherwise = go (i+1) xs
fullExtend' :: Int -> Solution -> [Solution]
fullExtend' n partialSolution
 | length partialSolution == n = [partialSolution]
 | otherwise = [0..(n-1)] >>= (\x -> extend' partialSolution x >>= fullExtend' n)
nQueens' :: Int -> [Solution]
nQueens' n = fullExtend' n []

General comments on coding style would also be helpful.

Answer 1

TL;DR:

1. Don't repeat yourself. If you notice that code is very similar, ask whether you can use that similarity.
2. Express functions with other functions.
3. Avoid length in recursive calls, as it will add another factor n to your time complexity

Overall, still well done.

Naming and (time) complexity

Let's start by looking at the types. Well, you have type signatures at every top-level binding, which is a great start. I think that the name Solution is slightly misleading, since you call the variable b for Board. But naming is hard, so let's focus on other parts.

extend :: Solution -> Int -> Maybe Solution
extend b new = go 0 b
 where
 n = length b -- 1
 go _ [] = Just (b ++ [new]) -- 2
 go i (x:xs)
 | x == new = Nothing 
 | abs (i - n) == abs (x - new) = Nothing 
 | otherwise = go (i+1) xs

extend has two small problems. First, xs ++ [e] (see 2 above) is linear (\$\mathcal O(n)\$), whereas e : xs is constant (\$\mathcal O(1)\$). If possible, we should prefer the second variant. And length b is also linear (see 1 above). But if we fix 2 we don't need n anymore:

extend :: Solution -> Int -> Maybe Solution
extend bs new = go 1 bs
 where
 go _ [] = Just (new : bs)
 go i (x:xs)
 | x == new = Nothing
 | i == abs (x - new) = Nothing
 | otherwise = go (i + 1)

Note that I've renamed b to bs, since the suffix s indicates multiple elements.

Don't repeat yourself

Although yout extend and extend' differ, the logic in go is almost the same. That's a sign that you can re-use the code, so let's try that:

placeable :: Int -> Solution -> Bool
placeable n xs = null [ x | (i,x) <- zip [1..] xs, x == n || abs (x - n) == i]
-- same as
placeable' :: Int -> Solution -> Bool
placeable' n xs = go 1 xs
 where
 go _ [] = True
 go i (x:xs) = x /= n && abs (x - n) == i && go (i + 1) xs

Now we can simplify extend and extend':

extend :: Solution -> Int -> Maybe Solution
extend bs new = if placeable new bs 
 then Just (new : bs) 
 else Nothing
extend' :: Solution -> Int -> [Solution]
extend' bs new = if placeable new bs 
 then [new : bs]
 else []

Feel free to use guard syntax instead.

Reuse functions

If you have a function listToMaybe :: [a] -> Maybe a, you don't need to write extend:

extend :: Solution-> Int -> Maybe Solution
extend bs new = listToMaybe (extend' bs new)

We can do the same for nQueens and get rid of extend completely:

nQueens :: Int -> Maybe Solution
nQueens n = listToMaybe (nQueens' n)

But you need to be lazy enough for that.

Use knowledge you already have

In fullExtend, you'll check whether you already reached the correct length:

fullExtend :: Int -> Solution -> Maybe Solution
fullExtend n partialSolution
 | length partialSolution == n = Just partialSolution -- here
 ...

However, that's again \$\mathcal O(n)\$. But we know the length of our current solution; almost. It's the number of recursive calls:

 ...
 propose x Nothing = extend partialSolution x >>= fullExtend n -- one element more

Also n does not change. This calls for a go-like function:

fullExtend :: Int -> Solution -> Maybe Solution
fullExtend n = go n
 where
 go 0 partialSolution = Just partialSolution
 go k partialSolution = foldr propose Nothing [0..(n-1)]
 where
 propose _ (Just xs) = Just xs
 propose x Nothing = extend partialSolution x >>= go (k - 1)

We now count down from n to 0 in go. Whenever we reached 0, we have all n elements. This removes the need for length. At this point fullExtend is almost the same as nQueens, so we can get rid of it:

nQueens :: Int -> Maybe Solution
nQueens n = go n []
 where
 go 0 partialSolution = Just partialSolution
 go k partialSolution = foldr propose Nothing [0..(n-1)]
 where
 propose _ (Just xs) = Just xs
 propose x Nothing = extend partialSolution x >>= go (k - 1)

We can use the same approach for fullExtend'. First, get rid of length:

fullExtend' :: Int -> Solution -> [Solution]
fullExtend' n partialSolution = go n partialSolution
 where
 go 0 xs = [xs]
 go k xs = [0..(n-1)] >>= (\x -> extend' partialSolution x >>= go (k - 1))

Then rewrite nQueens':

nQueens' :: Int -> [Solution]
nQueens' n = go n []
 where
 go 0 xs = [xs]
 go k xs = [0..(n-1)] >>= (\x -> extend' xs x >>= go (k - 1))

By the way, this looks a little bit nicer with do notation:

nQueens' :: Int -> [Solution]
nQueens' n = go n []
 where
 go 0 bs = [bs]
 go k bs = do 
 x <- [0..(n-1)]
 xs <- extend' bs x
 go (k - 1) xs

But that's up to you to decide.

Your propose question

Can the propose function be expressed in a more elegant way?

You can use Maybe's Alternative instance:

propose x solution = solution <|> (extend partialSolution x >>= go (k -1))

However, that's not really necessary if you rewrite nQueens

All at once

If we also inline extend, we end up with the following code for the list variant:

import Data.Maybe (listToMaybe)
type Board = [Int]
nQueens :: Int -> Maybe Board
nQueens = listToMaybe . nQueens'
nQueens' :: Int -> [Board]
nQueens' n = go n []
 where
 go 0 bs = [bs]
 go k bs = concatMap (go (k - 1)) [ x : bs | x <- [1..n], placeable x bs]
 placeable n xs = null [ i | (i,x) <- zip [1..] xs, n == x || abs (n - x) == i]

We could rewrite go above also as

 go k bs = do
 x <- [1..n]
 guard (placeable x bs)
 go (k - 1) (x : bs)

or

 go k bs = [1..n] >>= (\x -> guard (placeable x xs) >> go (k - 1) (x : bs)

but that's only personal preference, they all work the same.

Answer 2

Continuing from Zeta.

placeable disregards what's in the list that's checked for emptiness, unless:

placeable n xs = and [n /= x && abs (n - x) /= i | (i,x) <- zip [1..] xs]

go is a left fold and can be turned into a right fold for less argument passing.

go 0 = [[]]
go k = [x : bs | bs <- go (k - 1), x <- [1..n], placeable x bs]

This reveals that iterate can replace the explicit recursion:

nQueens' n = iterate (concatMap grow) [[]] !! n where
 grow bs = [x : bs | x <- [1..n], placeable x bs]
 placeable n xs = and [n /= x && abs (n - x) /= i | (i,x) <- zip [1..] xs]

• Zeta: I'm not sure whether this is really a review of the original code.
• Agnishom Chattopadhyay: Could you explain what you mean by "disregards what's in the list that's checked for emptiness"?
• Gurkenglas: One could write null [ i | (i,x) <- zip [1..] xs, n == x || abs (n - x) == i] as null [ x | (i,x) <- zip [1..] xs, n == x || abs (n - x) == i] or null [ () | (i,x) <- zip [1..] xs, n == x || abs (n - x) == i]