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

Question

Here is a way to solve Euler 43 problem (please let me know if this does not give the correct answer). Is there a monad or some other syntactic sugar that can help track notElem conditions?

 toNum xs = foldl (\sd -> s*10+d) 0 xs numTest xs m = (toNum xs) `mod` m == 0 pandigitals = [ [d0,d1,d2,d3,d4,d5,d6,d7,d8,d9] | d7 <- [0..9], d8 <- [0..9], d8 `notElem` [d7], d9 <- [0..9], d9 `notElem` [d8,d7], numTest [d7,d8,d9] 17, d5 <- [0,5], d5 `notElem` [d9,d8,d7], d3 <- [0,2,4,6,8], d3 `notElem` [d5,d9,d8,d7], d6 <- [0..9], d6 `notElem` [d3,d5,d9,d8,d7], numTest [d6,d7,d8] 13, numTest [d5,d6,d7] 11, d4 <- [0..9], d4 `notElem` [d6,d3,d5,d9,d8,d7], numTest [d4,d5,d6] 7, d2 <- [0..9], d2 `notElem` [d4,d6,d3,d5,d9,d8,d7], numTest [d2,d3,d4] 3, d1 <- [0..9], d1 `notElem` [d2,d4,d6,d3,d5,d9,d8,d7], d0 <- [1..9], d0 `notElem` [d1,d2,d4,d6,d3,d5,d9,d8,d7] ] main = do let nums = map toNum pandigitals print $ nums putStrLn "" print $ sum nums 

For example, in this case, the appointment of d3 not optimal - it really should be transferred immediately before the numTest [d2,d3,d4] 3 test. However, this would mean modifying some notElem tests to remove d3 from the list being checked. Since consecutive notElem lists notElem obtained by simply passing the last selected value to the previous list, it seems that this should be feasible - somehow.

UPDATE: here is the above program rewritten with Louis UniqueSel monad below:

 toNum xs = foldl (\sd -> s*10+d) 0 xs numTest xs m = (toNum xs) `mod` m == 0 pandigitalUS = do d7 <- choose d8 <- choose d9 <- choose guard $ numTest [d7,d8,d9] 17 d6 <- choose guard $ numTest [d6,d7,d8] 13 d5 <- choose guard $ d5 == 0 || d5 == 5 guard $ numTest [d5,d6,d7] 11 d4 <- choose guard $ numTest [d4,d5,d6] 7 d3 <- choose d2 <- choose guard $ numTest [d2,d3,d4] 3 d1 <- choose guard $ numTest [d1,d2,d3] 2 d0 <- choose guard $ d0 /= 0 return [d0,d1,d2,d3,d4,d5,d6,d7,d8,d9] pandigitals = map snd $ runUS pandigitalUS [0..9] main = do print $ pandigitals 

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 (ka) 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 a list monad, and guard is for forced selection, except that it will not select an item more than once. After computing UniqueSel [Int] just do a map snd (runUS computation [0..9]) to give it [0..9] choice to make.

Answer 2

Before moving on to monads, we’ll first consider a unique selection of destination domains :

 -- all possibilities: pick_any [] = [] pick_any (x:xs) = (xs,x) : [ (x:dom,y) | (dom,y) <- pick_any xs ] -- guided selection (assume there 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 using 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 supplemented with additional operations based on the above functions:

 import Control.Monad newtype UniqueSel a = UniqueSel { runUS :: [Int] -> [([Int], a)] } instance Monad UniqueSel where -- as in Louis answer instance MonadPlus UniqueSel where -- as in Louis 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 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 proposed by Louis Wasserman is exactly StateT [Integer] [] (I use Integer everywhere for simplicity).

The state stores available numbers and each calculation is non-deterministic - from this state we can select different numbers to continue. 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 executed by evalStateT as

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