Связь между `DList` и`[]`с Codensity

Question

Связь между `DList` и`[]`с Codensity

Я экспериментировал с Codensity в последнее время, который должен относиться DList с [] между прочим Во всяком случае, я никогда не нашел код, который заявляет об этом отношении. После некоторых экспериментов я закончил с этим:

{-# LANGUAGE RankNTypes #-}
module Codensity where

newtype Codensity f a = Codensity
  { runCodensity :: forall b. (a -> f b) -> f b }

type DList a = Codensity [] [a]

nil :: DList a
nil = Codensity ($ [])

infixr 5 `cons`
cons :: a -> DList a -> DList a
cons x (Codensity xs) = Codensity ($ (xs (x:)))

append :: DList a -> DList a -> DList a
append (Codensity xs) ys = Codensity ($ (xs (++ toList ys)))

toList :: DList a -> [a]
toList xs = runCodensity xs id

fromList :: [a] -> DList a
fromList xs = Codensity (\k -> k xs)

Однако определение DList чувствует себя немного неприглядным в моем примере. Есть ли другой способ заявить об этом отношении? Это даже правильный способ сделать это?

21

list haskell category-theory

Источник

user1396134 24 авг '15 в 21:15

2 ответа

Решение

TL;DR: DList за (++) служит той же цели, что и Codensity за (>>=): переназначение операторов справа.
Это полезно, потому что для обоих, (++) а также (>>=) левые ассоциированные вычисления (могут) демонстрируют квадратичное поведение во время выполнения.

1. Полная история

План следующий:

Мы идем шаг за шагом через пример для (++) а также (>>=), демонстрируя проблему с ассоциативностью.
Мы используем CPS, чтобы избежать квадратичной сложности с DList а также Codensity
Последствия и Бонус (Обобщение от (++) в (<>))

2. Проблема: квадратичное поведение во время выполнения

2а. Список `(++)`

Имейте в виду, что пока я использую (++) Например, это справедливо и для других функций, если они работают аналогично (++),

Итак, давайте сначала посмотрим на проблему со списками. Операция concat для списков обычно определяется как:

(++) []     ys = ys
(++) (x:xs) ys = x : xs ++ ys

Который означает, что (++) всегда будет ходить первый аргумент от начала до конца. Чтобы увидеть, когда это является проблемой, рассмотрим следующие два вычисления:

as, bs, cs:: [Int]

rightAssoc :: [Int]
rightAssoc = (as ++ (bs ++ cs))

leftAssoc :: [Int]
leftAssoc = ((as ++ bs) ++ cs)

Давайте начнем с rightAssoc и пройти через оценку.

as = [1,2]
bs = [3,4]
cs = [5,6]
rightAssoc = ([1,2] ++ ([3,4] ++ [5,6]))
           -- pattern match gives (1:[2]) for first arg
           = 1 : ([2] ++ ([3,4] ++ [5,6]))
           -- pattern match gives (2:[]) for first arg
           = 1 : 2 : ([] ++ ([3,4] ++ [5,6]))
           -- first case of (++)
           = 1 : 2 : ([3,4] ++ [5,6])
           = 1 : 2 : 3 : ([4] ++ [5,6])
           = 1 : 2 : 3 : 4 : ([] ++ [5,6])
           = 1 : 2 : 3 : 4 : [5,6]
           = [1,2,3,4,5,6]

Итак, мы должны идти as а также bs,

Хорошо, это было не так уж плохо, давайте продолжим leftAssoc:

as = [1,2]
bs = [3,4]
cs = [5,6]
leftAssoc = (([1,2] ++ [3,4]) ++ [5,6])
          = ((1 : ([2] ++ [3,4])) ++ [5,6])
          = ((1 : 2 : ([] ++ [3,4])) ++ [5,6])
          = ((1 : 2 : [3,4]) ++ [5,6])
          = ([1,2,3,4] ++ [5,6])
          -- uh oh
          = 1 : ([2,3,4] ++ [5,6])
          = 1 : 2 : ([3,4] ++ [5,6])
          = 1 : 2 : 3 : ([4] ++ [5,6])
          = 1 : 2 : 3 : 4 : ([] ++ [5,6])
          = 1 : 2 : 3 : 4 : [5,6]
          = [1,2,3,4,5,6]

О, вы видели, что мы должны были пройти as дважды? Однажды как [1,2] а потом снова внутри as ++ bs = [1,2,3,4], С каждым другим операндом, который ошибочно связан, список слева (++) который мы должны проходить полностью каждый раз, будет увеличиваться на каждом шаге, приводя к квадратичному поведению во время выполнения.

Итак, как вы видите выше, связанный слева (++) уничтожит производительность. Что приводит нас к:

2b. Бесплатная монада `(>>=)`

Имейте в виду, что пока я использую Free в качестве примера, это также относится и к другим монадам, например, к Tree ведет себя так же

Во-первых, мы используем наивный Free тип:

data Free f a = Pure a | Free (f (Free f a))

Вместо (++) мы смотрим на (>>=) который определяется как и использовать (>>=) в префиксной форме:

instance Functor f => Monad (Free f) where
  return = Pure
  (>>=) (Pure a) f = f a
  (>>=) (Free m) f = Free ((>>= f) <$> m)

Если вы сравните это с определением (++) от 2a выше, вы можете увидеть, что определение (>>=) снова смотрит на первый аргумент. Это вызывает первое беспокойство, будет ли это работать так же плохо, как в (++) случай, когда связаны неправильно? Ну посмотрим, пользуюсь Identity здесь для простоты, но выбор функтора не является важным фактом здесь:

-- specialized to 'Free'
liftF :: Functor f => f a -> Free f a
liftF fa = Free (Pure <$> fa)

x :: Free Identity Int
x = liftF (Identity 20) = Free (Identity (Pure 20))

f :: Int -> Free Identity Int
f x = liftF (Identity (x+1)) = Free (Identity (Pure (x+1)))

g :: Int -> Free Identity Int
g x = liftF (Identity (x*2)) = Free (Identity (Pure (x*2)))

rightAssoc :: Free Identity Int
rightAssoc = (x >>= \x -> (f x >>= g))

leftAssoc :: Free Identity Int
leftAssoc = ((x >>= f) >>= g)

Мы снова начнем с rightAssoc Вариант первый:

rightAssoc = (x >>= \x -> (f x >>= g))
                    ~~~
           -- definition of x
           = ((Free (Identity (Pure 20))) >>= \x -> (f x >>= g))
              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
           -- second case of definition for 'Free's (>>=)
           = Free ((>>= \x -> (f x >>= g)) <$> Identity (Pure 20))
                   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
           -- (<$>) for Identity
           = Free (Identity ((Pure 20) >>= \x -> (f x >>= g)))
                             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
           -- first case of the definition for 'Free's (>>=)
           = Free (Identity (f 20 >>= g))
                             ~~~~
           = Free (Identity ((Free (Identity (Pure 21))) >>= g))
                             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
           -- second case of definition for 'Free's (>>=)
           = Free (Identity (Free ((>>= g) <$> Identity (Pure 21))))
                                   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
           = Free (Identity (Free (Identity ((Pure 21) >>= g))))
                                             ~~~~~~~~~~~~~~~
           = Free (Identity (Free (Identity (g 21))))
                                             ~~~~
           = Free (Identity (Free (Identity (Free (Identity (Pure 42))))))

Пух, ладно я добавил ~~~~ под выражением, которое сокращено на следующем этапе для ясности. Если вы косите достаточно сильно, вы можете увидеть некоторое знакомство с 2a дело для rightAssoc: мы идем два первых аргумента (сейчас x а также f вместо as а также bs) аргументы один раз. Не теряя больше времени, вот leftAssoc:

leftAssoc = ((x >>= f) >>= g)
             ~~~
          = ((Free (Identity (Pure 20)) >>= f) >>= g)
             ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          = (Free ((>>= f) <$> Identity (Pure 20)) >>= g)
                   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          = (Free (Identity ((Pure 20) >>= f)) >>= g)
                             ~~~~~~~~~~~~~~~
          = (Free (Identity (f 20)) >>= g)
                             ~~~~
          = (Free (Identity (Free (Identity (Pure 21)))) >>= g)
            ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          = Free ((>>= g) <$> (Identity (Free (Identity (Pure 21)))))
                  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          -- uh oh
          = Free (Identity (Free (Identity (Pure 21)) >>= g))
                            ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          = Free (Identity (Free ((>>= g) <$> Identity (Pure 21))))
                                  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          = Free (Identity (Free (Identity ((Pure 21) >>= g))))
                                            ~~~~~~~~~~~~~~~~
          = Free (Identity (Free (Identity (g 21))))
                                            ~~~~
          = Free (Identity (Free (Identity (Free (Identity (Pure 42))))))

Если вы посмотрите внимательно, после uh oh мы должны снова разрушить промежуточную структуру, как в (++) случай (также отмечен uh oh).

2с. Результат пока

В обоих случаях, leftAssoc приводит к квадратичному поведению во время выполнения, потому что мы перестраиваем первый аргумент несколько раз и снова разбираем его для следующей операции. Это означает, что на каждом этапе оценки мы должны строить и разрушать растущую промежуточную структуру - плохо.

3. Связь между `DList` а также `Codensity`

Здесь мы обнаружим связь между DList а также Codensity, Каждый из них решает проблему ошибочно ассоциированных вычислений, показанных выше, используя CPS для эффективной повторной привязки вправо.

3a. DList

Сначала мы вводим определение DList а также append:

newtype DList a = DL { unDL :: [a] -> [a] }

append :: DList a -> DList a -> DList a
append xs ys = DL (unDL xs . unDL ys)

fromList :: [a] -> DList a
fromList = DL . (++)

toList :: DList a -> [a]
toList = ($[]) . unDL

а теперь наши старые друзья

as,bs,cs :: DList Int
as = fromList [1,2] = DL ([1,2] ++)
bs = fromList [3,4] = DL ([3,4] ++)
cs = fromList [5,6] = DL ([5,6] ++)

rightAssoc :: [Int]
rightAssoc = toList $ as `append` (bs `append` cs)

leftAssoc :: [Int]
leftAssoc = toList $ ((as `append` bs) `append` cs)

Оценка примерно такова:

rightAssoc = toList $ (DL ([1,2] ++)) `append` (bs `append` cs)
           = toList $ DL $ unDL (DL ([1,2] ++)) . unDL (bs `append` cs)
                           ~~~~~~~~~~~~~~~~~~~~
           = toList $ DL $ ([1,2] ++) . unDL (bs `append` cs)
                                              ~~
           = toList $ DL $ ([1,2] ++) . unDL ((DL ([3,4] ++)) `append` cs)
                                              ~~~~~~~~~~~~~~~~~~~~~~~~~~~
           = toList $ DL $ ([1,2] ++) . unDL (DL $ unDL (DL ([3,4] ++)) . unDL cs)
                                                   ~~~~~~~~~~~~~~~~~~~~
           = toList $ DL $ ([1,2] ++) . unDL (DL $ ([3,4] ++) . unDL cs)
                                                                     ~~
           = toList $ DL $ ([1,2] ++) . unDL (DL $ ([3,4] ++) . unDL (DL ([5,6] ++)))
           = toList $ DL $ ([1,2] ++) . unDL (DL $ ([3,4] ++) . ([5,6] ++))
                                        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
           = toList $ DL $ ([1,2] ++) . (([3,4] ++) . ([5,6] ++))
             ~~~~~~
           -- definition of toList
           = ($[]) . unDL $ DL $ ([1,2] ++) . (([3,4] ++) . ([5,6] ++))
                     ~~~~~~~~~
           -- unDL . DL == id
           = ($[]) $ (([1,2] ++) . (([3,4] ++) . ([5,6] ++)))
           -- move ($[]) to end
           = (([1,2] ++) . (([3,4] ++) . ([5,6] ++))) []
           -- def: (.) g f x = g (f x)
           = (([1,2] ++) ((([3,4] ++) . ([5,6] ++)) []))
           = (([1,2] ++) (([3,4] ++) (([5,6] ++) [])))
           -- drop unnecessary parens
           = (([1,2] ++) (([3,4] ++) ([5,6] ++ [])))
           = ([1,2] ++ ([3,4] ++ ([5,6] ++ [])))
                                  ~~~~~~~~~~~
           -- (xs ++ []) == xs
           = ([1,2] ++ ([3,4] ++ ([5,6])))
           = (as ++ (bs ++ cs))

Хах! Результат точно такой же, как rightAssoc от 2a, Хорошо, с ростом напряженности мы переходим к leftAssoc:

leftAssoc = toList $ ((as `append` bs) `append` cs)
          = toList $ (((DL ([1,2]++)) `append` bs) `append` cs)
          = toList $ ((DL (unDL (DL ([1,2]++)) . unDL bs)) `append` cs)
          = toList $ ((DL (unDL (DL ([1,2]++)) . unDL (DL ([3,4]++)))) `append` cs)
          = toList $ ((DL (([1,2]++) . ([3,4]++))) `append` cs)
          = toList $ (DL (unDL (DL (([1,2]++) . ([3,4]++))) . unDL cs))
          = toList $ (DL (unDL (DL (([1,2]++) . ([3,4]++))) . unDL (DL ([5,6]++))))
          = toList $ (DL ((([1,2]++) . ([3,4]++)) . ([5,6]++)))
          = ($[]) . unDL $ (DL ((([1,2]++) . ([3,4]++)) . ([5,6]++)))
          = ($[]) ((([1,2]++) . ([3,4]++)) . ([5,6]++))
          = ((([1,2]++) . ([3,4]++)) . ([5,6]++)) []
          -- expand (f . g) to \x -> f (g x)
          = ((\x -> ([1,2]++) (([3,4]++) x)) . ([5,6]++)) []
          = ((\x -> ([1,2]++) (([3,4]++) x)) (([5,6]++) []))
          -- apply lambda
          = ((([1,2]++) (([3,4]++) (([5,6]++) []))))
          = ([1,2] ++ ([3,4] ++ [5,6]))
          = as',bs',cs' ~ versions of 2a with no prime
          = (as' ++ (bs' ++ cs'))

Эврика! Результат связан правильно (справа), квадратичного замедления нет.

3b. Codensity

Хорошо, если вы дошли до этого момента, вы должны быть серьезно заинтересованы, это хорошо, потому что я тоже:). Начнем с определения и Monad экземпляр Codensity (с сокращенными именами):

newtype Codensity m a = C { run :: forall b. (a -> m b) -> m b }

instance Monad (Codensity f) where
  return x = C (\k -> k x)
  m >>= k = C (\c -> run m (\a -> run (k a) c))

-- hidden as a instance for `MonadTrans`
liftCodensity :: Monad m => m a -> Codensity m a
liftCodensity m = C (m >>=)

lowerCodensity :: Monad m => Codensity m a -> m a
lowerCodensity a = run a return

Я думаю, вы знаете, что будет дальше:

x :: Codensity (Free Identity) Int
x = liftCodensity (Free (Identity (Pure 20)))
  = C (Free (Identity (Pure 20)) >>=)
  -- note the similarity to (DL (as ++))
  -- with DL ~ Codensity and (++) ~ (>>=) !

f :: Int -> Codensity (Free Identity) Int
f x = liftCodensity (Free (Identity (Pure (x+1))))
    = C (Free (Identity (Pure (x+1))) >>=)

g :: Int -> Codensity (Free Identity) Int
g x = liftCodensity (Free (Identity (Pure (x*2))))
    = C (Free (Identity (Pure (x*2))) >>=)

rightAssoc :: Free Identity Int
rightAssoc = lowerCodensity (x >>= \x -> (f x >>= g))

leftAssoc :: Free Identity Int
leftAssoc = lowerCodensity ((x >>= f) >>= g)

Прежде чем мы еще раз пройдем оценку, вас может заинтересовать сравнение append от DList а также (>>=) от Codensity (unDL~run) иди и сделай это, если хочешь, я подожду тебя.

Хорошо, мы начнем с rightAssoc:

rightAssoc = lowerCodensity (x >>= \x -> (f x >>= g))
                            ~~~
           -- def of x
           = lowerCodensity ((C (Free (Identity (Pure 20)) >>=)) >>= \x -> (f x >>= g))
           -- (>>=) of codensity
           = lowerCodensity (C (\c -> run (C (Free (Identity (Pure 20)) >>=)) (\a -> run ((\x -> (f x >>= g)) a) c)))
           -- run . C == id
           = lowerCodensity (C (\c -> Free (Identity (Pure 20)) >>= \a -> run ((\x -> (f x >>= g)) a) c))
           -- substitute x' for 'Free (Identity (Pure 20))' (same as only x from 2b)
           = lowerCodensity (C (\c -> x' >>= \a -> run ((\x -> (f x >>= g)) a) c))
                                                                ~~~
           = lowerCodensity (C (\c -> x' >>= \a -> run ((\x -> (C (Free (Identity (Pure (x+1))) >>=)) >>= g) a) c))
                                                                ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
           = lowerCodensity (C (\c -> x' >>= \a -> run ((\x -> (C (\c2 -> run (C (Free (Identity (Pure (x+1))) >>=)) (\a2 -> run (g a2) c2)))) a) c))
                                                                           ~~~~~~
           = lowerCodensity (C (\c -> x' >>= \a -> run ((\x -> (C (\c2 -> (Free (Identity (Pure (x+1))) >>=) (\a2 -> run (g a2) c2)))) a) c))
           -- again, substitute f' for '\x -> Free (Identity (Pure (x+1)))' (same as only f from 2b)
           = lowerCodensity (C (\c -> x' >>= \a -> run ((\x -> (C (\c2 -> (f' x >>=) (\a2 -> run (g a2) c2)))) a) c))
                                                                                                   ~~~~
           = lowerCodensity (C (\c -> x' >>= \a -> run ((\x -> (C (\c2 -> (f' x >>=) (\a2 -> run (C (Free (Identity (Pure (a2*2))) >>=)) c2)))) a) c))
                                                                                              ~~~~~~
           = lowerCodensity (C (\c -> x' >>= \a -> run ((\x -> (C (\c2 -> (f' x >>=) (\a2 -> (Free (Identity (Pure (a2*2))) >>=) c2)))) a) c))
           -- one last time, substitute g' (g from 2b)
           = lowerCodensity (C (\c -> x' >>= \a -> run ((\x -> (C (\c2 -> (f' x >>=) (\a2 -> (g' a2 >>=) c2)))) a) c))
           -- def of lowerCodensity
           = run (C (\c -> x' >>= \a -> run ((\x -> (C (\c2 -> (f' x >>=) (\a2 -> (g' a2 >>=) c2)))) a) c)) return
           = (\c -> x' >>= \a -> run ((\x -> (C (\c2 -> (f' x >>=) (\a2 -> (g' a2 >>=) c2)))) a) c) return
           = (x' >>= \a -> run ((\x -> (C (\c2 -> (f' x >>=) (\a2 -> (g' a2 >>=) c2)))) a) return)
                                 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
           = (x' >>= \a -> run (C (\c2 -> (f' a >>=) (\a2 -> (g' a2 >>=) c2))) return)
                           ~~~~~~
           = (x' >>= \a -> (\c2 -> (f' a >>=) (\a2 -> (g' a2 >>=) c2)) return)
                            ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
           = (x' >>= \a -> (f' a >>=) (\a2 -> g' a2 >>= return))
           -- m >>= return ~ m
           = (x' >>= \a -> (f' a >>=) (\a2 -> g' a2))
           -- m >>= (\x -> f x) ~ m >>= f
           = (x' >>= \a -> (f' a >>= g'))
           -- rename a to x
           = (x' >>= \x -> (f' x >>= g'))

И теперь мы можем видеть, что (>>=) Они связаны с правом, это не особенно удивительно, учитывая, что это также имело место в начале. Итак, полные ожидания, мы обращаем наше внимание на наш последний и последний след оценки, leftAssoc:

leftAssoc = lowerCodensity ((x >>= f) >>= g)
          -- def of x
          = lowerCodensity ((C (Free (Identity (Pure 20)) >>=) >>= f) >>= g)
          -- (>>=) from Codensity
          = lowerCodensity ((C (\c -> run (C (Free (Identity (Pure 20)) >>=)) (\a -> run (f a) c))) >>= g)
                                      ~~~~~~
          = lowerCodensity ((C (\c -> (Free (Identity (Pure 20)) >>=) (\a -> run (f a) c))) >>= g)
          -- subst x'
          = lowerCodensity ((C (\c -> (x' >>=) (\a -> run (f a) c))) >>= g)
          -- def of f
          = lowerCodensity ((C (\c -> (x' >>=) (\a -> run (C (Free (Identity (Pure (a+1))) >>=)) c))) >>= g)
                                                      ~~~~~~
          = lowerCodensity ((C (\c -> (x' >>=) (\a -> (Free (Identity (Pure (a+1))) >>=) c))) >>= g)
          -- subst f'
          = lowerCodensity ((C (\c -> (x' >>=) (\a -> (f' a >>=) c))) >>= g)
                            ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          = lowerCodensity (C (\c2 -> run (C (\c -> (x' >>=) (\a -> (f' a >>=) c))) (\a2 -> run (g a2) c2)))
                                      ~~~~~~
          = lowerCodensity (C (\c2 -> (\c -> (x' >>=) (\a -> (f' a >>=) c)) (\a2 -> run (g a2) c2)))
          -- def of g
          = lowerCodensity (C (\c2 -> (\c -> (x' >>=) (\a -> (f' a >>=) c)) (\a2 -> run (C (Free (Identity (Pure (a2*2))) >>=)) c2)))
                                                                                    ~~~~~~
          = lowerCodensity (C (\c2 -> (\c -> (x' >>=) (\a -> (f' a >>=) c)) (\a2 -> (Free (Identity (Pure (a2*2))) >>=) c2)))
          -- subst g'
          = lowerCodensity (C (\c2 -> (\c -> (x' >>=) (\a -> (f' a >>=) c)) (\a2 -> (g' a2 >>=) c2)))
          -- def lowerCodensity
          = run (C (\c2 -> (\c -> (x' >>=) (\a -> (f' a >>=) c)) (\a2 -> (g' a2 >>=) c2))) return
          = (\c2 -> (\c -> (x' >>=) (\a -> (f' a >>=) c)) (\a2 -> (g' a2 >>=) c2)) return
          = ((\c -> (x' >>=) (\a -> (f' a >>=) c)) (\a2 -> g' a2 >>= return))
          = ((\c -> (x' >>=) (\a -> (f' a >>=) c)) (\a2 -> g' a2))
          = ((\c -> (x' >>=) (\a -> (f' a >>=) c)) g')
          = (x' >>=) (\a -> (f' a >>=) g')
          = (x' >>=) (\a -> (f' a >>= g')
          = (x' >>= (\a -> (f' a >>= g'))
          = (x' >>= (\x -> (f' x >>= g'))

Наконец, у нас это есть, все привязки связаны с тем, как нам они нравятся!

4. Последствия

Если вы сделали это до здесь, поздравляю. Давайте подведем итоги того, что мы сделали:

Мы продемонстрировали проблему с ошибочно связанным (++) в 2a а также (>>=) в 2b
Мы показали решение, используя DList в 3a а также Codensity в 3b,
Продемонстрировал силу эквационального мышления в Haskell:)

5. Бонус

На самом деле, мы можем обобщить DList от (++) и использовать (<>) вместо того, чтобы получить DMonoid, переупорядочение (<>),

newtype DMonoid m = DM { unDM :: m -> m }

instance Monoid m => Monoid (DMonoid m) where
  mempty = DM (mempty <>)
  x `mappend` y = DM (unDM x . unDM y)

liftDM :: Monoid m => m -> DMonoid m
liftDM = DM . (<>)

lowerDM :: Monoid m => DMonoid m -> m
lowerDM = ($ mempty) . unDM

Тогда сравнение выглядит следующим образом:

DMonoid это (мое изобретение) "моноидный трансформатор", переассоцирующий (<>) направо
Codensity это монад трансформер, реассоцирующий (>>=) направо

17

Источник

user566890 25 авг '15 в 21:03

Другие вопросы по тегам list haskell category-theory

user1333025 25 авг '15 в 09:24 2015-08-25 09:24 · Accepted Answer · 2015-08-25 09:24

Одна точка зрения может быть, что DList это способ переупорядочения моноидных операций, так же как Codensity способ переупорядочения монадных операций

[] это свободный моноид на aИтак, давайте представим списки, используя свободную монаду писателя, то есть Free ((,) a):

module Codensity where

import Control.Monad
import Control.Monad.Free
import Control.Monad.Codensity
import Control.Monad.Trans (lift)

type DList a = Free ((,) a) ()

Теперь мы можем определить стандартные операции со списком:

nil :: DList a
nil = return ()

singleton :: a -> DList a
singleton x = liftF (x, ())

append :: DList a -> DList a -> DList a
append = (>>)

infixr 5 `snoc`
snoc :: DList a -> a -> DList a
snoc xs x = xs >> singleton x

exec :: Free ((,) a) () -> [a]
exec (Free (x, xs)) = x : exec xs
exec (Pure _) = []

fromList :: [a] -> DList a
fromList = mapM_ singleton

toList :: DList a -> [a]
toList = exec

Это представление имеет те же недостатки, что и список, когда дело доходит до snoc, Мы можем проверить, что

last . toList . foldl snoc nil $ [1..10000]

занимает значительное (квадратичное) количество времени. Однако, как и любая бесплатная монада, ее можно улучшить, используя Codensity, Мы просто заменим определение на

type DList a = Codensity (Free ((,) a)) ()

а также toList с

toList = exec . lowerCodensity

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

Связь между `DList` и`[]`с Codensity

2 ответа

1. Полная история

2. Проблема: квадратичное поведение во время выполнения

2а. Список (++)

2b. Бесплатная монада (>>=)

2с. Результат пока

3. Связь между DList а также Codensity

3a. DList

3b. Codensity

4. Последствия

5. Бонус

2а. Список `(++)`

2b. Бесплатная монада `(>>=)`

3. Связь между `DList` а также `Codensity`