Являются ли свободные монады аппликативными?

Я думаю, что я придумала интересный "быстрый" экземпляр Applicative 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

Это своего рода самая длинная стратегия. Например, используя data Pair r = Pair rr в качестве функтора (поэтому FreeMonad Pair представляет собой двоичное дерево с внешней меткой):

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

Я не видел, чтобы кто-нибудь упоминал этот случай раньше. Это нарушает какие-либо Applicative законы? (Конечно, это не согласуется с обычным экземпляром Monad, который является "заменой", а не "молниеносным".)

ОТВЕТЫ

Ответ 1

Да, похоже, это законный Applicative. Weird!

Как @JosephSible указует, вы можете считывать идентификационный, гомоморфизм и переставить законы непосредственно из определений. Единственный хитрый - это закон композиции.

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

Есть восемь случаев, чтобы проверить, так что пристегните.

  • Один случай с тремя Return s: pure (.) <*> Return f <*> Return g <*> Return z
    • Тривиально следует из ассоциативности (.).
  • Три случая с одним Free:
    • pure (.) <*> Free u <*> Return g <*> Return z
      • Работая в обратном направлении от Free u <*> (Return g <*> Return z) вы получаете fmap (\f → f (gz)) (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 s: pure (.) <*> Free u <*> Free v <*> Free w
    • В этом случае используется только случай Free/Free для <*>, правая часть которого совпадает с правой частью Compose <*>. Так что это следует из правильности экземпляра Compose.

Для pure (.) <*> Free u <*> Free v <*> Return z я использовал лемму:

Лемма: fmap f (fmap gu <*> v) = liftA2 (\xy → f (gxy)) uv.

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.

По-разному я использую функторные и аппликативные законы в предположении индукции.

Это было довольно весело доказать! Я хотел бы видеть формальное доказательство в Coq или Agda (хотя я подозреваю, что проверка завершения/положительности может испортить это).

Ответ 2

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

Хотя я на самом деле не записал доказательства, я считаю, что случаи смешанного освобождения и возврата закона композиции должны выполняться из-за параметричности. Я также подозреваю, что это должно быть легче показать, используя моноидальную презентацию.

Моноидальное представление экземпляра 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 fa. Параметричность (или, более конкретно, свободная теорема для (*&*)) означает, что не имеет значения, делаем ли мы это до или после использования (*&*). Это означает, что левая часть составляет:

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

Другие смешанные случаи могут рассматриваться аналогично. Для остальной части доказательства см. Ответ Бенджамина Ходжсона.

Ответ 3

Из определения Applicative:

Если f также является Monad, она должна удовлетворять

  • pure= return

  • (<*>)= ap

  • (*>)= (>>)

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

Тем не менее, нет никаких причин, по которым вы не могли иметь упаковщик FreeMonad для FreeMonad, у которого не было экземпляра монады, но имел вышеуказанный аппликативный экземпляр

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

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