时间戳

首页 > 解决方案 > 水平顺序 repminPrint

haskell - 水平顺序 repminPrint

问题描述

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

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

我们需要编写一个函数 down( ) ，它将获取一棵数字树，并在一次传递repmin中将其中的所有数字替换为它们的最小值。也可以沿途打印树（假设函数执行此操作）。使用值递归可以很容易地写下前序、后序和有序。以下是 in-order 的示例：repminPrintrepminrepminPrintrepminPrint

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-orderrepminPrint怎么办？

我的猜测是我们不能使用队列，因为我们需要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

那么，这怎么可能呢？我希望得到提示而不是完整的解决方案。

标签： haskelltreemonadsbreadth-first-searchtying-the-knot

解决方案

我认为完成您在这里要做的事情的最佳方法是遍历（在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 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

现在缺少的是一个以广度优先而不是深度优先的顺序遍历树的遍历。我将使用我在这里写的函数：

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

推荐阅读