2017-04-08 128 views
-2

我正在玩狀態monad和隊列。目前,我有以下代碼:退出狀態Monad循環

{-# LANGUAGE ViewPatterns, FlexibleContexts #-} 
module Main where 

import Criterion.Main 
import Control.Monad.State.Lazy 
import Data.Maybe (fromJust) 
import Data.Sequence ((<|), ViewR ((:>))) 
import qualified Data.Sequence as S 

-------------------------------------------------------- 
data Queue a = Queue { enqueue :: [a], dequeue :: [a] } 
             deriving (Eq, Show) 
-- adds an item 
push :: a -> Queue a -> Queue a 
push a q = Queue (a:enqueue q) (dequeue q) 

pop :: Queue a -> Maybe (a, Queue a) 
pop q = if null (dequeue q) then 
      go $ Queue [] (reverse (enqueue q)) 
     else 
      go q 
    where go (Queue _ []) = Nothing 
     go (Queue en (x:de)) = Just (x, Queue en de) 

queueTst :: Int -> Queue Int -> Queue Int 
queueTst 0 q = q 
queueTst n q | even n = queueTst (n - 1) (push (100 + n) q) 
      | otherwise = queueTst (n - 1) 
          (if popped == Nothing then q 
          else snd (fromJust popped)) 
    where popped = pop q 
------------------------------------------------------------- 
pushS :: a -> S.Seq a -> S.Seq a 
pushS a s = a <| s 

pushS' :: a -> State (S.Seq a) (Maybe a) 
pushS' a = do 
    s <- get 
    put (a <| s) 
    return Nothing 

pushS'' :: a -> State (S.Seq a) (Maybe a) 
pushS'' a = get >>= (\g -> put (a <| g)) >> return Nothing 

popS :: S.Seq a -> Maybe (a, S.Seq a) 
popS (S.viewr -> S.EmptyR) = Nothing 
popS (S.viewr -> s:>r) = Just (r,s) 

popS' :: State (S.Seq a) (Maybe a) 
popS' = do 
    se <- get 
    let sl = popS'' se 
    put $ snd sl 
    return $ fst sl 
    where popS'' (S.viewr -> S.EmptyR) = (Nothing, S.empty) 
     popS'' (S.viewr -> beg:>r) = (Just r, beg) 

queueTstS :: Int -> S.Seq Int -> S.Seq Int 
queueTstS 0 s = s 
queueTstS n s | even n = queueTstS (n - 1) (pushS (100 + n) s) 
       | otherwise = queueTstS (n - 1) 
          (if popped == Nothing then s 
          else snd (fromJust popped)) 
     where popped = popS s 

queueTstST :: Int -> State (S.Seq Int) (Maybe Int) 
queueTstST n = 
    if (n > 0) then 
    if even n then 
     pushS' (100 + n) >> queueTstST (n - 1) 
    else 
     popS' >> queueTstST (n - 1) 
    else return Nothing 

main :: IO() 
main = defaultMain 
    [ bench "Twin Queue" $ whnf (queueTst 550) (Queue [500,499..1] []) 
    , bench "Sequence Queue" $ whnf (queueTstS 550) (S.fromList [500,499..1]) 
    , bench "State Queue" $ whnf 
        (runState (queueTstST 550)) (S.fromList [500,499..1]) 
    ] 

這是一些代碼,但真的是與此有關的唯一功能是mainqueueTstST。有沒有辦法退出queueTstST,同時保留最後的「Maybe值」而不是「Nothing」?

回答

0
queueTstST :: Int -> State (S.Seq Int) (Maybe Int) 
queueTstST n = 
    if (n > 1) then 
    if even n then 
     pushS' (100 + n) >> queueTstST (n - 1) 
    else 
     popS' >> queueTstST (n - 1) 
    else popS' 
+0

這不是真正的正確答案。因爲如果第二個循環是pushS',那麼正確的答案就是'Nothing'。如果它是popS',那麼它就是那個特定pops的'Just'值 - 不是隨後的popS'。 – user1897830

+0

是的 - 你的權利。然而,我想知道是否有一種方法來退出循環與最後一個循環的值,即。如果你不知道天氣,倒數第二圈甚至是賠率。 – user1897830

+0

但最初,第二個循環始終是popS',因爲n = 1,在這裏我通過中止遞歸來返回n = 1循環中的值。 – Gurkenglas

0

如果向遞歸函數添加參數,則可以記住上一個值。

queueTstST :: Int -> State (S.Seq Int) (Maybe Int) 
queueTstST n = go n Nothing 
    where 
    go :: Int -> Maybe Int -> State (S.Seq Int) (Maybe Int) 
    go n v = 
    if (n > 1) 
    then if even n 
     then pushS' (100 + n) >> go (n - 1) Nothing 
     else popS' >>= go (n - 1) 
    else return v