Структурно принудительная свободная альтернатива, без левого распределения

В большом бесплатном пакете есть хорошая "Бесплатная альтернатива" , которая поднимает Functor на альтернативу слева-дистрибутива.

То есть утверждение состоит в том, что:

runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a

- альтернативный гомоморфизм с liftAlt. И действительно, это одно, но только для left-distributive Альтернативные экземпляры.

Конечно, на самом деле очень мало альтернативных экземпляров на самом деле оставлено - дистрибутив. Большинство альтернативных экземпляров, которые на самом деле имеют значение (парсеры, MaybeT f для большинства Monad f и т.д.), Не являются лево-дистрибутивными. Этот факт можно показать примером, где runAlt и liftAlt не образуют альтернативного гомоморфизма:

(writeIORef x False <|> writeIORef True) *> (guard =<< readIORef x)
-- is an IO action that throws an exception
runAlt id $ (liftAlt (writeIORef x False) <|> liftAlt (writeIORef True))
               *> liftAlt (guard =<< readIORef x)
-- is an IO action that throws no exception and returns successfully ()

So runAlt является лишь альтернативным гомоморфизмом для некоторых Альтернатив, но не для всех. Это связано с тем, что структура Alt нормализует все действия для распространения по левому краю.

Alt велико, потому что структурно Alt f является законным Applicative и Alternative. Нет никакого способа построить значение типа Alt f a с использованием Аппликативной и Альтернативной функций, которые не следуют законам... сама структура самого типа делает ее свободной Альтернативой.

Так же, как и для списков, вы не можете создать список, используя <> и mempty, который не учитывает x <> mempty = x, mempty <> x = x и ассоциативность.

Я написал бесплатную альтернативу, которая не применяет апликативные и альтернативные законы, структурно, но дает действительный альтернативный и аппликативный гомоморфизм с runAlt/liftAlt:

data Alt :: (* -> *) -> * -> * where
    Pure  :: a   -> Alt f a
    Lift  :: f a -> Alt f a
    Empty :: Alt f a
    Ap    :: Alt f (a -> b) -> Alt f a -> Alt f b
    Plus  :: Alt f as -> Alt f as -> Alt f as

instance Functor f => Functor (Alt f) where
    fmap f = \case
      Pure x     -> Pure (f x)
      Lift x     -> Lift (f <$> x)
      Empty      -> Empty
      Ap fs xs   -> Ap ((f .) <$> fs) xs
      Plus xs ys -> Plus (f <$> xs) (f <$> ys)

instance Functor f => Applicative (Alt f) where
    pure  = Pure
    (<*>) = Ap

instance Functor f => Alternative (Alt f) where
    empty = Empty
    (<|>) = Plus

структурно, Alt f не является фактическим Applicative, потому что:

pure f <*> pure x = Ap (Pure f) (Pure x)
pure (f x)        = Pure (f x)

Итак, pure f <*> pure x не является структурным, а pure (f x). Недействительный Аппликатив, прямо с места в карьер.

Но с данными runAlt и liftAlt:

liftAlt :: f a -> Alt f a
liftAlt = Lift

runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
runAlt f = \case
  Pure x     -> pure x
  Lift x     -> f x
  Empty      -> empty
  Ap fs xs   -> runAlt f fs <*> runAlt f xs
  Plus xs ys -> runAlt f xs <|> runAlt f ys

И runAlt здесь действительно действует как действительный аппликативный гомоморфизм с заданным естественным преобразованием...

Можно сказать, что мой новый Alt f является допустимым альтернативным и аппликативным, если он определяется отношением эквивалентности, определенным runAlt, предположим.

Во всяком случае, это лишь немного неудовлетворительно. Есть ли способ написать бесплатную альтернативу, которая является структурно действительной альтернативной и аппликативной, без соблюдения левой дистрибутивности?

(В частности, меня действительно интересует тот, который следует за законом left catch и навязывает его структурно. Это будет отдельный а также интересная вещь, но не полностью необходимая.)

И, если нет, почему бы и нет?

Ответы

Ответ 1

Control.Alternative.Free Alt f освобождает левый дистрибутив Alternative бесплатно, даже если f не Alternative или f является нелевым дистрибутивным Alternative. Мы можем сказать, что в дополнение к хорошо согласованным альтернативным законам

empty <|> x = x
x <|> empty = x
(x <|> y) <|> z = x <|> (y <|> z)
empty <*> f = empty

Alt f также дает свободное распределение слева.

(a <|> b) <*> c = (a <*> c) <|> (b <*> c)

Поскольку Alt f всегда остается дистрибутивным (и runAlt . liftAlt = id) liftAlt никогда не может быть гомоморфизмом для нелевых дистрибутивов Alternative s. Если a Alternative f не является лево-дистрибутивным, то существуют a, b и c такие, что

(a <|> b) <*> c != (a <*> c) <|> (b <*> c)

Если liftAlt : f -> Alt f были гомоморфизмом, то

                  (a <|> b) <*> c  !=                   (a <*> c) <|> (b <*> c)                                       -- f is not left-distributive
id               ((a <|> b) <*> c) != id               ((a <*> c) <|> (b <*> c))
runAlt . liftAlt ((a <|> b) <*> c) != runAlt . liftAlt ((a <*> c) <|> (b <*> c))                                      -- runAlt . liftAlt = id
runAlt ((liftAlt a <|> liftAlt b) <*> liftAlt c) != runAlt ((liftAlt a <*> liftAlt c) <|> (liftAlt b <*> liftAlt c))  -- homomorphism
runAlt ((liftAlt a <|> liftAlt b) <*> liftAlt c) != runAlt ((liftAlt a <|> liftAlt b) <*> liftAlt c)                  -- by left-distribution of `Alt`, this is a contradiction

Чтобы продемонстрировать это, нам нужен Alternative, который не является лево-дистрибутивным. Здесь один, FlipAp [].

newtype FlipAp f a = FlipAp {unFlipAp :: f a}
  deriving Show

instance Functor f => Functor (FlipAp f) where
    fmap f (FlipAp x) = FlipAp (fmap f x)

instance Applicative f => Applicative (FlipAp f) where
    pure = FlipAp . pure
    (FlipAp f) <*> (FlipAp xs) = FlipAp ((flip ($) <$> xs) <*> f)

instance Alternative f => Alternative (FlipAp f) where
    empty = FlipAp empty
    (FlipAp a) <|> (FlipAp b) = FlipAp (a <|> b)

Наряду с некоторыми законами для распределения слева и справа, а некоторые примеры

leftDist :: Alternative f => f (x -> y) -> f (x -> y) -> f x -> Example (f y)
leftDist a b c = [(a <|> b) <*> c, (a <*> c) <|> (b <*> c)]

rightDist :: Alternative f => f (x -> y) -> f x -> f x -> Example (f y)
rightDist a b c = [a <*> (b <|> c), (a <*> b) <|> (a <*> c)]

type Example a = [a]

ldExample1 :: Alternative f => Example (f Int)
ldExample1 = leftDist (pure (+1)) (pure (*10)) (pure 2 <|> pure 3)

rdExample1 :: Alternative f => Example (f Int)
rdExample1 = rightDist (pure (+1) <|> pure (*10)) (pure 2) (pure 3)

Мы можем продемонстрировать несколько свойств списков, FlipAp списков и runAlt.

Списки являются лево-дистрибутивными, но FlipAp списки не

ldExample1 :: Example [Int]
ldExample1 :: Example (FlipAp [] Int)

[[3,4,20,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,4,20,30]}]

Списки не являются правильными дистрибутивами, но FlipAp перечислены

rdExample1 :: Example [Int]
rdExample1 :: Example (FlipAp [] Int)

[[3,4,20,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,20,4,30]}]

Alt всегда слева-дистрибутив

map (runAlt id) ldExample1 :: Example [Int]
map (runAlt id) ldExample1 :: Example (FlipAp [] Int)

[[3,4,20,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,4,20,30]},FlipAp {unFlipAp = [3,4,20,30]}]

Alt никогда не является правильным дистрибутивом

map (runAlt id) rdExample1 :: Example [Int]
map (runAlt id) rdExample1 :: Example (FlipAp [] Int)

[[3,4,20,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,4,20,30]},FlipAp {unFlipAp = [3,20,4,30]}]

Мы можем дефинировать право-дистрибутивную свободную альтернативу в терминах FlipAp и Alt.

runFlipAlt :: forall f g a. Alternative g => (forall x. f x -> g x) -> FlipAp (Alt f) a -> g a
runFlipAlt nt = runAlt nt . unFlipAp

FlipAp Alt никогда не является левым дистрибутивом.

map (runFlipAlt id) ldExample1 :: Example [Int]
map (runFlipAlt id) ldExample1 :: Example (FlipAp [] Int)

[[3,20,4,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,4,20,30]}]

FlipAp Alt всегда правая дистрибутива

map (runFlipAlt id) rdExample1 :: Example [Int]
map (runFlipAlt id) rdExample1 :: Example (FlipAp [] Int)

[[3,20,4,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,20,4,30]}]

До сих пор я не говорил вам ничего, что вы еще не предполагали, говоря, что liftAlt : f -> Alt f является гомоморфизмом Alternative, но только для лево-дистрибутивных альтернативных экземпляров. Но я показал вам бесплатную альтернативу, которая не является левым дистрибутивом (вместо этого она тривиально правая дистрибутива).

Структурно действующий свободный Alternative

В этом разделе рассматривается основная часть вашего вопроса, есть ли структурно действующий бесплатный Alternative, который не является левым дистрибутивом? Да.

Это не эффективная реализация; цель состоит в том, чтобы продемонстрировать, что она существует, и что некоторые ее версии могут быть получены прямолинейно.

Чтобы сделать структурно допустимый свободный Alternative, я делаю две вещи. Первый заключается в создании структуры данных, которая не может представлять ни одного из законов Alternative; если он не может представлять закон, тогда структура не может быть построена независимо от класса типа, чтобы ее нарушить. Это тот же трюк, который используется для составления списков, структурно подчиняющихся закону Alternative ассоциативности; нет списка, который может представлять связанный слева (x <|> y) <|> z. Вторая часть - убедиться, что операции подчиняются законам. Список не может представлять левый закон ассоциации, но реализация <|> может все еще нарушать его, например x <|> y = x ++ reverse y.

Невозможно построить следующую структуру для представления любого из законов Alternative.

{-# Language GADTs #-}
{-# Language DataKinds #-}
{-# Language KindSignatures #-}

data Alt :: (* -> *) -> * -> * where
    Alt :: Alt' empty pure plus f a -> Alt f a

--           empty   pure    plus
data Alt' :: Bool -> Bool -> Bool -> (* -> *) -> * -> * where
    Empty ::        Alt' True  False False f a
    Pure  :: a   -> Alt' False True  False f a
    Lift  :: f a -> Alt' False False False f a

    Plus  :: Alt' False pure1 False f a -> Alt' False pure2 plus2 f a -> Alt' False False True  f a
      -- Empty can't be to the left or right of Plus
      -- empty <|> x = x
      -- x <|> empty = x

      -- Plus can't be to the left of Plus
      -- (x <|> y) <|> z = x <|> (y <|> z)
    Ap    :: Alt' False False plus1 f (a -> b) -> Alt' empty False plus2 f a -> Alt' False False False f b
      -- Empty can't be to the left of `Ap`
      -- empty <*> f = empty

      -- Pure can't be to the left or right of `Ap`
      -- pure id <*> v = v     
      -- pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
      -- pure f <*> pure x = pure (f x)
      -- u <*> pure y = pure ($ y) <*> u

Это a Functor

instance Functor f => Functor (Alt' empty pure plus f) where
    fmap _ Empty       = Empty
    fmap f (Pure a)    = Pure (f a)
    fmap f (Plus a as) = Plus (fmap f a) (fmap f as)
    fmap f (Lift a)    = Lift (fmap f a)
    fmap f (Ap g a)    = Ap (fmap (f .) g) a

instance Functor f => Functor (Alt f) where
    fmap f (Alt a) = Alt (fmap f a)

И это Applicative. Поскольку структура не может представлять законы, когда мы сталкиваемся с термином, содержащим одно из непредсказуемых выражений, мы вынуждены преобразовывать его во что-то другое. Законы говорят нам, что делать.

instance Functor f => Applicative (Alt f) where
    pure a = Alt (Pure a)

    Alt Empty <*> _ = Alt Empty                          -- empty <*> f = empty
    Alt (Pure f) <*> (Alt x) = Alt (fmap f x)            -- pure f <*> x = fmap f x          (free theorem)
    Alt u <*> (Alt (Pure y)) = Alt (fmap ($ y) u)        -- u <*> pure y = pure ($ y) <*> u
    Alt [email protected](Lift _)   <*> Alt [email protected]      = Alt (Ap f x)
    Alt [email protected](Lift _)   <*> Alt [email protected](Lift _)   = Alt (Ap f x)
    Alt [email protected](Lift _)   <*> Alt [email protected](Plus _ _) = Alt (Ap f x)
    Alt [email protected](Lift _)   <*> Alt [email protected](Ap _ _)   = Alt (Ap f x)
    Alt [email protected](Plus _ _) <*> Alt [email protected]      = Alt (Ap f x)
    Alt [email protected](Plus _ _) <*> Alt [email protected](Lift _)   = Alt (Ap f x)
    Alt [email protected](Plus _ _) <*> Alt [email protected](Plus _ _) = Alt (Ap f x)
    Alt [email protected](Plus _ _) <*> Alt [email protected](Ap _ _)   = Alt (Ap f x)
    Alt [email protected](Ap _ _)   <*> Alt [email protected]      = Alt (Ap f x)
    Alt [email protected](Ap _ _)   <*> Alt [email protected](Lift _)   = Alt (Ap f x)
    Alt [email protected](Ap _ _)   <*> Alt [email protected](Plus _ _) = Alt (Ap f x)
    Alt [email protected](Ap _ _)   <*> Alt [email protected](Ap _ _)   = Alt (Ap f x)

Все эти Ap могут быть покрыты парой шаблонов представлений, но это не делает их проще.

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

{-# Language ViewPatterns #-}

import Control.Applicative

data AltEmpty :: (* -> *) -> * -> * where
    Empty_    :: Alt' True  False False f a -> AltEmpty f a
    NonEmpty_ :: AltNE f a -> AltEmpty f a

data AltNE :: (* -> *) -> * -> * where
    AltNE :: Alt' False pure plus f a -> AltNE f a

empty_ :: Alt' e1 p1 p2 f a -> AltEmpty f a
empty_ [email protected]      = Empty_ x
empty_ [email protected](Pure _)   = NonEmpty_ (AltNE x)
empty_ [email protected](Lift _)   = NonEmpty_ (AltNE x)
empty_ [email protected](Plus _ _) = NonEmpty_ (AltNE x)
empty_ [email protected](Ap _ _)   = NonEmpty_ (AltNE x)

instance Functor f => Alternative (Alt f) where
    empty = Alt Empty

    Alt Empty <|> x = x                                 -- empty <|> x = x
    x <|> Alt Empty = x                                 -- x <|> empty = x
    Alt (empty_ -> NonEmpty_ a) <|> Alt (empty_ -> NonEmpty_ b) = case a <> b of AltNE c -> Alt c
      where
        (<>) :: AltNE f a -> AltNE f a -> AltNE f a
        AltNE (Plus x y) <> AltNE z = AltNE x <> (AltNE y <> AltNE z)  -- (x <|> y) <|> x = x <|> (y <|> z)
        AltNE [email protected](Pure _) <> AltNE b = AltNE (Plus a b)
        AltNE [email protected](Lift _) <> AltNE b = AltNE (Plus a b)
        AltNE [email protected](Ap _ _) <> AltNE b = AltNE (Plus a b)

liftAlt и runAlt

{-# Language RankNTypes #-}
{-# Language ScopedTypeVariables #-}

liftAlt :: f a -> Alt f a
liftAlt = Alt . Lift

runAlt' :: forall f g x empty pure plus a. Alternative g => (forall x. f x -> g x) -> Alt' empty pure plus f a -> g a
runAlt' u = go
  where
    go :: forall empty pure plus a. Alt' empty pure plus f a -> g a
    go Empty    = empty
    go (Pure a) = pure a
    go (Lift a) = u a
    go (Plus x y) = go x <|> go y
    go (Ap f x)   = go f <*> go x

runAlt :: Alternative g => (forall x. f x -> g x) -> Alt f a -> g a
runAlt u (Alt x) = runAlt' u x

Этот новый Alt f не предоставляет бесплатное распределение слева или справа, и поэтому runAlt id :: Alt f a -> g a сохраняет как дистрибутивный g.

Списки по-прежнему оставлены-дистрибутивными, но FlipAp списки не являются.

map (runAlt id) ldExample1 :: Example [Int]
map (runAlt id) ldExample1 :: Example (FlipAp [] Int)

[[3,4,20,30],[3,4,20,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,4,20,30]}]

Список не является правильным дистрибутивом, но FlipAp списки все еще

map (runAlt id) rdExample1 :: Example [Int]
map (runAlt id) rdExample1 :: Example (FlipAp [] Int)

[[3,4,20,30],[3,20,4,30]]
[FlipAp {unFlipAp = [3,20,4,30]},FlipAp {unFlipAp = [3,20,4,30]}]

Исходный код для этого раздела

Структурно действующий левый скин Alternative

Чтобы контролировать, какие законы мы хотим, мы можем добавить их к альтернативе, свободной от структуры, которую мы сделали ранее.

Чтобы добавить левый ловушек, мы изменим структуру, чтобы она не представляла ее. Левый улов

(чистый a) < | > x = чистый a

Чтобы сохранить Alt' от его представления, мы исключаем pure из того, что разрешено слева от Plus.

--           empty   pure    plus
data Alt' :: Bool -> Bool -> Bool -> (* -> *) -> * -> * where
    Empty ::        Alt' True  False False f a
    Pure  :: a   -> Alt' False True  False f a
    Lift  :: f a -> Alt' False False False f a

    Plus  :: Alt' False False False f a -> Alt' False pure2 plus2 f a -> Alt' False False True  f a
      -- Empty can't be to the left or right of Plus
      -- empty <|> x = x
      -- x <|> empty = x

      -- Plus can't be to the left of Plus
      -- (x <|> y) <|> z = x <|> (y <|> z)

      -- Pure can't be to the left of Plus
      -- (pure a) <|> x = pure a

    ...

Это приводит к ошибке компилятора в реализации Alternative Alt

Couldn't match type ‘'True’ with ‘'False’
Expected type: Alt' 'False 'False 'False f a1
  Actual type: Alt' 'False pure2 plus2 f a1
In the first argument of ‘Plus’, namely ‘a’
In the first argument of ‘AltNE’, namely ‘(Plus a b)

Что мы можем исправить, обратившись к нашему новому закону, (pure a) <|> x = pure a

instance Functor f => Alternative (Alt f) where
    empty = Alt Empty

    Alt Empty <|> x = x                                 -- empty <|> x = x
    x <|> Alt Empty = x                                 -- x <|> empty = x
    Alt (empty_ -> NonEmpty_ a) <|> Alt (empty_ -> NonEmpty_ b) = case a <> b of AltNE c -> Alt c
      where
        (<>) :: AltNE f a -> AltNE f a -> AltNE f a
        AltNE [email protected](Pure _) <> _ = AltNE a                                -- (pure a) <|> x = pure a
        AltNE (Plus x y) <> AltNE z = AltNE x <> (AltNE y <> AltNE z)  -- (x <|> y) <|> x = x <|> (y <|> z)
        AltNE [email protected](Lift _) <> AltNE b = AltNE (Plus a b)
        AltNE [email protected](Ap _ _) <> AltNE b = AltNE (Plus a b)