Data.Tree包含unfoldTreeM_BF和unfoldForestM_BF函数，使用monadic动作的结果构造树广度优先。使用forest unfolder可以轻松地编写树展开文件，因此我将重点关注后者：
unfoldForestM_BF :: Monad m =>
(b -> m (a, [b])) -> [b] -> m [Tree a]
从种子列表开始，它为每个种子应用一个函数，生成将产生树根的动作和下一级展开的种子。使用的算法有点严格，因此将unfoldForestM_BF与Identity monad一起使用与使用纯unfoldForest不完全相同。我一直在试图弄清楚是否有办法让它变得懒惰而不牺牲其O(n)时限。如果（正如Edward Kmett向我建议的那样）这是不可能的，我想知道是否可以使用更具约束力的类型来执行此操作，特别是需要MonadFix而不是Monad。这个概念将（以某种方式）设置指向未来计算结果的指针，同时将这些计算添加到待办事项列表中，因此如果它们在早期计算的效果中是惰性的，它们将立即可用。
答案 0 :(得分：15)
我之前声称，下面介绍的第三个解决方案与深度优先unfoldForest具有相同的严格性，这是不正确的。
即使我们不需要MonadFix个实例，你的直觉树木可以懒散地展开广度至少部分是正确的。当已知分支因子是有限的并且已知分支因子是大的时候，特殊情况存在解决方案。我们将从O(n)时间为具有有限分支因子的树运行的解决方案开始，包括退化树，每个节点只有一个子节点。有限分支因子的解决方案将无法在具有无限分支因子的树上终止，我们将使用O(n)时间运行的解决方案来解决这些问题，对于具有＆＃34;大＆＃34;分枝因子大于1，包括具有无限分支因子的树。 ＆＃34;大＆＃34;的解决方案分支因子将在O(n^2)时间内在退化树上运行，每个节点只有一个子节点或没有子节点。当我们结合两个步骤中的方法以尝试在O(n)时间内为任何分支因子运行的混合解决方案时，我们将获得比有限分支因子的第一个解决方案更懒的解决方案，但是不能容纳树从无限分支因子快速过渡到没有分支。
一般的想法是，我们将首先为整个级别构建所有标签，并为下一级别构建森林的种子。然后我们将进入下一个层次，构建所有这些层次。我们将汇集更深层次的结果，为外层建造森林。我们将标签与森林一起建造树木。
unfoldForestM_BF非常简单。如果它返回的级别没有种子。在构建了所有标签之后，它将每个森林的种子收集起来，并将它们收集到一个所有种子的列表中，以构建下一个级别并展开整个更深层次。最后，它从种子的结构构建每棵树的森林。
import Data.Tree hiding (unfoldTreeM_BF, unfoldForestM_BF)
unfoldForestM_BF :: Monad m => (b->m (a, [b])) -> [b] -> m [Tree a]
unfoldForestM_BF f [] = return []
unfoldForestM_BF f seeds = do
level <- sequence . fmap f $ seeds
let (labels, bs) = unzip level
deeper <- unfoldForestM_BF f (concat bs)
let forests = trace bs deeper
return $ zipWith Node labels forests
trace从展平列表中重建嵌套列表的结构。假设[b]中的每个项目[[a]]中都有一个项目。concat。使用trace ... trace :: [[a]] -> [b] -> [[b]]
trace [] ys = []
trace (xs:xxs) ys =
let (ys', rem) = takeRemainder xs ys
in ys':trace xxs rem
where
takeRemainder [] ys = ([], ys)
takeRemainder (x:xs) (y:ys) =
let ( ys', rem) = takeRemainder xs ys
in (y:ys', rem)
来展平有关祖先级别的所有信息会阻止此实现在节点上为具有无限子节点的树进行处理。
unfoldTreeM_BF :: MonadFix m => (b->m (a, [b])) -> b -> m (Tree a)
unfoldTreeM_BF f = (>>= return . head) . unfoldForestMFix_BF f . (:[])
在展开森林方面，展开树是微不足道的。
concat大分支因子的解决方案与有限分支因子的解决方案大致相同，除了它保持树的整个结构而不是trace将一个级别中的分支设置为单个列表和import该列表。除了上一节中使用的Compose之外，我们还将使用Traversable一起构建树的多个级别的仿函数，并在多个sequence到import Data.Tree hiding (unfoldForestM_BF, unfoldTreeM_BF)
import Data.Foldable
import Data.Traversable
import Data.Functor.Compose
import Prelude hiding (sequence, foldr)
之间构建仿函数级结构。
concat不是将所有祖先结构与Compose一起展平，而是用unfoldForestM_BF :: (Traversable t, Traceable t, Monad m) =>
(b->m (a, [b])) -> t b -> m (t (Tree a))
unfoldForestM_BF f seeds
| isEmpty seeds = return (fmap (const undefined) seeds)
| otherwise = do
level <- sequence . fmap f $ seeds
deeper <- unfoldForestM_BF f (Compose (fmap snd level))
return $ zipWithIrrefutable Node (fmap fst level) (getCompose deeper)
包裹祖先和下一级别的种子并递归整个结构。
zipWithIrrefutable zipWith是Traceable的更加懒惰的版本，它依赖于第一个列表中每个项目的第二个列表中有一个项目的假设。 Functors结构是zipWithIrrefutable，可以提供Traceable。如果a然后xs和ys，则fmap (const a) xs == fmap (const a) ys的法律适用于zipWithIrrefutable (\x _ -> x) xs ys == xs，zipWithIrrefutable (\_ y -> y) xs ys == ys和f。每xs和zipWithIrrefutable f xs ⊥ == fmap (\x -> f x ⊥) xs class Functor f => Traceable f where
zipWithIrrefutable :: (a -> b -> c) -> f a -> f b -> f c
都有严格的要求。
instance Traceable [] where
zipWithIrrefutable f [] ys = []
zipWithIrrefutable f (x:xs) ~(y:ys) = f x y : zipWithIrrefutable f xs ys
如果我们已经知道它们具有相同的结构，我们可以懒惰地组合两个列表。
instance (Traceable f, Traceable g) => Traceable (Compose f g) where
zipWithIrrefutable f (Compose xs) (Compose ys) =
Compose (zipWithIrrefutable (zipWithIrrefutable f) xs ys)
如果我们知道可以组合每个仿函数，我们可以组合两个仿函数的组合。
isEmpty []检查要扩展的空节点结构，就像isEmpty :: Foldable f => f a -> Bool
isEmpty = foldr (\_ _ -> False) True
中有限分支因子的解决方案中的模式匹配一样。
zipWithIrrefutable精明的读者可能会注意到Traceable中的liftA2与Applicative非常相似，而[b]的定义是[b]的一半。
混合解决方案结合了有限解决方案和＆＃34;大＆＃34;解。与有限解一样，我们将在每一步压缩和解压缩树表示。就像＆＃34;大＆＃34;的解决方案分支因素我们将使用允许跨越完整分支的数据结构。有限分支因子解决方案使用了在任何地方展平的数据类型[[b]]。 ＆＃34;大＆＃34;分支因子解决方案使用的数据类型在任何地方都是扁平的：越来越多的嵌套列表以[[[b]]]开头，然后是b，然后是[b]，依此类推。在这些结构之间将是嵌套列表，这些列表要么停止嵌套，要么只保留Free或保持嵌套并保持data Free f a = Pure a | Free (f (Free f a))
。递归模式通常由Free [] monad描述。
data Free [] a = Pure a | Free [Free [] a]
我们将专门针对import Data.Tree hiding (unfoldTreeM_BF, unfoldForestM_BF)
import Data.Traversable
import Prelude hiding (sequence, foldr)
开展工作。
Free []对于混合解决方案，我们将重复其所有导入和组件，以便下面的代码应该是完整的工作代码。
zipWithIrrefutable由于我们将与class Functor f => Traceable f where
zipWithIrrefutable :: (a -> b -> c) -> f a -> f b -> f c
instance Traceable [] where
zipWithIrrefutable f [] ys = []
zipWithIrrefutable f (x:xs) ~(y:ys) = f x y : zipWithIrrefutable f xs ys
instance (Traceable f) => Traceable (Free f) where
zipWithIrrefutable f (Pure x) ~(Pure y ) = Pure (f x y)
zipWithIrrefutable f (Free xs) ~(Free ys) =
Free (zipWithIrrefutable (zipWithIrrefutable f) xs ys)
合作，因此我们会向其提供unfoldFreeM_BF :: (Monad m) => (b->m (a, [b])) -> Free [] b -> m (Free [] (Tree a))
unfoldFreeM_BF f (Free []) = return (Free [])
unfoldFreeM_BF f seeds = do
level <- sequence . fmap f $ seeds
let (compressed, decompress) = compress (fmap snd level)
deeper <- unfoldFreeM_BF f compressed
let forests = decompress deeper
return $ zipWithIrrefutable Node (fmap fst level) forests
。
compress广度优先遍历看起来与有限分支树的原始版本非常相似。我们为当前级别构建当前标签和种子，压缩树的其余部分的结构，为剩余的深度完成所有工作，并解压缩结果的结构以使森林与标签一起使用。
Free [] [b]需要[b]持有森林种子Free并将Free [] b展平为decompress以获得compress :: Free [] [b] -> (Free [] b, Free [] a -> Free [] [a])
compress (Pure [x]) = (Pure x, \(Pure x) -> Pure [x])
compress (Pure xs ) = (Free (map Pure xs), \(Free ps) -> Pure (map getPure ps))
compress (Free xs) = wrapList . compressList . map compress $ xs
where
compressList [] = ([], const [])
compressList ((Free [],dx):xs) = let (xs', dxs) = compressList xs
in (xs', \xs -> dx (Free []):dxs xs)
compressList ( (x,dx):xs) = let (xs', dxs) = compressList xs
in (x:xs', \(x:xs) -> dx x:dxs xs)
wrapList ([x], dxs) = (x, \x -> Free (dxs [x]))
wrapList (xs , dxs) = (Free xs, \(Free xs) -> Free (dxs xs ))
。它还返回一个Free []函数，可用于撤消展平以恢复原始结构。我们压缩了分支，没有剩下的种子和分支，只有一个分支。
Free []每个压缩步骤还会返回一个函数，该函数在应用于具有相同结构的Pure树时将撤消该函数。所有这些功能都是部分定义的;他们对Free具有不同结构的树所做的事情是不确定的。为简单起见，我们还为getPure (Pure x) = x
getFree (Free xs) = xs
和unfoldForestM_BF的反转定义了部分函数。
unfoldTreeM_BF Free [] b和unfoldTreeM_BF :: MonadFix m => (b->m (a, [b])) -> b -> m (Tree a)
unfoldTreeM_BF f = (>>= return . getPure) . unfoldFreeM_BF f . Pure
unfoldForestM_BF :: MonadFix m => (b->m (a, [b])) -> [b] -> m [Tree a]
unfoldForestM_BF f = (>>= return . map getPure . getFree) . unfoldFreeM_BF f . Free . map Pure
都是通过将其参数打包到>>=中来定义的，并假设它们处于相同的结构中而对结果进行解包。
Monad这个算法的更优雅的版本可能是通过识别Free FreeT正在树上嫁接而compress和compressList提供monad实例来实现的。 0和counterExample :: Int -> (Int, [Int])
counterExample 0 = (0, [1, 2])
counterExample 1 = (1, repeat 3)
counterExample 2 = (2, [3])
counterExample 3 = (3, [])
都可能有更优雅的演示文稿。
上面提出的算法并不足以允许查询以无限多种方式分支然后终止的树。一个简单的反例是从0
|
+- 1
| |
| +- 3
| |
| `- 3
| |
| ...
|
`- 2
|
+- 3
展开的以下生成函数。
2这棵树看起来像
unfoldForestM_BF尝试下降第二个分支（到runIdentity . unfoldTreeM_BF (Identity . f)）并检查剩余的有限子树将无法终止。
以下示例演示unfoldTree的所有实现都以广度优先顺序运行操作，unfoldTree与具有有限分支因子的树具有相同的严格性mkUnary :: Int -> (Int, [Int])
mkUnary x = (x, [x+1])
mkBinary :: Int -> (Int, [Int])
mkBinary x = (x, [x+1,x+2])
mkInfinitary :: Int -> (Int, [Int])
mkInfinitary x = (x, [x+1..])
。对于具有无限分支因子的树木，只有＆＃34;大＆＃34;的解决方案。分支因子与unfoldTree具有相同的严格性。为了展示懒惰，我们将定义三个无限树 - 一个带有一个分支的一元树，一个带有两个分支的二叉树，以及一个每个节点都有无限数量分支的无限树。
unfoldTreeDF与unfoldTreeM一起，我们将根据unfoldTreeM定义unfoldTreeBF，以检查unfoldTreeMFix_BF是否真的像您声称的那样懒惰，import Data.Functor.Identity
unfoldTreeDF f = runIdentity . unfoldTreeM (Identity . f)
unfoldTreeBF f = runIdentity . unfoldTreeM_BF (Identity . f)
就{ subForest检查新实现是否同样懒惰。
takeWhileTree :: (a -> Bool) -> Tree a -> Tree a
takeWhileTree p (Node label branches) = Node label (takeWhileForest p branches)
takeWhileForest :: (a -> Bool) -> [Tree a] -> [Tree a]
takeWhileForest p = map (takeWhileTree p) . takeWhile (p . rootLabel)
要获得这些无限树的有限部分，即使是无限分支的树，只要其标签与谓词匹配，我们就会定义从树中获取的方法。在将函数应用于每个unary = takeWhileTree (<= 3) (unfoldTree mkUnary 0)
unaryDF = takeWhileTree (<= 3) (unfoldTreeDF mkUnary 0)
unaryBF = takeWhileTree (<= 3) (unfoldTreeBF mkUnary 0)
binary = takeWhileTree (<= 3) (unfoldTree mkBinary 0)
binaryDF = takeWhileTree (<= 3) (unfoldTreeDF mkBinary 0)
binaryBF = takeWhileTree (<= 3) (unfoldTreeBF mkBinary 0)
infinitary = takeWhileTree (<= 3) (unfoldTree mkInfinitary 0)
infinitaryDF = takeWhileTree (<= 3) (unfoldTreeDF mkInfinitary 0)
infinitaryBF = takeWhileTree (<= 3) (unfoldTreeBF mkInfinitary 0)
的能力方面，可以更简洁地写出这一点。
putStrLn . drawTree . fmap show这让我们可以定义九个示例树。
0
|
`- 1
|
`- 2
|
`- 3
0
|
+- 1
| |
| +- 2
| | |
| | `- 3
| |
| `- 3
|
`- 2
|
`- 3
所有五种方法对于一元树和二元树具有相同的输出。输出来自0
|
+- 1
| |
| +- 2
| | |
| | `- 3
| |
| `- 3
|
+- 2
| |
| `- 3
|
`- 3
unfoldTreeBF然而，对于具有无限分支因子的树，有限分支因子解决方案的广度优先遍历不够懒惰。其他四种方法输出整个树
0
|
+- 1
| |
| +- 2
| | |
| | `- 3
| |
| `- 3
使用mkDepths :: Int -> IO (Int, [Int])
mkDepths d = do
print d
return (d, [d+1, d+1])
mkFiltered :: (Monad m) => (b -> Bool) -> (b -> m (a, [b])) -> (b -> m (a, [b]))
mkFiltered p f x = do
(a, bs) <- f x
return (a, filter p bs)
binaryDepths = unfoldTreeM_BF (mkFiltered (<= 2) mkDepths) 0
为有限分支因子解决方案生成的树永远不能完全绘制在其第一个分支之外。
binaryDepths建筑绝对是第一位的。
0
1
1
2
2
2
2
运行Data.Tree输出内部级别之前的外部级别
unfoldTree前面部分的混合解决方案并不足以具有与unfoldTree＆＃39; s log(N)相同的严格语义。它是一系列算法中的第一个，每个算法都比它们的前一个稍微懒，但没有一个算法具有与O(n^2)相同的严格语义。
混合解决方案不能保证探索树的一部分并不需要探索同一棵树的其他部分。 下面的代码也不会。在一个特殊但常见的情况identified by dfeuer仅探索有限树的Free []大小的切片强制整个树。当探索具有恒定深度的树的每个分支的最后一个后代时，会发生这种情况。当压缩树时，我们抛出每个没有后代的普通分支，这是避免unfoldTree运行时间所必需的。如果我们能够快速显示分支至少有一个后代，我们就可以懒得跳过这部分压缩，因此我们可以拒绝模式O(n)。在具有恒定深度的树的最大深度处，没有任何分支具有任何剩余的后代，因此我们永远不能跳过压缩的步骤。这导致探索整个树以便能够访问最后一个节点。当由于无限分支因子而导致该深度的整个树是非有限的时，探索一部分树在由N生成时终止时将无法终止。
混合解决方案部分中的压缩步骤压缩掉第一代中没有后代的分支，它们可以被发现，这对于压缩是最佳的，但对于懒惰不是最佳的。我们可以通过在发生压缩时延迟来使算法变得更加懒惰。如果我们将它延迟一代（甚至任何常数代），我们将按时保持O(N)上限。如果我们将它延迟了几代以某种方式取决于[]，那么我们必然会牺牲Free []时限。在本节中，我们将延迟压缩一代。
为了控制压缩的发生方式，我们将最内层的(,)填充到bindFreeInvertible结构中，以便用0或1个后代压缩退化分支。
因为这个技巧的一部分在压缩中没有很多懒惰的情况下不起作用，所以我们会在各处采取一种偏执的懒惰程度的懒惰。如果可以确定关于除元组构造函数Pure [b,...]以外的结果的任何内容而不用模式匹配强制其部分输入，我们将避免强制它直到必要。对于元组，任何与它们匹配的模式都会懒散地进行。因此，下面的一些代码看起来像核心或更糟。
Free [Pure b,...]将bindFreeInvertible :: Free [] ([] b) -> (Free [] b, Free [] a -> Free [] ([] a))
bindFreeInvertible = wrapFree . go
where
-- wrapFree adds the {- Free -} that would have been added in both branches
wrapFree ~(xs, dxs) = (Free xs, dxs)
go (Pure xs) = ({- Free -} (map Pure xs), Pure . map getPure . getFree)
go (Free xs) = wrapList . rebuildList . map bindFreeInvertible $ xs
rebuildList = foldr k ([], const [])
k ~(x,dx) ~(xs, dxs) = (x:xs, \(~(x:xs)) -> dx x:dxs xs)
wrapList ~(xs, dxs) = ({- Free -} xs, \(~(Free xs)) -> Free (dxs xs)))
替换为compressFreeList
Free [] Free [xs]删除了xs的出现次数，并将compressFreeList :: Free [] b -> (Free [] b, Free [] a -> Free [] a)
compressFreeList (Pure x) = (Pure x, id)
compressFreeList (Free xs) = wrapList . compressList . map compressFreeList $ xs
where
compressList = foldr k ([], const [])
k ~(x,dx) ~(xs', dxs) = (x', dxs')
where
x' = case x of
Free [] -> xs'
otherwise -> x:xs'
dxs' cxs = dx x'':dxs xs''
where
x'' = case x of
Free [] -> Free []
otherwise -> head cxs
xs'' = case x of
Free [] -> cxs
otherwise -> tail cxs
wrapList ~(xs, dxs) = (xs', dxs')
where
xs' = case xs of
[x] -> x
otherwise -> Free xs
dxs' cxs = Free (dxs xs'')
where
xs'' = case xs of
[x] -> [cxs]
otherwise -> getFree cxs
替换为Pure []。
Free在缩小Free被压缩之前，整体压缩不会将Free绑定到compress :: Free [] [b] -> (Free [] b, Free [] a -> Free [] [a])
compress xs = let ~(xs' , dxs' ) = compressFreeList xs
~(xs'', dxs'') = bindFreeInvertible xs'
in (xs'', dxs' . dxs'')
s，从而延迟对引入的简并getFree的压缩一代到下一代的压缩。
getPure在持续的偏执狂中，帮助者getFree ~(Free xs) = xs
getPure ~(Pure x) = x
和print . until (null . subForest) (last . subForest) $
flip unfoldTreeBF 0 (\x -> (x, if x > 5 then [] else replicate 10 (x+1)))
也变得无可辩驳。
1这很快就解决了dfeuer发现的有问题的例子
1但是由于我们只将print . until (null . subForest) (last . subForest) $
flip unfoldTreeBF (0,0) (\(x,y) -> ((x,y),
if x==y
then if x>5 then [] else replicate 9 (x+1, y) ++ [(x+1, y+1)]
else if x>4 then [] else replicate 10 (x+1, y)))
代推迟了压缩，如果最后一个分支的最后一个节点比所有其他分支更深{{1}}级，我们可以重新创建完全相同的问题。
{{1}}