pila scomoda del trasformatore della monade

Question

Risoluzione di un problema da Google Code Jam ( 2009.1AA: " Felicità multi-base " ) Mi è venuta in mente una soluzione imbarazzante (per quanto riguarda il codice) e sono interessato a come potrebbe essere migliorato.

La descrizione del problema, a breve, è: trova il numero più piccolo più grande di 1 per il quale il calcolo iterativo della somma dei quadrati delle cifre raggiunge 1, per tutte le basi di un dato elenco.

O descrizione in pseudo-Haskell (codice che lo risolverebbe se elem potesse sempre funzionare per infiniti elenchi):

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

E la mia soluzione imbarazzante:

• Per imbarazzante intendo che ha questo tipo di codice: happy <- lift . lift . lift $ isHappy Set.empty base cur
• Memorizzo i risultati della funzione isHappy. Utilizzo della monade di stato per la mappa dei risultati memorizzata.
• Cercando di trovare la prima soluzione, non ho usato head e filter (come fa lo pseudo-haskell sopra), perché il calcolo non è puro (cambia stato). Quindi ho ripetuto usando StateT con un contatore e MaybeT per terminare il calcolo quando la condizione è valida.
• Già all'interno di un MaybeT (StateT a (State b)), se la condizione non vale per una base, non è necessario controllare le altre, quindi ne ho un'altra MaybeT nello stack.

Codice:

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

Altri concorrenti che utilizzavano Haskell avevano soluzioni migliori , ma risolto il problema in modo diverso. La mia domanda riguarda piccoli miglioramenti iterativi del mio codice.

Answer 1

La tua soluzione è certamente imbarazzante nel suo uso (e abuso) delle monadi:

• È solito costruire monadi frammentariamente impilando diversi trasformatori
• È meno usuale, ma a volte succede, impilare diversi stati
• È molto insolito impilare diversi trasformatori Forse
• È ancora più insolito usare MaybeT per interrompere un loop

Il tuo codice è un po 'troppo inutile:

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

invece di più facile da leggere

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

Concentrandoci ora sulla funzione solving1, semplifichiamolo. Un modo semplice per farlo è rimuovere la monade MaybeT interna. Invece di un ciclo per sempre che si interrompe quando viene trovato un numero felice, puoi fare il contrario e ricorrere solo se il il numero non è felice.

Inoltre, non hai nemmeno bisogno della monade dello stato, vero? Si può sempre sostituire lo stato con un argomento esplicito.

L'applicazione di queste idee per risolvere1 ora sembra molto meglio:

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)

Sarei più felice di quel codice. Il resto della tua soluzione va bene. Una cosa che mi preoccupa è che butti via la cache dei memo per ogni sottoproblema. C'è una ragione per questo?

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"

La tua soluzione non sarebbe più efficiente se la riutilizzassi?

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

Le classi Monad * esistono per rimuovere la necessità di ripetuti sollevamenti. Se cambi le firme in questo modo:

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

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

In questo modo è possibile rimuovere la maggior parte degli "ascensori". Tuttavia, la sequenza più lunga di ascensori non può essere rimossa, poiché è una monade di Stato all'interno di uno StateT, quindi l'uso della classe di tipo MonadState ti darà lo StateT esterno, dove devi raggiungere lo stato interno. Potresti avvolgere la tua monade di Stato in un tipo nuovo e creare una classe MonadHappy, simile alle classi di monade esistenti.

Answer 3

ListT (dal Elenco ) fa un lavoro molto più bello di MaybeT interrompendo il calcolo quando necessario.

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

Qualche elaborazione su come funziona:

Se avessimo usato un elenco regolare il codice sarebbe stato così:

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

Questo calcolo avviene in una State monade, ma se vorremmo ottenere lo stato risultante, avremmo un problema, perché filterM esegue il predicato monadico che ottiene per ogni elemento di [2..], un elenco infinito.

Con l'elenco monadico, filterL cond (fromList [2..]) rappresenta un elenco a cui possiamo accedere a un elemento alla volta come azione monadica, quindi il nostro predicato monadico cond non viene effettivamente eseguito (e influisce sullo stato) a meno che non consumiamo il voci dell'elenco corrispondenti.

Allo stesso modo, l'implementazione di andL usando False non ci fa calcolare e aggiornare lo stato se abbiamo già ottenuto un isHappy Set.empty num risultato da uno dei <=> calcoli.