Haskell，从树中得到一个列表的列表

Question

我有一个树结构的数据：

data Tree a = NodeT a (Tree a) (Tree a) | EmptyT

我需要创建一个函数，返回一个列表的列表，其中每个列表元素表示树的一层。例如，从这个数据：

          1
         / \
       2     3
      / \   / \
     4   5 6   7     

要翻译为：[[1],[2,3],[4,5,6,7]]。

该函数必须具备以下形式：

                     f :: Tree a -> [[a]]

如何使用递归来实现？

有人知道吗？

谢谢

- Dick Burns

Answer 1

答案

levels :: Tree a -> [[a]]
levels t = levels' t []

levels' :: Tree a -> [[a]] -> [[a]]
levels' EmptyT rest = rest
levels' (NodeT a l r) [] = [a] : levels' l (levels r)
levels' (NodeT a l r) (x : xs) = (a : x) : levels' l (levels' r xs)

一种稍微复杂但更加懒惰的实现方式是 levels'：

levels' EmptyT rest = rest
levels' (NodeT a l r) rest = (a : front) : levels' l (levels' r back)
  where
    (front, back) = case rest of
       [] -> ([], [])
       (x : xs) -> (x, xs)

喜欢函数式编程的人会注意到这些都是以catamorphism形式结构化的：

cata :: (a -> b -> b -> b) -> b -> Tree a -> b
cata n e = go
  where
    go EmptyT = e
    go (NodeT a l r) = n a (go l) (go r)

levels t = cata br id t []
  where
    br a l r rest = (a : front) : l (r back)
      where
        (front, back) = case rest of
          [] -> ([], [])
          (x : xs) -> (x, xs)

正如chi指出的那样，这种通用方法与使用Jakub Daniel的解决方案并以差异列表作为中间形式的结果似乎存在某种联系。这可能看起来像：

import Data.Monoid

levels :: Tree a -> [[a]]
levels = map (flip appEndo []) . (cata br [])
  where
    br :: a -> [Endo [a]] -> [Endo [a]] -> [Endo [a]]
    br a l r = Endo (a :) : merge l r

merge :: Monoid a => [a] -> [a] -> [a]
merge [] ys = ys
merge (x : xs) ys = (x <> y) : merge xs ys'
   where
     (y,ys') =
       case ys of
         [] -> (mempty, [])
         p : ps -> (p, ps)

我不确定这种方法与更直接的方法相比如何。

讨论

Kostiantyn Rybnikov的答案引用了Okasaki的《广度优先编号：从算法设计的小练习中获得的教训》，这是一篇很好的论文，强调了许多函数式程序员的“盲点”，并提出了使抽象数据类型易于使用的良好论据，以便它们不会被忽略。然而，这篇论文描述的问题比这个问题复杂得多；这里需要的机器不是那么多。此外，该论文指出，在ML中，面向级别的解决方案实际上比基于队列的解决方案稍微快一些；在Haskell等惰性语言中，我希望看到更大的差异。

Jakub Daniel的答案尝试了一个面向级别的解决方案，但不幸的是存在效率问题。它通过反复将一个列表附加到另一个列表来构建每个级别，这些列表可能都具有相等的长度。因此，在最坏的情况下，如果我计算正确，处理具有n个元素的树需要O(n log n)的时间。

我选择的方法是面向级别的，但通过将每个左子树传递给其右兄弟和堂兄弟的级别来避免了连接的痛苦。树的每个节点/叶子仅处理一次。该处理涉及O(1)的工作：对该节点/叶子进行模式匹配，并且如果它是一个节点，则对从右兄弟和堂兄弟派生的列表进行模式匹配。因此，处理具有n个元素的树的总时间为O(n)。

- dfeuer

---

感谢出色的“讨论”部分。我应该注意到，我更关心Jakub Daniel的内存复杂度解决方案，因为树有时候会很大，而且总是很好看到一种逐步以共归方式“生成”答案的方法，给你的内存带来一些足迹。我没有深入审查您的解决方案，但它看起来也不错。 - Konstantine Rybnikov

看起来很漂亮，这是我无法得到的东西 :) - Konstantine Rybnikov

谢谢，@KostiantynRybnikov。 - dfeuer

不错。我想知道 - 我们能否正确地说上面的 level 函数接受一棵树并返回一个差异列表？如果是这样，那么使用 DList 进行所有连接是否比使用 Jakub 的答案更有效率？ - chi

@chi，我非常确定当它们被完全强制执行时它们是同样好的；不太清楚的是它们是否同样具有增量性。 - dfeuer

@chi，我稍微完善了一下那个想法。我认为最终结果差不多，但我不能百分之百确定。 - dfeuer

Answer 2

你需要递归计算层级，并始终按点合并两个子树的列表（因此同一深度的所有切片都会被合并在一起）。

f :: Tree a -> [[a]]
f EmptyT = []
f (NodeT a t1 t2) = [a] : merge (f t1) (f t2)

merge :: [[a]] -> [[a]] -> [[a]]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys) = (x ++ y) : merge xs ys

如果树是完整的（从根到列表的所有路径长度相同），那么你可以使用zipWith (++)作为merge。

- jakubdaniel

---

我认为这相当低效，因为每个级别都是使用 ++ 构建的，并且左参数通常不小于右参数。 - dfeuer

Answer 3

稍微有些复杂的解决方案，比被接受的那个更好，但我认为我的方法在内存消耗方面可能更佳（现在时间有点晚了，请自行确认）。

直觉来自于Chris Okasaki "Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design"一篇精彩的论文。你可以详细了解函数式语言中树的广度优先遍历的一般性直觉。

我进行了有些丑陋的添加以添加“列表的列表”拆分，可能有更好的方法：

module Main where

data Tree a = NodeT a (Tree a) (Tree a) | EmptyT

--      1
--     / \
--   2     3
--  / \   / \
-- 4   5 6   7     

f :: Tree a -> [[a]]
f t = joinBack (f' [(t, True)])

type UpLevel = Bool

f' :: [(Tree a, UpLevel)] -> [(a, UpLevel)]
f' [] = []
f' ((EmptyT, _) : ts) = f' ts
f' ((NodeT a t1 t2, up) : ts) = (a, up) : f' (ts ++ [(t1, up)] ++ [(t2, False)])

joinBack :: [(a, UpLevel)] -> [[a]]
joinBack = go []
  where
    go acc [] = [reverse acc]
    go acc ((x, False) : xs) = go (x : acc) xs
    go acc ((x, True) : xs) = reverse acc : go [] ((x, False):xs)

main :: IO ()
main = do
  let tree = NodeT 1 (NodeT 2 (NodeT 4 EmptyT EmptyT) (NodeT 5 EmptyT EmptyT))
                     (NodeT 3 (NodeT 6 EmptyT EmptyT) (NodeT 7 EmptyT EmptyT))
             :: Tree Int
  print (tail (f tree))

- Konstantine Rybnikov