不动点上的单面褶皱

Question

给定一个不动点的任意数据结构，我们可以在不手动指定所有情形的情况下构造一个单余代数吗？

假设我们得到了数据类型Expr，如下所示。使用recursion-schemes库，我们可以派生一个基本函子ExprF，它也自动具有Functor、Foldable和Traversable实例。

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}

import Data.Semigroup (Sum(..))
import Data.Functor.Foldable
import Data.Functor.Foldable.TH

import Prelude hiding (fail)

data Expr = Var String
          | Const Int
          | Add [Expr]
          | Mult [Expr]
          deriving Show

$(makeBaseFunctor ''Expr)

expr :: Fix ExprF
expr = ana project $ Add [Const 1, Const 2, Mult [Const 3, Const 4], Var "hello"]

现在，假设我们想要计算expr中的叶子数。我们可以很容易地为这样一个小数据结构编写一个代数：

alg (ConstF _) = 1
alg (VarF   _) = 1
alg (AddF  xs) = sum xs
alg (MulF  xs) = sum xs

现在，我们可以调用cata alg expr，它返回5，这是正确的结果。

让我们假设Expr变得非常庞大和复杂，我们不想手动为所有数据构造函数编写用例。cata如何知道如何组合来自所有情况的结果？我怀疑这是可以使用Monoid的，可能是与Const函子一起使用(但对最后一部分还不完全确定)。

fail = getSum $ foldMap (const (Sum 1) . unfix) $ unfix expr

fail返回4，而实际上我们有5叶。我假设问题在于不动点，因为我们只能剥离一层Fix，因此Mult [..]只能算作一片叶子。

是否有可能在不手动指定所有实例的情况下，以某种方式将整个不动点折叠起来并收集Monoid-like结构中的结果？我想要的是某种foldMap，但以一种更通用的方式。

我有种感觉，我错过了一些很明显的东西。

Answer 1

这是解决方案的本质。我打开了

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, PatternSynonyms #-}

让我们简单地回顾一下定点和变形。

newtype Fix f = In {out :: f (Fix f)}

cata :: Functor f => (f t -> t) -> Fix f -> t
cata alg = alg . fmap (cata alg) . out

代数alg :: f t -> t接受子节点已经被t值替换的节点，然后返回父节点的t。cata操作符的工作方式是解压缩父节点，递归地处理它的所有子节点，然后应用alg完成任务。

因此，如果我们想在这样的结构中计算树叶，我们可以这样开始：

leaves :: (Foldable f, Functor f) => Fix f -> Integer
leaves = cata sumOrOne where
  -- sumOrOne :: f Integer -> Integer

代数中，sumOrOne可以看到父节点的每个子节点中的叶数。我们可以使用cata，因为f是Functor。因为f是Foldable，所以我们可以计算孩子们的叶子总数。

  sumOrOne fl = case sum fl of
    ...

然后有两种可能性:如果父级没有子级，它的叶和将是0，我们可以检测到，但这意味着父级本身就是叶，因此应该返回1。否则，叶和将是非零，在这种情况下，父母不是叶，因此它的叶和确实是其子女的总叶和。这给了我们

leaves :: (Foldable f, Functor f) => Fix f -> Integer
leaves = cata sumOrOne where
  sumOrOne fl{- number of leaves in each child-} = case sum fl of
    0 -> 1  -- no leaves in my children means I am a leaf
    l -> l  -- otherwise, pass on the total

一个快速的例子，基于Hutton的Razor (带有整数和加法的表达式语言，这通常是说明这一点的最简单的东西)。表达式由Hutton的函子生成。

data HF h = Val Int | h :+: h deriving (Functor, Foldable, Traversable)

我介绍了一些模式同义词，以恢复定制类型的外观和感觉。

pattern V x    = In (Val x)
pattern s :+ t = In (s :+: t)

我用三个层次的叶子做了一个快速的示例表达式。

example :: Fix HF
example = (V 1 :+ V 2) :+ ((V 3 :+ V 4) :+ V 5)

果然

Ok, modules loaded: Leaves.
*Leaves> leaves example
5

另一种方法是，在感兴趣的子结构中，在叶子处的物质中，函数和折叠。(我们得到的正是免费的单元组。)

data Tree f x = Leaf x | Node (f (Tree f x)) deriving (Functor, Foldable)

一旦将叶/节点分离作为基本构造的一部分，就可以直接使用foldMap访问叶子了。再加上一点Control.Newtype，我们就可以

ala' Sum foldMap (const 1)  :: Foldable f => f x -> Integer

这是低于Fairbairn门槛(即，足够短，不需要一个名字和所有更清楚的没有一个)。

当然，问题在于，数据结构在“感兴趣的子结构”中常常以多种有趣但相互冲突的方式起作用。Haskell并不总是让我们访问“已发现的函数式”的最佳方法:当我们在声明时将数据类型参数化时，我们必须以某种方式预测我们需要的函式。但还有时间去改变这些..。