バブルソートの無限ループハスケルのトラバーサル

Question

Tardisモナドを使用して、トラバース可能なコンテナにバブルソートを実装しようとしています。

{-# 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では、一番右の要素がすでにソートされていることを前提とし、それの左側の要素が上がらない場合は、フラグを変更します」 t; bubbleTraversableでは逆の方向に行っています。

mfをbubbleTraversableに評価しようとすると、ghc出力<<loop>>で示されるように、プログラムは遅延参照に無限ループに入ります。

forMは、モナドチェーンが行われる前に（特にforMがリストの場合はflip traverseであるため）、要素を連続して評価しようとしている可能性があります。この実装を救済する方法はありますか？

Answer 1

まず、スタイルワイズ、Finished = Data.Monoid.Any（それは同様bubble . sndかもしれときにのみ(bubble =<<)ためMonoidビットを使用するので、私はちょうど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。

第2に、forceが何もしないと仮定すると、Tardisは間違っています。 Thunksはレイジーパターンのマッチで作成されたことを「記憶」していません。 force自体は何もしませんが、それが生成するサンクが評価されると、与えられたサンクがNFに評価されるようになりますが、例外はありません。あなたの場合、case mf of ...は、mfにforceがあるので、（WHNFの代わりに）mfを通常の形式と評価します。私はそれがここに問題を引き起こしているとは思わない。

実際の問題は、将来の価値に応じて「何をすべきかを決定する」ことです。これは、将来の値を照合していることを意味し、その値を使用して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が約unsafePerformIO . (return() <$) . printで）深く、それを評価しtraceShowMがIOで何かを印刷するよう、すべて自分自身で問題を引き起こしていることを意味します。 mfが実行さunsafePerformIOとして評価される必要があるが、mfはtraceShowM後に来るTardis操作の評価に依存するが、traceShowMは、次Tardis操作（return()）が明らかにされることを可能にする前printを行うことを強制します。 <<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 
    -- If the type signature was supposed to be like a comment on how the tuple is 
    -- rearranged, this one seems clearer. 
    extract :: (a, (b, (c, d))) -> (d, a) 
    -- Left-sectioning (f <$>) = fmap f is pointlessly unreadable 
    -- I replaced fmap with second because I think it's clearer, but that's up for debate 
    extract = swap . (second $ snd . snd) 
    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！）、この場合、リストの末尾を逆順に表示するように見えます。