就像Chitty-Chitty-Bang-Bang中吸引孩子的人一样，他们将糖果和玩具吸引到囚禁中，大学物理专业的招聘人员喜欢用肥皂泡和飞旋镖来糊弄，但是当门c关闭时，这是“对了，孩子们，有时间学习关于部分分化！”。我也是。不要说我没有警告过你。
下面是另一个警告：下面的代码需要{-# 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
fmap upF (downF xs) = fmap (const xs) xs
多项式函子是可微的
常数函子是可微的。
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。
该标识仿函数是可微。
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 z@(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 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))
:<-: 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 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)
！多项式都是可微的，因此给我们带来了共鸣。
嗯 有点抽象。所以我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))
练习表明，使用链规则可微分函子的组成是可微分的。
甜！我们现在可以回家吗？当然不是。我们尚未区分任何递归结构。
用bifunctors构造递归函
甲Bifunctor，如在数据类型通用编程的现有文献（由帕特里克杨松和Johan Jeuring，或由Jeremy长臂猿优良讲义看到工作）说明在长度为一个类型构造具有两个参数，对应于两类子结构。我们应该能够“映射”两者。
class Bifunctor b where
bimap :: (x -> x') -> (y -> y') -> b x y -> b x' y'
我们可以使用Bifunctors给出递归容器的节点结构。每个节点都有子节点和元素。这些可能只是两种子结构。
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)
资金和产品bifunctors是bifunctors
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)))
如果您想将这些类型用于实际数据，而又不盲目地模仿Georges Seurat的传统，请使用模式同义词。
但是拉链呢？我们如何证明它Mu b是可区分的？我们将需要证明这两个变量b是可微的。铛！现在是时候了解部分差异化了。
双功能的偏导数
因为我们有两个变量，所以我们将需要能够有时在其他时间集体讨论它们。我们将需要单身家庭：
data Vary :: Var -> * where
VX :: Vary X
VY :: Vary Y
现在我们可以说说Bifunctor在每个变量中具有偏导数并给出相应的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}
此D操作需要知道要定位的变量。相应的拉链Z b v告诉我们哪个变量v必须是焦点。当我们“用上下文装饰”时，我们必须x用X-contexts装饰-elements和y用Y-contexts装饰-elements。但除此之外，这是同一回事。
我们还有两个任务：首先，证明我们的bifunctor套件是可区分的。其次，表明Diff2 b允许我们建立Diff1 (Mu b)。
区分Bifunctor套件
恐怕这不是摆弄，而是有趣。随时跳过。
常数与以前一样。
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 z@(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 z@(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 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)
产品是艰苦的工作，这就是为什么我是数学家而不是工程师。
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)
从概念上讲，它和以前一样，但是官僚机构更多。我使用pre-type-hole技术构建了这些文件，undefined在我还没准备好工作的地方将其用作存根，并在某个地方（在任何给定的时间）引入了故意的类型错误，在那里我需要来自typechecker的有用提示。您也可以在电子游戏方面进行类型检查，即使在Haskell中也是如此。
递归容器的子节点拉链
的偏导数b相对于X告诉我们如何找到一个节点内的子节点一步，所以我们得到的拉链的传统观念。
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))})
但是我们需要元素-zippers。
元素拉链固定点的元素拉链
每个元素都在节点内部。该节点位于X-衍生物堆栈下。但是元素在该节点中的位置由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
但是在进行操作之前，我需要点点滴滴。
我可以在functor-zippers和bifunctor-zippers之间交换数据，如下所示：
zAboveY :: ZF (Mu b) y -> [D b X (Mu b y) y]
zAboveY (d :<-: y) = aboveY d
zZipY :: ZF (Mu b) y -> Z b Y (Mu b y) y
zZipY (d :<-: y) = belowY d :<- YY y
这足以让我定义：
upF z = muUp (MuZpr {aboveMu = zAboveY z, hereMu = In (up VY (zZipY z))})
也就是说，我们首先重新组装元素所在的节点，然后将元素拉链变成子节点拉链，然后像上面一样一直缩小。
接下来，我说
downF = yOnDown []
从空堆栈开始向下，并定义down从任何堆栈下面重复出现的helper函数：
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 :<- XX t) -> yOnDown (dX : dXs) t)
(\ (dY :<- YY y) -> MuCx {aboveY = dXs, belowY = dY} :<-: y)
对于每个Y位置，我们都必须提供一个元素拉链，这样很好，我们知道整个上下文都可以dXs返回到根，并且dY可以描述元素在其节点中的位置。对于每个X位置，都有一个进一步的子树可以探索，因此我们扩大了堆栈并继续前进！
那只剩下转移焦点的事了。我们可能会保持原状，或者从我们所在的位置走下，或者上升，或者上升然后再下降。开始。
aroundF z@(MuCx {aboveY = dXs, belowY = dY} :<-: _) = MuCx
{ aboveY = yOnUp dXs (In (up VY (zZipY z)))
, belowY = contextualize dXs (cxZ $ around VY (zZipY z))
} :<-: z
与以往一样，现有元素被其整个拉链取代。对于这一belowY部分，我们看一下现有节点中还有哪些地方可以找到：我们将找到替代元素-positionsY或其他X-subnodes进行探索，因此我们将contextualise其找到。对于这一aboveY部分，我们必须X在重新组装我们要访问的节点之后，以自己的方式备份-derivatives堆栈。
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探索上下文以寻找其他事物以实现上下文。如果我们对节点具有适当的差分结构，则可以为整棵树开发差分结构。
哦，分别对待类型构造函数的每个Arity是公然的。更好的方法是在索引集之间使用函子
f :: (i -> *) -> (o -> *)
在这里我们可以创建o不同种类的结构，以存储i不同种类的元素。这些在雅可比构造下是封闭的
J f :: (i -> *) -> ((o, i) -> *)
其中每个生成的-(o, i)结构都是偏导数，告诉您如何在i-o结构中制作-元素孔。但这又是一次有趣的打字。