Эйлер 43 - есть ли монада, чтобы помочь написать этот список понимания?

Question

Вот способ решить проблему Эйлера 43 (пожалуйста, дайте мне знать, если это не даст правильный ответ). Есть ли монада или какой-нибудь другой синтетический сахар, который может помочь в отслеживании условий 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 ниже:

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

Answer 1

Конечно.

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 с guard для принудительного выбора, за исключением того, что он не выберет элемент более одного раза. Если у вас есть вычисления UniqueSel [Int], просто наберите map snd (runUS computation [0..9]), чтобы выбрать [0..9] для выбора.

Answer 2

Прежде чем перейти к монадам, давайте рассмотрим уникальную управляемую выборку из конечных доменов сначала:

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

Монада из Ответ Луи Вассермана может быть дополнительно дополнен дополнительными операциями, основанными на перечисленных выше функциях:

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

Answer 3

Монада UniqueSel, предложенная Луи Вассерманом, точно равна 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

А затем монадой управляет evalStateT как

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