List Haskell,树上的列表列表

List Haskell,树上的列表列表,list,haskell,tree,List,Haskell,Tree,我有一个树的数据结构: 数据树a=节点集a(树a)(树a)|清空 我需要创建一个函数,返回一个列表列表,其中列表的每个元素表示树的一个级别。例如,从以下方面: 1 / \ 2 3 / \ / \ 4 5 6 7 对此:[[1]、[2,3]、[4,5,6,7]] 该函数必须具有以下形式: f :: Tree a -> [[a]] 如何使用递归实

我有一个树的数据结构:

数据树a=节点集a(树a)(树a)|清空

我需要创建一个函数,返回一个列表列表,其中列表的每个元素表示树的一个级别。例如,从以下方面:

          1
         / \
       2     3
      / \   / \
     4   5 6   7     
对此:[[1]、[2,3]、[4,5,6,7]]

该函数必须具有以下形式:

                     f :: Tree a -> [[a]]
如何使用递归实现它

有人吗


感谢您递归地计算级别,并始终从两个子树逐点合并列表(因此相同深度的所有切片都合并在一起)


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

稍微复杂一些的解决方案,而不是被接受的解决方案,但我认为我的解决方案在内存消耗方面可能更好(有点晚了,所以请检查自己)

直觉来自一篇精彩的论文。在函数式语言中,您可以获得关于树的广度优先遍历的一般直觉

我做了一些丑陋的添加来添加“列表列表”拆分,可能有更好的方法:

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))
答复
级别的实现稍微复杂一些,但更懒惰一些。

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)
因此,这种一般方法与使用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)
导入数据.Monoid
级别::树a->[[a]]
级别=贴图(翻转附录[])。(cata br[])
哪里
br::a->[Endo[a]]->[Endo[a]]->[Endo[a]]
br a l r=Endo(a:):合并l r
合并::幺半群a=>[a]->[a]->[a]
合并[]ys=ys
合并(x:xs)ys=(xy):合并xs-ys'
哪里
(y,y′)=
案件
[]->(记忆,[])
p:ps->(p,ps)
我不完全确定这与更直接的方法相比如何

讨论 Kostiantyn Rybnikov引用了Okasaki的文章,这是一篇优秀的论文,突出了许多函数式程序员的“盲点”,并为使抽象数据类型易于使用提供了很好的论据,使它们不会被遗漏。然而,论文所描述的问题要比这个问题复杂得多;这里不需要那么多机器。此外,本文还指出,在ML中,面向级别的解决方案实际上比基于队列的解决方案稍快一些;我希望在像哈斯克尔这样的懒惰语言中看到更大的区别

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


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

我认为这是非常低效的,因为每个级别都是使用
++
构建的,并且左参数通常不小于右参数。感谢伟大的“讨论”部分。我应该注意到,我更关心的是Jakub Daniel关于内存复杂性的解决方案,因为有时树往往很大,而且总是很高兴看到这种方法能够一块一块地“生成”答案,从而给你的内存留下一些脚印。我没有深入查看您的解决方案,但它看起来也不错。看起来很漂亮,有些东西我无法得到:)很好。我想知道——我们能否正确地说上面的
level'
函数接受一个树并返回一个差异列表?如果是这样的话,这会比使用Jakub的答案但使用
DList
s进行所有连接更有效吗?@chi,我敢肯定,如果一直强制执行,这些都同样有效;“不太清楚的是它们是否同样是递增的。”池,我把这个想法充实了一点。我想结果差不多,但我不是100%确定。
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)
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)