Euler 43 - 是否有一个monad来帮助写这个列表理解?

时间:2012-03-22 22:17:21

标签: haskell list-comprehension monads

这是一种解决欧拉问题43的方法(如果没有给出正确答案,请告诉我)。是否有monad或其他合成糖可以帮助跟踪notElem条件?

toNum xs = foldl (\s d -> 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

例如,在这种情况下,对d3的分配不是最佳的 - 它应该在numTest [d2,d3,d4] 3测试之前移动。但是,这样做意味着更改某些notElem测试以从正在检查的列表中删除d3。由于连续的notElem列表是通过将最后选择的值输入到前一个列表中获得的,所以看起来这应该是可行的 - 不知何故。

更新:以下是路易斯'UniqueSel monad重写的上述程序:

toNum xs = foldl (\s d -> 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

3 个答案:

答案 0 :(得分:10)

不确定

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)]

然后你将它视为List monad,guard强制执行选择,但它不会多次选择一个项目。完成UniqueSel [Int]计算后,只需map snd (runUS computation [0..9])给它[0..9]作为选择的选项。

答案 1 :(得分:4)

在跳转到monad之前,让我们首先考虑来自有限域的 引导的唯一选择

-- 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 ]

通过这种方式,可以在不使用elem调用的情况下编写列表理解:

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

来自Louis Wasserman's answer的monad可以根据上述函数进一步增加额外的操作:

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)])

这样我们就可以写

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

答案 2 :(得分:3)

Louis Wasserman建议的UniqueSel monad正是StateT [Integer] [](为了简单起见,我到处使用Integer

状态保持可用的数字,并且每个计算都是不确定的 - 从给定状态我们可以选择不同的数字继续。现在choose函数可以实现为

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

然后monad由evalStateT作为

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