4
\$\begingroup\$

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.

\$\endgroup\$
4
\$\begingroup\$

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.

\$\endgroup\$
0
\$\begingroup\$

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]
\$\endgroup\$
  • \$\begingroup\$ I'm not sure whether this is really a review of the original code. \$\endgroup\$ – Zeta Oct 15 '17 at 6:54
  • \$\begingroup\$ Could you explain what you mean by "disregards what's in the list that's checked for emptiness"? \$\endgroup\$ – Agnishom Chattopadhyay Oct 15 '17 at 15:31
  • \$\begingroup\$ 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] \$\endgroup\$ – Gurkenglas Oct 15 '17 at 21:43

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.