10
\$\begingroup\$

This is one of my Haskell solutions to a variation of the N-Queens problem, where the queens can move like knights in addition to their normal moves. It has been optimized somewhat to avoid investigating redundant combinations.

place :: Int -> [[Int]]
place 0 = [[]]
place n = go $ take n $ repeat [1..n] 
    where go [] = [[]]
          go (row:rest) = do
                q <- row 
                qs <- go $ safe q rest
                return (q : qs)
          safe q = notK q . notD q . notC q
          notC q = map (filter (/= q))
          notD q = (map (\(x, r) -> filter (\y -> abs(y - q) /= x) r)) . (zip [1..])
          notK q = map (\(f, r) -> filter f r) . (zip (kFilters q))
          kFilters q = (\x -> abs (x - q) /= 2) : (\x -> abs (x - q) > 1) : (repeat (const True))

solutions = length . place

main = do
    n <- readLn
    putStrLn $ show $ solutions n

I am satisfied with the performance, but I feel there must be a more elegant way to apply a series of functions (in this case, filters) to a list.

In each iteration of the recursive function go, the top row of the board is selected and then for each position in sequence a queen is positioned and the function recurs with a filtered copy of the rest of the board, so that each iteration has only safe squares to choose from. The safe function applies three filters to the board:

  1. notC removes all spaces in the same column as the new queen.
  2. notD removes any spaces on a diagonal from the new queen.
  3. notK removes knight moves from the next two lines.

I feel that notK in particular could be implemented more cleanly and idiomatically but I couldn't see a better way to apply one function to the first item of a list, another to the second and something else to the rest. And using zip does save me from having to check for the end of the board.

I wouldn't be surprised if there is a better way to write notD. So I am looking for more expressive ways to apply a sequence of varying functions to successive list items.

UPDATE:

I realise that I can use uncurry to clean up notK...

        notK q = map (uncurry filter) . (zip (kFilters q))

and the two filters in Kfilters can be written in dot notation...

        ((/= 2) . abs . subtract q) : ((/= 1) . abs . subtract q) : ...

which allows the kFilters line to be rendered as

        kFilters = (f 2) : (f 1) : (repeat (const True))

but this doesn't actually change my original question. I'm still looking for a better mechanism for applying a varying sequence of functions to a list.

\$\endgroup\$

1 Answer 1

6
\$\begingroup\$
notK q = map (uncurry filter) . (zip (kFilters q))

is equivalent to

notK q rows = zipWith filter (kFilters q) rows

Onto making above Haskell less idiomatic and less pointfree and more readable.

notC q = map (filter (/= q))
notD q = (map (\(x, r) -> filter (\y -> abs(y - q) /= x) r)) . (zip [1..])
notK q = map (\(f, r) -> filter f r) . (zip (kFilters q))

These three are logically similar but structurally dissimilar.

First let's factor out common components, give them meaningful names, and some comments to help those readers without the Developer's Manual.

-- a new queen placed in column q
-- would take a piece placed in column x
-- n rows down
-- because (r, q) and (r+n, x)

-- are on the same column
sameColumn q n x = x == q

-- are on the same diagonal
sameDiagonal q n x = abs(x - q) == n

-- or (n, |q - x|) is in [(1,2),(2,1)]
onKnightMove :: Int -> Int -> Int -> Bool
onKnightMove q n x = (n, abs(x - q)) `elem` [(1,2),(2,1)]

The last one needs a better name still, oh well. At least they are of the same form, with parameter name use consistent among them (and elsewhere).

rowFilterList :: Int -> (Int -> Int -> Int -> Bool) -> [Int -> Bool]
rowFilterList q pred = map (\n x -> not $ pred q n x) [1..]

such that kFilters q = rowFilterList q onKnightMove

filterRows :: Int -> (Int -> Int -> Int -> Bool) -> [[Int]] -> [[Int]]
filterRows q pred rows = zipWith filter (rowFilterList q pred) rows

This way notC q = filterRows q sameColumn and notD q = filterRows q sameDiagonal

notK q . notD q . notC q a repetition is evident. And we now can factor it out easily.

filterWithAll :: Int -> [[Int]] -> [Int -> Int -> Int -> Bool] -> [[Int]]
filterWithAll q rows preds = foldl (\rows' pred -> filterRows q pred rows') rows preds

such that safe q rows = filterWithAll q rows [sameColumn, sameDiagonal, onKnightMove]

By factoring out [sameColumn, sameDiagonal, onKnightMove] as a parameter to place n one could easily generalize place from n super-queens to n queens or n rooks.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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