Esempi di una monade la cui parte Applicativa può essere ottimizzata meglio della parte Monad

Question

In una discussione ho sentito che l'interfaccia Applicative di alcuni parser è implementata in modo diverso, più efficiente della loro interfaccia Monad. Il motivo è che con Applicative conosciamo tutti gli "effetti" in anticipo, prima che venga eseguito l'intero calcolo efficace. Con le monadi, gli effetti possono dipendere dai valori durante il calcolo, quindi questa ottimizzazione non è possibile.

Mi piacerebbe vedere alcuni buoni esempi di questo. Può essere un parser molto semplice o una monade diversa, non è importante. L'importante è che l'interfaccia Applicative di tale monade sia compatibile con il suo return e ap, ma utilizzando il codice Applicative produce codice più efficiente.

Aggiornamento: Giusto per chiarire, qui non mi interessano gli applicativi che non possono essere monadi. La domanda riguarda le cose che sono entrambe.

Answer 1

Un altro esempio è una piega a sinistra rigorosa. È possibile scrivere un'istanza applicativa che consente di comporre pieghe in modo tale che la piega risultante possa essere eseguita sui dati in un'unica passata e in uno spazio costante. Tuttavia, l'istanza monad deve ripetere l'iterazione dall'inizio dei dati per ciascun bind e conservare l'intera lista in memoria.

{-# LANGUAGE GADTs #-} 

import Criterion.Main 

import Data.Monoid 
import Control.Applicative 
import Control.Monad 

import Prelude hiding (sum) 

data Fold e r where 
    Step :: !(a -> e -> a) -> !a -> !(a -> r) -> Fold e r 
    Bind :: !(Fold e r) -> !(r -> Fold e s) -> Fold e s 

data P a b = P !a !b 

instance Functor (Fold e) where 
    fmap f (Step step acc ret) = Step step acc (f . ret) 
    fmap f (Bind fld g) = Bind fld (fmap f . g) 

instance Applicative (Fold e) where 
    pure a = Step const a id 
    Step fstep facc fret <*> Step xstep xacc xret = Step step acc ret where 
     step (P fa xa) e = P (fstep fa e) (xstep xa e) 
     acc = P facc xacc 
     ret (P fa xa) = (fret fa) (xret xa) 

    Bind fld g <*> fldx = Bind fld ((<*> fldx) . g) 
    fldf <*> Bind fld g = Bind fld ((fldf <*>) . g) 

instance Monad (Fold e) where 
    return = pure 
    (>>=) = Bind 

fold :: Fold e r -> [e] -> r 
fold (Step _ acc ret) [] = ret acc 
fold (Step step acc ret) (x:xs) = fold (Step step (step acc x) ret) xs 
fold (Bind fld g) lst = fold (g $ fold fld lst) lst 

monoidalFold :: Monoid m => (e -> m) -> (m -> r) -> Fold e r 
monoidalFold f g = Step (\a -> mappend a . f) mempty g 

count :: Num n => Fold e n 
count = monoidalFold (const (Sum 1)) getSum 

sum :: Num n => Fold n n 
sum = monoidalFold Sum getSum 

avgA :: Fold Double Double 
avgA = liftA2 (/) sum count 

avgM :: Fold Double Double 
avgM = liftM2 (/) sum count 

main :: IO() 
main = defaultMain 
    [ bench "Monadic"  $ nf (test avgM) 1000000 
    , bench "Applicative" $ nf (test avgA) 1000000 
    ] where test f n = fold f [1..n] 

aver scritto quanto sopra dalla parte superiore della mia testa come un esempio quindi potrebbe non essere l'implementazione ottimale per le pieghe applicative e monadici, ma in esecuzione quanto sopra mi dà:

benchmarking Monadic 
mean: 119.3114 ms, lb 118.8383 ms, ub 120.2822 ms, ci 0.950 
std dev: 3.339376 ms, lb 2.012613 ms, ub 6.215090 ms, ci 0.950 

benchmarking Applicative 
mean: 51.95634 ms, lb 51.81261 ms, ub 52.15113 ms, ci 0.950 
std dev: 850.1623 us, lb 667.6838 us, ub 1.127035 ms, ci 0.950 

Answer 2

Forse l'esempio canonico è dato dai vettori.

data Nat = Z | S Nat deriving (Show, Eq, Ord) 

data Vec :: Nat -> * -> * where 
    V0 ::     Vec Z x 
    (:>) :: x -> Vec n x -> Vec (S n) x 

Possiamo applicarli con un piccolo sforzo, prima definendo singleton, quindi avvolgendoli in una classe.

data Natty :: Nat -> * where 
    Zy :: Natty Z 
    Sy :: Natty n -> Natty (S n) 

class NATTY (n :: Nat) where 
    natty :: Natty n 

instance NATTY Z where 
    natty = Zy 

instance NATTY n => NATTY (S n) where 
    natty = Sy natty 

Ora noi possiamo sviluppare la struttura di Applicative

instance NATTY n => Applicative (Vec n) where 
    pure = vcopies natty 
    (<*>) = vapp 

vcopies :: forall n x. Natty n -> x -> Vec n x 
vcopies Zy  x = V0 
vcopies (Sy n) x = x :> vcopies n x 

vapp :: forall n s t. Vec n (s -> t) -> Vec n s -> Vec n t 
vapp V0   V0   = V0 
vapp (f :> fs) (s :> ss) = f s :> vapp fs ss 

Tralascio l'istanza Functor (che dovrebbe essere estratto tramite fmapDefault dall'istanza Traversable).

Ora, c'è un'istanza Monad corrispondente a questo Applicative, ma che cos'è? Pensiero diagonale! Questo è ciò che è richiesto! Un vettore può essere visto come la tabulazione di una funzione da un dominio finito, quindi lo Applicative è solo una tabella dei combinatori K e S e lo Monad ha un comportamento simile a Reader.

vtail :: forall n x. Vec (S n) x -> Vec n x 
vtail (x :> xs) = xs 

vjoin :: forall n x. Natty n -> Vec n (Vec n x) -> Vec n x 
vjoin Zy  _     = V0 
vjoin (Sy n) ((x :> _) :> xxss) = x :> vjoin n (fmap vtail xxss) 

instance NATTY n => Monad (Vec n) where 
    return = vcopies natty 
    xs >>= f = vjoin natty (fmap f xs) 

si potrebbe risparmiare un po 'definendo >>= più direttamente, ma in qualsiasi modo si taglia, il comportamento monadica crea thunk inutili per i calcoli off-diagonale. La pigrizia potrebbe salvarci dal rallentamento di un fattore di armageddon, ma il comportamento di zipping dello <*> è destinato ad essere almeno un po 'più economico rispetto alla diagonale di una matrice.

Answer 3

Come affermato da un allevatore, gli array sono l'esempio ovvio; il loro esempio monade non è solo un po 'più problematico sul piano concettuale con le lunghezze di tipo indicizzato ecc, ma svolge anche peggiore nel molto Data.Vector implementazione real-mondana:

import Criterion.Main 
import Data.Vector as V 

import Control.Monad 
import Control.Applicative 

functions :: V.Vector (Int -> Int) 
functions = V.fromList [(+1), (*2), (subtract 1), \x -> x*x] 

values :: V.Vector Int 
values = V.enumFromN 1 32 

type NRuns = Int 

apBencher :: (V.Vector (Int -> Int) -> V.Vector Int -> V.Vector Int) 
      -> NRuns -> Int 
apBencher ap' = run values 
where run arr 0 = V.sum arr 
     run arr n = run (functions `ap'` arr) $ n-1 

main = defaultMain 
     [ bench "Monadic"  $ nf (apBencher ap ) 4 
     , bench "Applicative" $ nf (apBencher (<*>)) 4 ] 

$ GHC-7.6 - O1 -o -fllvm -o bin/def0.hs bench-d0
$ panca-d0
riscaldamento fino
stima risoluzione orologio ...
media è 1,516,271 mila noi (640001 iterazioni)
trovato 3768 valori anomali tra 639.999 campioni (0,6%)
2924 (0.5%) ad alta grave
stima costo di una chiamata orologio ...
dire è 41.62906 ns (12 iterazioni)
trovati valori anomali 1 tra 12 campioni (8,3%)
1 (8,3%) di altezza grave

analisi comparativa Monadica
media: 2.773062 ms, lb 2.769786 ms, UB 2.779151 ms, cI 0.950
Std: 22,14,54 mille di noi, lb 13,55,686 mila noi, ub 36.88265 noi, ci 0,950

di benchmarking applicativo
media: 1. 269351 ms, lb 1.267654 ms, UB 1.271526 ms, CI 0.950
Std: 9.799454 noi, lb 8,171,284 mila noi, ub 13.09267 noi, Ci 0,950

Nota che non esce con la differenza di prestazioni quando compili con -O2; apparentemente ap è sostituito da <*> quindi. Ma >>= può solo allocare la giusta quantità di memoria dopo ogni chiamata di funzione e quindi mettere i risultati in posizione, che sembra essere piuttosto costosa nel tempo; mentre <*> può semplicemente precomputare la lunghezza del risultato come prodotto delle lunghezze functions e values e quindi scrivere su un array fisso.