Fokkinga的prepromorphism意味着什么？

Question

我一直在查看recursion-schemes库，我对prepro应该用于什么，甚至它的用途感到非常困惑。它作为'Fokkinga的prepromorphism'的描述并不是非常有用，并且签名（prepro :: Corecursive t => (forall b . Base t b -> Base t b) -> (Base t a -> a) -> t -> a）看起来非常类似于cata（catamorphism），但有一个额外的参数，其意图不明确。有人能够解释这个函数的意图吗？

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。它通过首先剥离外层来折叠一个值，然后重写＆＃34;带有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