我正在尝试使用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
)。有什么办法可以挽救这种实现? 最佳答案
首先,在样式上是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
本身不执行任何操作,但是当评估它产生的thunk时,它将导致它被赋予的thunk被评估为NF,没有异常(exception)。在您的情况下,该case mf of ...
将mf
评估为普通格式(而不只是WHNF),因为mf
中包含force
。不过,我不认为这会引起任何问题。
真正的问题是您正在根据 future 的值(value)“决定做什么”。这意味着您要匹配一个将来值,然后使用该将来值来生成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
取决于评估在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
内花时间!),尽管在这种情况下,它似乎只是打印了列表的尾部倒退。