Question

从Google Code Jam解决问题（2009.1A.A: "Multi-base happiness"）我提出了一个尴尬（代码方面）的解决方案，我对如何改进它感兴趣。

问题描述很快就是：找到大于1的最小数，对于所有来自给定列表的碱，迭代计算数字的平方和达到1。

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

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

我的尴尬解决方案：

尴尬我的意思是它有这样的代码：happy <- lift . lift . lift $ isHappy Set.empty base cur
我记得isHappy函数的结果。使用State monad作为memoized results Map。
试图找到第一个解决方案，我没有使用head和filter（就像上面的伪haskell一样），因为计算不纯（改变状态）。所以我通过使用带有计数器的StateT和一个MaybeT来迭代，以便在条件成立时终止计算。
已经在MaybeT (StateT a (State b))内，如果条件不适用于一个基数，则无需检查其他基数，因此我在堆栈中有另一个MaybeT。

代码：

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的其他参赛者确实有nicer solutions，但以不同方式解决了问题。我的问题是关于我的代码的小迭代改进。

Answer 1

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

通常通过堆叠几个变形金刚来构建monadal
不太常见，但有时仍会发生堆叠多个状态
堆叠几个Maybe变形金刚是非常不寻常的
使用MaybeT来中断循环更为不寻常

你的代码有点过于无意义了：

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

而不是更容易阅读

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

现在关注功能solve1，让我们简化它。一个简单的方法是删除内在的MaybeT 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 monad包装为newtype并创建一个MonadHappy类，类似于现有的monad类。

Answer 3

ListT（来自List包）在必要时停止计算时比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中，但如果我们想得到结果状态，我们就会遇到问题，因为filterM运行它为每个元素得到的monadic谓词[2..]，无限列表。

使用monadic列表，filterL cond (fromList [2..])表示一个列表，我们可以一次访问一个项目作为monadic动作，因此我们的monadic谓词cond实际上并未执行（并影响状态）除非我们使用相应的列表项。

同样，如果我们已经从cond计算之一得到andL结果，那么使用False实施isHappy Set.empty num会使我们无法计算和更新状态。

尴尬的monad变压器堆栈

3 个答案:

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