厄介なモナド変換器スタック

StackOverflow https://stackoverflow.com/questions/1441469

  •  10-07-2019
  •  | 
  •  

質問

Google Code Jamの問題の解決（ 2009.1AA： <！> quot; Multi-base happiness <！> quot; ）厄介な（コードごとの）ソリューションを思いついたのですが、どうすれば改善できるか興味があります。

問題の説明は、簡単に言うと、与えられたリストのすべての基数について、1より大きい最小数を見つけて、2乗和を繰り返し計算して1に達することです。

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

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

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

  • 厄介なのは、この種のコードがあることを意味します：happy <- lift . lift . lift $ isHappy Set.empty base cur
  • isHappy関数の結果をメモします。メモ化された結果マップにStateモナドを使用します。
  • 最初の解決策を見つけようとして、headとfilterを使用しませんでした（上記の擬似ハスケルのように）。計算は純粋ではない（状態を変更する）からです。そこで、StateTをカウンターで使用し、MaybeTを使用して、条件が満たされたときに計算を終了することで繰り返しました。
  • すでに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を使用している他の参加者は、より優れたソリューション、しかし問題は別様に解決しました。私の質問は、コードの小さな反復的な改善についてです。

役に立ちましたか？

解決

あなたの解決策は、モナドの使用（および乱用）において確かに厄介です：

  • 通常、複数のトランスフォーマーをスタックしてモナドを断片的に構築します
  • あまり一般的ではありませんが、いくつかの状態をスタックすることが時々起こります
  • 複数のトランスフォーマーをスタックすることは非常にまれです
  • 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

他のヒント

Monad *クラスは、繰り返し持ち上げる必要をなくすために存在します。このように署名を変更した場合：

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

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

この方法で、ほとんどの「リフト」を削除できます。ただし、最も長いリフトのシーケンスは、StateT内のStateモナドであるため削除できません。したがって、MonadStateタイプクラスを使用すると、外側のStateTが得られ、内側のStateに到達する必要があります。 Stateモナドをnewtypeでラップし、既存のモナドクラスと同様のMonadHappyクラスを作成できます。

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

モナドリストでは、filterL cond (fromList [2..])はモナドアクションとして一度に1つの項目にアクセスできるリストを表すため、モナド述語condは実際に実行されません（そして状態に影響を与えます）対応するリスト項目。

同様に、andLを使用してFalseを実装すると、既にisHappy Set.empty num計算のいずれかから<=>の結果が得られている場合、状態を計算および更新しません。

ライセンス： CC-BY-SA と 帰属
所属していません StackOverflow
scroll top