Statutory Calculus Warning. 这个问题的基本答案包括专门制定标准递归方案。但我有点得意忘形了。当我试图将相同的方法应用于列表以外的结构时,事情变得更加抽象。我最终找到了艾萨克·牛顿和拉尔夫·福克斯,并在此过程中设计了 alopegmorphism,这可能是新事物。
但无论如何,这种东西应该存在。它看起来像是 anamorphism 或“展开”的特例。让我们从库中称为unfoldr 的内容开始。
unfoldr :: (seed -> Maybe (value, seed)) -> seed -> [value]
它展示了如何通过重复使用称为 coalgebra 的函数从种子中生成值列表。在每一步中,余代数都会说明是停止使用[],还是继续将一个值添加到从新种子生成的列表中。
unfoldr coalg s = case coalg s of
Nothing -> []
Just (v, s') -> v : unfoldr coalg s'
这里,seed 类型可以是任何你喜欢的类型——任何适合展开过程的本地状态。一个完全合理的种子概念就是“目前为止的列表”,可能是相反的顺序,因此最近添加的元素是最近的。
growList :: ([value] -> Maybe value) -> [value]
growList g = unfoldr coalg B0 where
coalg vz = case g vz of -- I say "vz", not "vs" to remember it's reversed
Nothing -> Nothing
Just v -> Just (v, v : vz)
在每一步,我们的g 操作都会查看我们已经拥有的值的上下文并决定是否添加另一个:如果是这样,新值将成为列表的头部和新上下文中的最新值.
所以,这个growList 在每一步都会为您提供以前的结果列表,为zipWith (*) 做好准备。反转对于卷积来说相当方便,所以也许我们正在研究类似的东西
ps = growList $ \ pz -> Just (sum (zipWith (*) sigmas pz) `div` (length pz + 1))
sigmas = [sigma j | j <- [1..]]
也许?
递归方案? 对于列表,我们有一个变形的特殊情况,其中种子是我们目前所构建内容的上下文,并且一旦我们说明了如何构建再多一点,我们知道如何以同样的方式扩展上下文。不难看出这对列表是如何工作的。但一般来说,它是如何处理变形的呢? 这就是麻烦的地方。
我们建立可能无限的值,其节点形状由某个函子 f 给出(当我们“打结”时,其参数结果是“子结构”)。
newtype Nu f = In (f (Nu f))
在变形中,余代数使用种子来选择最外层节点的形状,填充子结构的种子。 (共同)递归地,我们映射变形,将这些种子生长成子结构。
ana :: Functor f => (seed -> f seed) -> seed -> Nu f
ana coalg s = In (fmap (ana coalg) (coalg s))
让我们从ana 重构unfoldr。我们可以从 Nu 和一些简单的部分构建许多普通的递归结构:多项式仿函数工具包。
newtype K1 a x = K1 a -- constants (labels)
newtype I x = I x -- substructure places
data (f :+: g) x = L1 (f x) | R1 (g x) -- choice (like Either)
data (f :*: g) x = f x :*: g x -- pairing (like (,))
Functor 实例
instance Functor (K1 a) where fmap f (K1 a) = K1 a
instance Functor I where fmap f (I s) = I (f s)
instance (Functor f, Functor g) => Functor (f :+: g) where
fmap h (L1 fs) = L1 (fmap h fs)
fmap h (R1 gs) = R1 (fmap h gs)
instance (Functor f, Functor g) => Functor (f :*: g) where
fmap h (fx :*: gx) = fmap h fx :*: fmap h gx
对于value的列表,节点形状函子是
type ListF value = K1 () :+: (K1 value :*: I)
意思是“一个无聊的标签(对于 nil)或 value 标签和子列表的(缺点)对”。 ListF value 余代数的类型变为
seed -> (K1 () :+: (K1 value :*: I)) seed
这是同构的(通过在seed 处“评估”多项式ListF value)到
seed -> Either () (value, seed)
这不过是毫厘之差
seed -> Maybe (value, seed)
unfoldr 期望的。你可以像这样恢复一个普通的列表
list :: Nu (ListF a) -> [a]
list (In (L1 _)) = []
list (In (R1 (K1 a :*: I as))) = a : list as
现在,我们如何培养一些通用的Nu f?一个好的开始是为最外层的节点选择 shape。 f () 类型的值只给出了一个节点的形状,在子结构位置有一些普通的存根。事实上,为了种植我们的树,我们基本上需要一些方法来选择“下一个”节点形状,因为我们需要了解我们已经到达的位置以及到目前为止我们所做的事情。我们应该期待
grow :: (..where I am in a Nu f under construction.. -> f ()) -> Nu f
请注意,对于不断增长的列表,我们的 step 函数返回一个 ListF value (),它与 Maybe value 同构。
但是到目前为止,我们如何在Nu f 中表达我们的位置?我们将从结构的根开始有这么多节点,所以我们应该期待一堆层。每一层都应该告诉我们(1)它的形状,(2)我们当前所处的位置,以及(3)已经在该位置左侧构建的结构,但我们希望在我们所处的位置仍然有存根还没有到。换句话说,它是我 2008 年关于 Clowns and Jokers 的 POPL 论文中 dissection 结构的一个示例。
解剖运算符将函子f(被视为元素的容器)转换为双函子Diss f,其中包含两种不同类型的元素,左侧的元素(小丑)和右侧的元素(小丑) f 结构中的“光标位置”。首先,让我们拥有Bifunctor 类和一些实例。
class Bifunctor b where
bimap :: (c -> c') -> (j -> j') -> b c j -> b c' j'
newtype K2 a c j = K2 a
data (f :++: g) c j = L2 (f c j) | R2 (g c j)
data (f :**: g) c j = f c j :**: g c j
newtype Clowns f c j = Clowns (f c)
newtype Jokers f c j = Jokers (f j)
instance Bifunctor (K2 a) where
bimap h k (K2 a) = K2 a
instance (Bifunctor f, Bifunctor g) => Bifunctor (f :++: g) where
bimap h k (L2 fcj) = L2 (bimap h k fcj)
bimap h k (R2 gcj) = R2 (bimap h k gcj)
instance (Bifunctor f, Bifunctor g) => Bifunctor (f :**: g) where
bimap h k (fcj :**: gcj) = bimap h k fcj :**: bimap h k gcj
instance Functor f => Bifunctor (Clowns f) where
bimap h k (Clowns fc) = Clowns (fmap h fc)
instance Functor f => Bifunctor (Jokers f) where
bimap h k (Jokers fj) = Jokers (fmap k fj)
注意Clowns f 是双函子,相当于一个只包含小丑的f 结构,而Jokers f 只包含小丑。如果您对重复所有 Functor 用具以得到 Bifunctor 用具感到困扰,那么您是对的:如果我们抽象出这些参数并使用 indexed 集,但那是另一回事了。
让我们将 dissection 定义为将双函子与函子相关联的类。
class (Functor f, Bifunctor (Diss f)) => Dissectable f where
type Diss f :: * -> * -> *
rightward :: Either (f j) (Diss f c j, c) ->
Either (j, Diss f c j) (f c)
Diss f c j 类型表示f 结构,在一个元素位置有一个“孔”或“光标位置”,在孔左侧的位置我们有c 中的“小丑”,右边是j 中的“jokers”。 (该术语取自 Stealer's Wheel 歌曲“Stuck in the Middle with You”。)
类中的关键操作是同构rightward,它告诉我们如何从任一位置开始向右移动一个位置
- 整个结构的左侧,到处都是小丑,或者
- 结构上的一个洞,连同一个要放进洞里的小丑
然后到达任何一个
- 结构上的一个洞,连同从中出来的小丑,或
- 整个小丑建筑的权利。
艾萨克·牛顿喜欢解剖,但他称它们为除差,并将它们定义在实值函数上以获得曲线上两点之间的斜率,因此
divDiff f c j = (f c - f j) / (c - j)
他使用它们对任何旧函数等进行最佳多项式逼近。相乘和相乘
divDiff f c j * c - j * divDiff f c j = f c - f j
然后两边都加,去掉减法
f j + divDiff f c j * c = f c + j * divDiff f c j
你得到了rightward 同构。
如果我们查看实例,我们可能会为这些事情建立更多的直觉,然后我们可以回到我们最初的问题。
一个无聊的旧常数的除差为零。
instance Dissectable (K1 a) where
type Diss (K1 a) = K2 Void
rightward (Left (K1 a)) = (Right (K1 a))
rightward (Right (K2 v, _)) = absurd v
如果我们从左到右,我们会跳过整个结构,因为没有元素位置。如果我们从一个元素位置开始,那么有人在撒谎!
恒等函子只有一个位置。
instance Dissectable I where
type Diss I = K2 ()
rightward (Left (I j)) = Left (j, K2 ())
rightward (Right (K2 (), c)) = Right (I c)
如果我们从左边开始,我们到达位置并弹出小丑;推一个小丑,我们在右边完成。
对于总和,结构是继承的:我们只需要正确地去标记和重新标记。
instance (Dissectable f, Dissectable g) => Dissectable (f :+: g) where
type Diss (f :+: g) = Diss f :++: Diss g
rightward x = case x of
Left (L1 fj) -> ll (rightward (Left fj))
Right (L2 df, c) -> ll (rightward (Right (df, c)))
Left (R1 gj) -> rr (rightward (Left gj))
Right (R2 dg, c) -> rr (rightward (Right (dg, c)))
where
ll (Left (j, df)) = Left (j, L2 df)
ll (Right fc) = Right (L1 fc)
rr (Left (j, dg)) = Left (j, R2 dg)
rr (Right gc) = Right (R1 gc)
对于产品,我们必须在一对结构中的某个位置:要么我们在左边的小丑和小丑之间,右边的结构都是小丑,或者左边的结构都是小丑,我们在右边的小丑之间和小丑。
instance (Dissectable f, Dissectable g) => Dissectable (f :*: g) where
type Diss (f :*: g) = (Diss f :**: Jokers g) :++: (Clowns f :**: Diss g)
rightward x = case x of
Left (fj :*: gj) -> ll (rightward (Left fj)) gj
Right (L2 (df :**: Jokers gj), c) -> ll (rightward (Right (df, c))) gj
Right (R2 (Clowns fc :**: dg), c) -> rr fc (rightward (Right (dg, c)))
where
ll (Left (j, df)) gj = Left (j, L2 (df :**: Jokers gj))
ll (Right fc) gj = rr fc (rightward (Left gj)) -- (!)
rr fc (Left (j, dg)) = Left (j, R2 (Clowns fc :**: dg))
rr fc (Right gc) = Right (fc :*: gc)
rightward 逻辑确保我们通过左侧结构工作,然后一旦我们完成它,我们就开始在右侧工作。标记(!)的线是中间的关键时刻,我们从左侧结构的右侧出现,然后进入右侧结构的左侧。
Huet 的数据结构中“左”和“右”光标移动的概念源于可剖析性(如果您完成了 rightward 与其对应的 leftward 的同构)。 f 的 导数 只是小丑和小丑之间的差异趋于零时的极限,或者对我们来说,当你在光标的任一侧拥有相同类型的东西时你会得到什么。
此外,如果你把小丑归零,你会得到
rightward :: Either (f x) (Diss f Void x, Void) -> Either (x, Diss f Void x) (f Void)
但是我们可以去掉不可能的输入情况得到
type Quotient f x = Diss f Void x
leftmost :: f x -> Either (x, Quotient f x) (f Void)
leftmost = rightward . Left
这告诉我们每个f 结构要么有一个最左边的元素,要么根本没有,这是我们在学校学习的“剩余定理”的结果。 Quotient 运算符的多元版本是 Brzozowski 应用于正则表达式的“导数”。
但我们的特例是 Fox 的派生词(我从 Dan Piponi 那里了解到):
type Fox f x = Diss f x ()
这是f-结构的类型,在光标右侧带有存根。 现在我们可以给出一般grow操作符的类型了。
grow :: Dissectable f => ([Fox f (Nu f)] -> f ()) -> Nu f
我们的“上下文”是一堆层,每个层的左侧都有完全增长的数据,右侧有存根。我们可以直接实现grow如下:
grow g = go [] where
go stk = In (walk (rightward (Left (g stk)))) where
walk (Left ((), df)) = walk (rightward (Right (df, go (df : stk))))
walk (Right fm) = fm
当我们到达每个位置时,我们提取的小丑只是一个存根,但它的上下文告诉我们如何扩展堆栈以增长树的子结构,这给了我们需要向右移动的小丑.一旦我们用树填充了所有的存根,我们就完成了!
但这里有一个转折点:grow 不像变形那样容易表达。很容易为每个节点的最左边的孩子提供“种子”,因为我们只有右边的存根。但是要将下一粒种子传给右边,我们需要的不仅仅是最左边的种子——我们需要从它长出的树!变形模式要求我们在生成子结构之前提供所有子结构的种子。我们的growList 只是一个变形,因为列表节点最多有一个子节点。
所以它毕竟是新的东西,从无到有,但允许给定层的后期增长依赖于早期的树,Fox 衍生品捕捉了“我们尚未工作的存根”的想法。也许我们应该称它为alopegmorphism,来自希腊语αλωπηξ,意思是“狐狸”。