水平顺序 repminPrint

Question

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 的绑定。我看不出这怎么会因队列而下降。我写了一个 level-order 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 上运行任何内容。

那么，如何做到这一点呢？我希望得到提示而不是完整的解决方案。

Answer 1

我认为完成您在这里要做的事情的最佳方法是遍历（在 Traversable 类的意义上）。首先，我将概括一下玫瑰树：

data Tree a
  = a :& [Tree a]
  deriving (Show, Eq, Ord, Functor, Foldable, Traversable)

我展示的所有函数都应该很简单地转换为您给出的树定义，但是这种类型更通用一些，并且我认为可以更好地显示一些模式。

那么，我们的第一个任务是在这棵树上编写repmin 函数。 我们还想使用派生的Traversable 实例来编写它。 幸运的是，repmin 完成的模式可以使用 reader 和 writer 应用程序的组合来表达：

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 转换器版本，但我们当然不需要，因为 Applicatives 总是组合。

下一步是将其转换为 repminPrint 函数：为此，我们将需要 RecursiveDo 扩展，它允许我们在 unloop 函数中打结，即使我们在 IO 中单子。

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

现在缺少的是按广度优先而不是深度优先的顺序遍历树的遍历。我要使用我写的函数here：

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