是`data PoE a = Empty |配对a`a monad？

Question

这个问题来自这个答案在 example of a functor that is Applicative but not a Monad: 据称

data PoE a = Empty | Pair a a deriving (Functor,Eq)

不能有 monad 实例，但我没有看到它：

instance Applicative PoE where
    pure x = Pair x x
    Pair f g <*> Pair x y = Pair (f x) (g y)
    _        <*> _        = Empty
instance Monad PoE where
    Empty    >>= _ = Empty
    Pair x y >>= f = case (f x, f y) of 
                       (Pair x' _,Pair _ y') -> Pair x' y'
                       _ -> Empty

我认为这是一个 monad 的真正原因是它与 Maybe (Pair a) 和 Pair a = P a a 同构。它们都是单子，都是可遍历的，所以它们的组合也应该形成一个单子。 .

哪个反例不符合哪个单子法则？ （以及如何系统地找出答案？）

---

edit: 没想到大家对这个问题这么感兴趣。 "systematically"部分是接受最好的例子还是最好的答案，现在我要拿定主意了。

与此同时，我想想象一下 join 如何适用于更简单的 Pair a = P a a:

                   P
          ________/ \________
         /                   \
        P                     P
       / \                   / \
      1   2                 3   4

它总是走外部路径，产生 P 1 4，通常称为矩阵表示中的对角线。对于单子关联性，我需要三个维度，树可视化效果更好。取自 chi 的回答，这是 join 的失败示例，以及我如何理解它。

                  Pair
          _________/\_________
         /                    \
       Pair                   Pair
        /\                     /\
       /  \                   /  \
    Pair  Empty           Empty  Pair
     /\                           /\
    1  2                         3  4

现在您通过首先折叠较低级别来执行 join . fmap join，因为 join . join 从根折叠。

Answer 1

显然，它不是 monad。 monad“join”法则之一是

join . join = join . fmap join

因此，根据上面的定律，这两个输出应该相等，但它们不是。

main :: IO ()
main = do
  let x = Pair (Pair (Pair 1 2) Empty) (Pair Empty (Pair 7 8))
  print (join . join $ x)
  -- output: Pair 1 8
  print (join . fmap join $ x)
  -- output: Empty

问题在于

join x      = Pair (Pair 1 2) (Pair 7 8)
fmap join x = Pair Empty Empty

对它们执行额外的 join 并不能使它们相等。

how to find that out systematically?

join . join 的类型是 m (m (m a)) -> m (m a)，所以我从 triple-nested Pair-of-Pair-of-Pair 开始，使用数字 1..8。效果很好。然后，我试着在里面插入一些Empty，很快就找到了上面的反例

这种方法是可行的，因为 m (m (m Int)) 内部只包含有限数量的整数，而且我们只有构造函数 Pair 和 Empty 可以尝试。

对于这些检查，我发现 join 定律比 >>= 的结合律更容易测试。

Answer 2

QuickCheck 立即找到关联性的反例。

{-# LANGUAGE DeriveFunctor #-}

import Test.QuickCheck

data PoE a = Empty | Pair a a deriving (Functor,Eq, Show)

instance Applicative PoE where
    pure x = Pair x x
    Pair f g <*> Pair x y = Pair (f x) (g y)
    _        <*> _        = Empty
instance Monad PoE where
    Empty    >>= _ = Empty
    Pair x y >>= f = case (f x, f y) of 
                       (Pair x' _,Pair _ y') -> Pair x' y'
                       _ -> Empty

instance Arbitrary a => Arbitrary (PoE a) where
  arbitrary = oneof [pure Empty, Pair <$> arbitrary <*> arbitrary]

prop_assoc :: PoE Bool -> (Bool -> PoE Bool) -> (Bool -> PoE Bool) -> Property
prop_assoc m k h =
  ((m >>= k) >>= h) === (m >>= (\a -> k a >>= h))

main = do
  quickCheck $ \m (Fn k) (Fn h) -> prop_assoc m k h

输出：

*** Failed! Falsifiable (after 35 tests and 3 shrinks):    
Pair True False
{False->Pair False False, True->Pair False True, _->Empty}
{False->Pair False True, _->Empty}
Pair False True /= Empty

Answer 3

既然你对如何系统地做到这一点很感兴趣，这里是我用quickcheck找到一个反例的方法：

{-# LANGUAGE DeriveFunctor #-}

import Control.Monad ((>=>))
import Test.QuickCheck

-- <your code>

定义任意实例以生成随机PoEs。

instance (Arbitrary a) => Arbitrary (PoE a) where
    arbitrary = do
      emptyq <- arbitrary
      if emptyq
        then return Empty
        else Pair <$> arbitrary <*> arbitrary

并测试 monad 法则：

prop_right_id m = (m >>= return) == m
    where
    _types = (m :: PoE Int)

prop_left_id fun x = (return x >>= f) == f x
    where
    _types = fun :: Fun Int (PoE Int)
    f = applyFun fun

prop_assoc fun gun hun x = (f >=> (g >=> h)) x == ((f >=> g) >=> h) x
    where
    _types = (fun :: Fun Int (PoE Int),
              gun :: Fun Int (PoE Int),
              hun :: Fun Int (PoE Int),
              x :: Int)
    f = applyFun fun
    g = applyFun gun
    h = applyFun hun

我没有发现任何恒等律失败，但 prop_assoc 确实产生了一个反例：

ghci> quickCheck prop_assoc
*** Failed! Falsifiable (after 7 tests and 36 shrinks):
{6->Pair 1 (-1), _->Empty}
{-1->Pair (-3) (-4), 1->Pair (-1) (-2), _->Empty}
{-3->Empty, _->Pair (-2) (-4)}
6

并不是说它对理解为什么 失败有很大帮助，它确实为您提供了一个起点。如果我们仔细观察，我们会发现我们正在将 (-3) 和 (-2) 传递给第三个函数； (-3) 映射到 Empty 而 (-2) 映射到 Pair，所以我们不能遵从这两个单子中任何一个的规律 PoE 由.

Answer 4

这种潜在的Monad实例可以简明地描述为"taking the diagonal"。如果我们使用 join 表示，就更容易理解为什么。这是您提到的 Pair 类型的 join：

join (P (P a00 a11) (P a10 a11)) = P a00 a11

然而，采用对角线只能保证为固定长度（或无限）列表提供合法的 join。那是因为结合律：

join . join = join . fmap join

如果列表列表中的 n-th 列表没有 n-th 元素，它将导致对角线成为 trimmed：它将在其 n-th元素。 join . join 首先取外对角线（列表 列表 的列表），而 join . fmap join 首先取内对角线。对于不在 trim join . fmap join 的外对角线的最内层列表可能不够长，但它不可能影响 join . join。 （这会更容易用图片而不是文字来展示。）

您的 PoE 是 list-like 类型，没有固定长度（长度为零或二）。事实证明，采用它的对角线并不能给我们一个单子，因为上面讨论的潜在问题实际上会妨碍（如 所示）。

补充说明：

• 这正是 ZipList 不是 monad 的原因：快速行为相当于采用对角线。

• 无限列表与自然函数同构，固定长度列表与自然函数同构，直到适当的值。这意味着您可以从函数的实例中为它们获取一个 Monad 实例——您获得的实例同样相当于采用对角线。

• Once upon a time I got confused about this exact issue.

Answer 5

（将此作为单独的答案发布，因为它与我的另一个答案几乎没有重叠。）

The actual reason why I believe this to be a monad is that it is isomorphic to Maybe (Pair a) with Pair a = P a a. They are both monads, both traversables so their composition should form a monad, too. .

单子 m-over-n 与 n 可遍历的条件是：

-- Using TypeApplications notation to make the layers easier to track.
sequenceA @n @m . pure @n = fmap @m (pure @n)
sequenceA @n @m . fmap @n (join @m)
    = join @m . fmap @m (sequenceA @n @m) . sequenceA @n @m
sequenceA @n @m . join @n
    = fmap @m (join @n) . sequenceA @n @m . fmap @n (sequenceA @n @m)

（还有 sequenceA @n @m . fmap @n (pure @m) = pure @m，但始终成立。）

在我们的例子中，我们有 m ~ Maybe 和 n ~ Pair。 Pair 的相关方法定义为：

fmap f (P x y) = P (f x) (f y)
pure x = P x x
P f g <*> P x y = P (f x) (g y)
join (P (P a00 a01) (P a10 a11)) = P a00 a11 -- Let's pretend join is a method.
sequenceA (P x y) = P <$> x <*> y

让我们检查第三个属性:

sequenceA @n @m . join @n
    = fmap @m (join @n) . sequenceA @n @m . fmap @n (sequenceA @n @m)

-- LHS
sequenceA . join $ P (P a00 a01) (P a10 a11)
sequenceA $ P a00 a11
P <$> a00 <*> a11 -- Maybe (Pair a)

-- RHS
fmap join . sequenceA . fmap sequenceA $ P (P a00 a01) (P a10 a11)
fmap join . sequenceA $ P (P <$> a00 <*> a01) (P <$> a10 <*> a11)
fmap join $ P <$> (P <$> a00 <*> a01) <*> (P <$> a10 <*> a11)
fmap join $ (\x y z w -> P (P x y) (P z w)) <$> a00 <*> a01 <*> a10 <*> a11
(\x _ _ w -> P x w) <$> a00 <*> a01 <*> a10 <*> a11 -- Maybe (Pair a)

这些显然不一样：虽然任何 a 值都将专门从 a00 和 a11 中提取，但 a01 和 [=32= 的影响] 在 left-hand 端被忽略，但在 right-hand 端不会（换句话说，如果 a01 或 a10 是 Nothing，RHS 将是Nothing，但 LHS 不一定如此）。 LHS 正好对应 , and the RHS corresponds to the inner diagonal trimming described in .

中消失的 Empty

---

P.S.: 我忘了证明我们在这里讨论的 would-be 实例与问题中讨论的实例相同：

join' ::  m (n (m (n a))) -> m (n a)
join' = fmap @m (join @n) . join @m . fmap @m (sequenceA @n @m)

对于 m ~ Maybe 和 n ~ Pair，我们有：

join' :: Maybe (Pair (Maybe (Pair a))) -> Maybe (Pair a)
join' = fmap @Maybe (join @Pair) . join @Maybe . fmap @Maybe (sequenceA @Pair @Maybe)

join @Maybe . fmap @Maybe (sequenceA @Pair @Maybe) 表示 join' 将导致 Nothing，除非任何地方都没有 Nothing：

join' = \case
    Just (P (Just (P a00 a01)) (Just (P a10 a11))) -> _
    _ -> Nothing

计算非Nothing情况很简单：

fmap join . join . fmap sequenceA $ Just (P (Just (P a00 a01)) (Just (P a10 a11)))
fmap join . join $ Just (Just (P (P a00 a01) (P a10 a11)))
fmap join $ Just (P (P a00 a01) (P a10 a11))
Just (P a00 a11)

因此...

join' = \case
    Just (P (Just (P a00 _)) (Just (P _ a11))) -> Just (P a00 a11)
    _ -> Nothing

... 本质上等同于：

join = \case
    Pair (Pair a00 _) (Pair _ a11) -> Pair (a00 a11)
    _ -> Empty