专用于列表的 Histomorphisms、Zygomorphism 和 Futumorphisms

Question

我终于搞清楚了。查看我的演讲视频和幻灯片：

原问题：

在我努力理解通用递归方案（即使用 Fix）的过程中，我发现编写各种方案的仅列表版本很有用。它使理解实际方案变得更加容易（没有 Fix 东西的额外开销）。

但是，我还没有弄清楚如何定义 zygo 和 futu 的仅列表版本。

到目前为止，这是我的专业定义：

cataL :: (a ->        b -> b) -> b -> [a] -> b
cataL f b (a : as) = f a    (cataL f b as)
cataL _ b []       = b

paraL :: (a -> [a] -> b -> b) -> b -> [a] -> b
paraL f b (a : as) = f a as (paraL f b as)
paraL _ b []       = b

-- TODO: histo

-- DONE: zygo (see below)

anaL  :: (b ->       (a, b))               -> b -> [a]
anaL  f b = let (a, b') = f b in a : anaL f b'

anaL' :: (b -> Maybe (a, b))               -> b -> [a]
anaL' f b = case f b of
    Just (a, b') -> a : anaL' f b'
    Nothing      -> []

apoL :: ([b] -> Maybe (a, Either [b] [a])) -> [b] -> [a]
apoL f b = case f b of
    Nothing -> []
    Just (x, Left c)  -> x : apoL f c
    Just (x, Right e) -> x : e

-- DONE: futu (see below)

hyloL  :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
hyloL f z g = cataL f z . anaL' g

hyloL' :: (a -> c -> c) -> c -> (c -> Maybe (a, c))      -> c
hyloL' f z g = case g z of
    Nothing     -> z
    Just (x,z') -> f x (hyloL' f z' g)

如何定义列表的 histo、zygo 和 futu？

Answer 1

Zygomorphism 是我们为由两个 半相互 递归函数构建的折叠赋予的数学名称。我举个例子。

想象一个函数 pm :: [Int] -> Int（对于 加-减），它在数字列表中交替穿插 + 和 -，例如pm [v,w,x,y,z] = v - (w + (x - (y + z)))。您可以使用原始递归将其写出来：

lengthEven :: [a] -> Bool
lengthEven = even . length

pm0 [] = 0
pm0 (x:xs) = if lengthEven xs
             then x - pm0 xs
             else x + pm0 xs

显然 pm0 不是 compositional - 您需要在每个位置检查整个列表的长度以确定您是在添加还是在减去。 Paramorphism 为这种原始递归建模，折叠函数需要在每次折叠迭代时遍历整个子树。所以我们至少可以重写代码以符合既定模式。

paraL :: (a -> [a] -> b -> b) -> b -> [a] -> b
paraL f z [] = z
paraL f z (x:xs) = f x xs (paraL f z xs)

pm1 = paraL (\x xs acc -> if lengthEven xs then x - acc else x + acc) 0

但这是低效的。 lengthEven 在同态的每次迭代中遍历整个列表，导致 O(n²) 算法。

我们可以通过注意到 lengthEven 和 para 都可以表示为变形和 foldr...

cataL = foldr

lengthEven' = cataL (\_ p -> not p) True
paraL' f z = snd . cataL (\x (xs, acc) -> (x:xs, f x xs acc)) ([], z)

...这表明我们可以将这两个操作融合到对列表的单次传递中。

pm2 = snd . cataL (\x (isEven, total) -> (not isEven, if isEven
                                                      then x - total
                                                      else x + total)) (True, 0)

我们有一个折叠取决于另一个折叠的结果，我们能够将它们融合到列表的一次遍历中。 Zygomorphism 正好捕捉到了这种模式。

zygoL :: (a -> b -> b) ->  -- a folding function
         (a -> b -> c -> c) ->  -- a folding function which depends on the result of the other fold
         b -> c ->  -- zeroes for the two folds
         [a] -> c
zygoL f g z e = snd . cataL (\x (p, q) -> (f x p, g x p q)) (z, e)

在折叠的每次迭代中，f 从上一次迭代中看到它的答案，就像在变形中一样，但是 g 可以看到两个函数的答案。 g与f纠缠不清。

我们将 pm 写成一个 zygomorphism，第一个折叠函数计算列表的长度是偶数还是奇数，第二个折叠函数计算总数。

pm3 = zygoL (\_ p -> not p) (\x isEven total -> if isEven
                                                then x - total
                                                else x + total) True 0

这是经典的函数式编程风格。我们有一个高阶函数来完成消耗列表的繁重工作；我们所要做的就是插入逻辑来汇总结果。构造明显终止（只需要证明foldr终止），比原来的手写版本启动效率更高

Aside: @AlexR points out in the comments that zygomorphism has a big sister called mutumorphism, which captures mutual recursion in all its glory. mutu generalises zygo in that both the folding functions are allowed to inspect the other's result from the previous iteration.
mutuL :: (a -> b -> c -> b) ->
         (a -> b -> c -> c) ->
         b -> c ->
         [a] -> c
mutuL f g z e = snd . cataL (\x (p, q) -> (f x p q, g x p q)) (z, e)
You recover zygo from mutu simply by ignoring the extra argument. zygoL f = mutuL (\x p q -> f x p)

当然，所有这些折叠模式都从列表推广到任意函子的固定点：

newtype Fix f = Fix { unFix :: f (Fix f) }

cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = f . fmap (cata f) . unFix

para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a
para f = snd . cata (\x -> (Fix $ fmap fst x, f x))

zygo :: Functor f => (f b -> b) -> (f (b, a) -> a) -> Fix f -> a
zygo f g = snd . cata (\x -> (f $ fmap fst x, g x))

mutu :: Functor f => (f (b, a) -> b) -> (f (b, a) -> a) -> Fix f -> a
mutu f g = snd . cata (\x -> (f x, g x))

比较zygo和zygoL的定义。还要注意 zygo Fix = para，后三折可以根据 cata 来实现。在折叠学中，一切都与其他一切相关。

您可以从通用版本恢复列表版本。

data ListF a r = Nil_ | Cons_ a r deriving Functor
type List a = Fix (ListF a)

zygoL' :: (a -> b -> b) -> (a -> b -> c -> c) -> b -> c -> List a -> c
zygoL' f g z e = zygo k l
    where k Nil_ = z
          k (Cons_ x y) = f x y
          l Nil_ = e
          l (Cons_ x (y, z)) = g x y z

pm4 = zygoL' (\_ p -> not p) (\x isEven total -> if isEven
                                                 then x - total
                                                 else x + total) True 0

Answer 2

由于还没有其他人回答 futu，我将尝试逐步解决。我要使用 ListF a b = Base [a] = ConsF a b | NilF

采用 recursion-schemes 中的类型：futu :: Unfoldable t => (a -> Base t (Free (Base t) a)) -> a -> t.

我将忽略 Unfoldable 约束并用 [b] 代替 t。

(a -> Base [b] (Free (Base [b]) a)) -> a -> [b]
(a -> ListF b (Free (ListF b) a)) -> a -> [b]

Free (ListF b) a) 是一个列表，末尾可能有一个 a 类型的孔。这意味着它与 ([b], Maybe a) 同构。所以现在我们有：

(a -> ListF b ([b], Maybe a)) -> a -> [b]

消除最后一个ListF，注意到ListF a b同构于Maybe (a, b)：

(a -> Maybe (b, ([b], Maybe a))) -> a -> [b]

现在，我很确定玩俄罗斯方块会导致唯一合理的实现：

futuL f x = case f x of
  Nothing -> []
  Just (y, (ys, mz)) -> y : (ys ++ fz)
    where fz = case mz of
      Nothing -> []
      Just z -> futuL f z

总结生成的函数，futuL 接受一个种子值和一个可能产生 至少一个 结果的函数，如果它产生一个结果。

起初我以为这等同于

notFutuL :: (a -> ([b], Maybe a)) -> a -> [b]
notFutuL f x = case f x of
  (ys, mx) -> ys ++ case mx of
    Nothing -> []
    Just x' -> notFutuL f x'

在实践中，也许或多或少是这样，但一个重要的区别是真正的 futu 保证了生产力（即如果 f 总是 returns，你会永远不会永远等待下一个列表元素。

Answer 3

Histomorphism 模型 动态规划，将先前子计算的结果制表的技术。（有时称为 course-of-value induction。）在组织态中，折叠函数可以访问折叠早期迭代结果的 table。将此与变形进行比较，其中折叠函数只能看到最后一次迭代的结果。 histomorphism 有后见之明的好处 - 你可以看到所有的历史。

这是主意。当我们使用输入列表时，折叠代数将输出一个 b 序列。 histo 会记下每个 b 出现的结果，并将其附加到 table 结果中。历史记录中的项目数等于您处理的列表层数 - 当您拆除整个列表时，您的操作历史记录的长度将等于列表的长度。

这是迭代列表（ory）的历史：

data History a b = Ancient b | Age a b (History a b)

History 是事物和结果对的列表，最后有一个额外的结果对应于 []-事物。我们会将输入列表的每一层与其对应的结果配对。

cataL = foldr

history :: (a -> History a b -> b) -> b -> [a] -> History a b
history f z = cataL (\x h -> Age x (f x h) h) (Ancient z)

从右到左折叠整个列表后，您的最终结果将位于堆栈的顶部。

headH :: History a b -> b
headH (Ancient x) = x
headH (Age _ x _) = x

histoL :: (a -> History a b -> b) -> b -> [a] -> b
histoL f z = headH . history f z

（碰巧 History a 是 comonad，但 headH（née extract）是我们需要定义的全部 histoL。）

History 用相应的结果标记输入列表的每一层。 cofree comonad 捕获标记任意结构的每一层的模式。

data Cofree f a = Cofree { headC :: a, tailC :: f (Cofree f a) }

（我通过将 ListF 插入 Cofree 并简化得到 History。）

将其与 free monad、

进行比较

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

Free 是余积类型； Cofree 是产品类型。 Free 将 f 的千层面分层，千层面底部的值为 a。 Cofree 将烤宽面条分层，每一层的值为 a。自由单子是广义的外部标记树； cofree comonads 是广义的内部标记树。

有了Cofree，我们可以从列表泛化到任意函子的不动点，

newtype Fix f = Fix { unFix :: f (Fix f) }

cata :: Functor f => (f b -> b) -> Fix f -> b
cata f = f . fmap (cata f) . unFix

histo :: Functor f => (f (Cofree f b) -> b) -> Fix f -> b
histo f = headC . cata (\x -> Cofree (f x) x)

并再次恢复列表版本。

data ListF a r = Nil_ | Cons_ a r deriving Functor
type List a = Fix (ListF a)
type History' a b = Cofree (ListF a) b

histoL' :: (a -> History' a b -> b) -> b -> List a -> b
histoL' f z = histo g
    where g Nil_ = z
          g (Cons_ x h) = f x h

Aside: histo is the dual of futu. Look at their types.
histo :: Functor f => (f (Cofree f a) -> a) -> (Fix f -> a)
futu  :: Functor f => (a  ->  f (Free f a)) -> (a -> Fix f)
futu is histo with the arrows flipped and with Free replaced by Cofree. Histomorphisms see the past; futumorphisms predict the future. And much like cata f . ana g can be fused into a hylomorphism, histo f . futu g can be fused into a chronomorphism.

即使您跳过了数学部分，this paper by Hinze and Wu 也提供了一个很好的、示例驱动的关于组织态及其用法的教程。

专用于列表的 Histomorphisms、Zygomorphism 和 Futumorphisms

Histomorphisms, Zygomorphisms and Futumorphisms specialised to lists

recursion

haskell

recursion-schemes