固定点上的Monoidal折叠

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知道如何结合所有案例的结果？我怀疑这可能是使用Monoids,可能与Constfunctor 一起使用(尽管不完全确定最后一部分).

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

fail返回4,而我们实际上有5叶子.我认为问题在于固定点,因为我们只能剥离一层Fixing,因此Mult [..]只计算为一片叶子.

有可能以某种方式一般地折叠整个固定点并将结果收集到类似Monoid结构中而无需手动指定所有实例吗？我想要的是一种foldMap更通用的方式.

我有一种感觉,我错过了一些非常明显的东西.

Answer 1

这是解决方案的本质.我已经开启了

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

让我们回顾一下固定点和catamorphisms.

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

另一种方法是在感兴趣的子结构中进行编织和折叠,在这种情况下,是叶子上的东西.(我们得到的是免费的monad.)

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并不总是最好的让我们访问"找到的functoriality":我们不得不预测在声明时参数化数据类型时我们需要的功能.但仍有时间改变这一切......