pilha transformador mônada estranho

Question

Resolver um problema do Google Code Jam ( 2009.1AA: "felicidade multi-base" ) eu vim com uma) solução desajeitada (código-sábio, e eu estou interessado em saber como ele poderia ser melhorado.

A descrição do problema, logo, é: Encontre o menor número maior do que 1 para que iteratively calcular a soma dos quadrados dos dígitos chega a 1, para todas as bases de uma determinada lista .

Ou descrição em pseudo-Haskell (código que iria resolvê-lo se elem poderia sempre trabalho para listas infinitas):

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

E a minha solução desajeitada:

• Por que eu estranho significa que tem este tipo de código: happy <- lift . lift . lift $ isHappy Set.empty base cur
• I memoize resultados da função isHappy. Usando a Mônada Estado para os resultados memoized Mapa. ??
• Tentando encontrar a primeira solução, eu não usar head e filter (como o pseudo-haskell acima faz), porque o cálculo não é puro (muda de estado). Então eu iterado usando statet com um contador e um MaybeT para terminar o cálculo quando a condição se mantém.
• Já dentro de um MaybeT (StateT a (State b)), se a condição não se sustenta por uma base, não há necessidade de verificar os outros, então eu tenho outra MaybeT na pilha para isso.

Código:

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

Outros concorrentes usando Haskell tinha mais agradável soluções , mas resolveu o problema de forma diferente. Minha pergunta é sobre pequenas melhorias iterativos para o meu código.

Answer 1

A sua solução é certamente estranho no seu uso (e abuso) de mônadas:

• É comum monads construção fragmentada pelo empilhamento de vários transformadores
• É menos de costume, mas ainda acontece às vezes, para empilhar vários estados
• É muito incomum para empilhar vários Talvez transformadores
• É ainda mais raro usar MaybeT para interromper um loop

Seu código é um pouco inútil:

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

em vez do mais fácil de ler

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

Com foco agora na função solve1, vamos simplificá-lo. Uma maneira fácil de fazer isso é para remover a Mônada MaybeT interior. Em vez de um loop sempre que quebra quando um número feliz é encontrado, você pode ir por outro caminho e recurse somente se o número não é feliz.

Além disso, você realmente não precisa do Estado mônada quer, não é? Pode-se sempre substituir o Estado com um argumento explícito.

A aplicação dessas idéias solve1 agora parece muito melhor:

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)

Eu ficaria mais feliz han com esse código. O resto da sua solução está bem. Uma coisa que me incomoda é que você joga fora o cache memorando para cada subproblema. Existe uma razão para isso?

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"

Não seria a sua solução ser mais eficiente se você reutilizado em vez?

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

A Mônada * aulas existem para eliminar a necessidade de levantamento repetido. Se você alterar suas assinaturas como esta:

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

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

Desta forma, você pode remover a maioria dos 'do elevador. No entanto, a mais longa sequência de elevadores não pode ser removido, uma vez que é uma mônada Estado dentro de um statet, portanto, usando a classe tipo MonadState lhe dará a statet exterior, onde você precisa tot chegar ao estado interior. Você poderia envolver sua mônada Estado em um Newtype e fazer uma classe MonadHappy, similar às classes mônada existentes.

Answer 3

ListT (do pacote Lista ) faz um trabalho mais agradável tanto que MaybeT em parar o cálculo quando necessário.

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

Algumas elaboração sobre como isso funciona:

Se tivéssemos usado uma lista regularmente o código seria tinha olhado como esta:

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

Este cálculo acontece em uma mônada State, mas se nós gostaríamos de obter o estado resultante, teríamos um problema, porque filterM corre o predicado monádico ele ganha para cada elemento da [2..], uma lista infinita.

Com a lista monádico, filterL cond (fromList [2..]) representa uma lista que podemos acessar um item de cada vez como uma ação monádico, então o nosso cond predicado monádico não é realmente executada (e afetar o estado), a menos que consumir os itens da lista correspondente.

Da mesma forma, a implementação cond usando andL nos faz não calcular e actualizar o estado se já obteve um resultado False de um dos cálculos isHappy Set.empty num.