固定点上的单向折叠

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，其中 returns 5，正确的结果。

让我们假设 Expr 变得非常大和复杂，我们不想为所有数据构造函数手动编写案例。 cata 如何知道如何组合所有案例的结果？我怀疑使用 Monoids 是可能的，可能与 Const 函子结合使用（尽管对最后一部分不完全确定）。

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

fail returns 4，而我们实际上有 5 个叶子。我假设问题出在固定点上，因为我们只能剥掉一层 Fixing 所以 Mult [..] 只算作一片叶子。

是否有可能以某种方式通用地折叠整个固定点并将结果收集在类似 Monoid 的结构中 而无需 手动指定所有实例？我想要的是一种 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 值替换，然后 returns 父节点的 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 的仿函数生成的。

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)

将 leaf/node 分离部分作为基本构造后，您可以直接使用 foldMap 访问叶子。投入一点 Control.Newtype，我们得到

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

低于 Fairbairn 阈值（即，足够短，不需要名字，更清楚的是没有名字）。

当然，问题在于数据结构在 "substructures of interest" 中通常以多种有趣但相互冲突的方式起作用。 Haskell 在让我们访问 "found functoriality" 方面并不总是最好的：当我们在声明时参数化数据类型时，我们必须以某种方式预测我们需要的函数性。但还有时间改变这一切...

固定点上的单向折叠

Monoidal folds on fixed points

haskell

monoids

recursion-schemes