4

Google Code Jam の問題解決 ( 2009.1AA: "マルチベースの幸福" ) 厄介な (コード単位の) 解決策を思いついたので、それをどのように改善できるか興味があります。

簡単に言えば、問題の説明は次のとおりです。指定されたリストのすべての基数について、数字の二乗和を繰り返し計算すると 1 に達する、1 より大きい最小の数を見つけます。

elemまたは擬似Haskellでの説明（無限リストに対して常に機能する場合に解決するコード）：

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

そして私の厄介な解決策：

  • ぎこちないというのは、この種のコードがあることを意味します。happy <- lift . lift . lift $ isHappy Set.empty base cur
  • isHappy 関数の結果をメモします。メモ化された結果マップに State モナドを使用する。
  • 最初の解決策を見つけようとして、 (上記の疑似 Haskell のように) headand を使用しませんでした。これは、計算が純粋ではない (状態が変化する) ためです。filterそのため、StateT をカウンターと共に使用して反復し、条件が満たされたときに計算を終了するために MaybeT を使用しました。
  • すでに a の中にありMaybeT (StateT a (State b))、条件が 1 つのベースに当てはまらない場合、他のベースをチェックする必要はないので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

あなたのソリューションは、モナドの使用（および乱用）において確かに厄介です。

  • いくつかのトランスフォーマーを積み重ねてモナドを少しずつ構築するのが普通です
  • あまり一般的ではありませんが、いくつかの状態を積み重ねることはまだ時々起こります
  • メイビートランスフォーマーを何個も重ねるなんて珍しいですね
  • ループを中断するために MaybeT を使用するのはさらに珍しいことです

あなたのコードは少し無意味です:

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

読みやすくする代わりに

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

関数 solve1 に注目して、単純化してみましょう。これを行う簡単な方法は、内側の MaybeT モナドを削除することです。幸せな数が見つかったときに壊れる永遠のループの代わりに、反対の方向に進み、その数が幸せでない場合にのみ再帰することができます。

さらに、 State モナドも本当に必要ありませんよね？状態はいつでも明示的な引数に置き換えることができます。

これらのアイデア 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)

私はそのコードにもっと満足しています。残りのソリューションは問題ありません。私が気になることの 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モナドであるため、リフトの最長シーケンスを削除することはできません。したがって、MonadState型クラスを使用すると、内側のStateに到達する必要がある外側のStateTが得られます。Stateモナドを新しいタイプでラップし、既存のモナドクラスと同様にMonadHappyクラスを作成できます。

于 2009-09-18T14:31:27.777 に答える
0

ListT（リスト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モナドで行われますが、結果の状態を取得したい場合は、問題が発生します。これは、無限リストfilterMのすべての要素に対して取得するモナド述語を実行するためです。[2..]

モナディックリストでfilterL cond (fromList [2..])は、モナディックアクションとして一度に1つのアイテムにアクセスできるリストを表します。したがってcond、対応するリストアイテムを消費しない限り、モナディック述語は実際には実行されません（状態に影響しません）。

同様に、condusingを実装すると、計算の1つからすでに結果andLが得られている場合、状態を計算および更新しなくなります。FalseisHappy Set.empty num

于 2011-02-22T20:19:59.693 に答える