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

Posted 2023-02-14

【中文标题】Haskell中Traversable冒泡排序中的无限循环

【英文标题】：Infinite loop in bubble sort over Traversable in Haskell

【发布时间】：2018-05-05 03:31:17

【问题描述】：

我正在尝试使用 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 用于列表）。有没有办法挽救这个实现？

【问题讨论】：

这是一个很好的问题，我目前没有时间研究。我想指出这个关于排序 Traversables 的讨论：reddit.com/r/haskell/comments/63a4ea/… 如果您还没有意识到它，也许您可​​以从中获得一些想法。

【参考方案1】：

首先，风格方面，Finished = Data.Monoid.Any（但你只在(bubble =<<) 使用Monoid 位，而它可能是bubble . snd，所以我只为Bool 放弃了它），@ 987654326@、case x of Nothing -> default; Just t = f t = maybe default f x 和 maybe default id = fromMaybe default。

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

真正的问题是您“决定做什么”取决于未来的价值。这意味着您正在匹配未来值，然后您正在使用该未来值来生成 Tardis 计算，该计算将 (>>=)'d 转换为产生该值的计算。这是一个禁忌。如果更清楚：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

如果你还想tracemf，你可以mf <- traceShowId <$> getFuture，但是你可能没有得到任何明确定义的消息顺序（不要指望时间在Tardis中有意义！） ，但在这种情况下，它似乎只是向后打印列表的尾部。