Haskell 专门研究列表的组织形态学、接合形态学和未来形态学

我终于弄明白了。请看我演讲的视频和幻灯片：

原始问题：

在我努力理解通用递归方案（即使用

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

？

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

不是-您需要检查每个位置的整个列表的长度，以确定您是在加减。当折叠函数需要在折叠的每次迭代中遍历整个子树时，准形态为这类原始递归建模。因此，我们至少可以重写代码以符合既定模式

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（n2）算法

---

我们可以通过注意到

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)

我们有一个折叠依赖于另一个折叠的结果，我们能够将它们融合到列表的一次遍历中。左右对称正好抓住了这个模式

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

写成一个对称形式

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

这是经典的函数式编程风格。我们有一个高阶函数来完成消费列表的繁重工作；我们所要做的就是插入逻辑来聚合结果。构造显然终止了（您只需要证明

foldr

的终止），并且它比原始的手写版本启动更有效

旁白：@AlexR在评论中指出，同形性有一个叫做异形性的大姐姐，它捕获了所有类型的相互递归 它的荣耀

mutu

概括了

zygo

，因为折叠 允许函数检查其他函数从上一个函数得到的结果 迭代

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)

只需忽略额外的参数，即可从

mutu

恢复

zygo

。

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

和

zygo

的定义。还请注意，

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

---

既然还没有其他人为futu负责，我就试着蹒跚而行。我将使用

listfab=Base[a]=consfab|NilF

输入：

futu:：unfotable t=>（a->Base t（Free（Base t）a））->a->t

我将忽略

可展开的

约束，并将

[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]，可能是a）

。现在我们有：

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

删除最后一个

ListF

，注意

listfab

同构于

可能（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

总是返回，你将永远不会被困在等待下一个列表元素中）。

组织形态模型动态编程，将以前的子计算结果制成表格的技术。（它有时被称为。）在组织形态中，折叠函数可以访问折叠早期迭代的结果表。将此与反同态进行比较，其中折叠函数只能看到最后一次迭代的结果。后见之明的好处是，你可以看到所有的历史

这是我的想法。当我们使用输入列表时，折叠代数将输出一系列

b

s<代码>历史将在出现时记下每个

b

，并将其附加到结果表中。历史记录中的项目数等于您已处理的列表层数-在您拆下整个列表时，您的历史记录将被删除

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'

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

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

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

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

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

histo :: Functor f => (f (Cofree f a) -> a) -> (Fix f -> a)
futu  :: Functor f => (a  ->  f (Free f a)) -> (a -> Fix f)