Примеры монады, чья аппликативная часть может быть лучше оптимизирована, чем часть Монады

Ответ 1

Другим примером является строгая левая складка. Вы можете написать аппликативный экземпляр, который позволяет создавать складки так, чтобы получившаяся сводка могла выполняться на данных за один проход и постоянное пространство. Тем не менее, экземпляр monad должен повторно итерации с начала данных для каждого связывания и сохранить весь список в памяти.

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

Я написал выше из верхней части головы в качестве примера, так что это может быть не оптимальная реализация аппликативных и монадических складок, но выполнение приведенного выше дает мне:

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

Ответ 2

Возможно, канонический пример задается векторами.

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

Мы можем сделать их аппликативными с небольшим усилием, сначала определяя одиночные числа, а затем завершая их в класс.

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

Теперь мы можем разработать структуру 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

Я опускаю экземпляр Functor (который должен быть извлечен через fmapDefault из экземпляра Traversable).

Теперь существует экземпляр Monad, соответствующий этому Applicative, но что это такое? Диагональное мышление! Это то, что нужно! Вектор можно рассматривать как табуляцию функции из конечной области, поэтому Applicative является просто таблицей K- и S-комбинаторов, а Monad имеет поведение 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)

Вы можете немного сэкономить, указав >>= более прямо, но каким бы способом вы его не отрезали, монадическое поведение создает бесполезные трюки для недиагональных вычислений. Лень может спасти нас от замедления с помощью армагеддона, но поведение застежки <*> должно быть по крайней мере немного дешевле, чем брать диагональ матрицы.

Ответ 3

Как сказал свиновод, массивы - очевидный пример; их экземпляр монады не только немного более проблематичен на концептуальном уровне с индексами, индексированными по типу и т.д., но и хуже работает в очень реалистичной реализации Data.Vector:

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
$ bench-d0
разогрев
оценка разрешения часов...
означает 1,516271 нас (640001 итераций)
найдено 3768 выбросов среди 639999 образцов (0,6%)
2924 (0,5%) высокая степень тяжести
оценка стоимости часового звонка...
среднее значение - 41,62906 нс (12 итераций)
найдено 1 выброс среди 12 образцов (8,3%)
1 (8,3%) с высокой степенью тяжести

бенчмаркинг Monadic
среднее значение: 2,773062 мс, фунт 2,769786 мс, ub 2,779151 мс, ci 0,950
std dev: 22.14540 us, lb 13.55686 us, ub 36.88265 us, ci 0.950

сравнительный анализ среднее значение: 1.269351 мс, фунт 1.267654 мс, ub 1.271526 мс, ci 0,950
std dev: 9.799454 us, lb 8.171284 us, ub 13.09267 us, ci 0.950

Обратите внимание, что при компиляции с -O2 он не отличается разницей в производительности; очевидно, ap заменяется на <*>. Но >>= может выделять нужное количество памяти после каждого вызова функции, а затем помещать результаты на место, что, по-видимому, довольно дорогое время; тогда как <*> может просто прекомпотировать длину результата как произведение длин functions и values, а затем записать в один фиксированный массив.