-----------------------------------------------------------------------------
-- |
-- Module : Data.Queue.TwoStack
-- Copyright : (c) Leon P Smith 2009
-- License : BSD3
--
-- Maintainer : leon at melding-monads dot com
-- Stability : experimental
-- Portability : portable
--
-- Two-Stack Queues of functional programming folklore.
-- Notably mentioned inside Chris Okasaki's thesis, with
-- relevant citations.
--
-- /Purely Functional Data Structures/ by Chris Okasaki,
-- /Cambridge University Press/, 1998
--
-- http://www.cs.cmu.edu/~rwh/theses/okasaki.pdf
--
-----------------------------------------------------------------------------
module Data.Queue.TwoStack
( Q()
, empty
, enque
, deque
, listToQueue
, queueToList
, len
) where
import qualified Data.Queue.Class as Class
import Data.List
import Control.Monad.Queue.Util
data Q e = Q !LenType [e] [e]
instance Functor Q where
fmap f (Q n as zs) = Q n (map f as ++ map f (reverse zs)) []
instance (Eq e) => Eq (Q e) where
(Q ln as ys) == (Q mn bs zs) = ln == mn && loop as bs ys zs
where
loop as bs (y:ys) (z:zs) = y == z && loop as bs ys zs
loop as bs ys zs = loop2 as bs ys zs
loop2 (a:as) (b:bs) ys zs = a == b && loop2 as bs ys zs
loop2 as [] [] zs = as == reverse zs
loop2 [] bs ys [] = bs == reverse ys
instance (Ord e) => Ord (Q e) where
compare (Q _ as ys) (Q _ bs zs) = loop as bs ys zs
where
loop (a:as) (b:bs) ys zs
= case compare a b of
LT -> LT
EQ -> loop as bs ys zs
GT -> GT
loop [] [] [] [] = EQ
loop [] bs [] zs = LT
loop [] bs ys zs = loop (reverse ys) bs [] zs
loop as [] ys [] = GT
loop as [] ys zs = loop as (reverse zs) ys []
empty :: Q e
empty = Q 0 [] []
enque :: e -> Q e -> Q e
enque z (Q 0 [] []) = Q 1 [z] []
enque z (Q n (a:as) zs) = Q (n+1) (a:as) (z:zs)
deque :: Q e -> (Maybe e, Q e)
deque (Q 0 [] []) = ( Nothing , Q 0 [] [] )
deque (Q n (a:as) zs)
| null as = ( Just a , Q (n-1) as' [] )
| otherwise = ( Just a , Q (n-1) as zs )
where as' = reverse zs
listToQueue :: [e] -> Q e
listToQueue as = Q (genericLength as) as []
queueToList :: Q e -> [e]
queueToList (Q _ as zs) = as ++ reverse zs
len :: Q e -> LenType
len (Q l _ _) = l
instance Class.Queue Q where
empty = empty
enque = enque
deque = deque