9

对于带有标记节点的叶值树，我从这种类型开始：

type Label = String
data Tree a = Leaf Label a 
            | Branch Label [Tree a]

我想在这棵树上写一些折叠，它们都采用变态的形式，所以让我们recursion-schemes为我做递归遍历：

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, TemplateHaskell, TypeFamilies #-}
import Data.Functor.Foldable.TH (makeBaseFunctor)
import Data.Functor.Foldable (cata)

type Label = String
data Tree a = Leaf Label a 
            | Branch Label [Tree a]
makeBaseFunctor ''Tree

allLabels :: Tree a -> [Label]
allLabels = cata go
  where go (LeafF l _) = [l]
        go (BranchF l lss) = l : concat lss

一切都很好：我们可以遍历一棵树：

λ> allLabels (Branch "root" [(Leaf "a" 1), Branch "b" [Leaf "inner" 2]])
["root","a","b","inner"]

但是 Tree 的定义有点笨拙：每个数据构造函数都需要单独处理 Label。对于像 Tree 这样的小型结构来说，这并不算太糟糕，但是如果有更多的构造函数，那就太麻烦了。所以让我们让标签成为它自己的层：

data Node' a = Leaf' a
             | Branch' [Tree' a]
data Labeled a = Labeled Label a
newtype Tree' a = Tree' (Labeled (Node' a))
makeBaseFunctor ''Tree'
makeBaseFunctor ''Node'

太好了，现在我们的 Node 类型代表了没有标签的树的结构，Tree' 和 Labeled 一起用标签来装饰它。但我不再知道如何使用cata这些类型，即使它们与原始Tree类型同构。makeBaseFunctor没有看到任何递归，所以它只定义了与原始类型相同的基本函子：

$ stack build --ghc-options -ddump-splices
...
newtype Tree'F a r = Tree'F (Labeled (Node' a))
...
data Node'F a r = Leaf'F a | Branch'F [Tree' a]

就像，公平地说，我也不知道我希望它生成什么：cata期望一个单一的类型进行模式匹配，当然它不能合成一个是我的两种类型的组合。

那么这里的计划是什么？cata如果我定义自己的 Functor 实例，这里是否有一些适应？或者定义这种类型的更好方法，避免重复处理 Label 但仍然是自递归而不是相互递归？

我认为这个问题可能与具有多种类型的递归方案有关，但我不明白那里的答案：Cofree到目前为止对我来说很神秘，我无法判断它是问题的本质还是只是表示的一部分用过的; 并且该问题中的类型不是相互递归的，所以我不知道如何将解决方案应用于我的类型。

4

1 回答 1

2

链接问题的一个答案提到添加一个额外的类型参数，以便Tree (Labeled a)我们使用Tree Labeled a：

type Label = String
data Labeled a = Labeled Label a deriving Functor
data Tree f a = Leaf (f a)
              | Branch (f [Tree f a])

这样，单个类型 ( Tree) 负责递归，因此makeBaseFunctor应该识别递归并将其抽象到函子上。它确实这样做了，但它生成的实例并不完全正确。再看一遍-ddump-splices，我看到makeBaseFunctor ''Tree产生：

data TreeF f a r = LeafF (f a) | BranchF (f [r]) deriving (Functor, Foldable, Traversable)
type instance Base (Tree f a) = TreeF f a
instance Recursive (Tree f a) where
  project (Leaf x) = LeafF x
  project (Branch x) = BranchF x
instance Corecursive (Tree f a) where
  embed (LeafF x) = Leaf x
  embed (BranchF x) = Branch x

但这不会编译，因为 Recursive 和 Corecursive 实例仅在是仿f函数时才是正确的。似乎递归方案确实具有某种可插拔机制，可以以不同的方式获取实例，但我不明白。但是，我可以直接将接头复制到我的文件中并自己添加约束：

data TreeF f a r = LeafF (f a) | BranchF (f [r]) deriving (Functor, Foldable, Traversable)
type instance Base (Tree f a) = TreeF f a
instance Functor f => Recursive (Tree f a) where
  project (Leaf x) = LeafF x
  project (Branch x) = BranchF x
instance Functor f => Corecursive (Tree f a) where
  embed (LeafF x) = Leaf x
  embed (BranchF x) = Branch x

之后，我可以cata以与我的问题中的原始版本非常相似的方式使用：

allLabels :: Tree Labeled a -> [Label]
allLabels = cata go
  where go (LeafF (Labeled l _)) = [l]
        go (BranchF (Labeled l lss)) = l : concat lss

我仍然欢迎一个解释如何完成类似事情的答案，而不必将一堆拼接的废话手动复制到我的源文件中。

于 2021-12-18T17:02:56.920 回答