Haskell 中 Traversable 冒泡排序中的无限循环

Question

我正在尝试使用 Tardis monad 对任何可遍历容器实施冒泡排序。

{-# LANGUAGE TupleSections #-}

module Main where

import Control.DeepSeq
import Control.Monad.Tardis
import Data.Bifunctor
import Data.Traversable
import Data.Tuple
import Debug.Trace

newtype Finished = Finished { isFinished :: Bool }

instance Monoid Finished where
  mempty = Finished False
  mappend (Finished a) (Finished b) = Finished (a || b)

-- | A single iteration of bubble sort over a list.
-- If the list is unmodified, return 'Finished' 'True', else 'False'
bubble :: Ord a => [a] -> (Finished, [a])
bubble (x:y:xs)
  | x <= y = bimap id                       (x:) (bubble (y:xs))
  | x  > y = bimap (const $ Finished False) (y:) (bubble (x:xs))
bubble as = (Finished True, as)

-- | A single iteration of bubble sort over a 'Traversable'.
-- If the list is unmodified, return 'Finished' 'True', else 'Finished' 'False'
bubbleTraversable :: (Traversable t, Ord a, NFData a, Show a) => t a -> (Finished, t a)
bubbleTraversable t = extract $ flip runTardis (initFuture, initPast) $ forM t $ \here -> do
  sendPast (Just here)
  (mp, finished) <- getPast
  -- For the first element use the first element,
  -- else the biggest of the preceding.
  let this = case mp of { Nothing -> here; Just a -> a }
  mf <- force <$> getFuture -- Tardis uses lazy pattern matching,
                            -- so force has no effect here, I guess.
  traceM "1"
  traceShowM mf -- Here the program enters an infinite loop.
  traceM "2"
  case mf of
    Nothing -> do
      -- If this is the last element, there is nothing to do.
      return this
    Just next -> do
      if this <= next
        -- Store the smaller element here
        -- and give the bigger into the future.
        then do
          sendFuture (Just next, finished)
          return this
        else do
          sendFuture (Just this, Finished False)
          return next
  where
    extract :: (Traversable t) => (t a, (Maybe a, (Maybe a, Finished))) -> (Finished, t a)
    extract = swap . (snd . snd <$>)

    initPast = (Nothing, Finished True)
    initFuture = Nothing

-- | Sort a list using bubble sort.
sort :: Ord a => [a] -> [a]
sort = snd . head . dropWhile (not . isFinished . fst) . iterate (bubble =<<) . (Finished False,)

-- | Sort a 'Traversable' using bubble sort.
sortTraversable :: (Traversable t, Ord a, NFData a, Show a) => t a -> t a
sortTraversable = snd . head . dropWhile (not . isFinished . fst) . iterate (bubbleTraversable =<<) . (Finished False,)

main :: IO ()
main = do
  print $ sort ([1,4,2,5,2,5,7,3,2] :: [Int]) -- works like a charm
  print $ sortTraversable ([1,4,2,5,2,5,7,3,2] :: [Int]) -- breaks

bubble 和 bubbleTraversable 之间的主要区别在于 Finished 标志的处理：在 bubble 中，我们假设最右边的元素已经排序并且如果标志左侧的元素不是，则更改标志；在 bubbleTraversable 中，我们以相反的方式进行。

在尝试计算 bubbleTraversable 中的 mf 时，程序在惰性引用中进入了一个无限循环，正如 ghc 输出 <<loop>> 所证明的那样。

问题可能是，forM 试图在单子链接发生之前连续评估元素（特别是因为 forM 是 flip traverse 列表）。有什么办法可以挽救这个实现吗？

Answer 1

首先，在风格方面，Finished = Data.Monoid.Any（但你只使用 Monoid 位作为 (bubble =<<)，而它也可能是 bubble . snd，所以我只是为 Bool)、head . dropWhile (not . isFinished . fst) = fromJust . find (isFinished . fst)、case x of { Nothing -> default; Just t = f t } = maybe default f x 和 maybe default id = fromMaybe default.

放弃了它

其次，您认为 force 在 Tardis 中什么都不做的假设是错误的。 Thunk 不会 "remember" 它们是在惰性模式匹配中创建的。 force 本身什么都不做，但是当它产生的 thunk 被评估时，它会导致它被评估为 NF 的 thunk，没有例外。在您的情况下，case mf of ... 将 mf 评估为正常形式（而不仅仅是 WHNF），因为 mf 中包含 force。不过，我不认为它会导致任何问题。

真正的问题是你 "deciding what to do" 取决于未来的价值。这意味着您正在匹配一个未来值，然后您正在使用该未来值来生成一个 Tardis 计算，该计算将 (>>=) 放入生成该值的计算中。这是一个禁忌。如果更清楚：runTardis (do { x <- getFuture; x `seq` return () }) ((),()) = _|_ 但 runTardis (do { x <- getFuture; return $ x `seq` () }) ((),()) = ((),((),()))。你可以用一个未来的价值来创造一个纯粹的价值，但你不能用它来决定你会Tardis运行。在您的代码中，这是您尝试 case mf of { Nothing -> do ...; Just x -> do ... }.

这也意味着 traceShowM 本身就是一个问题，因为在 IO 中打印某些内容会对其进行深入评估（traceShowM 大约是 unsafePerformIO . (return () <$) . print）。 mf 需要在 unsafePerformIO 执行时进行评估，但是 mf 取决于评估 traceShowM 之后的 Tardis 操作，但是 traceShowM 强制 print 在它允许显示下一个 Tardis 操作（return ()）之前完成。 <<loop>>!

这是固定版本：

{-# LANGUAGE TupleSections #-}

module Main where

import Control.Monad
import Control.Monad.Tardis
import Data.Bifunctor
import Data.Tuple
import Data.List hiding (sort)
import Data.Maybe

-- | A single iteration of bubble sort over a list.
-- If the list is unmodified, return 'True', else 'False'
bubble :: Ord a => [a] -> (Bool, [a])
bubble (x:y:xs)
  | x <= y = bimap id            (x:) (bubble (y:xs))
  | x  > y = bimap (const False) (y:) (bubble (x:xs))
bubble as = (True, as)

-- | A single iteration of bubble sort over a 'Traversable'.
-- If the list is unmodified, return 'True', else 'False'
bubbleTraversable :: (Traversable t, Ord a) => t a -> (Bool, t a)
bubbleTraversable t = extract $ flip runTardis init $ forM t $ \here -> do
  -- Give the current element to the past so it will have sent us biggest element
  -- so far seen. 
  sendPast (Just here)
  (mp, finished) <- getPast
  let this = fromMaybe here mp


  -- Given this element in the present and that element from the future,
  -- swap them if needed.
  -- force is fine here
  mf <- getFuture
  let (this', that', finished') = fromMaybe (this, mf, finished) $ do
                                    that <- mf
                                    guard $ that < this
                                    return (that, Just this, False)

  -- Send the bigger element back to the future
  -- Can't use mf to decide whether or not you sendFuture, but you can use it
  -- to decide WHAT you sendFuture.
  sendFuture (that', finished')

  -- Replace the element at this location with the one that belongs here
  return this'
  where
    -- No need to be clever
    extract (a, (_, (_, b))) = (b, a)
    init = (Nothing, (Nothing, True))

-- | Sort a list using bubble sort.
sort :: Ord a => [a] -> [a]
sort = snd . fromJust . find fst . iterate (bubble . snd) . (False,)

-- | Sort a 'Traversable' using bubble sort.
sortTraversable :: (Traversable t, Ord a) => t a -> t a
sortTraversable = snd . fromJust . find fst . iterate (bubbleTraversable . snd) . (False,)

main :: IO ()
main = do
  print $ sort ([1,4,2,5,2,5,7,3,2] :: [Int]) -- works like a charm
  print $ sortTraversable ([1,4,2,5,2,5,7,3,2] :: [Int]) -- works like a polymorphic charm

-- Demonstration that force does work in Tardis
checkForce = fst $ sortTraversable [(1, ""), (2, undefined)] !! 1
-- checkForce = 2 if there is no force
-- checkForce = _|_ if there is a force

如果您仍想 trace mf，您可以 mf <- traceShowId <$> getFuture，但您可能无法获得任何明确定义的消息顺序（不要期望时间sense inside a Tardis!)，尽管在这种情况下它似乎只是向后打印列表的尾部。

Haskell 中 Traversable 冒泡排序中的无限循环

Infinite loop in bubble sort over Traversable in Haskell

haskell

monads

lazy-evaluation

bubble-sort

traversable