-- | Several purely functional queue implementations.
module Queue where


-- * Stack (trivial)

type Stack a = [a]

-- O(1)
pop :: Stack a -> Maybe (a, Stack a)
pop []     = Nothing
pop (x:xs) = Just (x,xs)

-- O(1)
push :: a -> Stack a -> Stack a
push x s = x : s


-- * Queue abstract data type

class Queue t where
  empty   :: t a
  enqueue :: a -> t a -> t a
  dequeue :: t a -> Maybe (a, t a)

-- | Enqueue all elements from a list in order.
fromList :: Queue t => [a] -> t a
fromList = foldl (flip enqueue) empty

-- | Dequeue an element and drop it, or do nothing if the queue is empty.
skip :: Queue t => t a -> t a
skip q = maybe q snd (dequeue q)


-- ** Naive Queue

-- | A naive queue. Dequeues from the front of the list, enqueues to the back.
newtype Naive a = NQ [a]
  deriving (Eq,Show)

naiveEmpty :: Naive a
naiveEmpty = NQ []

-- | Worst case: O(1)
naiveDequeue :: Naive a -> Maybe (a, Naive a)
naiveDequeue (NQ [])     = Nothing
naiveDequeue (NQ (x:xs)) = Just (x, NQ xs)

-- | Worst case: O(n) <-- bad!
naiveEnqueue :: a -> Naive a -> Naive a
naiveEnqueue x (NQ xs) = NQ (xs ++ [x])

instance Queue Naive where
  empty   = naiveEmpty
  enqueue = naiveEnqueue
  dequeue = naiveDequeue


-- ** Two-Stack Queue

-- | Encodes a queue as a pair of lists (l,r), such that the corresponding
--   naive queue is: l ++ reverse r.
--
--   Supports amortized constant time enqueue and dequeue when used as a
--   traditional (i.e. non-persistent) data structure. Dequeue is O(n) in
--   the persistent case.
data Better a = BQ [a] [a]
  deriving (Eq,Show)

betterEmpty :: Better a
betterEmpty = BQ [] []

-- | Worst case: O(1)
--   
--   Banker's method: save 1 credit to r
betterEnqueue :: a -> Better a -> Better a
betterEnqueue x (BQ l r) = BQ l (x:r)

-- | Worst case: O(n)
--
--   Banker's method:
--     | length l > 0 = spend 1 credit
--     | otherwise    = spend 1 + all credits on r
betterDequeue :: Better a -> Maybe (a, Better a)
betterDequeue (BQ []   []) = Nothing
betterDequeue (BQ (x:l) r) = Just (x, BQ l r)
betterDequeue (BQ []    r) = betterDequeue (BQ (reverse r) [])

instance Queue Better where
  empty   = betterEmpty
  enqueue = betterEnqueue
  dequeue = betterDequeue


-- ** "Clever" Queue

-- | Same representation as the Two-Stack Queue, but attempts to take
--   advantage of lazy evaluation to make modifications of old versions
--   efficient (doesn't quite work).
-- 
--   Idea: Don't wait until a dequeue to redistribute. Redistribute after
--   each enqueue and dequeue so we can reuse this work for multiple dequeues
--   on the same version.
--
--   Unfortunately, our redistribute function is too simple. A bunch of
--   initial enqueues will still put us in debt since only the first
--   dequeue will be O(1); subsequent dequeues will require redistributing.
data Clever a = CQ [a] [a]
  deriving (Eq,Show)

cleverEmpty :: Clever a
cleverEmpty = CQ [] []

-- | Redistribute the two lists, if necessary.
reload :: Clever a -> Clever a
reload (CQ [] r) = CQ (reverse r) []
reload q         = q

cleverEnqueue :: a -> Clever a -> Clever a
cleverEnqueue x (CQ l r) = reload (CQ l (x:r))

cleverDequeue :: Clever a -> Maybe (a, Clever a)
cleverDequeue (CQ []    _) = Nothing
cleverDequeue (CQ (x:l) r) = Just (x, reload (CQ l r))

instance Queue Clever where
  empty   = cleverEmpty
  enqueue = cleverEnqueue
  dequeue = cleverDequeue


-- ** Persistent Queue


-- | A persistent queue with amortized O(1) time for both enqueue and dequeue!
--   (This is the good one.)
--
--   The basic idea is the same as the "Clever" Queue, we just have a smarter
--   redistribution function that gives the performance we want.
--
--   The actual accounting is quite complicated, but 
data PQueue a = PQ Int Int [a] [a]
  deriving (Eq,Show)

pEmpty :: PQueue a
pEmpty = PQ 0 0 [] []

-- | Redistribute the two lists, if necessary.
--
--   NOTE: The second case will always trigger when nr = nl + 1
--   This is crucial to our accounting since whenever we must reverse r,
--   we will have already paid for it with a corresponding number of credits
--   saved to l.
--
--   The actual accounting is quite involved, see 6.3.2 of Okasaki's book.
balance :: PQueue a -> PQueue a
balance q@(PQ nl nr l r) | nr <= nl  = q
                         | otherwise = PQ (nl+nr) 0 (l ++ reverse r) []

pEnqueue :: a -> PQueue a -> PQueue a
pEnqueue x (PQ nl nr l r) = balance (PQ nl (nr+1) l (x:r))

pDequeue :: PQueue a -> Maybe (a, PQueue a)
pDequeue (PQ _  _  []    _) = Nothing
pDequeue (PQ nl nr (x:l) r) = Just (x, balance (PQ (nl-1) nr l r))

instance Queue PQueue where
  empty   = pEmpty
  enqueue = pEnqueue
  dequeue = pDequeue


-- ** Some hacky timing code

-- To use in GHCi:
-- bash> ghci -fobject-code Queue.hs
-- ghci> set +s

forceDequeue :: (Monad m, Queue t) => t a -> m ()
forceDequeue q = case dequeue q of
                   Just _  -> return ()
                   Nothing -> return ()

shareDequeue1 :: (Monad m, Queue t) => t Int -> Int -> m ()
shareDequeue1 empty n = mapM_ forceDequeue (replicate 100000 q)
  where q = foldr enqueue empty [1..n]

shareDequeue2 :: (Monad m, Queue t) => t Int -> Int -> m ()
shareDequeue2 empty n = mapM_ (forceDequeue . skip) (replicate 100000 q)
  where q = foldr enqueue empty [1..n]