级序repminPrint

Question

repmin 问题是众所周知的。我们得到了树的数据类型：

data Tree a = Leaf a | Fork (Tree a) a (Tree a) deriving Show

我们需要写下一个函数 (repmin)，它将获取一棵数字树并将其中的所有数字替换为它们的最小值 单次传递。也可以沿途打印出树（假设函数 repminPrint 执行此操作）。 repmin 和前序，post- 和中序 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 的绑定。我看不出这怎么会因为队列而下降。我写下了一个级别顺序 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 class 的意义上）。首先，我要对玫瑰树进行一些概括：

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 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

级序repminPrint

Level-order repminPrint

monads

tree

haskell

breadth-first-search

tying-the-knot