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

Question

我正在阅读this paper by Chris Okasaki；标题为 "Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design".

问题是 - 算法中的魔法是如何发生的？有一些数字（例如标题为"threading the output of one level into the input of next level"的图7）不幸的是，也许只有我一个人，但那个数字让我完全莫名其妙。我根本不明白线程是如何发生的？

Answer 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 作为函数）。

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

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

explain the Haskell breadth first numbering code to traverse trees

algorithm

tree

haskell

breadth-first-search

tree-traversal