Застежка-молния Comonads, в общем

Для любого типа контейнера мы можем сформировать (привязанный к элементам) Zipper и знать, что эта структура является Comonad. Это было недавно подробно изучено в еще одном вопросе для следующего типа:

data Bin a = Branch (Bin a) a (Bin a) | Leaf a deriving Functor

со следующей молнией

data Dir = L | R
data Step a = Step a Dir (Bin a)   deriving Functor
data Zip  a = Zip [Step a] (Bin a) deriving Functor
instance Comonad Zip where ...

В этом случае Zip является Comonad, хотя построение его экземпляра немного волосатое. Тем не менее, Zip может быть полностью механически получен из Tree и (я полагаю) любой тип, полученный таким образом, автоматически является Comonad, поэтому я считаю, что это должно быть так, что мы можем построить эти типы и их comonads в общем и автоматическом режиме.

Одним из способов достижения общности конструкции молнии является использование следующего семейства классов и типов

data Zipper t a = Zipper { diff :: D t a, here :: a }

deriving instance Diff t => Functor (Zipper t)

class (Functor t, Functor (D t)) => Diff t where
  data D t :: * -> *
  inTo  :: t a -> t (Zipper t a)
  outOf :: Zipper t a -> t a

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

Итак, в конечном счете, мой вопрос заключается в том, можем ли мы писать

instance Diff t => Comonad (Zipper t) where ...

который может использоваться для включения конкретного экземпляра Comonad, описанного выше:

instance Diff Bin where
  data D Bin a = DBin { context :: [Step a], descend :: Maybe (Bin a, Bin a) }
  ...

К сожалению, мне не повезло написать такой экземпляр. Достаточна ли подпись inTo/outOf? Есть ли что-то еще для ограничения типов? Возможно ли, что этот пример возможен?

ОТВЕТЫ

Ответ 1

Как и ребенок-катчер в Chitty-Chitty-Bang-Bang, заманивая детей в плен с конфетами и игрушками, рекрутеры в бакалавриат физики любят дурачиться с мыльными пузырями и бумерангами, но когда дверь закрывается, это "Правильно, дети, время, чтобы узнать о частичной дифференциации!". Я тоже. Не говорите, что я вас не предупреждал.

Здесь другое предупреждение: следующий код нуждается в {-# LANGUAGE KitchenSink #-}, или скорее

{-# LANGUAGE TypeFamilies, FlexibleContexts, TupleSections, GADTs, DataKinds,
    TypeOperators, FlexibleInstances, RankNTypes, ScopedTypeVariables,
    StandaloneDeriving, UndecidableInstances #-}

в определенном порядке.

Дифференцируемые функторы дают комонадные молнии

Что такое дифференцируемый функтор?

class (Functor f, Functor (DF f)) => Diff1 f where
  type DF f :: * -> *
  upF      ::  ZF f x  ->  f x
  downF    ::  f x     ->  f (ZF f x)
  aroundF  ::  ZF f x  ->  ZF f (ZF f x)

data ZF f x = (:<-:) {cxF :: DF f x, elF :: x}

Это функтор, который имеет производную, которая также является функтором. Производная представляет собой одноточечный контекст для элемента. Тип застежки-молнии ZF f x представляет собой пару одноточечного контекста и элемента в отверстии.

Операции для Diff1 описывают виды навигации, которые мы можем делать на застежках-молниях (без каких-либо понятий "влево" и "вправо", для которых см. Бумаги клоунов и джокеров). Мы можем идти "вверх", перестраивая структуру, затыкая элемент в его отверстие. Мы можем идти "вниз", находя каждый способ посетить элемент в структуре давальца: мы украшаем каждый элемент своим контекстом. Мы можем идти "вокруг", используя существующую застежку-молнию и украшая каждый элемент своим контекстом, поэтому мы находим все способы переориентации (и как сохранить наш текущий фокус).

Теперь тип aroundF может напоминать вам некоторые из

class Functor c => Comonad c where
  extract    :: c x -> x
  duplicate  :: c x -> c (c x)

и вы правы, чтобы напомнить! У нас есть прыжок и промах,

instance Diff1 f => Functor (ZF f) where
  fmap f (df :<-: x) = fmap f df :<-: f x

instance Diff1 f => Comonad (ZF f) where
  extract    = elF
  duplicate  = aroundF

и мы настаиваем, что

extract . duplicate == id
fmap extract . duplicate == id
duplicate . duplicate == fmap duplicate . duplicate

Нам также нужно, чтобы

fmap extract (downF xs) == xs              -- downF decorates the element in position
fmap upF (downF xs) = fmap (const xs) xs   -- downF gives the correct context

Полиномиальные функторы дифференцируемы

Функторы

Константа дифференцируемы.

data KF a x = KF a
instance Functor (KF a) where
  fmap f (KF a) = KF a

instance Diff1 (KF a) where
  type DF (KF a) = KF Void
  upF (KF w :<-: _) = absurd w
  downF (KF a) = KF a
  aroundF (KF w :<-: _) = absurd w

Невозможно поместить элемент, поэтому невозможно сформировать контекст. Нам некуда идти upF или downF из, и мы легко находим все пути перехода downF.

Функтор identity дифференцируем.

data IF x = IF x
instance Functor IF where
  fmap f (IF x) = IF (f x)

instance Diff1 IF where
  type DF IF = KF ()
  upF (KF () :<-: x) = IF x
  downF (IF x) = IF (KF () :<-: x)
  aroundF [email protected](KF () :<-: x) = KF () :<-: z

Там один элемент в тривиальном контексте, downF находит его, upF переупаковывает его, а aroundF может оставаться только на месте.

Сумма сохраняет дифференцируемость.

data (f :+: g) x = LF (f x) | RF (g x)
instance (Functor f, Functor g) => Functor (f :+: g) where
  fmap h (LF f) = LF (fmap h f)
  fmap h (RF g) = RF (fmap h g)

instance (Diff1 f, Diff1 g) => Diff1 (f :+: g) where
  type DF (f :+: g) = DF f :+: DF g
  upF (LF f' :<-: x) = LF (upF (f' :<-: x))
  upF (RF g' :<-: x) = RF (upF (g' :<-: x))

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

  downF (LF f) = LF (fmap (\ (f' :<-: x) -> LF f' :<-: x) (downF f))
  downF (RF g) = RF (fmap (\ (g' :<-: x) -> RF g' :<-: x) (downF g))

Чтобы перейти aroundF, мы разделим тэг, выясним, как обойти немаркированную вещь, а затем восстановить тег во всех полученных застежках-молниях. Элемент в фокусе x заменяется всей его молнией, z.

  aroundF [email protected](LF f' :<-: (x :: x)) =
    LF (fmap (\ (f' :<-: x) -> LF f' :<-: x) . cxF $ aroundF (f' :<-: x :: ZF f x))
    :<-: z
  aroundF [email protected](RF g' :<-: (x :: x)) =
    RF (fmap (\ (g' :<-: x) -> RF g' :<-: x) . cxF $ aroundF (g' :<-: x :: ZF g x))
    :<-: z

Обратите внимание, что мне пришлось использовать ScopedTypeVariables для устранения неоднозначности рекурсивных вызовов aroundF. В качестве функции типа DF не является инъективным, поэтому того факта, что f' :: D f x недостаточно, чтобы заставить f' :<-: x :: Z f x.

Продукт сохраняет дифференцируемость.

data (f :*: g) x = f x :*: g x
instance (Functor f, Functor g) => Functor (f :*: g) where
  fmap h (f :*: g) = fmap h f :*: fmap h g

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

instance (Diff1 f, Diff1 g) => Diff1 (f :*: g) where
  type DF (f :*: g) = (DF f :*: g) :+: (f :*: DF g)
  upF (LF (f' :*: g) :<-: x) = upF (f' :<-: x) :*: g
  upF (RF (f :*: g') :<-: x) = f :*: upF (g' :<-: x)

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

  downF (f :*: g)
    =    fmap (\ (f' :<-: x) -> LF (f' :*: g) :<-: x) (downF f)
    :*:  fmap (\ (g' :<-: x) -> RF (f :*: g') :<-: x) (downF g)

Но aroundF - массивный мешок смеха. Какую бы сторону мы сейчас не посещали, у нас есть два варианта:

  • Переместите aroundF с этой стороны.
  • Переместите upF с той стороны и downF в другую сторону.

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

  aroundF [email protected](LF (f' :*: g) :<-: (x :: x)) =
    LF (fmap (\ (f' :<-: x) -> LF (f' :*: g) :<-: x)
          (cxF $ aroundF (f' :<-: x :: ZF f x))
        :*: fmap (\ (g' :<-: x) -> RF (f :*: g') :<-: x) (downF g))
    :<-: z
    where f = upF (f' :<-: x)
  aroundF [email protected](RF (f :*: g') :<-: (x :: x)) =
    RF (fmap (\ (f' :<-: x) -> LF (f' :*: g) :<-: x) (downF f) :*:
        fmap (\ (g' :<-: x) -> RF (f :*: g') :<-: x)
          (cxF $ aroundF (g' :<-: x :: ZF g x)))
    :<-: z
    where g = upF (g' :<-: x)

Уф! Полиномы все дифференцируемы и, таким образом, дают нам comonads.

Хм. Все это немного абстрактно. Поэтому я добавил deriving Show всюду, что мог, и бросил

deriving instance (Show (DF f x), Show x) => Show (ZF f x)

который допускал следующее взаимодействие (подбирается вручную)

> downF (IF 1 :*: IF 2)
IF (LF (KF () :*: IF 2) :<-: 1) :*: IF (RF (IF 1 :*: KF ()) :<-: 2)

> fmap aroundF it
IF  (LF (KF () :*: IF (RF (IF 1 :*: KF ()) :<-: 2)) :<-: (LF (KF () :*: IF 2) :<-: 1))
:*:
IF  (RF (IF (LF (KF () :*: IF 2) :<-: 1) :*: KF ()) :<-: (RF (IF 1 :*: KF ()) :<-: 2))

Упражнение Покажите, что композиция дифференцируемых функторов дифференцируема, используя правило цепи.

Сладкое! Можем ли мы вернуться домой? Конечно нет. Мы еще не дифференцировали рекурсивные структуры.

Создание рекурсивных функторов из бифунторов

A Bifunctor, поскольку существующая литература о типичном программировании типа данных (см. работу Патрика Янсона и Йохана Журинга или замечательные лекционные заметки Джереми Гиббонса) объясняет, что это конструктор типа с двумя параметрами, соответствующий двум типам подструктуры. Мы должны иметь возможность "отображать" оба.

class Bifunctor b where
  bimap :: (x -> x') -> (y -> y') -> b x y -> b x' y'

Мы можем использовать Bifunctor для создания структуры рекурсивных контейнеров node. Каждый node имеет подносы и элементы. Это могут быть только два вида подструктуры.

data Mu b y = In (b (Mu b y) y)

См? Мы связываем рекурсивный узел в первом аргументе b и сохраняем параметр y во втором. Соответственно, мы получим один раз для всех

instance Bifunctor b => Functor (Mu b) where
  fmap f (In b) = In (bimap (fmap f) f b)

Чтобы использовать это, нам понадобится набор экземпляров Bifunctor.

Комплект Bifunctor

Константы являются бифунхронными.

newtype K a x y = K a

instance Bifunctor (K a) where
  bimap f g (K a) = K a

Вы можете сказать, что я написал этот бит первым, потому что идентификаторы короче, но это хорошо, потому что код длиннее.

Переменные являются бифунхронными.

Нам нужны бифункторы, соответствующие одному параметру или другому, поэтому я сделал тип данных, чтобы отличить их, а затем определил подходящий GADT.

data Var = X | Y

data V :: Var -> * -> * -> * where
  XX :: x -> V X x y
  YY :: y -> V Y x y

Это делает V X x y копию x и V Y x y копии y. Соответственно

instance Bifunctor (V v) where
  bimap f g (XX x) = XX (f x)
  bimap f g (YY y) = YY (g y)

Суммы и Продукты для бифунторов являются бифунторами

data (:++:) f g x y = L (f x y) | R (g x y) deriving Show

instance (Bifunctor b, Bifunctor c) => Bifunctor (b :++: c) where
  bimap f g (L b) = L (bimap f g b)
  bimap f g (R b) = R (bimap f g b)

data (:**:) f g x y = f x y :**: g x y deriving Show

instance (Bifunctor b, Bifunctor c) => Bifunctor (b :**: c) where
  bimap f g (b :**: c) = bimap f g b :**: bimap f g c

До сих пор такой шаблонный, но теперь мы можем определить такие вещи, как

List = Mu (K () :++: (V Y :**: V X))

Bin = Mu (V Y :**: (K () :++: (V X :**: V X)))

Если вы хотите использовать эти типы для фактических данных и не ослепнуть в традициях пуриллиста Жоржа Серата, используйте синонимы шаблонов.

Но что за молнии? Как показать, что Mu b дифференцируема? Нам нужно будет показать, что b дифференцируема в обеих переменных. Clang! Пришло время узнать о частичной дифференциации.

Частичные производные бифунторов

Поскольку у нас есть две переменные, нам нужно будет иметь возможность говорить о них коллективно иногда и индивидуально в другое время. Нам понадобится одноэлементное семейство:

data Vary :: Var -> * where
  VX :: Vary X
  VY :: Vary Y

Теперь мы можем сказать, что значит для бифунтора иметь частные производные по каждой переменной и дать соответствующее понятие молнии.

class (Bifunctor b, Bifunctor (D b X), Bifunctor (D b Y)) => Diff2 b where
  type D b (v :: Var) :: * -> * -> *
  up      :: Vary v -> Z b v x y -> b x y
  down    :: b x y -> b (Z b X x y) (Z b Y x y)
  around  :: Vary v -> Z b v x y -> Z b v (Z b X x y) (Z b Y x y)

data Z b v x y = (:<-) {cxZ :: D b v x y, elZ :: V v x y}

Эта операция D должна знать, какую переменную нужно настроить. Соответствующая застежка-молния Z b v сообщает нам, какая переменная v должна быть в фокусе. Когда мы "украшаем контекстом", мы должны украшать x -элементы x -contexts и y -элементы с помощью y -contexts. Но в остальном это та же история.

У нас есть две оставшиеся задачи: во-первых, чтобы показать, что наш бифункциональный набор дифференцируем; во-вторых, чтобы показать, что Diff2 b позволяет установить Diff1 (Mu b).

Дифференциация набора бифунтонов

Я боюсь, что этот бит - это скорее, а не назидание. Не стесняйтесь пропустить.

Константы по-прежнему.

instance Diff2 (K a) where
  type D (K a) v = K Void
  up _ (K q :<- _) = absurd q
  down (K a) = K a
  around _ (K q :<- _) = absurd q

В этом случае жизнь слишком коротка, чтобы развить теорию уровня типа Kronecker-delta, поэтому я просто обрабатывал переменные отдельно.

instance Diff2 (V X) where
  type D (V X) X = K ()
  type D (V X) Y = K Void
  up VX (K () :<- XX x)  = XX x
  up VY (K q :<- _)      = absurd q
  down (XX x) = XX (K () :<- XX x)
  around VX [email protected](K () :<- XX x)  = K () :<- XX z
  around VY (K q :<- _)        = absurd q

instance Diff2 (V Y) where
  type D (V Y) X = K Void
  type D (V Y) Y = K ()
  up VX (K q :<- _)      = absurd q
  up VY (K () :<- YY y)  = YY y
  down (YY y) = YY (K () :<- YY y)
  around VX (K q :<- _)        = absurd q
  around VY [email protected](K () :<- YY y)  = K () :<- YY z

Для структурных случаев я счел полезным ввести помощник, позволяющий мне обрабатывать переменные равномерно.

vV :: Vary v -> Z b v x y -> V v (Z b X x y) (Z b Y x y)
vV VX z = XX z
vV VY z = YY z

Затем я построил гаджеты, чтобы облегчить тип "перетаскивания", который нам нужен для down и around. (Конечно, я видел, какие гаджеты мне нужны, когда я работал.)

zimap :: (Bifunctor c) => (forall v. Vary v -> D b v x y -> D b' v x y) ->
         c (Z b X x y) (Z b Y x y) -> c (Z b' X x y) (Z b' Y x y)
zimap f = bimap
  (\ (d :<- XX x) -> f VX d :<- XX x)
  (\ (d :<- YY y) -> f VY d :<- YY y)

dzimap :: (Bifunctor (D c X), Bifunctor (D c Y)) =>
         (forall v. Vary v -> D b v x y -> D b' v x y) ->
         Vary v -> Z c v (Z b X x y) (Z b Y x y) -> D c v (Z b' X x y) (Z b' Y x y)
dzimap f VX (d :<- _) = bimap
  (\ (d :<- XX x) -> f VX d :<- XX x)
  (\ (d :<- YY y) -> f VY d :<- YY y)
  d
dzimap f VY (d :<- _) = bimap
  (\ (d :<- XX x) -> f VX d :<- XX x)
  (\ (d :<- YY y) -> f VY d :<- YY y)
  d

И с этой партией, готовой идти, мы можем разглядеть детали. Суммы легко.

instance (Diff2 b, Diff2 c) => Diff2 (b :++: c) where
  type D (b :++: c) v = D b v :++: D c v
  up v (L b' :<- vv) = L (up v (b' :<- vv))
  down (L b) = L (zimap (const L) (down b))
  down (R c) = R (zimap (const R) (down c))
  around v [email protected](L b' :<- vv :: Z (b :++: c) v x y)
    = L (dzimap (const L) v ba) :<- vV v z
    where ba = around v (b' :<- vv :: Z b v x y)
  around v [email protected](R c' :<- vv :: Z (b :++: c) v x y)
    = R (dzimap (const R) v ca) :<- vV v z
    where ca = around v (c' :<- vv :: Z c v x y)

Продукты - это тяжелая работа, поэтому я математик, а не инженер.

instance (Diff2 b, Diff2 c) => Diff2 (b :**: c) where
  type D (b :**: c) v = (D b v :**: c) :++: (b :**: D c v)
  up v (L (b' :**: c) :<- vv) = up v (b' :<- vv) :**: c
  up v (R (b :**: c') :<- vv) = b :**: up v (c' :<- vv)
  down (b :**: c) =
    zimap (const (L . (:**: c))) (down b) :**: zimap (const (R . (b :**:))) (down c)
  around v [email protected](L (b' :**: c) :<- vv :: Z (b :**: c) v x y)
    = L (dzimap (const (L . (:**: c))) v ba :**:
        zimap (const (R . (b :**:))) (down c))
      :<- vV v z where
      b = up v (b' :<- vv :: Z b v x y)
      ba = around v (b' :<- vv :: Z b v x y)
  around v [email protected](R (b :**: c') :<- vv :: Z (b :**: c) v x y)
    = R (zimap (const (L . (:**: c))) (down b):**:
        dzimap (const (R . (b :**:))) v ca)
      :<- vV v z where
      c = up v (c' :<- vv :: Z c v x y)
      ca = around v (c' :<- vv :: Z c v x y)

Концептуально, это как и раньше, но с большей бюрократией. Я построил их с использованием технологии pre-type-hole, используя undefined в качестве заглушки в местах, где я не был готов работать, и вводил преднамеренную ошибку типа в одном месте (в любой момент времени), где мне нужен полезный намек от typechecker. У вас тоже может быть проверка типов как опыт видеоигр, даже в Haskell.

Поднесущие молнии для рекурсивных контейнеров

Частная производная от b по отношению к x рассказывает нам, как найти один подканал внутри node, поэтому мы получаем обычное понятие молнии.

data MuZpr b y = MuZpr
  {  aboveMu  :: [D b X (Mu b y) y]
  ,  hereMu   :: Mu b y
  }

Мы можем увеличить масштаб до корня путем повторного подключения к позициям x.

muUp :: Diff2 b => MuZpr b y -> Mu b y
muUp (MuZpr {aboveMu = [], hereMu = t}) = t
muUp (MuZpr {aboveMu = (dX : dXs), hereMu = t}) =
  muUp (MuZpr {aboveMu = dXs, hereMu = In (up VX (dX :<- XX t))})

Но нам нужны элементы-молнии.

Элемент-молнии для фиксированных точек бифунторов

Каждый элемент находится где-то внутри node. Этот node находится под стеком x -производных. Но положение элемента в том, что node дается a y -производным. Получаем

data MuCx b y = MuCx
  {  aboveY  :: [D b X (Mu b y) y]
  ,  belowY  :: D b Y (Mu b y) y
  }

instance Diff2 b => Functor (MuCx b) where
  fmap f (MuCx { aboveY = dXs, belowY = dY }) = MuCx
    {  aboveY  = map (bimap (fmap f) f) dXs
    ,  belowY  = bimap (fmap f) f dY
    }

Смело, я утверждаю

instance Diff2 b => Diff1 (Mu b) where
  type DF (Mu b) = MuCx b

но прежде чем я начну выполнять операции, мне понадобятся некоторые кусочки.

Я могу обменять данные между молниеносными застежками-молниями и застежками-молниями:

zAboveY :: ZF (Mu b) y -> [D b X (Mu b y) y]  -- the stack of `X`-derivatives above me
zAboveY (d :<-: y) = aboveY d

zZipY :: ZF (Mu b) y -> Z b Y (Mu b y) y      -- the `Y`-zipper where I am
zZipY (d :<-: y) = belowY d :<- YY y

Этого достаточно, чтобы я мог определить:

  upF z  = muUp (MuZpr {aboveMu = zAboveY z, hereMu = In (up VY (zZipY z))})

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

Далее, я говорю

  downF  = yOnDown []

чтобы спуститься с пустого стека и определить вспомогательную функцию, которая идет down несколько раз снизу любого стека:

yOnDown :: Diff2 b => [D b X (Mu b y) y] -> Mu b y -> Mu b (ZF (Mu b) y)
yOnDown dXs (In b) = In (contextualize dXs (down b))

Теперь down b приводит нас только внутрь node. Необходимые молнии также должны иметь контекст node. То, что делает contextualise:

contextualize :: (Bifunctor c, Diff2 b) =>
  [D b X (Mu b y) y] ->
  c (Z b X (Mu b y) y) (Z b Y (Mu b y) y) ->
  c (Mu b (ZF (Mu b) y)) (ZF (Mu b) y)
contextualize dXs = bimap
  (\ (dX :<- XX t) -> yOnDown (dX : dXs) t)
  (\ (dY :<- YY y) -> MuCx {aboveY = dXs, belowY = dY} :<-: y)

Для каждого y -позиции мы должны дать элемент-застежку-молнию, поэтому хорошо, что мы знаем весь контекст dXs назад к корню, а также dY, который описывает, как элемент находится в его node. Для каждого x -позиции есть еще одно поддерево для изучения, поэтому мы выращиваем стек и продолжаем идти!

Это оставляет только дело смещения фокуса. Мы можем остаться на месте или спуститься с того места, где мы находимся, или подняться, или подняться, а затем по другому пути. Здесь идет.

  aroundF [email protected](MuCx {aboveY = dXs, belowY = dY} :<-: _) = MuCx
    {  aboveY = yOnUp dXs (In (up VY (zZipY z)))
    ,  belowY = contextualize dXs (cxZ $ around VY (zZipY z))
    }  :<-: z

Как всегда, существующий элемент заменяется всей его молнией. Для части belowY мы посмотрим, где еще мы можем пойти в существующем node: мы найдем альтернативный элемент y -позиций или далее x -subnodes для изучения, поэтому мы contextualise их. Для части aboveY мы должны вернуться к стопке x -производных после повторной сборки node, которую мы посещали.

yOnUp :: Diff2 b => [D b X (Mu b y) y] -> Mu b y ->
         [D b X (Mu b (ZF (Mu b) y)) (ZF (Mu b) y)]
yOnUp [] t = []
yOnUp (dX : dXs) (t :: Mu b y)
  =  contextualize dXs (cxZ $ around VX (dX :<- XX t))
  :  yOnUp dXs (In (up VX (dX :<- XX t)))

На каждом шаге мы можем либо превратиться где-нибудь еще, что around, либо продолжать расти.

И это! Я не дал формального доказательства законов, но мне кажется, что операции тщательно поддерживают контекст правильно, когда они сканируют структуру.

Что мы узнали?

Дифференцируемость индуцирует понятия предмет-в-его-контексте, вызывая комонадическую структуру, где extract дает вам вещь, а duplicate исследует контекст, ищущий другие вещи для контекстуализации. Если у нас есть соответствующая дифференциальная структура для узлов, мы можем развить дифференциальную структуру для целых деревьев.

О, и рассмотрение каждой индивидуальности arty конструктора типа по отдельности является откровенно ужасным. Лучше всего работать с функторами между индексированными наборами

f :: (i -> *) -> (o -> *)

где мы делаем o различные типы структуры, хранящие i различные типы элементов. Они закрыты по построению якобиана

J f :: (i -> *) -> ((o, i) -> *)

где каждая из полученных (o, i) -структур является частной производной, рассказывая вам, как сделать i -элементное отверстие в структуре o. Но это в зависимости от времени набирало веселье, в другое время.

Ответ 2

Экземпляр Comonad для молнии не

instance (Diff t, Diff (D t)) => Comonad (Zipper t) where
    extract = here
    duplicate = fmap outOf . inTo

где outOf и inTo относятся к экземпляру Diff для Zipper t. Вышеупомянутый пример нарушает закон Comonad fmap extract . duplicate == id. Вместо этого он ведет себя так:

fmap extract . duplicate == \z -> fmap (const (here z)) z

Diff (молния t)

Экземпляр Diff для Zipper предоставляется путем идентификации их как продуктов и повторного использования кода для продуктов (ниже).

-- Zippers are themselves products
toZipper :: (D t :*: Identity) a -> Zipper t a
toZipper (d :*: (Identity h)) = Zipper d h

fromZipper :: Zipper t a -> (D t :*: Identity) a
fromZipper (Zipper d h) = (d :*: (Identity h))

Учитывая изоморфизм между типами данных и изоморфизм между их производными, мы можем повторно использовать один тип inTo и outOf для другого.

inToFor' :: (Diff r) =>
            (forall a.   r a ->   t a) ->
            (forall a.   t a ->   r a) ->
            (forall a. D r a -> D t a) ->
            (forall a. D t a -> D r a) ->
            t a -> t (Zipper t a)
inToFor' to from toD fromD = to . fmap (onDiff toD) . inTo . from

outOfFor' :: (Diff r) =>
            (forall a.   r a ->   t a) ->
            (forall a.   t a ->   r a) ->
            (forall a. D r a -> D t a) ->
            (forall a. D t a -> D r a) ->
            Zipper t a -> t a
outOfFor' to from toD fromD = to . outOf . onDiff fromD

Для типов, которые являются только newTypes для существующего экземпляра Diff, их производные являются одним и тем же типом. Если мы скажем проверке типа об этом типе равенства D r ~ D t, мы можем воспользоваться этим, вместо того чтобы предоставить изоморфизм для производных.

inToFor :: (Diff r, D r ~ D t) =>
           (forall a. r a -> t a) ->
           (forall a. t a -> r a) ->
           t a -> t (Zipper t a)
inToFor to from = inToFor' to from id id

outOfFor :: (Diff r, D r ~ D t) =>
            (forall a. r a -> t a) ->
            (forall a. t a -> r a) ->
            Zipper t a -> t a
outOfFor to from = outOfFor' to from id id

Оборудованный этими инструментами, мы можем повторно использовать экземпляр Diff для продуктов для реализации Diff (Zipper t)

-- This requires undecidable instances, due to the need to take D (D t)
instance (Diff t, Diff (D t)) => Diff (Zipper t) where
    type D (Zipper t) = D ((D t) :*: Identity)
    -- inTo :: t        a -> t        (Zipper  t         a)
    -- inTo :: Zipper t a -> Zipper t (Zipper (Zipper t) a)
    inTo = inToFor toZipper fromZipper
    -- outOf :: Zipper  t         a -> t        a
    -- outOf :: Zipper (Zipper t) a -> Zipper t a
    outOf = outOfFor toZipper fromZipper

Boilerplate

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

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}

import Control.Monad.Identity
import Data.Proxy
import Control.Comonad

data Zipper t a = Zipper { diff :: D t a, here :: a }

onDiff :: (D t a -> D u a) -> Zipper t a -> Zipper u a
onDiff f (Zipper d a) = Zipper (f d) a

deriving instance Diff t => Functor (Zipper t)
deriving instance (Eq (D t a), Eq a) => Eq (Zipper t a)
deriving instance (Show (D t a), Show a) => Show (Zipper t a)

class (Functor t, Functor (D t)) => Diff t where
  type D t :: * -> *
  inTo  :: t a -> t (Zipper t a)
  outOf :: Zipper t a -> t a

Продукты, суммы и константы

Экземпляр Diff (Zipper t) полагается на реализации Diff для продуктов :*:, sums :+:, константы Identity и ноль Proxy.

data (:+:) a b x = InL (a x) | InR (b x)
    deriving (Eq, Show)
data (:*:) a b x = a x :*: b x
    deriving (Eq, Show)

infixl 7 :*:
infixl 6 :+:

deriving instance (Functor a, Functor b) => Functor (a :*: b)

instance (Functor a, Functor b) => Functor (a :+: b) where
    fmap f (InL a) = InL . fmap f $ a
    fmap f (InR b) = InR . fmap f $ b


instance (Diff a, Diff b) => Diff (a :*: b) where
    type D (a :*: b) = D a :*: b :+: a :*: D b
    inTo (a :*: b) = 
        (fmap (onDiff (InL . (:*: b))) . inTo) a :*:
        (fmap (onDiff (InR . (a :*:))) . inTo) b
    outOf (Zipper (InL (a :*: b)) x) = (:*: b) . outOf . Zipper a $ x
    outOf (Zipper (InR (a :*: b)) x) = (a :*:) . outOf . Zipper b $ x

instance (Diff a, Diff b) => Diff (a :+: b) where
    type D (a :+: b) = D a :+: D b
    inTo (InL a) = InL . fmap (onDiff InL) . inTo $ a
    inTo (InR b) = InR . fmap (onDiff InR) . inTo $ b
    outOf (Zipper (InL a) x) = InL . outOf . Zipper a $ x
    outOf (Zipper (InR a) x) = InR . outOf . Zipper a $ x

instance Diff (Identity) where
    type D (Identity) = Proxy
    inTo = Identity . (Zipper Proxy) . runIdentity
    outOf = Identity . here

instance Diff (Proxy) where
    type D (Proxy) = Proxy
    inTo = const Proxy
    outOf = const Proxy

Пример бина

Я представил пример Bin как изоморфизм к сумме произведений. Нам нужна не только его производная, но и ее вторая производная,

newtype Bin   a = Bin   {unBin   ::      (Bin :*: Identity :*: Bin :+: Identity)  a}
    deriving (Functor, Eq, Show)
newtype DBin  a = DBin  {unDBin  ::    D (Bin :*: Identity :*: Bin :+: Identity)  a}
    deriving (Functor, Eq, Show)
newtype DDBin a = DDBin {unDDBin :: D (D (Bin :*: Identity :*: Bin :+: Identity)) a}
    deriving (Functor, Eq, Show)

instance Diff Bin where
    type D Bin = DBin
    inTo  = inToFor'  Bin unBin DBin unDBin
    outOf = outOfFor' Bin unBin DBin unDBin

instance Diff DBin where
    type D DBin = DDBin
    inTo  = inToFor'  DBin unDBin DDBin unDDBin
    outOf = outOfFor' DBin unDBin DDBin unDDBin

Пример данных из предыдущего ответа -

aTree :: Bin Int    
aTree =
    (Bin . InL) (
        (Bin . InL) (
            (Bin . InR) (Identity 2)
            :*: (Identity 1) :*:
            (Bin . InR) (Identity 3)
        )
        :*: (Identity 0) :*:
        (Bin . InR) (Identity 4)
    )

Не экземпляр Comonad

В приведенном выше примере Bin приведен пример соответствия fmap outOf . inTo правильной реализации duplicate для Zipper t. В частности, он дает встречный пример закону fmap extract . duplicate = id:

fmap ( \z -> (fmap extract . duplicate) z == z) . inTo $ aTree

Который оценивает (замечает, как он заполнен False всюду, любого False было бы достаточно, чтобы опровергнуть закон)

Bin {unBin = InL ((Bin {unBin = InL ((Bin {unBin = InR (Identity False)} :*: Identity False) :*: Bin {unBin = InR (Identity False)})} :*: Identity False) :*: Bin {unBin = InR (Identity False)})}

inTo aTree - это дерево с той же структурой, что и aTree, но везде есть значение, вместо этого вместо этого стоит застежка-молния со значением, а остальная часть дерева со всеми исходными значениями не установлена. fmap (fmap extract . duplicate) . inTo $ aTree также является деревом с той же структурой, что и aTree, но каждый из них имел значение вместо этого - застежка-молния со значением, а остальная часть дерева со всеми значениями, замещенными этим же значением. Другими словами:

fmap extract . duplicate == \z -> fmap (const (here z)) z

Полный тестовый набор для всех трех законов Comonad, extract . duplicate == id, fmap extract . duplicate == id и duplicate . duplicate == fmap duplicate . duplicate равен

main = do
    putStrLn "fmap (\\z -> (extract . duplicate) z == z) . inTo $ aTree"
    print   . fmap ( \z -> (extract . duplicate) z == z) . inTo $ aTree    
    putStrLn ""
    putStrLn  "fmap (\\z -> (fmap extract . duplicate) z == z) . inTo $ aTree"
    print    . fmap ( \z -> (fmap extract . duplicate) z == z) . inTo $ aTree    
    putStrLn ""
    putStrLn "fmap (\\z -> (duplicate . duplicate) z) == (fmap duplicate . duplicate) z) . inTo $ aTree"
    print   . fmap ( \z -> (duplicate . duplicate) z == (fmap duplicate . duplicate) z) . inTo $ aTree

Ответ 3

Для бесконечно дифференцируемого класса Diff:

class (Functor t, Functor (D t)) => Diff t where
    type D t :: * -> *
    up :: Zipper t a -> t a
    down :: t a -> t (Zipper t a)  
    -- Require that types be infinitely differentiable
    ddiff :: p t -> Dict (Diff (D t))

around можно записать в терминах up и down на производном Zipper Diff, по существу, как

around [email protected](Zipper d h) = Zipper ctx z
    where
        ctx = fmap (\z' -> Zipper (up z') (here z')) (down d)

Zipper t a состоит из D t a и a a. Пойдем down the D t a, получив a D t (Zipper (D t) a) с застежкой-молнией в каждом отверстии. Эти молнии состоят из D (D t) a и a, которые были в отверстии. Мы идем up каждый из них, получая a D t a и обрабатывая его с a, который был в отверстии. A D t a и a сделать Zipper t a, давая нам D t (Zipper t a), который является контекстом, необходимым для Zipper t (Zipper t a).

Экземпляр Comonad тогда просто

instance Diff t => Comonad (Zipper t) where
    extract   = here
    duplicate = around

Захват словаря производной Diff требует некоторой дополнительной сантехники, которая может быть выполнена с помощью Data.Constraint или с точки зрения метода, представленного в соответствующем ответе

around :: Diff t => Zipper t a -> Zipper t (Zipper t a)
around z = Zipper (withDict d' (fmap (\z' -> Zipper (up z') (here z')) (down (diff z)))) z
    where
        d' = ddiff . p' $ z
        p' :: Zipper t x -> Proxy t
        p' = const Proxy