解释 Haskell 广度优先编号代码遍历树

Posted 2023-03-31

【中文标题】解释 Haskell 广度优先编号代码遍历树

【英文标题】：explain the Haskell breadth first numbering code to traverse trees

【发布时间】：2015-04-19 06:10:13

【问题描述】：

我正在阅读this paper by Chris Okasaki;标题为“广度优先编号：算法设计小练习的经验教训”。

一个问题是 - 算法中的魔法是如何发生的？有一些图（例如图 7 标题为“将一个级别的输出线程化到下一个级别的输入”） 不幸的是，也许只有我一个人，但那个数字完全让我感到困惑。我完全不明白线程是如何发生的？

【问题讨论】：

一次只有 一个 问题

（该论文中的大部分代码（包括您发布的 sn-p）都使用 SML。）

@KarolyHorvath 编辑了问题

unfoldForestM_BF in Data.Tree 有该算法的 Haskell 实现。

顺便说一句，您还应该研究一下冈崎与他的对比方法——我认为他称之为面向水平的解决方案。它也很不错，而且我怀疑速度更快。

【参考方案1】：

广度优先遍历意味着逐层遍历树。所以让我们假设我们已经知道每个级别开始时的数字是什么 - 到目前为止每个级别之前遍历的元素的数量。对于论文中的简单示例

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）。

这样做之后，我们将再次获得相同的尺寸列表，只是移动了一个 - 现在我们有了每个级别之后的元素总数。所以诀窍是：假设我们有这样一个列表，将其用于计算，然后将输出作为输入 - tie the knot。

一个示例实现：

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')

概括为Monoid（对于编号，您可以将const $ Sum 1 作为函数）。

【讨论】：

现在，难道不想为任意应用写一个遍历函数吗？

@dfeuer 可以，但问题是我们需要逐层遍历，然后从下一层（l' 和r'）获取子节点。所以我不确定是否可以用于一般应用程序。

看我的回答。我很确定我明白了。我基于unfoldForestBF 概念定义了一个Traversable 实例。

@PetrPudlák 谢谢，太棒了；我正试图绕过它。看起来仍然像魔术一样。你能解释一下ms 是如何在tagBfs f t = let (ms, r) = thread (mempty : ms) t 行中定义的吗？它看起来无限递归。

@mntk123 非常类似于将斐波那契数列定义为无限列表fibs = 0 : 1 : zipWith (+) fibs (tail fibs)。由于thread逐级处理列表，所以只需要头部mempty处理第一级。对于第二层的计算，它使用在第一层中计算的结果，等等。列表可能是无限的，但这很好，因为我们只需要列表中的元素与我们检查树的深度一样多。

【参考方案2】：

查看树编号的一种方法是遍历。具体来说，我们希望使用State 以广度优先顺序遍历树进行计数。必要的Traversable 实例看起来像这样。请注意，您可能实际上想要为newtype 定义此实例，例如BFTree，但为了简单起见，我只是使用原始Tree 类型。这段代码受到Cirdec's monadic rose tree unfolding code 中想法的强烈启发，但这里的情况似乎 要简单得多。希望我没有错过任何可怕的事情。

-# 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])

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

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)