尴尬的 Monad 变压器堆栈

Question

解决 Google Code Jam 中的问题 (2009.1AA：“Multi-基本幸福”）我想出了一个尴尬的（代码方面的）解决方案，我对如何改进它很感兴趣。

简而言之，问题描述是：对于给定列表中的所有碱基，找到大于 1 的最小数字，迭代计算数字平方和达到 1。

或伪 Haskell 中的描述（如果 elem 始终适用于无限列表，则可以解决该问题的代码）：

solution =
  head . (`filter` [2..]) .
  all ((1 `elem`) . (`iterate` i) . sumSquareOfDigitsInBase)

我的尴尬解决方案：

• 尴尬的意思是它有这种代码： happy < ;- 举起 。举起 。 lift $ isHappy Set.empty base cur
• 我记住 isHappy 函数的结果。使用 State monad 来存储结果 Map。
• 为了找到第一个解决方案，我没有使用 head 和 filter （就像上面的伪 haskell 那样），因为计算不是纯粹的（改变状态）。因此，我使用 StateT 和计数器进行迭代，并使用 MaybeT 在条件成立时终止计算。
• 已经在 MaybeT (StateT a (State b)) 中，如果某个碱基的条件不成立，则无需检查其他碱基，因此我有另一个 MaybeT< /code> 在堆栈中。

代码：

import Control.Monad.Maybe
import Control.Monad.State
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.Set as Set

type IsHappyMemo = State (Map.Map (Integer, Integer) Bool)

isHappy :: Set.Set Integer -> Integer -> Integer -> IsHappyMemo Bool
isHappy _ _ 1 = return True
isHappy path base num = do
  memo <- get
  case Map.lookup (base, num) memo of
    Just r -> return r
    Nothing -> do
      r <- calc
      when (num < 1000) . modify $ Map.insert (base, num) r
      return r
  where
    calc
      | num `Set.member` path = return False
      | otherwise = isHappy (Set.insert num path) base nxt
    nxt =
      sum . map ((^ (2::Int)) . (`mod` base)) .
      takeWhile (not . (== 0)) . iterate (`div` base) $ num

solve1 :: [Integer] -> IsHappyMemo Integer
solve1 bases =
  fmap snd .
  (`runStateT` 2) .
  runMaybeT .
  forever $ do
    (`when` mzero) . isJust =<<
      runMaybeT (mapM_ f bases)
    lift $ modify (+ 1)
  where
    f base = do
      cur <- lift . lift $ get
      happy <- lift . lift . lift $ isHappy Set.empty base cur
      unless happy mzero

solve :: [String] -> String
solve =
  concat .
  (`evalState` Map.empty) .
  mapM f .
  zip [1 :: Integer ..]
  where
    f (idx, prob) = do
      s <- solve1 . map read . words $ prob
      return $ "Case #" ++ show idx ++ ": " ++ show s ++ "\n"

main :: IO ()
main =
  getContents >>=
  putStr . solve . tail . lines

使用 Haskell 的其他参赛者确实有更好的解决方案 ，但解决问题的方式不同。我的问题是关于对我的代码进行小的迭代改进。

Answer 1

您的解决方案在使用（和滥用） monad 方面肯定很尴尬：

• 通常通过堆叠多个变压器来零碎地构建 monad
• 堆叠多个状态的情况不太常见，但有时仍然会发生
• 堆叠几个 Maybe 变压器是非常不寻常
• 的更不寻常的是使用 MaybeT 中断循环

您的代码有点太无意义了：

(`when` mzero) . isJust =<<
   runMaybeT (mapM_ f bases)

而不是更容易阅读

let isHappy = isJust $ runMaybeT (mapM_ f bases)
when isHappy mzero

现在关注函数solve1，让我们简化它。
一个简单的方法是删除内部 MaybeT monad。您可以反其道而行之，仅当满足以下条件时才递归，而不是在找到满意的数字时中断的永远循环
数不高兴。

此外，您也并不真正需要 State monad，不是吗？人们总是可以用明确的参数来代替状态。

应用这些想法solve1现在看起来好多了：

solve1 :: [Integer] -> IsHappyMemo Integer
solve1 bases = go 2 where
  go i = do happyBases <- mapM (\b -> isHappy Set.empty b i) bases
            if and happyBases
              then return i
              else go (i+1)

我会对这段代码更加满意。
你的解决方案的其余部分都很好。
困扰我的一件事是你为每个子问题都扔掉了备忘录缓存。这是有原因的吗？

solve :: [String] -> String
 solve =
    concat .
    (`evalState` Map.empty) .
    mapM f .
   zip [1 :: Integer ..]
  where
    f (idx, prob) = do
      s <- solve1 . map read . words $ prob
      return $ "Case #" ++ show idx ++ ": " ++ show s ++ "\n"

如果您重用它，您的解决方案不是会更有效吗？

solve :: [String] -> String
solve cases = (`evalState` Map.empty) $ do
   solutions <- mapM f (zip [1 :: Integer ..] cases)
   return (unlines solutions)
  where
    f (idx, prob) = do
      s <- solve1 . map read . words $ prob
      return $ "Case #" ++ show idx ++ ": " ++ show s

Answer 2

Monad* 类的存在是为了消除重复提升的需要。如果您像这样更改签名：

type IsHappyMemo = Map.Map (Integer, Integer) Bool

isHappy :: MonadState IsHappyMemo m => Set.Set Integer -> Integer -> Integer -> m Bool

这样您就可以删除大部分“电梯”。但是，最长的提升序列无法删除，因为它是 StateT 内的 State monad，因此使用 MonadState 类型类将为您提供外部 StateT，您需要在其中访问内部 State。您可以将 State monad 包装在新类型中并创建一个 MonadHappy 类，类似于现有的 monad 类。

Answer 3

ListT （来自 List 包）比 < code>MaybeT 在必要时停止计算。

solve1 :: [Integer] -> IsHappyMemo Integer
solve1 bases = do
  Cons result _ <- runList . filterL cond $ fromList [2..]
  return result
  where
    cond num = andL . mapL (isHappy Set.empty num) $ fromList bases

关于其工作原理的一些详细说明：

如果我们使用常规列表，代码将如下所示：

solve1 bases = do
  result:_ <- filterM cond [2..]
  return result
  where
    cond num = fmap and . mapM (isHappy Set.empty num) bases

此计算发生在 State monad 中，但如果我们想获得结果状态，我们' d 有一个问题，因为 filterM 运行它为 [2..]（一个无限列表）的每个元素获取的单子谓词。

对于一元列表，filterL cond (fromList [2..]) 表示一个列表，我们可以将其作为一元操作一次访问一项，因此我们的一元谓词 cond 除非我们消耗相应的列表项，否则实际上不会执行（并影响状态）。

类似地，如果我们已经从 isHappy 之一获得了 False 结果，则使用 andL 实现 cond 会使我们不再计算和更新状态。 Set.empty num计算。