5

给定一个具有固定点的任意数据结构,我们可以在不手动指定所有情况的情况下构造一个单曲面代数吗?

假设我们得到如下数据类型Expr。使用该recursion-schemes库,我们可以派生一个基础仿函数,它也ExprF自动具有Functor和实例。FoldableTraversable

{-# 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,可能与Const仿函数一起使用(虽然不完全确定最后一部分)。

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

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

是否可以在不手动指定所有实例的情况下以某种方式通用地折叠整个固定点并以类似Monoid结构的方式收集结果?我想要的是一种但更通用的方式。foldMap

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

4

1 回答 1

10

这是解决方案的精髓。我已经开启

{-# 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可以看到父节点的每个子节点的叶子数。我们可以使用catabecause fis a Functor。因为fFoldable,我们可以计算孩子的叶子总数。

  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

它低于费尔贝恩阈值(即,足够短,不需要名字,没有名字就更清楚了)。

当然,问题在于数据结构通常以多种有趣但相互冲突的方式在“感兴趣的子结构”中发挥作用。Haskell 并不总是最擅长让我们访问“找到的功能性”:当我们在声明时参数化数据类型时,我们必须以某种方式预测我们需要的功能性。但仍有时间改变这一切……

于 2017-06-07T09:31:32.860 回答