Euler 43 - is there a monad to help write this list comprehension?

Question

Here is a way to solve Euler problem 43 (please let me know if this doesn\'t give the correct answer). Is there a monad or some other syntatic sugar which could assist with

Answer 1

Sure.

newtype UniqueSel a = UniqueSel {runUS :: [Int] -> [([Int], a)]}
instance Monad UniqueSel where
  return a = UniqueSel (\ choices -> [(choices, a)])
  m >>= k = UniqueSel (\ choices -> 
    concatMap (\ (choices', a) -> runUS (k a) choices')
      (runUS m choices))

instance MonadPlus UniqueSel where
  mzero = UniqueSel $ \ _ -> []
  UniqueSel m `mplus` UniqueSel k = UniqueSel $ \ choices ->
    m choices ++ k choices

-- choose something that hasn't been chosen before
choose :: UniqueSel Int
choose = UniqueSel $ \ choices ->
  [(pre ++ suc, x) | (pre, x:suc) <- zip (inits choices) (tails choices)]

and then you treat it like the List monad, with guard to enforce choices, except that it won't choose an item more than once. Once you have a UniqueSel [Int] computation, just do map snd (runUS computation [0..9]) to give it [0..9] as the choices to select from.

Answer 2

Before jumping to monads, let's consider guided unique selection from finite domains first:

-- all possibilities:
pick_any []     = []       
pick_any (x:xs) = (xs,x) : [ (x:dom,y) | (dom,y) <- pick_any xs ]

-- guided selection (assume there's no repetitions in the domain):
one_of ns xs = [ (dom,y) | let choices = pick_any xs, n <- ns,
                           (dom,y) <- take 1 $ filter ((==n).snd) choices ]

With this a list comprehension can be written without the use of elem calls:

p43 = sum [ fromDigits [d0,d1,d2,d3,d4,d5,d6,d7,d8,d9]
            | (dom5,d5) <- one_of [0,5] [0..9]
            , (dom6,d6) <- pick_any dom5          
            , (dom7,d7) <- pick_any dom6          
            , rem (100*d5+10*d6+d7) 11 == 0 
            ....

fromDigits    :: (Integral a) => [a] -> Integer
fromDigits ds = foldl' (\s d-> s*10 + fromIntegral d) 0 ds

The monad from Louis Wasserman's answer can be further augmented with additional operations based on the functions above:

import Control.Monad 

newtype UniqueSel a = UniqueSel { runUS :: [Int] -> [([Int], a)] }
instance Monad UniqueSel where
  -- as in Louis's answer

instance MonadPlus UniqueSel where
  -- as in Louis's answer

choose             = UniqueSel pick_any   
choose_one_of xs   = UniqueSel $ one_of xs
choose_n n         = replicateM n choose
set_choices cs     = UniqueSel (\ _ -> [(cs, ())])
get_choices        = UniqueSel (\cs -> [(cs, cs)])

So that we can write

numTest xs m = fromDigits xs `rem` m == 0

pandigitalUS :: UniqueSel [Int]
pandigitalUS = do
     set_choices [0..9]
     [d7,d8,d9] <- choose_n 3
     guard $ numTest [d7,d8,d9] 17
     d6 <- choose
     guard $ numTest [d6,d7,d8] 13
     d5 <- choose_one_of [0,5]
     guard $ numTest [d5,d6,d7] 11
     d4 <- choose
     guard $ numTest [d4,d5,d6] 7
     d3 <- choose_one_of [0,2..8]
     d2 <- choose
     guard $ rem (d2+d3+d4) 3 == 0 
     [d1,d0] <- choose_n 2
     guard $ d0 /= 0
     return [d0,d1,d2,d3,d4,d5,d6,d7,d8,d9]

pandigitals = map (fromDigits.snd) $ runUS pandigitalUS []

main = do print $ sum pandigitals

Answer 3

The UniqueSel monad suggested by Louis Wasserman is exactly StateT [Integer] [] (I'm using Integer everywhere for simplicity).

The state keeps the available digits and every computation is nondeterministic - from a given state we can select different digits to continue with. Now the choose function can be implemented as

import Control.Monad
import Control.Monad.State
import Control.Monad.Trans
import Data.List

choose :: PanM Integer
choose = do
    xs <- get
    x <- lift xs -- pick one of `xs`
    let xs' = x `delete` xs
    put xs'
    return x

And then the monad is run by evalStateT as

main = do
         let nums = evalStateT pandigitals [0..9]
         -- ...