2017-11-21 154 views
11

Tardis monad kullanılarak herhangi bir taşınabilir konteynerin üzerinde bir kabarcık sıralaması uygulamaya çalışıyorum.Kabarcık sıralamasındaki sonsuz döngü Haskell'de geçiş yapılabilir

{-# 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 ve bubbleTraversable arasındaki temel fark Finished bayrak işlenmesidir: bubble yılında farz ederiz en sağdaki eleman zaten sıralanır ve ona solundaki unsurları' hizmet etmeyen, bayrağını değiştirmek t; bubbleTraversable numaralı telefondan bunu başka bir şekilde yapıyoruz.

ghc çıkış <<loop>> ile kanıtlandığı gibi program yavaş referanslarda sonsuz bir döngüye girer mf bubbleTraversable değerlendirmek için çalışırken.

sorun forM monadic zincirleme yeri (özellikle forM listeler için flip traverse olan) gerçekleşmeden önce, arka arkaya unsurları değerlendirmek çalıştığı, muhtemelen. Bu uygulamayı kurtarmak için herhangi bir yolu var mı? Her şeyden

+0

Bu, şu anda içine bakmak için zamanım olmadığı mükemmel bir sorudur. Bu tartışmayı Traversables'i sıralamak istiyorum: https://www.reddit.com/r/haskell/comments/63a4ea/fast_total_sorting_of_arbitrary_traversable/ Zaten farkında değildiysen, belki ondan bazı fikirler alabilirsin. . – Carl

cevap

2

Birincisi, stil-bilge, Finished = Data.Monoid.Any (ama aynı zamanda bubble . snd olabilir zaman sadece (bubble =<<) için Monoid bit kullanmak, bu yüzden sadece Bool için düşürdü), head . dropWhile (not . isFinished . fst) = fromJust . find (isFinished . fst), case x of { Nothing -> default; Just t = f t } = maybe default f x ve maybe default id = fromMaybe default.

İkincisi, force'un Tardis içinde hiçbir şey yapmadığı varsayımınız yanlıştır. Thunks tembel-desen maçında yaratıldıklarını hatırlamıyorlar. force'un kendisi hiçbir şey yapmaz, ancak ürettiği thunk değeri değerlendirildiğinde, NF'ye değerlendirilmesinin, istisna olmaksızın verilmiş olmasına neden olur. Sizin durumunuzda, case mf of ...mfmf'un force içerdiğinden normal forma (sadece WHNF yerine) mf değerini değerlendirir. Yine de burada sorunlara neden olduğuna inanmıyorum.

Asıl sorun, gelecekteki bir değere bağlı olarak "ne yapacağınıza" karar vermenizdir. Bu, gelecekteki bir değerle eşleştiğiniz anlamına gelir ve daha sonra, (>>=) 'd değerini üreten bir Tardis hesaplaması üretmek için bu değeri kullanırsınız. Bu bir hayır değil. Daha açıksa: runTardis (do { x <- getFuture; x `seq` return() }) ((),()) = _|_ ancak runTardis (do { x <- getFuture; return $ x `seq`() }) ((),()) = ((),((),())). Saf bir değer oluşturmak için gelecekteki bir değeri kullanmanıza izin verilir, ancak bunu kullanacağınız Tardis'a karar vermek için kullanamazsınız. Kodunuzda, case mf of { Nothing -> do ...; Just x -> do ... }'u denediğinizde budur.

Bu aynı zamanda (traceShowM yaklaşık unsafePerformIO . (return() <$) . print olan) derinden bunu değerlendirir traceShowMIO şey baskı olarak, kendi başına bir soruna neden olduğu anlamına gelir. mf çalıştırdığı unsafePerformIO olarak değerlendirilmesi gerekiyor fakat mftraceShowM sonra gelen Tardis operasyonlarını değerlendiren bağlıdır, ancak traceShowM sonraki Tardis operasyonu (return()) ortaya olanak önce print yapılması gereken zorlar. <<loop>>! Hala tracemf isterseniz mf <- traceShowId <$> getFuture can,

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

, ancak mantıklı bir zaman beklemeyin iletilere herhangi iyi tanımlanmış düzeni (alamayabilirsiniz: Burada

sabit versiyonu Tardis içinde!), ancak bu durumda listelerin kuyruklarını geriye doğru yazdırıyor gibi görünüyor.