web-dev-qa-db-fra.com

Les monades gratuites sont-elles également applicables de manière zippante?

Je pense que j'ai trouvé une instance "zippy" Applicative intéressante pour Free .

data FreeMonad f a = Free (f (FreeMonad f a))
                   | Return a

instance Functor f => Functor (FreeMonad f) where
    fmap f (Return x) = Return (f x)
    fmap f (Free xs) = Free (fmap (fmap f) xs)

instance Applicative f => Applicative (FreeMonad f) where
    pure = Return

    Return f <*> xs = fmap f xs
    fs <*> Return x = fmap ($x) fs
    Free fs <*> Free xs = Free $ liftA2 (<*>) fs xs

C'est une sorte de stratégie Zip-long. Par exemple, en utilisant data Pair r = Pair r r comme foncteur (donc FreeMonad Pair est un arbre binaire étiqueté extérieurement):

    +---+---+    +---+---+               +-----+-----+
    |       |    |       |      <*>      |           |
 +--+--+    h    x   +--+--+    -->   +--+--+     +--+--+
 |     |             |     |          |     |     |     |
 f     g             y     z         f x   g x   h y   h z

Je n'ai vu personne mentionner cet exemple auparavant. Est-ce qu'il enfreint les lois Applicative? (Il n'est pas d'accord avec l'instance habituelle Monad bien sûr, qui est "substitutey" plutôt que "zippy".)

haskelltreemonadsapplicativefree-monad
24
Benjamin Hodgson

Oui , il semble que ce soit un Applicative légal. Bizarre!

Comme @ JosephSible le souligne , vous pouvez lire l'identité , l'homomorphisme et échangent les lois immédiatement des définitions. La seule ruse est la loi de composition .

pure (.) <*> u <*> v <*> w = u <*> (v <*> w)

Il y a huit cas à vérifier, alors attachez-vous.

  • Un cas avec trois Returns: pure (.) <*> Return f <*> Return g <*> Return z
    • Suit trivialement de l'associativité de (.).
  • Trois cas avec un Free:
    • pure (.) <*> Free u <*> Return g <*> Return z
      • En travaillant en arrière à partir de Free u <*> (Return g <*> Return z) vous obtenez fmap (\f -> f (g z)) (Free u), cela découle donc de la loi du foncteur.
    • pure (.) <*> Return f <*> Free v <*> Return z
fmap ($z) $ fmap f (Free v)
fmap (\g -> f (g z)) (Free v)                  -- functor law
fmap (f . ($z)) (Free v)
fmap f (fmap ($z) (Free v))                    -- functor law
Return f <$> (Free v <*> Return z)             -- RHS of `<*>` (first and second cases)
QED
    • pure (.) <*> Return f <*> Return g <*> Free w
      • Réduit immédiatement à fmap (f . g) (Free w), découle donc de la loi de foncteur.
  • Trois cas avec un Return: 
    • pure (.) <*> Return f <*> Free v <*> Free w
Free $ fmap (<*>) (fmap (fmap (f.)) v) <*> w
Free $ fmap (\y z -> fmap (f.) y <*> z) v <*> w                  -- functor law
Free $ fmap (\y z -> fmap (.) <*> Return f <*> y <*> z) v <*> w  -- definition of fmap, twice
Free $ fmap (\y z -> Return f <*> (y <*> z)) v <*> w             -- composition
Free $ fmap (\y z -> fmap f (y <*> z)) v <*> w                   -- RHS of fmap, definition of liftA2
Free $ fmap (fmap f) $ fmap (<*>) v <*> w                        -- functor law, eta reduce
fmap f $ Free $ liftA2 (<*>) v w                                 -- RHS of fmap
Return f <*> Free v <*> Free w                                   -- RHS of <*>
QED.

    • pure (.) <*> Free u <*> Return g <*> Free w
Free ((fmap (fmap ($g))) (fmap (fmap (.)) u)) <*> Free w
Free (fmap (fmap (\f -> f . g) u)) <*> Free w                    -- functor law, twice
Free $ fmap (<*>) (fmap (fmap (\f -> f . g)) u) <*> w
Free $ fmap (\x z -> fmap (\f -> f . g) x <*> z) u <*> w         -- functor law
Free $ fmap (\x z -> pure (.) <*> x <*> Return g <*> z) u <*> w
Free $ fmap (\x z -> x <*> (Return g <*> z)) u <*> w             -- composition
Free $ fmap (<*>) u <*> fmap (Return g <*>) w                    -- https://Gist.github.com/benjamin-hodgson/5b36259986055d32adea56d0a7fa688f
Free u <*> fmap g w                                              -- RHS of <*> and fmap
Free u <*> (Return g <*> w)
QED.

    • pure (.) <*> Free u <*> Free v <*> Return z
Free (fmap (<*>) (fmap (fmap (.)) u) <*> v) <*> Return z
Free (fmap (\x y -> fmap (.) x <*> y) u <*> v) <*> Return z        -- functor law
Free $ fmap (fmap ($z)) (fmap (\x y -> fmap (.) x <*> y) u <*> v)
Free $ liftA2 (\x y -> (fmap ($z)) (fmap (.) x <*> y)) u v         -- see Lemma, with f = fmap ($z) and g x y = fmap (.) x <*> y
Free $ liftA2 (\x y -> fmap (.) x <*> y <*> Return z) u v          -- interchange
Free $ liftA2 (\x y -> x <*> (y <*> Return z)) u v                 -- composition
Free $ liftA2 (\f g -> f <*> fmap ($z) g) u v                      -- interchange
Free $ fmap (<*>) u <*> (fmap (fmap ($z)) v)                       -- https://Gist.github.com/benjamin-hodgson/5b36259986055d32adea56d0a7fa688f
Free u <*> Free (fmap (fmap ($z)) v)
Free u <*> (Free v <*> Return z)
QED.
  • Trois Frees: pure (.) <*> Free u <*> Free v <*> Free w
    • Ce cas n'exerce que le cas Free/Free de <*>, Dont le côté droit est identique à celui de Compose<*>. Donc, celui-ci découle de l'exactitude de l'instance de Compose.

Pour le cas pure (.) <*> Free u <*> Free v <*> Return z j'ai utilisé un lemme:

Lemme : fmap f (fmap g u <*> v) = liftA2 (\x y -> f (g x y)) u v.

fmap f (fmap g u <*> v)
pure (.) <*> pure f <*> fmap g u <*> v  -- composition
fmap (f .) (fmap g u) <*> v             -- homomorphism
fmap ((f .) . g) u <*> v                -- functor law
liftA2 (\x y -> f (g x y)) u v          -- eta expand
QED.

Diversement, j'utilise le foncteur et les lois applicatives sous l'hypothèse d'induction.

C'était assez amusant à prouver! J'adorerais voir une preuve formelle dans Coq ou Agda (bien que je soupçonne que le vérificateur de terminaison/positivité pourrait le gâcher).

14
Benjamin Hodgson

Par souci d'exhaustivité, je vais utiliser cette réponse pour développer mon commentaire ci-dessus :

Bien que je n'aie pas vraiment écrit la preuve, je pense que les cas mixtes de libre et de retour de la loi sur la composition doivent tenir en raison de la paramétrie. Je soupçonne également que cela devrait être plus facile à montrer en utilisant la présentation monoïdale .

La présentation monoïdale de l'instance Applicative est la suivante:

unit = Return ()

Return x *&* v = (x,) <$> v
u *&* Return y = (,y) <$> u
-- I will also piggyback on the `Compose` applicative, as suggested above.
Free u *&* Free v = Free (getCompose (Compose u *&* Compose v))

Sous la présentation monoïdale, la loi de composition/associativité est:

(u *&* v) *&* w ~ u *&* (v *&* w)

Considérons maintenant l'un de ses cas mixtes; disons, le Free-Return-Free celui:

(Free fu *&* Return y) *&* Free fw ~ Free fu *&* (Return y *&* Free fw)

(Free fu *&* Return y) *&* Free fw -- LHS
((,y) <$> Free fu) *&* Free fw

Free fu *&* (Return y *&* Free fw) -- RHS
Free fu *&* ((y,) <$> Free fw)

Examinons de plus près ce côté gauche. (,y) <$> Free fu Applique (,y) :: a -> (a, b) Aux valeurs a trouvées dans Free fu :: FreeMonad f a. La paramétricité (ou, plus précisément, le théorème libre pour (*&*)) Signifie que cela n'a pas d'importance si nous le faisons avant ou après avoir utilisé (*&*). Cela signifie que le côté gauche équivaut à:

first (,y) <$> (Free fu *&* Free fw)

De façon analogue, le côté droit devient:

second (y,) <$> (Free fu *&* Free fw)

Puisque first (,y) :: (a, c) -> ((a, b), c) et second (y,) :: (a, c) -> (a, (b, c)) sont les mêmes jusqu'à la réassociation des paires, nous avons:

first (,y) <$> (Free fu *&* Free fw) ~ second (y,) <$> (Free fu *&* Free fw)
-- LHS ~ RHS

Les autres cas mixtes peuvent être traités de manière analogue. Pour le reste de la preuve, voir réponse de Benjamin Hodgson .

4
duplode

De la définition de Applicative :

Si f est également un Monad, il doit satisfaire

  • pure = return

  • (<*>) = ap

  • (*>) = (>>)

Donc, cette implémentation briserait les lois applicatives qui disent qu'elle doit être d'accord avec l'instance Monad.

Cela dit, il n'y a aucune raison pour laquelle vous ne pouviez pas avoir un wrapper newtype pour FreeMonad qui n'avait pas d'instance monad, mais qui avait l'instance d'application ci-dessus

newtype Zip f a = Zip { runZip :: FreeMonad f a }
  deriving Functor

instance Applicative f => Applicative (Zip f) where -- ...
3
rampion