4

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

简而言之，问题描述是：对于给定列表中的所有碱基，找到大于 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 用于记忆结果 Map。
  • 试图找到第一个解决方案，我没有使用headand filter（就像上面的伪 Haskell 一样），因为计算不是纯粹的（改变状态）。因此，我通过使用带有计数器的 StateT 和 MaybeT 进行迭代，以在条件成立时终止计算。
  • 已经在 aMaybeT (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 的参赛者确实有更好的解决方案，但解决问题的方式不同。我的问题是关于对我的代码进行小的迭代改进。

4

3 回答 3

5

您的解决方案在使用（和滥用）单子时肯定很尴尬：

  • 通常通过堆叠几个变压器来零碎地构建单子
  • 堆叠多个状态不太常见，但有时仍会发生
  • 堆叠几个 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
于 2009-09-18T16:11:10.523 回答
4

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

于 2009-09-18T14:31:27.777 回答
0

ListT（来自ListMaybeT包）比在必要时停止计算要好得多。

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

这个计算发生在一个Statemonad 中，但是如果我们想要得到结果状态，我们就会遇到问题，因为运行它为 的每个元素（一个无限列表）filterM获取的 monadic 谓词。[2..]

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

类似地，如果我们已经从其中一个计算中获得了结果，那么实现condusing会使我们不计算和更新状态。andLFalseisHappy Set.empty num

于 2011-02-22T20:19:59.693 回答