Что должен делать препроморфизм Фоккинга?

Question

Я смотрел на recursion-schemes библиотека, и я очень смущен тем, что prepro предполагается использовать для, или даже то, что он делает. Описание этого как "препроморфизм Фоккинга" не очень информативен, и подпись (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)), потому что он сворачивает слои функтора, встраивая их обратно в выходное значение:

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