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

Question

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

То есть претензия такова:

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

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

Конечно, на самом деле, очень немногие экземпляры Alternative являются фактически левораспределительными. Большинство альтернативных экземпляров, которые действительно имеют значение (парсеры, MaybeT f для большинства монад 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 ()

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

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

Так же, как для списков, вы не можете создать список с помощью <> а также 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, Я полагаю.

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

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

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

Answer 1

Control.Alternative.Free"s 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 никогда не может быть гомоморфизмом для не левой дистрибутивной Alternatives. Если 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

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

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]}]

FlipApAlt всегда правораспределительный

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

Это 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 f@(Lift _)   <*> Alt x@Empty      = Alt (Ap f x)
    Alt f@(Lift _)   <*> Alt x@(Lift _)   = Alt (Ap f x)
    Alt f@(Lift _)   <*> Alt x@(Plus _ _) = Alt (Ap f x)
    Alt f@(Lift _)   <*> Alt x@(Ap _ _)   = Alt (Ap f x)
    Alt f@(Plus _ _) <*> Alt x@Empty      = Alt (Ap f x)
    Alt f@(Plus _ _) <*> Alt x@(Lift _)   = Alt (Ap f x)
    Alt f@(Plus _ _) <*> Alt x@(Plus _ _) = Alt (Ap f x)
    Alt f@(Plus _ _) <*> Alt x@(Ap _ _)   = Alt (Ap f x)
    Alt f@(Ap _ _)   <*> Alt x@Empty      = Alt (Ap f x)
    Alt f@(Ap _ _)   <*> Alt x@(Lift _)   = Alt (Ap f x)
    Alt f@(Ap _ _)   <*> Alt x@(Plus _ _) = Alt (Ap f x)
    Alt f@(Ap _ _)   <*> Alt x@(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_ x@Empty      = Empty_ x
empty_ x@(Pure _)   = NonEmpty_ (AltNE x)
empty_ x@(Lift _)   = NonEmpty_ (AltNE x)
empty_ x@(Plus _ _) = NonEmpty_ (AltNE x)
empty_ x@(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 a@(Pure _) <> AltNE b = AltNE (Plus a b)
        AltNE a@(Lift _) <> AltNE b = AltNE (Plus a b)
        AltNE a@(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

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

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

(чистый а) <|> х = чистый а

Хранить 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 a@(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 a@(Lift _) <> AltNE b = AltNE (Plus a b)
        AltNE a@(Ap _ _) <> AltNE b = AltNE (Plus a b)