haskell - 级序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)

但是如果我们想把 level-order repminPrint 写下来呢？

我的猜测是我们不能使用队列，因为我们需要 ml 和 mr 来更新 m 的绑定(bind)。我看不出这怎么会因为队列而下降。我写下了 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 完成的模式可以使用读取器和写入器应用程序的组合来表示:

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 monad 中也是如此。

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