Is 'data PoE a = Empty | Пара аа 'монады?

Ответ 1

По-видимому, это не монада. Один из законов монада " 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 на них не делает их равными.

как найти это систематически?

join. join join. join имеет тип m (m (ma)) → m (ma), поэтому я начал с тройной Pair -of- Pair -of- Pair, используя номера 1..8. Это сработало хорошо. Затем я попытался вставить несколько Empty внутри и быстро нашел встречный пример выше.

Такой подход был возможен, так как m (m (m Int)) содержит только конечное количество целых чисел внутри, и у нас есть только конструкторы Pair и Empty чтобы попробовать.

Для этих проверок я считаю, что закон join легче тестировать, чем, скажем, ассоциативность >>=.

Ответ 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

Ответ 3

Поскольку вы заинтересованы в том, как это сделать систематически, вот как я нашел контрпример с помощью quickcheck:

{-# LANGUAGE DeriveFunctor #-}

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

-- <your code>

Определение произвольного экземпляра для генерации случайных PoE s.

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

И тесты для законов монады:

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.

Ответ 4

Этот тип потенциального экземпляра Monad можно кратко описать как "взятие диагонали". Легче понять, почему, если мы используем презентацию join. Здесь вы join к типу Pair вы упоминаете:

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

Однако брать диагональ гарантирует только законное join для фиксированных (или бесконечных) списков. Это из-за закона ассоциативности:

join . join = join . fmap join

Если n-й список в списке списков не имеет n-го элемента, это приведет к обрезке диагонали: она закончится до n-го элемента. join. join join. join сначала берет внешнюю диагональ (списка списков списков), а join. fmap join join. fmap join принимает внутренние диагонали. Возможно, что недостаточно длинный внутренний список, который не находится во внешней диагонали, чтобы обрезать join. fmap join join. fmap join, но это не может повлиять на join. join join. join. (Это было бы проще показать с изображением вместо слов.)

Ваш PoE является типом списка, который не имеет фиксированной длины (длина равна нулю или двум). Оказывается, что взятие его диагонали не дает нам монады, поскольку обсуждаемая выше потенциальная проблема действительно мешает (как показано в ответе ци).

Дополнительные замечания:

• Именно по этой причине ZipList не является монадой: поведение zippy сводится к диагонали.

• Бесконечные списки изоморфны функциям из натуральных, а списки фиксированной длины изоморфны функциям от натуральных до подходящего значения. Это означает, что вы можете получить экземпляр Monad для них из экземпляра для функций - и экземпляр, который вы получаете, опять-таки, сводится к диагонали.

• Когда-то я смутился по поводу этой точной проблемы.

Ответ 5

(Проводя это как отдельный ответ, так как он немного перекрывается с моим другим).

Фактическая причина, по которой я считаю, что это монада, состоит в том, что она изоморфна Maybe (Pair a) с Pair a = P aa. Они оба являются монадами, оба являются общими, поэтому их композиция также должна формировать монаду. О, я только узнал не всегда.

Условия составления монад 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 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 и a10, игнорируется в левой стороне, но не в правом (других словах, если a01 или a10 Nothing, RHS будет Nothing, но LHS не обязательно будет так). LHS точно соответствует исчезновению Empty в ответе chi, а RHS соответствует внутренней диагональной обрезке, описанной в моем другом ответе.

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

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 @Maybe. fmap @Maybe (sequenceA @Pair @Maybe) означает, что join' приведет к Nothing если нет Nothing нигде:

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

Разработка non- 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