Vòng lặp vô hạn trong sắp xếp bong bóng qua Traversable trong Haskell

Question

Tôi đang cố triển khai sắp xếp bong bóng trên bất kỳ vùng chứa nào có thể di chuyển bằng cách sử dụng đơn lẻ 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 

Sự khác biệt chính giữa bubble và bubbleTraversable là việc xử lý của Finished cờ: Trong bubble chúng tôi giả định rằng phải nhất yếu tố đã được sắp xếp và thay đổi cờ, nếu các yếu tố bên trái của nó aren' t; trong bubbleTraversable chúng tôi thực hiện theo cách khác.

Trong khi cố gắng đánh giá mf trong bubbleTraversable chương trình nhập một vòng lặp vô hạn trong tham chiếu lười biếng được chứng minh bằng đầu ra ghc <<loop>>.

Vấn đề có thể là, forM cố gắng đánh giá các phần tử liên tiếp, trước khi chuỗi đơn sắc diễn ra (đặc biệt là từ forM là flip traverse cho danh sách). Có cách nào để giải cứu việc triển khai này không?

Answer 1

Trước hết, phong cách khôn ngoan, Finished = Data.Monoid.Any (nhưng bạn chỉ sử dụng các bit Monoid cho (bubble =<<) khi nó cũng có thể bubble . snd, vì vậy tôi chỉ cần bỏ nó cho Bool), head . dropWhile (not . isFinished . fst) = fromJust . find (isFinished . fst), case x of { Nothing -> default; Just t = f t } = maybe default f x, và maybe default id = fromMaybe default.

Thứ hai, giả định rằng force không có gì trong số Tardis là sai. Thunks không "nhớ" chúng được tạo ra trong một trận đấu kiểu lười biếng. force chính nó không có gì, nhưng khi nó tạo ra được đánh giá, nó gây ra thunk nó đã được đưa ra để được đánh giá để NF, không có ngoại lệ. Trong trường hợp của bạn, rằng case mf of ... sẽ đánh giá mf thành biểu mẫu bình thường (thay vì chỉ WHNF) vì mf có force trong đó. Tôi không tin rằng nó gây ra bất kỳ vấn đề ở đây, mặc dù.

Vấn đề thực sự là bạn đang "quyết định phải làm gì" tùy thuộc vào giá trị trong tương lai. Điều này có nghĩa là bạn đang khớp với giá trị tương lai, và sau đó bạn đang sử dụng giá trị tương lai đó để tạo ra một tính toán Tardis được (>>=) 'd vào giá trị tạo ra giá trị đó. Đây là một không-không. Nếu nó rõ ràng hơn: runTardis (do { x <- getFuture; x `seq` return() }) ((),()) = _|_ nhưng runTardis (do { x <- getFuture; return $ x `seq`() }) ((),()) = ((),((),())). Bạn được phép sử dụng một giá trị tương lai để tạo ra một giá trị thuần túy, nhưng bạn không thể sử dụng nó để quyết định Tardis bạn sẽ chạy. Trong mã của bạn, đây là khi bạn thử case mf of { Nothing -> do ...; Just x -> do ... }.

này cũng có nghĩa là traceShowM đang gây ra một vấn đề tất cả bởi chính nó, như in cái gì đó trong IO đánh giá nó sâu sắc (traceShowM khoảng unsafePerformIO . (return() <$) . print). mf cần phải được đánh giá là unsafePerformIO được thực hiện, nhưng mf phụ thuộc vào đánh giá Tardis hoạt động mà đến sau khi traceShowM, nhưng traceShowM buộc print để được thực hiện trước khi nó cho phép người Tardis hoạt động tiếp theo (return()) được tiết lộ. <<loop>>!

Dưới đây là phiên bản cố định:

{-# 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 

Nếu bạn vẫn muốn tracemf, bạn có thể mf <- traceShowId <$> getFuture, nhưng bạn có thể không nhận được bất kỳ thứ tự rõ ràng để các thông điệp (tôi không mong đợi thời gian để làm cho tinh thần bên trong một số Tardis!), mặc dù trong trường hợp này có vẻ như chỉ in đuôi của các danh sách ngược.