Inconvenient Monad Transformer Block

Question

Solving the problem using Google Code Jam ( 2009.1AA: "Multifunctional happiness" ). I came up with an uncomfortable (code-wise), and I'm interested in how this can be improved.

Short description of the problem, soon: Find the smallest number greater than 1, for which the iterative calculation of the sum of the squares of the digits reaches 1, for all bases from the given list.

Or a description in pseudo-Haskell (code that would allow it if elem could always work for infinite lists):

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

And my inconvenient solution:

• Awkwardly, I mean that he has this code: happy <- lift . lift . lift $ isHappy Set.empty base cur happy <- lift . lift . lift $ isHappy Set.empty base cur
• I remember the results of the isHappy function. Using the state monad for a saved scorecard.
• Trying to find the first solution, I did not use head and filter (as the pseudo-haskell does), because the calculation is not clean (state of change). So I repeated using StateT using a counter and MaybeT to complete the calculation when the condition is met.
• Already inside a MaybeT (StateT a (State b)) , if the condition is not satisfied for one base, there is no need to check the others, so for this I need MaybeT in the stack as well.

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 

Other participants using Haskell did have nicer solutions , but solved the problem differently. My question is about small iterative improvements in my code.

Answer 1

Your solution is, of course, inconvenient to use (and abuse) monads:

• Usually build monads in parts by stacking several transformers.
• This is a less common occurrence, but it sometimes happens that for a stack of several states
• It is very difficult to stack several transformers. Maybe
• It’s even more unusual to use MaybeT to break the loop.

Your code is too pointless:

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

instead of simplified reading

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

Now let's focus on solve1 function, simplify it. An easy way to do this is to remove the MaybeT internal nun. Instead of a continuous loop that breaks when a lucky number is found, you can go the other way around and recurs only if the number is not satisfied.

In addition, you also do not need a state monad, do you? You can always replace a state with an explicit argument.

Applying these solve1 ideas now looks much better:

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

I would be happier with this code. The rest is your decision. My concern is that you throw away the memo cache for each subtask. Is there a reason for this?

 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" 

Wouldn't your solution be more effective if you reused it?

 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

There are Monad * classes to eliminate the need for re-raising. If you change your signatures as follows:

 type IsHappyMemo = Map.Map (Integer, Integer) Bool isHappy :: MonadState IsHappyMemo m => Set.Set Integer -> Integer -> Integer -> m Bool 

This way you can remove most of the "elevator". However, the longest sequence of elevators cannot be deleted, since it is a state monad inside StateT, so using a class like MonadState will give you an external StateT where you need it to get into the internal state. You can transfer your state monad to a new type and create a MonadHappy class, similar to existing monad classes.

Answer 3

ListT (from the List package) does a much MaybeT job than MaybeT when stopping the calculation if necessary.

 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 

Some information on how this works:

If we used a regular list, the code would look like this:

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

This calculation happens in the State monad, but if we want to get the resulting state, we will have a problem, because filterM runs the monadic predicate that it receives for each element [2..] , an infinite list.

With a monadic list, filterL cond (fromList [2..]) represents a list to which we can access one element at a time as a monadic action, so our monadic predicate cond does not actually execute (and does not affect the state) if we we do not consume the corresponding list items.

Similarly, the cond implementation using andL forces us not to compute and update the state if we already get the False result from one of the isHappy Set.empty num calculations.