haskell - 福金加的预态性意味着什么？

Question

我一直在研究recursion-schemes库，并且我对prepro的用途，甚至它的作用感到非常困惑。将其描述为“Fokkinga 的前同态”并没有提供太多信息，并且签名 (prepro::Corecursive t => (forall b . Base t b -> Base t b) -> (Base t a -> a) -> t -> a)看起来与cata(变形)非常相似，但有一个额外的参数，其意图尚不清楚。有人能解释一下这个函数的用途吗？

Answer 1

cata f = c where c = f . fmap c . project
{- c = cata f -}
       = f . fmap (cata f) . project

cata 折叠一个值:它解开仿函数的一层 (project)，递归地折叠内部值 (fmap (cata f))，然后折叠整个东西。

prepro e f = c where c = f . fmap (c . cata (embed . e)) . project
{- c = prepro e f -}
           = f . fmap (prepro e f . cata (embed . e)) . project

prepro 也会折叠一个值，但它也应用 e (自然转换 Base t ~> Base t)，因为它这样做。请注意，cata embed 表示 id(除了它能够将 [Int] 转换为 Fix (ListF Int) )，因为它通过将仿函数层嵌入回输出值来折叠仿函数层:

cata (embed . e) 非常相似，只不过它在向下传递时会转换仿函数的每一层。因为e是一种自然的变换，所以当层落下时它无法看到层内的任何东西；它只能重新组织层的结构(这包括打乱内部层，只要它实际上不查看内部层)。

那么，回到 prepro e f。它会折叠一个值，首先剥离外层，然后用e“重写”内层，递归地折叠内部值，然后折叠整个事物。请注意，由于递归是通过 prepro 本身进行的，因此值内部的层越深，它被 e 重写的次数就越多。

<小时/>

演示

#!/usr/bin/env stack
-- stack --resolver lts-9.14 script
{-# LANGUAGE TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
import Data.Functor.Foldable -- package recursion-schemes
import Data.Tree             -- package containers
-- Tree a = Rose trees of a
-- makeBaseFunctor breaks down on it, so...
data TreeF a r = NodeF { rootLabelF :: a, subForestF :: [r] }
  deriving (Functor, Foldable, Traversable)
type instance Base (Tree a) = TreeF a
instance Recursive (Tree a) where project (Node a ts) = NodeF a ts
instance Corecursive (Tree a) where embed (NodeF a ts) = Node a ts

tree :: Tree Integer
tree = Node 2 [Node 1 [Node 3 []], Node 7 [Node 1 [], Node 5 []]]

main = do -- Original
          drawTree' tree

          -- 0th layer: *1
          -- 1st layer: *2
          -- 2nd layer: *4
          -- ...
          drawTree' $ prepro (\(NodeF x y) -> NodeF (x*2) y) embed tree

          -- Same thing but a different algebra
          -- "sum with deeper values weighted more"
          print $ prepro (\(NodeF x y) -> NodeF (x*2) y) ((+) <$> sum <*> rootLabelF) tree
  where drawTree' = putStr . drawTree . fmap show