Algorithm 解释用于遍历树的Haskell宽度优先编号代码

我在读书；标题为“宽度优先编号：算法设计小练习的经验教训”

问题是——算法中的魔法是如何发生的？有一些图（例如图7标题为“将一个级别的输出穿入下一个级别的输入”）

---

不幸的是，也许只有我一个人，但这个数字让我完全困惑。我根本不明白线程是怎么发生的

宽度优先遍历是指逐个遍历树的各个层次。那么让我们假设我们已经知道了每个级别开始时的数字-到目前为止在每个级别之前遍历的元素的数量。对于本文中的简单示例

import Data.Monoid

data Tree a = Tree (Tree a) a (Tree a)
            | Empty
  deriving (Show)

example :: Tree Char
example = Tree (Tree Empty 'b' (Tree Empty 'c' Empty)) 'a' (Tree Empty 'd' Empty)

大小将为0、1、3、4。知道了这一点，我们可以通过从左到右的给定树（子树）遍历这样一个大小列表：我们将列表中的第一个元素向前推进一个节点，然后将列表的尾部先遍历左边，然后遍历右边的子树（请参见下面的

thread

）

这样做之后，我们将再次得到相同的大小列表，只移动了一个-现在我们有了每个级别之后的元素总数。所以诀窍是：假设我们有这样一个列表，使用它进行计算，然后将输出作为输入-

示例实现：

tagBfs :: (Monoid m) => (a -> m) -> Tree a -> Tree m
tagBfs f t = let (ms, r) = thread (mempty : ms) t
              in r
  where
    thread ms Empty = (ms, Empty)
    thread (m : ms) (Tree l x r) =
        let (ms1, l') = thread ms l
            (ms2, r') = thread ms1 r
         in ((m <> f x) : ms2, Tree l' m r')

tagBfs:：（幺半群m）=>（a->m）->树a->树m
tagBfs f t=let（ms，r）=线程（mempty:ms）t
在r
哪里
线程ms Empty=（ms，Empty）
螺纹（m:ms）（树长x树高）=
let（ms1，l'）=线程ms l
（ms2，r'）=线程ms1 r
在（（mfx）：ms2，树l'mr'）

---

泛化为

幺半群

（对于编号，您可以使用

const$Sum 1

作为函数）。

查看树编号的一种方法是遍历。具体来说，我们希望使用

State

以宽度优先的顺序遍历树进行计数。必要的

可遍历的
实例如下所示。注意，您可能实际上想要为
newtype
定义这个实例，比如
BFTree
，但为了简单起见，我只使用原始
树
类型。这段代码深受中的思想启发，但这里的情况似乎更简单。希望我没有错过什么可怕的事情

{-# LANGUAGE DeriveFunctor,
             GeneralizedNewtypeDeriving,
             LambdaCase #-}
{-# OPTIONS_GHC -Wall #-}

module BFT where

import Control.Applicative
import Data.Foldable
import Data.Traversable
import Prelude hiding (foldr)

data Tree a = Tree (Tree a) a (Tree a)
            | Empty
  deriving (Show, Functor)

newtype Forest a = Forest {getForest :: [Tree a]}
   deriving (Functor)

instance Foldable Forest where
  foldMap = foldMapDefault

-- Given a forest, produce the forest consisting
-- of the children of the root nodes of non-empty
-- trees.
children :: Forest a -> Forest a
children (Forest xs) = Forest $ foldr go [] xs
  where
    go Empty c = c
    go (Tree l _a r) c = l : r : c

-- Given a forest, produce a list of the root nodes
-- of the elements, with `Nothing` values in place of
-- empty trees.
parents :: Forest a -> [Maybe a]
parents (Forest xs) = foldr go [] xs
  where
    go Empty c = Nothing : c
    go (Tree _l a _r) c = Just a : c

-- Given a list of values (mixed with blanks) and
-- a list of trees, attach the values to pairs of
-- trees to build trees; turn the blanks into `Empty`
-- trees.
zipForest :: [Maybe a] -> Forest a -> [Tree a]
zipForest [] _ts = []
zipForest (Nothing : ps) ts = Empty : zipForest ps ts
zipForest (Just p : ps) (Forest ~(t1 : ~(t2 : ts'))) =
   Tree t1 p t2 : zipForest ps (Forest ts')

instance Traversable Forest where
  -- Traversing an empty container always gets you
  -- an empty one.
  traverse _f (Forest []) = pure (Forest [])

  -- First, traverse the parents. The `traverse.traverse`
  -- gets us into the `Maybe`s. Then traverse the
  -- children. Finally, zip them together, and turn the
  -- result into a `Forest`. If the `Applicative` in play
  -- is lazy enough, like lazy `State`, I believe 
  -- we avoid the double traversal Okasaki mentions as
  -- a problem for strict implementations.
  traverse f xs = (Forest .) . zipForest <$>
          (traverse.traverse) f (parents xs) <*>
          traverse f (children xs)

instance Foldable Tree where
  foldMap = foldMapDefault

instance Traversable Tree where
  traverse f t =
       (\case {(Forest [r]) -> r;
               _ -> error "Whoops!"}) <$>
       traverse f (Forest [t])

{-#语言派生函子，
广义newtypedering，
LambdaCase#-}
{-#选项#GHC-墙#-}
模块BFT在哪里
导入控制
导入数据。可折叠
导入数据。可遍历
导入前奏隐藏（foldr）
数据树a=树（树a）a（树a）
|空的
派生（显示，函子）
newtype Forest a=林{getForest:：[Tree a]}
派生（函子）
实例可折叠林在哪里
foldMap=foldMap默认值
--给定一片森林，就产生一片森林
--非空的根节点的子节点的
--树木。
儿童：：森林a->森林a
子级（森林xs）=森林$foldr go[]xs
哪里
清空c=c
go（树l_a r）c=l:r:c
--给定一个林，生成一个根节点列表
--元素的，用“Nothing”值代替
--空树。
父母：：森林a->[可能是a]
父级（林xs）=foldr go[]xs
哪里
空着c=什么也没有：c
go（Tree _la _r）c=只是a:c
--给出一个值列表（混有空格）和
--在树列表中，将值附加到
--植树造林；把空格变成空的`
--树木。
zipForest:：[可能是a]->森林a->[树a]
zipForest[]\u ts=[]
zipForest（无：ps）ts=空：zipForest ps ts
zipForest（仅p:ps）（森林~（t1:~（t2:ts'））=
树t1 p t2:zipForest ps（森林ts'）
实例可遍历的林在哪里
--遍历一个空容器总是让您
--一个空的。
遍历_f（林[]）=纯（林[]）
--首先，遍历父母。“特拉弗斯，特拉弗斯”`
--让我们进入‘也许’的世界。然后穿过
--孩子们。最后，将它们拉在一起，然后转动
--结果变成“森林”。如果“Applicative”在起作用
--我相信他足够懒了，就像懒散的“状态”
--我们避免冈崎提到的双重穿越
--严格实现的一个问题。
遍历f xs=（林）。紫杉林
（遍历。遍历）f（父对象xs）
遍历f（子对象xs）
实例可折叠树在哪里
foldMap=foldMap默认值
实例可遍历树，其中
横向f t=
（\case{（Forest[r]）->r；
_->错误“哎哟！”）
导线测量f（森林[t]）

现在我们可以编写代码，将树的每个元素与其宽度优先数配对，如下所示：

import Control.Monad.Trans.State.Lazy

numberTree :: Tree a -> Tree (Int, a)
numberTree tr = flip evalState 1 $ for tr $ \x ->
      do
        v <- get
        put $! (v+1)
        return (v,x)

import Control.Monad.Trans.State.Lazy
NumbertTree:：Tree a->Tree（Int，a）
numberTree tr=tr$\x->
做
v一次只问一个问题（那篇论文中的大部分代码（包括你发布的代码片段）都在SML中。）@KarolyHorvath编辑了这个问题，这个算法有一个Haskell实现。顺便说一下，你还应该看看Okasaki将他的方法与我认为他所谓的面向级别的解决方案进行对比的方法。它也很好，我怀疑速度更快。现在，人们不想为任意应用程序编写遍历函数吗？@dfeuer会，但问题是我们需要逐级遍历，同时从下面的级别获取子节点（
l'
和
r'
）。所以我不确定是否有可能成为一个通用的应用程序。请看我的答案。我很确定我明白了。我基于
unfoldForestBF
概念定义了一个
Traversable
实例。@PetrPudlák谢谢，这太神奇了；我正试着把我的头绕过去。看起来还是很神奇。你能解释一下在
tagBfs f t=let（ms，r）=thread（mempty:ms）t
行中如何定义
ms
？它看起来是无限递归。@mntk123它非常类似于将斐波那契序列定义为无限列表。