我正在尝试使用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尝试在monadic链接发生之前连续评估元素（特别是因为列表的forM是flip traverse）。有没有办法拯救这种实施？
答案 0 :(得分：2)
首先，风格方面，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在force中不执行任何操作是错误的。 Thunks不会“记住”它们是在惰性模式匹配中创建的。 case mf of ...本身什么都不做，但是当它产生的thunk被评估时，它会导致它被赋予的thunk被评估为NF，没有例外。在您的情况下，mf会将mf评估为普通表单（而不仅仅是WHNF），因为force中包含Tardis。不过，我不认为这会造成任何问题。
真正的问题是，你根据未来的价值“决定做什么”。这意味着您匹配未来的值，然后您正在使用该未来值来生成(>>=)计算，该计算将runTardis (do { x <- getFuture; x `seq` return () }) ((),()) = _|_'d输入到生成该值的那个计算中。这是禁忌。如果它更清楚：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，你可以Tardis，但是你可能没有明确定义消息（不要指望时间有意义一个{{1}}！），虽然在这种情况下它似乎只是向后打印列表的尾部。