2017-11-21 12 views
11

में ट्रैवर्सबल पर बबल प्रकार में अनंत लूप 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 में हम मानते हैं कि सबसे-दाएं तत्व पहले से ही क्रमित और झंडा बदलने के लिए, अगर यह के बाईं ओर तत्वों 'नहीं कर रहे है टी; bubbleTraversable में हम इसे दूसरी तरफ करते हैं।

रूप GHC उत्पादन <<loop>> इसका सबूत bubbleTraversable में mf कार्यक्रम आलसी संदर्भ में एक अनंत पाश में प्रवेश का मूल्यांकन करने की कोशिश कर रहा है।

समस्या शायद, कि forM से पहले monadic श्रृंखलन जगह (विशेष रूप से forM सूचियों के लिए flip traverse है) लेता है, क्रमिक तत्वों का मूल्यांकन करने की कोशिश करता है। क्या इस कार्यान्वयन को बचाने का कोई तरीका है?

+0

यह एक उत्कृष्ट सवाल है, जिसमें मेरे पास इस समय देखने के लिए समय नहीं है। मैं ट्रैवर्सबेल को सॉर्ट करने पर इस चर्चा को इंगित करना चाहता हूं: https://www.reddit.com/r/haskell/comments/63a4ea/fast_total_sorting_of_arbitrary_traversable/ अगर आप इससे पहले से अवगत नहीं थे, तो शायद आप इससे कुछ विचार ले सकते हैं । – Carl

उत्तर

2

सबसे पहले, शैली के लिहाज से, Finished = Data.Monoid.Any (लेकिन आप केवल (bubble =<<) के लिए Monoid बिट का उपयोग जब यह रूप में अच्छी तरह 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

दूसरा, आपकी धारणा है कि forceTardis में कुछ भी गलत नहीं है। Thunks "याद" नहीं है वे एक आलसी पैटर्न मैच में बनाया गया था। force स्वयं कुछ भी नहीं करता है, लेकिन जब इसका उत्पादन होता है तो इसका मूल्यांकन किया जाता है, यह एनएफ को मूल्यांकन करने के लिए दिया गया था, यह कोई अपवाद नहीं है। आपके मामले में, case mf of ...mf का मूल्यांकन सामान्य रूप (केवल WHNF के बजाय) के लिए करता है क्योंकि mf में force है। मुझे विश्वास नहीं है कि यह यहां किसी भी समस्या का कारण बन रहा है।

असली समस्या यह है कि आप भविष्य के मूल्य के आधार पर "क्या करना है" तय कर रहे हैं। इसका मतलब है कि आप भविष्य के मूल्य पर मेल खाते हैं, और फिर आप 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 के रूप में मूल्यांकन किया जाना चाहिए, लेकिन mfTardis कार्य है कि 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 
    -- 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 के अंदर!), हालांकि इस मामले में यह सिर्फ सूचियों की पूंछ को पीछे की ओर प्रिंट करता है।