11

我正在尝试使用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我们反其道而行之。

尝试mf在bubbleTraversable程序中进行评估时，会在惰性引用中进入无限循环，如 ghc 输出所示<<loop>>。

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

4

1 回答 1

2

首先，风格方面，Finished = Data.Monoid.Any（但您只在可能的情况下使用该Monoid位，所以我只是将其用于）、、和。(bubble =<<)bubble . sndBoolhead . dropWhile (not . isFinished . fst) = fromJust . find (isFinished . fst)case x of { Nothing -> default; Just t = f t } = maybe default f xmaybe default id = fromMaybe default

force其次，你什么都不做的假设Tardis是错误的。Thunk 不会“记住”它们是在惰性模式匹配中创建的。force它本身什么也不做，但是当它产生的 thunk 被评估时，它会导致它被赋予 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取决于评估Tardis之后的操作traceShowM，但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，但你可能没有得到任何明确定义的消息顺序（不要指望时间在 a 中有意义Tardis！），虽然在这种情况下它似乎只是打印列表的尾部向后。

于 2017-11-23T02:25:30.413 回答