repmin问题是众所周知的。我们得到了一种树的数据类型：
data Tree a = Leaf a | Fork (Tree a) a (Tree a) deriving Show
我们需要写一个函数(repmin(，它将取一棵数字树，并在一次传递中用其最小值替换其中的所有数字。同时也可以打印出树(假设函数repminPrint可以这样做(。使用值递归可以很容易地写下repmin和前、后、按顺序的repminPrint。以下是顺序为repminPrint:的示例
import Control.Arrow
replaceWithM :: (Tree Int, Int) -> IO (Tree Int, Int)
replaceWithM (Leaf a, m) = print a >> return (Leaf m, a)
replaceWithM (Fork l mb r, m) = do
(l', ml) <- replaceWithM (l, m)
print mb
(r', mr) <- replaceWithM (r, m)
return (Fork l' m r', ml `min` mr `min` mb)
repminPrint = loop (Kleisli replaceWithM)
但是，如果我们想写下级别顺序repminPrint呢？
我的猜测是，我们不能使用队列，因为我们需要ml和mr来更新m的绑定。我看不出这怎么会排成一排。我写了一个级别订单Foldable Tree的例子来展示我的意思：
instance Foldable Tree where
foldr f ini t = helper f ini [t] where
helper f ini [] = ini
helper f ini ((Leaf v) : q = v `f` helper f ini q
helper f ini ((Fork l v r) : q) = v `f` (helper f ini (q ++ [l, r]))
正如您所看到的，在当前递归调用期间，我们不会在l和r上运行任何内容。
那么，这怎么可能呢？我希望得到提示，而不是完整的解决方案。
我认为实现您想要做的事情的最佳方法是遍历(在Traversable类的意义上(。首先，我要概括一下玫瑰树：
data Tree a
= a :& [Tree a]
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
我展示的所有函数都应该非常简单，可以更改为您给出的树定义，但这种类型更通用，我认为显示一些模式会更好。
那么，我们的第一个任务就是在这个树上编写repmin函数。我们还想使用派生的Traversable实例来编写它。幸运的是，repmin完成的模式可以使用读取器和写入器应用程序的组合来表达：
unloop :: WriterT a ((->) a) b -> b
unloop m =
let (x,w) = runWriterT m w
in x
repmin :: Ord a => Tree a -> Tree a
repmin = unloop . traverse (WriterT . f)
where
f x ~(Just (Min y)) = (y, Just (Min x))
虽然我们在这里使用WriterT的monad转换器版本，但我们当然不需要，因为应用程序总是组合的。
下一步是将其转换为repminPrint函数：为此，我们将需要RecursiveDo扩展，它允许我们在IO monad内的unloop函数中打结。
unloopPrint :: WriterT a (ReaderT a IO) b -> IO b
unloopPrint m = mdo
(x,w) <- runReaderT (runWriterT m) w
pure x
repminPrint :: (Ord a, Show a) => Tree a -> IO (Tree a)
repminPrint = unloopPrint . traverse (WriterT . ReaderT . f)
where
f x ~(Just (Min y)) = (y, Just (Min x)) <$ print x
对：所以在这个阶段，我们已经设法编写了repminPrint的一个版本，它使用任何泛型遍历来执行repmin函数。当然，它仍然是有序的，而不是广度优先：
>>> repminPrint (1 :& [2 :& [4 :& []], 3 :& [5 :& []]])
1
2
4
3
5
现在缺少的是遍历，它按照广度优先而不是深度优先的顺序遍历树。我将使用我在这里写的函数：
bft :: Applicative f => (a -> f b) -> Tree a -> f (Tree b)
bft f (x :& xs) = liftA2 (:&) (f x) (bftF f xs)
bftF :: Applicative f => (a -> f b) -> [Tree a] -> f [Tree b]
bftF t = fmap head . foldr (<*>) (pure []) . foldr f [pure ([]:)]
where
f (x :& xs) (q : qs) = liftA2 c (t x) q : foldr f (p qs) xs
p [] = [pure ([]:)]
p (x:xs) = fmap (([]:).) x : xs
c x k (xs : ks) = ((x :& xs) : y) : ys
where (y : ys) = k ks
总而言之，这使得以下操作成为使用应用遍历的单程、广度优先的repminPrint：
unloopPrint :: WriterT a (ReaderT a IO) b -> IO b
unloopPrint m = mdo
(x,w) <- runReaderT (runWriterT m) w
pure x
repminPrint :: (Ord a, Show a) => Tree a -> IO (Tree a)
repminPrint = unloopPrint . bft (WriterT . ReaderT . f)
where
f x ~(Just (Min y)) = (y, Just (Min x)) <$ print x
>>> repminPrint (1 :& [2 :& [4 :& []], 3 :& [5 :& []]])
1
2
3
4
5