Haskell，树中的列表列表

Posted 2023-03-31

【中文标题】Haskell，树中的列表列表

【英文标题】：Haskell, list of lists from a tree

【发布时间】：2015-12-09 20:25:30

【问题描述】：

我有一个树的数据结构：

数据树 a = NodeT a (树 a) (树 a) |空T

我需要创建一个返回列表列表的函数，其中列表的每个元素代表树的一个级别。例如，从这里：

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

对此：[[1],[2,3],[4,5,6,7]]

函数必须具有以下形式：

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

如何使用递归来做到这一点？

有人吗？

谢谢

【参考方案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)

褶皱的粉丝会注意到这些是变形的：

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)

作为chipoints out，这种通用方法与使用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 的 answer 引用了 Okasaki 的 Breadth-First Numbering: Lessons from a Small Exercise in Algorithm Design，这是一篇出色的论文，它突出了许多函数式程序员的“盲点”，并为使抽象数据类型易于使用而不会被遗漏提供了很好的论据。但是，论文描述的问题比这个问题要复杂得多。这里不需要那么多机器。此外，该论文指出，在 ML 中，面向级别的解决方案实际上比基于队列的解决方案要快一些。我希望看到像 Haskell 这样的惰性语言会有更大的不同。

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

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

【讨论】：

感谢精彩的“讨论”部分。我应该注意到，我更关心 Jakub Daniel 的记忆复杂性解决方案，因为树有时往往很大，而且很高兴看到一种方法可以共同归纳地“生成”答案，给你的记忆一些脚印。我没有深入审查您的解决方案，但它看起来也不错。

看起来很漂亮，我买不到 :)

不错。我想知道——我们可以正确地说上面的level' 函数接受一棵树并返回一个差异列表吗？如果是这样，这会比使用 Jakub 的答案但使用 DLists 进行所有连接更有效吗？

@chi，我敢肯定，在强制的情况下，它们同样好；不太清楚的是它们是否同样递增。

@chi，我把这个想法充实了一点。我认为结果大致相同，但我不能 100% 确定。

【参考方案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。

【讨论】：

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

【参考方案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))