拉链Comonads，一般

本文介绍了拉链Comonads，一般的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述 29岁程序员，3月因学历无情被辞！ 给定任何容器类型，我们可以形成（以元素为中心的）拉链，并知道这个结构是一个Comonad。这是最近在另一堆栈溢出问题为以下类型： 数据Bin a =分支（Bin a）a（Bin a）|使用下面的拉链来衍生Functor data Dir = L | R data步骤a =步骤a导出Functor 数据Zip a = Zip [步骤a]（Bin a）派生Functor 实例Comonad Zip其中... Zip 是一个 Comonad 虽然其实例的构造有点多毛。也就是说， Zip 可以完全机械地从 Tree 派生，而且（我相信）以这种方式派生的任何类型都会自动成为 Comonad ，所以我认为应该是这种情况，我们可以一般和自动地构造这些类型和它们的共同作用。 实现拉链构造普遍性的一种方法是使用以下类和类型族 数据Zipper ta = Zipper {diff :: D ta，here :: a} 导出实例Diff t => Functor（Zipper t） class（Functor t，Functor（D t））=> Diff t其中 data D t :: * - > * inTo :: t a - > t（拉链t a） outOf ::拉链t a - > （或多或少）出现在Haskell Cafe线程和Conal Elliott的博客中。这个类可以为各种核心代数类型实例化，从而为讨论ADT的派生提供了一个通用框架。所以，最终，我的问题是否是否我们可以写出： instance Diff t => Comonad（Zipper t）其中... 可用于包含上述特定Comonad实例： 实例Diff Bin其中数据D Bin a = DBin {context :: [Step a]，下降： ：可能（Bin a，Bin a）} ... 不幸的是，没有运气写这样的例子。 inTo / outOf 签名是否足够？是否还有其他需要约束类型？这个例子甚至有可能吗？解决方案像Chitty-Chitty-Bang-Bang中的child l引诱孩子们被糖果和玩具囚禁，大学生物理学的招聘人员喜欢用肥皂泡和飞旋镖来欺骗，但是当门敲响时，它是正确的，孩子，学习偏分化的时候！。我也是。不要说我没有提醒你。 这是另一个警告：下面的代码需要 { - ＃LANGUAGE KitchenSink＃ - } ，或者更确切地说 { - ＃LANGUAGE TypeFamilies，FlexibleContexts，TupleSections，GADTs，DataKinds， TypeOperators，FlexibleInstances，RankNTypes，ScopedTypeVariables， StandaloneDeriving，UndecidableInstances＃ - } 订单。 可区分的函子给出comonadic zippers 无论如何，可微函子是什么？ class（Functor f，Functor（DF f））=> Diff1 f其中类型DF f :: * - > * upF :: ZF f x - > f x downF :: f x - > f（ZF f x） aroundF :: ZF f x - > ZF f（ZF fx） data ZF fx =（： pre> 这是一个函子，它有一个派生函数，它也是一个函子。该派生代表元素的单洞上下文。拉链类型 ZF fx 表示一对单孔上下文和孔中的元素。 Diff1 的操作描述了我们可以在拉链上进行的导航类型（没有任何向左和向右的概念，请参阅我的 Clowns and Jokers paper）。我们可以向上，通过将元件插入孔中来重新组装结构。我们可以向下，找到各种方式访问​​给定结构中的元素：我们用它的上下文来装饰每个元素。我们可以在周围，拿一个现有的拉链，并用它的上下文装饰每个元素，所以我们找到所有重新聚焦的方法（以及如何保持当前的焦点）。 现在，围绕的类型可能会提醒你们一些 class Functor c => Comonad c其中 extract :: c x - > x duplicate :: c x - > c（c x） 你被提醒了！我们有一跳和一个跳过， instance Diff1 f => Functor（ZF f）其中 fmap f（df：< - ：x）= f map f df：< - ：f x instance Diff1 f => Comonad（ZF f）其中 extract = elF duplicate = around F 和我们坚持认为 摘录。复制== ID fmap提取。复制== id 重复。重复== fmap重复。重复 我们还需要 fmap extract（downF xs）== xs - downF装饰元素位置 fmap upF（downF xs）= fmap（const xs）xs - downF给出正确的上下文 多项式函子是可微分的 常量函子是可区分的。 data KF ax = KF a 实例Functor（KF a）where （KF a）= KF a 实例Diff1（KF a）其中类型DF（KF a）= KF Void upF（KF w： < - ：_）=荒谬的w downF（KF a）= KF a aroundF（KF w： 没有地方放置元素，所以不可能形成上下文。无处可去 upF 或 downF ，我们很容易找到所有的方法去 downF 。 身份仿函数是可区分的。 data IF x = IF x 实例Functor IF其中 fmap f（IF x）= IF（fx） 实例Diff1 IF其中类型DF IF = KF（） upF（KF（）：< - ：x）= IF x downF（IF x）= IF（KF（） < - ：x） aroundF z @（KF（）：< - ：x）= KF（）：< - ：z 在一个普通的上下文中有一个元素， downF 找到它， upF 重新包装它，而 aroundF 只能保留。 总和保留可微分性 data（f：+：g）x = LF（fx）| RF（g x）实例（Functor f，Functor g）=> Functor（f：+：g）其中 fmap h（LF f）= LF（fmap hf） fmap h（RF g）= RF（fmap hg） instance （Diff1 f，Diff1 g）=> Diff1（f：+：g）其中， type DF（f：+：g）= DF f：+：DF g upF（LF f'： upF（RF g'：< - ：x）= RF（upF（g'： 其他零星零零碎碎。要去 downF ，我们必须在标记的组件内 downF ，然后修改生成的拉链以显示标记$ f $（$）$ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ > LF f'：< - ：x）（downF f）） downF（RF g）= RF（f map（f'（g'： RF g'） < - ：x）（downF g）） 要去 aroundF ，我们剥离标签，找出如何绕过未标记的东西，然后在所有生成的拉链中恢复标签。焦点元素 x 被其整个拉链替换为 z 。 aroundF z @（LF f'：< - ：（x :: x））= LF（fmap（\ （f'：< - ：x :: ZF fx））：< - ：z $ b （g'：< - ：（x :: x））= RF（f map（\（g'：：< - ：z 请注意，我必须使用 ScopedTypeVariables 将递归调用消除到 $ C>。作为一个类型函数， DF 不是内射的，所以 f':: D fx 不足以force f'：< - ：x :: Z fx 。 产品保留差异性。 pre $ data（f：*：g）x = fx：*：gx 实例（Functor f ，Functor g）=> Functor（f：*：g）其中 fmap h（f：*：g）= fmap hf：*：fmap hg 要专注于一对中的元素，您可以将注意力集中在左侧，让右侧单独放置，反之亦然。 Leibniz着名的产品规则对应于简单的空间直觉！ pre code> instance（Diff1 f，Diff1 g）=> Diff1（f：*：g）其中类型DF（f：*：g）=（DF f：*：g）：+：（f：*：DF g） upF（LF f：*：g）： upF（RF（f：*：g'）：< x）= f：*：upF（g'： 现在， code> downF 的工作方式与它对于和的方式类似，不同之处在于我们不仅需要使用标记来修正拉链上下文（以显示我们去过哪个方向），而且还需要（f：*：g） = fmap（\（f'：< / p） ; - ：x） - > LF（f'：*：g）：：*：fmap（\（g'：< - ：x） - > RF（f：*：g'）： 但是 aroundF 是一大堆笑声。无论我们目前正在访问的哪一方面，我们都有两种选择： 将移到 将 upF 移出该边，将 downF 移入其他方面。 每种情况都需要我们利用子结构的操作，然后修复上下文。 aroundF z @（LF（f'：*：g）：< - ：（x :: x））= LF （f'（f'（f'：（c' x :: ZF fx））：*：fmap（\（g'：< - ：x）→RF（f：*：g'）：：其中f = upF（f'： aroundF z（RF（f：*：g'）：< - ：（x :: x））= RF（fmap（\（f'：< - ：x）→LF（f'：*：g）：< - ：x）（ （f'）：*： fmap（\（g'： RF（f：*：g'）：（cxF $ aroundF（g'：< - ：x :: ZF gx））） ：< - ：z 其中g = upF（g'：< - ：x） 唷！多项式都是可微的，因此给我们带来了连接。 嗯。这都有点抽象。因此，我在任何地方都可以添加派生Show ，并且抛出 派生实例（Show（DF fx），Show x）=>显示（ZF fx） 允许以下互动（手工整理） > （LF（KF（）：*：IF 2）：< - ：1）：*：IF（RF（IF 1：*：KF（）） ：< - ：2） > （LF（KF（））：*：IF（RF（IF 1：*：KF（））：：*： IF（RF（IF（LF（KF（）：*：IF 2）：< - ：1） ：KF（））：< - :( RF（IF 1：*：KF（））：< - ：2）） 练习使用链规则显示可区分函子的组成是可区分的。 甜！我们现在能回家吗？当然不是。我们还没有区分任何递归结构。 从bifunctors制作递归函子 具有两个参数的构造函数，对应于两种子结构。我们应该能够映射两者。 类Bifunctor b其中 bimap ::（x - > x'） - > （y - > y'） - > b x y - > b x'y' 我们可以使用 Bifunctor s给出递归容器的节点结构。每个节点都有子节点和元素。这些可以只是两种子结构。 $ p $ 数据Mu by = In（b（Mu by）y） 请参阅？我们在 b 的第一个参数中绑定递归结，并在第二个参数中保存参数 y 。因此，我们获得一次所有的 实例Bifunctor b => Functor（Mu b）其中 fmap f（In b）= In（bimap（fmap f）fb） 为了使用它，我们需要一个包含 Bifunctor 实例的工具包。 Bifunctor工具包 $ b pre $ 常量 newtype K axy = K a 实例Bifunctor（K a）其中 bimap fg（K a）= K a 你可以告诉我先写这个位，因为标识符较短，但这很好，因为代码更长。 我们需要双函数对应一个参数或另一个参数，所以我做了一个数据类型来区分它们，然后定义了一个合适的GADT。 data Var = X | Y data V :: Var - > * - > * - > *其中 XX :: x - > V X x y YY :: y - > VY xy 这使得 VX xy 副本 x 和 VY xy y 的副本。因此， $ pre code $ b bimap fg（XX x）= XX（fx） bimap fg（YY y）= YY（gy） 总计和bifunctors的产品是bifunctors data（：++ :) fgxy = L（fxy）| R（g x y）导出Show b $ b实例（Bifunctor b，Bifunctor c）=> bifunctor（b：++：c）其中 bimap fg（L b）= L（bimap fgb） bimap fg（R b）= R（bimap fgb） 数据（：** :) fgxy = fxy：**：gxy派生显示 实例（Bifunctor b，Bifunctor c）=> bifunctor（b：**：c）其中 bimap fg（b：**：c）= bimap fgb：**：bimap fgc 到目前为止，这样的样板化，但现在我们可以定义像 List = V（K（）：++：（VY：**：VX）） Bin = Mu（VY： VX））） 如果您想要将这些类型用于实际数据，而不是盲目地在pointilliste Georges Seurat的传统，使用模式同义词。 但拉链是什么？我们应该如何证明 Mu b 是可微的？我们需要证明在 变量中 b 是可微分的。铛！现在是了解偏分化的时候了。 双折射函数的部分导数 因为我们有两个变量，需要能够在其他时间集体讨论它们。我们需要单身家庭： data Vary :: Var - > *其中 VX :: Vary X VY :: Vary Y 现在我们可以说一个Bifunctor对每个变量都有偏导数，并给出相应的拉链概念意味着什么。 class （双函数b，双函数（D b X），双函数（D b Y））=> Diff2 b其中 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 bv（Z b X xy）（Z b Y xy） data Z bvxy =（： 这个 D 操作需要知道要定位哪个变量。相应的拉链 Z b v 告诉我们哪个变量 v 必须是焦点。当我们用上下文装饰时，我们必须用 X -contexts和 - 元素c> y -elements with Y -contexts。但除此之外，情况也是如此。 我们还有两项任务：首先，为了表明我们的双联套件是可区分的;其次，显示 Diff2 b 允许我们建立 Diff1（Mu b）。 区分Bifunctor套件 恐怕这一点很烦琐，而不是令人遐想。可随意跳过。 常数与以前一样。 实例Diff2（K a）其中类型D（K a）v = K Void up _（K q： down（K a）= K a 围绕_（K q： 开这种情况下，生活太短而无法发展Kronecker-delta类型的理论，所以我只是单独处理这些变量。 实例Diff2（VX）其中 type D（VX）X = K（） type D（VX）Y = K Void up VX（K（）：向上VY（K q：向下（XX x）= XX（K（）：围绕VX （K q： 实例中的z（K（）： Diff2（VY）其中类型D（VY）X = K Void 类型D（VY）Y = K（） up VX（K q：围绕VX（K q：围绕VY z（K（）： 对于结构性案例，我发现引入一个助手可以让我统一处理变量。 / p> vV :: Vary v - > Z b v x y - > V v（Z b X xy）（Z b Y xy） vV VX z = XX z vV VY z = YY z 然后，我制作了小工具，以方便我们在 down 和周围需要的retagging类型。 （当然，我在工作时看到了我需要的小工具。） 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 xy）（Z b'Y xy） zimap f = bimap （\（d： f VX d：（\（d： f VY d： dzimap ::（Bifunctor（D c X），双函数（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 cv（Z b'X xy）（Z b'Y xy） dzimap f VX（d：< - _）= bimap （\（d：（\（d： f VY d：d dzimap （d：< - _x）= bimap （\（d： f VX d： ：< - YY y） - > f VY d：< - YY y）d 随着这一切准备就绪，我们可以研究细节。总和很容易。 instance（Diff2 b，Diff2 c）=> Diff2（b：++：c）其中类型D（b：++：c）v = D bv：++：D cv up v（L b'：向下（L b）= L（zimap（const L）（向下b））向下（R c）= R（zimap （const R）（向下c））围绕vz @（L b'： = L（dzimap（const L） v ba）：< -vV vz 其中ba = v（b'：围绕vz @（R c'： = R（dzimap（const R）v ca）：其中ca = v（c'： 产品都很努力，这就是为什么我是数学家而不是工程师。 instance（Diff2 b，Diff2 c）=> Diff2（b：**：c）其中类型D（b：**：c）v =（D bv：**：c）：++：（b：**：D cv）$ b （b'：**：c）： up v（R（b：* *：c'）： down（b：**：c）= zimap（const （b：** :)））（向下c）围绕vz @（L（b'））（向下b）：**：zimap ：**：c）： = L（dzimap（const（L。（：**：c）））v ba：* *： zimap（const（R。（b：** :)））（down c））：b = up v（b'：< （b：**：c'）： ba =绕v（b'： vv :: Z（b：**：c）vxy） = R（zimap（const（L。（：**：c）））（down b）：**： dzimap const（R（b：** :)））v ca）：c = up v（c'： ca = v（c'： 这与以前一样，但官僚作风更多。我使用pre-type-hole技术构建了这些技术，在我尚未准备好工作的地方使用 undefined 作为存根，并在一个地方引入了故意类型错误在任何时候），我想从typechecker有用的提示。你也可以在视频游戏体验中进行类型检查，即使在Haskell中也是如此。 递归容器的子节点拉链 b 关于 X 的偏导数告诉我们如何在一个节点内找到一个子节点，所以我们得到传统的拉链概念。 数据MuZpr by = MuZpr {above：Mu：[D b X ）y] ，hereMu :: Mu by } 我们可以放大通过重复插入 X 职位直至根目录。 muUp :: Diff2 b => MuZpr b y - > Mu by muUp（MuZpr {aboveMu = []，hereMu = t}）= t muUp（MuZpr {aboveMu =（dX：dXs），hereMu = t}）= muUp MuZpr {aboveMu = dXs，hereMu = In（up VX（dX： 但是我们需要元素 -zippers。 bifunctors固定点的元素拉链 每个元素都在某个节点内。该节点位于 X - 衍生物的堆栈下。但是该节点中元素的位置由 Y - 导出。我们得到 数据MuCx by = MuCx {aboveY :: [D b X（Mu by）y] ，belowY :: D b Y（Mu by）y } instance Diff2 b =>函数（MuCx b）其中 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）其中类型DF（Mu b）= MuCx b 但之前我开发了这些操作，我需要一些零件。 我可以按如下方式在仿函数拉链和bifunctor-zippers之间交换数据： zAboveY :: ZF（Mu b）y - > [D b X（Mu by）y] - 高于我的'X'衍生物的叠加 zAboveY（d： zZipY :: ZF（Mu b）y - > Z b Y（Mu by）y - 'Y`拉链，其中我是 zZipY（d： $ b 这足以让我定义： upF z = muUp（MuZpr {aboveMu = zAboveY z，hereMu = In（up VY（zZipY z））}） 也就是说，我们首先重新组装元素所在的节点，将元素拉链变成子节点拉链，然后像上面一样放大。 接下来，我说 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 只会将我们带入节点。我们需要的拉链还必须携带节点的上下文。这就是 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： ; yOnDown（dX：dXs）t）（\（dY： MuCx {aboveY = dXs，belowY = dY}： 对于每一个 Y -position，我们必须给出一个元素拉链，所以我们很好地知道整个上下文 dXs 回到根目录，以及 dY ，它描述了该元素位于其节点中。对于每一个 X -position，都有一个进一步的子树可供探索，所以我们增加了堆栈并继续进行下去！ 这只留下了转移焦点的业务。我们可能会保持沉默，或者离开我们的位置，或者走上去，或者走上去，然后沿着另一条路走下去。 aroundF z @（MuCx {aboveY = dXs，belowY = dY}： {aboveY = yOnUp dXs（in（up VY（zZipY z））），belowY = contextualize dXs（cxZ $ around VY（zZipY z））}：< - ：z 与以往一样，现有元素被其整个拉链替换。对于 belowY 部分，我们看看现有节点还有哪些地方可以去：我们会找到另一个元素 Y 或者进一步探讨 X - 子节点，所以我们 contextualise 它们。对于 aboveY 部分，我们必须在重新组装我们所在的节点之后回到 X - 衍生物的堆栈访问。 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） （dX：< -XX t））（b）yOnUp dXs（in（up VX（dX：< -XX t） ）） 在这一步的每一步中，我们可以转向其他地方围绕，或继续上涨。 就是这样！我没有给出正式的法律证明，但它在我看来好像操作在抓取结构时仔细维护上下文。 我们有什么了解？ 可区分性引发了上下文事物的概念，引发了一个 extract >给出的共同结构该事物和重复探索了上下文查找其他事物的上下文。如果我们有适当的节点差分结构，我们可以开发整棵树的差分结构。 哦，分别处理构造函数的每个单独元组是明显可怕的。更好的方法是在索引集之间使用函子 f ::（i - > *） - > （o - > *） 在 o 不同类型的结构存储 i 不同种类的元素。这些在雅可比构造下是 closed J f ::（i - > *） - > （（o，i） - > *） 结果（o，i） -structures是一个偏导数，告诉你如何在 - 元素洞C> 0 - 结构。但是，这是另一个有趣的类型。 Given any container type we can form the (element-focused) Zipper and know that this structure is a Comonad. This was recently explored in wonderful detail in another Stack Overflow question for the following type:data Bin a = Branch (Bin a) a (Bin a) | Leaf a deriving Functorwith the following zipperdata Dir = L | Rdata Step a = Step a Dir (Bin a) deriving Functordata Zip a = Zip [Step a] (Bin a) deriving Functorinstance Comonad Zip where ...It is the case that Zip is a Comonad though the construction of its instance is a little hairy. That said, Zip can be completely mechanically derived from Tree and (I believe) any type derived this way is automatically a Comonad, so I feel it ought to be the case that we can construct these types and their comonads generically and automatically.One method for achieving generality for zipper construction is the use the following class and type familydata 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 awhich has (more or less) shown up in Haskell Cafe threads and on Conal Elliott's blog. This class can be instantiated for the various core algebraic types and thus provides a general framework for talking about the derivatives of ADTs.So, ultimately, my question is whether or not we can writeinstance Diff t => Comonad (Zipper t) where ...which could be used to subsume the specific Comonad instance described above:instance Diff Bin where data D Bin a = DBin { context :: [Step a], descend :: Maybe (Bin a, Bin a) } ...Unfortunately, I've had no luck writing such an instance. Is the inTo/outOf signature sufficient? Is there something else needed to constrain the types? Is this instance even possible? 解决方案 Like the childcatcher in Chitty-Chitty-Bang-Bang luring kids into captivity with sweets and toys, recruiters to undergraduate Physics like to fool about with soap bubbles and boomerangs, but when the door clangs shut, it's "Right, children, time to learn about partial differentiation!". Me too. Don't say I didn't warn you.Here's another warning: the following code needs {-# LANGUAGE KitchenSink #-}, or rather{-# LANGUAGE TypeFamilies, FlexibleContexts, TupleSections, GADTs, DataKinds, TypeOperators, FlexibleInstances, RankNTypes, ScopedTypeVariables, StandaloneDeriving, UndecidableInstances #-}in no particular order.Differentiable functors give comonadic zippersWhat is a differentiable functor, anyway?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}It's a functor which has a derivative, which is also a functor. The derivative represents a one-hole context for an element. The zipper type ZF f x represents the pair of a one-hole context and the element in the hole.The operations for Diff1 describe the kinds of navigation we can do on zippers (without any notion of "leftward" and "rightward", for which see my Clowns and Jokers paper). We can go "upward", reassembling the structure by plugging the element in its hole. We can go "downward", finding every way to visit an element in a give structure: we decorate every element with its context. We can go "around",taking an existing zipper and decorating each element with its context, so we find all the ways to refocus (and how to keep our current focus).Now, the type of aroundF might remind some of you ofclass Functor c => Comonad c where extract :: c x -> x duplicate :: c x -> c (c x)and you're right to be reminded! We have, with a hop and a skip,instance Diff1 f => Functor (ZF f) where fmap f (df :<-: x) = fmap f df :<-: f xinstance Diff1 f => Comonad (ZF f) where extract = elF duplicate = aroundFand we insist thatextract . duplicate == idfmap extract . duplicate == idduplicate . duplicate == fmap duplicate . duplicateWe also need thatfmap extract (downF xs) == xs -- downF decorates the element in positionfmap upF (downF xs) = fmap (const xs) xs -- downF gives the correct contextPolynomial functors are differentiableConstant functors are differentiable.data KF a x = KF ainstance Functor (KF a) where fmap f (KF a) = KF ainstance Diff1 (KF a) where type DF (KF a) = KF Void upF (KF w :<-: _) = absurd w downF (KF a) = KF a aroundF (KF w :<-: _) = absurd wThere's nowhere to put an element, so it's impossible to form a context. There's nowhere to go upF or downF from, and we easily find all none of the ways to go downF.The identity functor is differentiable.data IF x = IF xinstance 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 z@(KF () :<-: x) = KF () :<-: zThere's one element in a trivial context, downF finds it, upF repacks it, and aroundF can only stay put.Sum preserves differentiability.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))The other bits and pieces are a bit more of a handful. To go downF, we must go downF inside the tagged component, then fix up the resulting zippers to show the tag in the context. downF (LF f) = LF (fmap (\ (f' :<-: x) -> LF f' :<-: x) (downF f)) downF (RF g) = RF (fmap (\ (g' :<-: x) -> RF g' :<-: x) (downF g))To go aroundF, we strip the tag, figure out how to go around the untagged thing, then restore the tag in all the resulting zippers. The element in focus, x, is replaced by its entire zipper, z. aroundF z@(LF f' :<-: (x :: x)) = LF (fmap (\ (f' :<-: x) -> LF f' :<-: x) . cxF $ aroundF (f' :<-: x :: ZF f x)) :<-: z aroundF z@(RF g' :<-: (x :: x)) = RF (fmap (\ (g' :<-: x) -> RF g' :<-: x) . cxF $ aroundF (g' :<-: x :: ZF g x)) :<-: zNote that I had to use ScopedTypeVariables to disambiguate the recursive calls to aroundF. As a type function, DF is not injective, so the fact that f' :: D f x is not enough to force f' :<-: x :: Z f x.Product preserves differentiability.data (f :*: g) x = f x :*: g xinstance (Functor f, Functor g) => Functor (f :*: g) where fmap h (f :*: g) = fmap h f :*: fmap h gTo focus on an element in a pair, you either focus on the left and leave the right alone, or vice versa. Leibniz's famous product rule corresponds to a simple spatial intuition!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)Now, downF works similarly to the way it did for sums, except that we have to fix up the zipper context not only with a tag (to show which way we went) but also with the untouched other component. downF (f :*: g) = fmap (\ (f' :<-: x) -> LF (f' :*: g) :<-: x) (downF f) :*: fmap (\ (g' :<-: x) -> RF (f :*: g') :<-: x) (downF g)But aroundF is a massive bag of laughs. Whichever side we are currently visiting, we have two choices:Move aroundF on that side.Move upF out of that side and downF into the other side.Each case requires us to make use of the operations for the substructure, then fix up contexts. aroundF z@(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 z@(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)Phew! The polynomials are all differentiable, and thus give us comonads.Hmm. It's all a bit abstract. So I added deriving Show everywhere I could, and threw inderiving instance (Show (DF f x), Show x) => Show (ZF f x)which allowed the following interaction (tidied up by hand)> downF (IF 1 :*: IF 2)IF (LF (KF () :*: IF 2) :<-: 1) :*: IF (RF (IF 1 :*: KF ()) :<-: 2)> fmap aroundF itIF (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))Exercise Show that the composition of differentiable functors is differentiable, using the chain rule.Sweet! Can we go home now? Of course not. We haven't differentiated any recursive structures yet.Making recursive functors from bifunctorsA Bifunctor, as the existing literature on datatype generic programming (see work by Patrik Jansson and Johan Jeuring, or excellent lecture notes by Jeremy Gibbons) explains at length is a type constructor with two parameters, corresponding to two sorts of substructure. We should be able to "map" both.class Bifunctor b where bimap :: (x -> x') -> (y -> y') -> b x y -> b x' y'We can use Bifunctors to give the node structure of recursive containers. Each node has subnodes and elements. These can just be the two sorts of substructure.data Mu b y = In (b (Mu b y) y)See? We "tie the recursive knot" in b's first argument, and keep the parameter y in its second. Accordingly, we obtain once for allinstance Bifunctor b => Functor (Mu b) where fmap f (In b) = In (bimap (fmap f) f b)To use this, we'll need a kit of Bifunctor instances.The Bifunctor KitConstants are bifunctorial.newtype K a x y = K ainstance Bifunctor (K a) where bimap f g (K a) = K aYou can tell I wrote this bit first, because the identifiers are shorter, but that's good because the code is longer.Variables are bifunctorial.We need the bifunctors corresponding to one parameter or the other, so I made a datatype to distinguish them, then defined a suitable GADT.data Var = X | Ydata V :: Var -> * -> * -> * where XX :: x -> V X x y YY :: y -> V Y x yThat makes V X x y a copy of x and V Y x y a copy of y. Accordinglyinstance Bifunctor (V v) where bimap f g (XX x) = XX (f x) bimap f g (YY y) = YY (g y)Sums and Products of bifunctors are bifunctorsdata (:++:) f g x y = L (f x y) | R (g x y) deriving Showinstance (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 Showinstance (Bifunctor b, Bifunctor c) => Bifunctor (b :**: c) where bimap f g (b :**: c) = bimap f g b :**: bimap f g cSo far, so boilerplate, but now we can define things likeList = Mu (K () :++: (V Y :**: V X))Bin = Mu (V Y :**: (K () :++: (V X :**: V X)))If you want to use these types for actual data and not go blind in the pointilliste tradition of Georges Seurat, use pattern synonyms.But what of zippers? How shall we show that Mu b is differentiable? We shall need to show that b is differentiable in both variables. Clang! It's time to learn about partial differentiation.Partial derivatives of bifunctorsBecause we have two variables, we shall need to be able to talk about them collectively sometimes and individually at other times. We shall need the singleton family:data Vary :: Var -> * where VX :: Vary X VY :: Vary YNow we can say what it means for a Bifunctor to have partial derivatives at each variable, and give the corresponding notion of zipper.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}This D operation needs to know which variable to target. The corresponding zipper Z b v tells us which variable v must be in focus. When we "decorate with context", we have to decorate x-elements with X-contexts and y-elements with Y-contexts. But otherwise, it's the same story.We have two remaining tasks: firstly, to show that our bifunctor kit is differentiable; secondly, to show that Diff2 b allows us to establish Diff1 (Mu b).Differentiating the Bifunctor kitI'm afraid this bit is fiddly rather than edifying. Feel free to skip along.The constants are as before.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 qOn this occasion, life is too short to develop the theory of the type level Kronecker-delta, so I just treated the variables separately.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 z@(K () :<- XX x) = K () :<- XX z around VY (K q :<- _) = absurd qinstance 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 z@(K () :<- YY y) = K () :<- YY zFor the structural cases, I found it useful to introduce a helper allowing me to treat variables uniformly.vV :: Vary v -> Z b v x y -> V v (Z b X x y) (Z b Y x y)vV VX z = XX zvV VY z = YY zI then built gadgets to facilitate the kind of "retagging" we need for down and around. (Of course, I saw which gadgets I needed as I was working.)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) ddzimap f VY (d :<- _) = bimap (\ (d :<- XX x) -> f VX d :<- XX x) (\ (d :<- YY y) -> f VY d :<- YY y) dAnd with that lot ready to go, we can grind out the details. Sums are easy.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 z@(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 z@(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)Products are hard work, which is why I'm a mathematician rather than an engineer.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 z@(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 z@(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)Conceptually, it's just as before, but with more bureaucracy. I built these using pre-type-hole technology, using undefined as a stub in places I wasn't ready to work, and introducing a deliberate type error in the one place (at any given time) where I wanted a useful hint from the typechecker. You too can have the typechecking as videogame experience, even in Haskell.Subnode zippers for recursive containersThe partial derivative of b with respect to X tells us how to find a subnode one step inside a node, so we get the conventional notion of zipper.data MuZpr b y = MuZpr { aboveMu :: [D b X (Mu b y) y] , hereMu :: Mu b y }We can zoom all the way up to the root by repeated plugging in X positions.muUp :: Diff2 b => MuZpr b y -> Mu b ymuUp (MuZpr {aboveMu = [], hereMu = t}) = tmuUp (MuZpr {aboveMu = (dX : dXs), hereMu = t}) = muUp (MuZpr {aboveMu = dXs, hereMu = In (up VX (dX :<- XX t))})But we need element-zippers.Element-zippers for fixpoints of bifunctorsEach element is somewhere inside a node. That node is sitting under a stack of X-derivatives. But the position of the element in that node is given by a Y-derivative. We getdata 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 }Boldly, I claiminstance Diff2 b => Diff1 (Mu b) where type DF (Mu b) = MuCx bbut before I develop the operations, I'll need some bits and pieces.I can trade data between functor-zippers and bifunctor-zippers as follows:zAboveY :: ZF (Mu b) y -> [D b X (Mu b y) y] -- the stack of `X`-derivatives above mezAboveY (d :<-: y) = aboveY dzZipY :: ZF (Mu b) y -> Z b Y (Mu b y) y -- the `Y`-zipper where I amzZipY (d :<-: y) = belowY d :<- YY yThat's enough to let me define: upF z = muUp (MuZpr {aboveMu = zAboveY z, hereMu = In (up VY (zZipY z))})That is, we go up by first reassembling the node where the element is, turning an element-zipper into a subnode-zipper, then zooming all the way out, as above.Next, I say downF = yOnDown []to go down starting with the empty stack, and define the helper function which goes down repeatedly from below any stack: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))Now, down b only takes us inside the node. The zippers we need must also carry the node's context. That's what contextualise does: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)For every Y-position, we must give an element-zipper, so it is good we know the whole context dXs back to the root, as well as the dY which describes how the element sits in its node. For every X-position, there is a further subtree to explore, so we grow the stack and keep going!That leaves only the business of shifting focus. We might stay put, or go down from where we are, or go up, or go up and then down some other path. Here goes. aroundF z@(MuCx {aboveY = dXs, belowY = dY} :<-: _) = MuCx { aboveY = yOnUp dXs (In (up VY (zZipY z))) , belowY = contextualize dXs (cxZ $ around VY (zZipY z)) } :<-: zAs ever, the existing element is replaced by its entire zipper. For the belowY part, we look where else we can go in the existing node: we will find either alternative element Y-positions or further X-subnodes to explore, so we contextualise them. For the aboveY part, we must work our way back up the stack of X-derivatives after reassembling the node we were visiting.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)))At each step of the way, we can either turn somewhere else that's around, or keep going up.And that's it! I haven't given a formal proof of the laws, but it looks to me as if the operations carefully maintain the context correctly as they crawl the structure.What have we learned?Differentiability induces notions of thing-in-its-context, inducing a comonadic structure where extract gives you the thing and duplicate explores the context looking for other things to contextualise. If we have the appropriate differential structure for nodes, we can develop differential structure for whole trees.Oh, and treating each individual arity of type constructor separately is blatantly horrendous. The better way is to work with functors between indexed setsf :: (i -> *) -> (o -> *)where we make o different sorts of structure storing i different sorts of element. These are closed under the Jacobian constructionJ f :: (i -> *) -> ((o, i) -> *)where each of the resulting (o, i)-structures is a partial derivative, telling you how to make an i-element-hole in an o-structure. But that's dependently typed fun, for another time. 这篇关于拉链Comonads，一般的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！ 上岸，阿里云！