2017-11-21 3 views
11

Tardis 모나드를 사용하여 모든 통과 컨테이너에 버블 정렬을 구현하려고합니다.거품의 무한 루프가 하스켈의 Traversable을 넘어갑니다

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

bubblebubbleTraversable 사이의 주요 차이점은 Finished 플래그의 처리입니다 : bubble에서 우리는 가정이 가장 오른쪽의 요소는 이미 정렬되어 바로 왼쪽의 요소가 '때로 믿을 경우, 플래그를 변경 티; bubbleTraversable에서 우리는 다른 방법으로 그것을합니다.

mfbubbleTraversable으로 평가하려고하면 프로그램은 ghc 출력 <<loop>>에 의해 입증 된 것처럼 지연 참조에 무한 루프를 입력합니다.

문제는 forM는 모나드 체인이 발생 (특히 이후 forM이 목록의 flip traverse입니다)되기 전에, 연속적 요소를 평가하기 위해 시도 할 때, 아마. 이 구현을 구할 수있는 방법이 있습니까? 모든

+0

이것은 훌륭한 질문입니다. 지금은 살펴볼 시간이 없습니다. Traversable 정렬에 관한이 토론을 지적하고자합니다 : https://www.reddit.com/r/haskell/comments/63a4ea/fast_total_sorting_of_arbitrary_traversable/ 이미 알고 있지 않다면, 그것으로부터 몇 가지 아이디어를 취할 수 있습니다. . – Carl

답변

2

첫째, 스타일 현명한, 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 xmaybe default id = fromMaybe default.

둘째로, force이 아무 것도 수행하지 않는다는 가정은 Tardis입니다. Thunks는 게으른 패턴 일치로 생성 된 것을 기억하지 않습니다. force 자체는 아무 것도하지 않지만, 그것이 생성하는 썽크가 평가되면, 그것은 예외가 아닌 NF로 평가되도록 주어진 썽크를 유발합니다. 귀하의 경우, case mf of ...mfforce이 있기 때문에 보통 형태 (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 ... }을 시도하면됩니다.

이것은 IO에 인쇄 할 때 (traceShowM은 약 unsafePerformIO . (return() <$) . print)이므로 traceShowM이 모두 문제를 일으키는 것을 의미합니다. mf는 실행중인 unsafePerformIO로 평가 될 필요가 있지만, mftraceShowM 후 오는 Tardis 운영 평가에 따라 다르지만 traceShowM는 다음 Tardis 작업 (return())를 공개 할 수 있습니다 전에 print이 할 수 강제로. <<loop>>! 당신은 여전히 ​​tracemf하려는 경우 mf <- traceShowId <$> getFuture 수,

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

,하지만 당신은 이해하는 시간을 기대하지 않는 메시지에 대한 잘 정의 된 순서를 (얻을 수 있습니다 여기에

은 고정 된 버전입니다 내부는 Tardis!),이 경우에는 목록의 꼬리를 거꾸로 인쇄하는 것처럼 보입니다.