Pregunta

La solución de un problema de Google Code Jam (2009.1 A. A:"Multi-base de la felicidad") Se me ocurrió con un incómodo (código-wise) de la solución, y estoy interesado en cómo se podría mejorar.

La descripción del problema, en breve, es:Encontrar el número más pequeño mayor que 1 para que de forma iterativa el cálculo de la suma de los cuadrados de los dígitos llega a 1, para todas las bases de una determinada lista.

O descripción en pseudo-Haskell (código que se resolvería si elem siempre se puede trabajar para listas infinitas):

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

Y mi torpe solución:

  • Por torpe me refiero a que tiene este tipo de código: happy <- lift . lift . lift $ isHappy Set.empty base cur
  • Yo memoize resultados de la isHappy función.Utilizando el Estado de mónada, para la memoized los resultados de la Mapa.
  • Tratando de encontrar la primera solución, yo no uso head y filter (como la pseudo-haskell anterior no hace), porque el cálculo no es puro (cambios de estado).Así que me reiterado por el uso de StateT con un contador, y un MaybeT para terminar el cálculo cuando la condición se mantiene.
  • Ya en el interior de un MaybeT (StateT a (State b)), si la condición no se cumpla para una base, no es necesario comprobar las otras, así que tengo otro MaybeT en la pila para que.

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

Otros concursantes con Haskell tenía mejor de las soluciones, pero resuelto el problema de manera diferente.Mi pregunta es acerca de las pequeñas mejoras iterativas a mi código.

¿Fue útil?

Solución

Su solución es ciertamente incómodo en su uso (y abuso) de las mónadas:

  • Es habitual para construir las mónadas fragmentaria por el apilamiento de varios transformadores
  • Es menos habitual, pero aún así sucede a veces, a la pila de varios estados
  • Es muy inusual para apilar varios transformadores tal vez
  • Es aún más raro usar MaybeT para interrumpir un bucle

El código es un poco sin sentido :

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

en lugar de los más fáciles de leer

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

Centrándonos ahora en función de solve1, nos vamos a simplificar.Una manera fácil de hacerlo es quitar el interior MaybeT mónada.En lugar de un eterno bucle, que se rompe cuando un feliz se encuentra el número, usted puede ir al revés y recurse sólo si el el número no es feliz.

Además, usted realmente no necesita el Estado de mónada, o bien, no ?Uno siempre puede sustituir al estado con un argumento explícito.

La aplicación de estas ideas solve1 ahora se ve mucho mejor:

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)

Yo sería más han feliz con ese código.El resto de la solución es buena.Una cosa que me molesta es que tire a la basura el memo de caché para cada subproblem.Hay una razón para eso?

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"

No de su solución, de ser más eficiente si se vuelve a utilizar en lugar ?

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

Otros consejos

La Mónada* existen clases para eliminar la necesidad de repetir la elevación.Si usted cambia su firma como esta:

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

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

De esta manera usted puede eliminar la mayoría de los 'lift.Sin embargo, la secuencia más larga de los ascensores no puede ser eliminado, ya que es un Estado de mónada, dentro de un StateT, por lo que el uso de la MonadState tipo de clase le dará el exterior StateT, donde usted necesita tot llegar al interior del Estado.Usted podría ajustar su Estado de mónada en un newtype y hacer un MonadHappy clase, similar a los existentes en la mónada de las clases.

ListT (a partir de la Lista paquete) hace un mucho mejor trabajo que MaybeT para detener el cálculo cuando sea necesario.

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

Algunas explicaciones sobre cómo funciona esto:

Tuvo que utilizar una lista regular, el código se había parecido a esto:

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

Este cálculo se realiza en un State mónada, pero si que nos gustaría obtener el estado resultante, tendríamos un problema, porque filterM ejecuta el predicado monádico se obtiene por cada elemento de [2..], una lista infinita.

Con la monádica de la lista, filterL cond (fromList [2..]) representa una lista que podemos acceder a un elemento en un tiempo como un monádico de acción, por lo que nuestro predicado monádico cond no es realmente ejecutada (y que afectan el estado), a menos que consumimos los correspondientes elementos de la lista.

Del mismo modo, la aplicación de cond el uso de andL no nos convierte en calcular y actualizar el estado si ya obtuvimos un False el resultado de uno de los isHappy Set.empty num los cálculos.

Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top