Exemples de monade dont la partie Applicative peut être mieux optimisée que la partie Monad

Question

Dans une discussion, j'ai entendu que Applicative de certains analyseurs syntaxiques est implémentée différemment, plus efficacement que leur Monad interface. La raison en est qu'avec Applicative nous connaissons tous les "effets" à l'avance, avant que l'ensemble du calcul effectif ne soit exécuté. Avec les monades, les effets peuvent dépendre de valeurs pendant le calcul, cette optimisation n'est donc pas possible.

J'aimerais voir de bons exemples de cela. Il peut s'agir d'un parseur très simple ou d'une monade différente, ce n'est pas important. L'important est que le Applicative l'interface d'une telle monade est conforme à son return y ap mais en utilisant le Applicative produit un code plus efficace.

Mise à jour : Juste pour clarifier, ici je ne suis pas intéressé par les applicatifs qui ne peuvent pas être des monades. La question porte sur les choses qui sont les deux.

Answer 1

Un autre exemple est le pliage strict à gauche. Vous pouvez écrire une instance applicative qui vous permet de composer des plis de sorte que le pli résultant puisse être exécuté sur les données en une seule passe et à espace constant. Cependant, l'instance de monade doit réitérer depuis le début des données pour chaque pli et garder la liste entière en mémoire.

{-# 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]

J'ai écrit ce qui précède à titre d'exemple et il se peut que ce ne soit pas l'implémentation optimale pour les plis applicatifs et monadiques, mais l'exécution de ce qui précède me donne.. :

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

L'exemple canonique est peut-être donné par les vecteurs.

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

Nous pouvons les rendre applicatifs avec un petit effort, en définissant d'abord les singletons, puis en les enveloppant dans une 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

Nous pouvons maintenant développer le Applicative structure

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

J'omets le Functor (qui devrait être extraite via fmapDefault de la Traversable instance).

Maintenant, il y a un Monad correspondant à cette Applicative mais qu'est-ce que c'est ? La pensée diagonale ! C'est ce qu'il faut ! Un vecteur peut être considéré comme la tabulation d'une fonction à partir d'un domaine fini, d'où l'expression "vecteur". Applicative n'est qu'un tableau des combinaisons K et S, et l'élément Monad a un Reader -un comportement similaire.

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)

Vous pouvez économiser un peu en définissant >>= plus directement, mais quelle que soit la façon dont vous le faites, le comportement monadique crée des thunks inutiles pour les calculs hors diagonale. La paresse pourrait nous éviter de ralentir par un facteur d'armageddon, mais le comportement de zippage de l'élément <*> est forcément un peu moins cher que de prendre la diagonale d'une matrice.

Answer 3

Comme l'a dit Pigworker, les tableaux sont un exemple évident ; leur instance monad n'est pas seulement un peu plus problématique sur le plan conceptuel avec des longueurs indexées par type, etc. Data.Vector mise en œuvre :

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/bench-d0 def0.hs
$ banc-d0
le réchauffement
estimation de la résolution de l'horloge...
la moyenne est de 1.516271 us (640001 itérations)
trouvé 3768 aberrations parmi 639999 échantillons (0,6%)
  2924 (0,5%) élevé grave
estimation du coût d'un appel d'horloge...
la moyenne est de 41.62906 ns (12 itérations)
a trouvé 1 cas aberrant parmi 12 échantillons (8,3%)
  1 (8,3 %) élevé grave

évaluation comparative Monadic
moyen : 2.773062 ms, lb 2.769786 ms, ub 2.779151 ms, ci 0.950
écart-type : 22.14540 us, lb 13.55686 us, ub 36.88265 us, ci 0.950

benchmarking Applicatif
moyenne : 1,269351 ms, lb 1,267654 ms, ub 1,271526 ms, ci 0,950
écart-type : 9.799454 us, lb 8.171284 us, ub 13.09267 us, ci 0.950

Notez que la différence de performance n'apparaît pas lorsque vous compilez avec -O2 ; apparemment ap est remplacé par <*> puis. Mais >>= peut seulement allouer la bonne quantité de mémoire après chaque appel de fonction et ensuite mettre les résultats en place, ce qui semble être assez coûteux en temps ; alors que <*> peut simplement précalculer la longueur du résultat comme le produit de functions y values longueurs, et ensuite écrire dans un tableau fixe.