有没有不可折叠的东西的地图堆积？

Question

假设我有一个二叉树：

data BinTree a
= Nil
| Branch a (BinTree a) (BinTree a)

我想在这样的结构上做一个累积图：

mapAccum ::
(
)
=> (a -> b -> (c, a)) -> a -> BinTree b -> BinTree c
mapAccum func x Nil =
Nil
mapAccum func x (Branch y left right) =
let
(y', x') =
func x y
in
Branch y' (mapAccum func x' left) (mapAccum func x' right) 

它在整个结构上执行带有累加器的映射。

然而，这是一个非常普遍的模式。 我们可以在各种树状结构上做到这一点，如果有一个很好的、常见的抽象，我宁愿使用它而不是在这里滚动我自己的抽象。

Traversables上有一个函数：

mapAccumL :: Traversable t => (s -> a -> (s, b)) -> s -> t a -> (s, t b)

哪种在列表中做同样的事情。 但它需要Foldable，这意味着它不适用于二叉树。 我正在寻找的将是它的更基本版本，无需Foldable即可工作。

我可以让它适用于用Cofree制成的类型：

mapAccum ::
( Functor f
)
=> (a -> b -> (c, a)) -> a -> Cofree f b -> Cofree f c
mapAccum func x (y :< rest) =
let
(y', x') =
func x y
in
y' :< fmap (mapAccum func x') rest

这表明它至少普遍适用于树状结构。

这个函数有通用的抽象吗？

Answer 1

以下是您使用bifunctors和recursion-schemes包编写的内容的概括：

{-# LANGUAGE TemplateHaskell, TypeFamilies #-}
import Control.Monad.Trans.State.Lazy
import Data.Bifunctor.TH
import Data.Bitraversable
import Data.Functor.Foldable
import Data.Functor.Foldable.TH
data BinTree a = Nil | Branch a (BinTree a) (BinTree a)
makeBaseFunctor ''BinTree
deriveBifunctor ''BinTreeF
deriveBifoldable ''BinTreeF
deriveBitraversable ''BinTreeF
mapAccum :: (Base tc ~ f c, Base tb ~ f b, Bitraversable f, Recursive tb,
Corecursive tc) => (a -> b -> (c, a)) -> a -> tb -> tc
mapAccum func x ys = embed ys' where
(ys', x') = runState (bitraverse (state . flip func) (pure . mapAccum func x') (project ys)) x
-- a slightly less general version, but that's usually good enough,
-- and will fix most ambiguous type errors
mapAccum' :: (Base (t c) ~ f c, Base (t b) ~ f b, Bitraversable f, Recursive (t b),
Corecursive (t c)) => (a -> b -> (c, a)) -> a -> t b -> t c
mapAccum' = mapAccum

它的工作方式是遍历树的当前元素中的所有值(特别是对于你的树，这始终只是一个元素)，转换它们并提出一个新的累加器值，然后递归地调用自己在树的每个子元素上具有该值。此外，由于它是懒惰状态，它会打结，所以它只需要在结构上行走一次而不是两次。换句话说，请注意，x'来自runState的输出，但它作为参数的一部分传递给它。在严格的语言中，这将导致无限循环，但由于Haskell是懒惰的，因此x'直到需要时才被评估，此时生成它的代码部分完成。

Answer 2

import Data.Functor.Foldable.TH
import Data.Functor.Foldable
data BinTree a
= Nil
| Branch a (BinTree a) (BinTree a)
deriving (Functor)
makeBaseFunctor ''BinTree

哈斯克尔拼接将定义的模板

data BinTreeF a x
= NilF
| BranchF a x x
deriving (Functor)

以及Base类型系列和BinTree的Recursive和Corecursive类的实例。多亏了该Recursive实例，您可以使用

cata :: Recursive t => (Base t r -> r) -> t -> r

在类型

cata :: (BinTreeF b (BinTree c) -> BinTree c) -> BinTree b -> BinTree c

具体说来

mapAccum:: a -> b -> (c, a)) -> a -> BinTree b -> BinTree c
mapAccum func = x t -> cata go t x
where
go NilF _x = Nil
go (BranchF y leftres rightres) x =
let
(y', x') = func x y
in
Branch y' (leftres x') (rightres x') 

或者，您可以使用

transverse :: (Recursive s, Corecursive t, Functor f) 
=> (forall r. Base s (f r) -> f (Base t r)) 
-> s -> f t

在类型

transverse :: (forall r. BinTreeF b (a -> r) -> a -> BinTreeF c r) 
-> BinTree b -> a -> BinTree c

这样

mapAccum:: forall a b c. (a -> b -> (c, a)) -> a -> BinTree b -> BinTree c
mapAccum func = x t -> transverse go t x
where
go :: BinTreeF b (a -> r) -> a -> BinTreeF c r
go NilF _x = NilF
go (BranchF y leftres rightres) x =
let
(y', x') = func x y
in
BranchF y' (leftres x') (rightres x')