Question

我认为我为Free提出了一个有趣的“ zippy” Applicative实例。

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

这是一种最长的策略。例如，使用data Pair r = Pair r r作为函子（因此FreeMonad Pair是外部标记的二进制树）：

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

我之前从未见过有人提到此实例。是否违反任何Applicative法律？（当然，这与通常的Monad实例不同，后者是“替代”而不是“ zippy”。）

Answer 1

是，看来这是合法的Applicative。奇怪！

与@JosephSible points out一样，您可以立即从定义中读取身份，<同态和互换定律。唯一棘手的是组成定律。

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

有八种情况需要检查，所以请系好皮带。

一个案例包含三个Return：pure (.) <*> Return f <*> Return g <*> Return z
- 简单地遵循(.)的关联性。

三个案例中有一个Free：

pure (.) <*> Free u <*> Return g <*> Return z
- 从Free u <*> (Return g <*> Return z)向后工作，您会得到fmap (\f -> f (g z)) (Free u)，因此这遵循函子定律。

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
- 立即降到fmap (f . g) (Free w)，因此遵循函子定律。

三个案例中有一个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.

三个Free：pure (.) <*> Free u <*> Free v <*> Free w
- 此案例仅适用于Free的{{1}} / Free案例，其右手边与Compose的<*>相同。因此，这是基于<*>实例的正确性。

对于Compose案例，我使用了引理：

引理：pure (.) <*> Free u <*> Free v <*> Return z。

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

在归纳假设下，我经常使用函子和应用定律。

证明这很有趣！我很想在Coq或Agda中看到正式的证明（尽管我怀疑终止/阳性检查器可能会弄乱它）。

Answer 2

出于完整性考虑，我将使用此答案在my comment above上进行扩展：

尽管我实际上并没有写下证明，但我相信由于参数性的原因，组合法的自由和收益混合案例必须成立。我还怀疑使用the monoidal presentation可以更容易地显示它。

Applicative实例的单等形式表示为：

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))

在等分表示下，组成/缔合律是：

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

现在让我们考虑一下它的混合情况之一；例如，Free-Return-Free一个：

(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)

让我们仔细看看左侧。 (,y) <$> Free fu将(,y) :: a -> (a, b)应用于a中的Free fu :: FreeMonad f a值。参数性（或更具体地讲，(*&*)的自由定理）意味着无论我们在使用(*&*)之前还是之后都这样做。这意味着左侧为：

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

类似地，右侧变为：

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

由于first (,y) :: (a, c) -> ((a, b), c)和second (y,) :: (a, c) -> (a, (b, c))在重新关联之前都是相同的，所以我们有：

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

其他混合情况也可以类似地处理。有关其余证明，请参见Benjamin Hodgson's answer。

Answer 3

来自definition of Applicative：

如果f也是Monad，它应该满足



pure = return



(<*>) = ap



(*>) = (>>)

因此，此实现将违反适用法律，即必须与Monad实例相符。

也就是说，没有理由您没有FreeMonad的新型包装器，该包装器没有monad实例，但确实具有上述适用实例

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

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

免费的monad是否也适用于拉链？

3 个答案: