[Haskell-cafe] Execute only one step in Hood-Melville Real time queue.

[Xinyu LIU]

Hi,

I read the Hood-Melville real time queue realization in [1].
There are 2 lists maintained in queue, front and rear. When the queue gets
unbalanced due to push/pop,
it amortized the f ++ reverse r incrementally to build the new front list
based on the below mechanism

reverse r = reverse' r [] where
  reverse' [] acc = acc
  reverse' (x:xs) = reverse' xs (x:acc)

and

f ++ reverse r
== reverse (reverse f) ++ reverse r
== reverse' (reverse f) [] ++ reverse r
== reverse' (reverse' f []) (reverse' r [])

And the re-balance happens once | f | + 1 = | r |. Let's denote m = |f|.
incremental f ++ reverse r takes total 2*m + 2 steps.

In the the realization mentioned in [1], it execute 2 steps every push and
pop to make sure the
incremental computation finish before next queue re-balancing.

However, I found it's possible to execute only one step per push/pop.
because:
1. Next re-balance happens at earliest | f' | + 1 = |r|+|f|+1+1 = 2*m + 2
times by continuously push operation;
2. If we keep a copy of f, and a counter of how many elements left in f,
which need to be incrementally 'appended', by continuously m times popping
operation. we can finish the f ++ reverse r (actually, only reverse r is
needed, as all elements in f are popped)

Based on this fact, I rewrite the program as the following:

data State a = Empty
             | Reverse Int [a] [a] [a] [a] -- n, f', acc_f' r, acc_r
             | Append Int [a] [a]          -- n, rev_f', acc
             | Done [a] -- result: f ++ reverse r
               deriving (Show, Eq)

-- front, length of front, on-goint reverse state, rear, length of reverse
data RealtimeQueue a = RTQ [a] Int (State a) [a] Int
                     deriving (Show, Eq)

-- we skip the empty error for pop and front
empty = RTQ [] 0 Empty [] 0

isEmpty (RTQ _ lenf _ _ _) = lenf == 0

-- O(1) time push
push (RTQ f lenf s r lenr) x = balance f lenf s (x:r) (lenr + 1)

-- O(1) time pop
pop (RTQ (_:f) lenf s r lenr) = balance f (lenf - 1) (abort s) r lenr

front (RTQ (x:_) _ _ _ _) = x

balance f lenf s r lenr
    | lenr <= lenf =  step f lenf s r lenr
    | otherwise = step f (lenf + lenr) (Reverse 0 f [] r []) [] 0

-- execute f ++ reverse r step by step
step f lenf s r lenr =
    case s' of
      Done f' -> RTQ f' lenf Empty r lenr
      s' -> RTQ f lenf s' r lenr
    where s' = if null f then next $ next s else next s

next (Reverse n (x:f) f' (y:r) r') = Reverse (n+1) f (x:f') r (y:r')
next (Reverse n [] f' [y] r') = Append n f' (y:r')
next (Append 0 _ acc) = Done acc
next (Append n (x:f') acc) = Append (n-1) f' (x:acc)
next s = s

-- Abort unnecessary appending as the element is popped
abort (Append 0 _ (_:acc)) = Done acc -- Note! we rollback 1 elem
abort (Append n f' acc) = Append (n-1) f' acc
abort (Reverse n f f' r r') = Reverse (n-1) f f' r r'
abort s = s

Note the 'where' clause in step function. This is because we need an extra
step to change the state from (Append 0 _ xs) to (Done xs).

I tested this program with invariant testing with QuickCheck. The behavior
is correct as other queue implementation.

The program can be found here:

https://github.com/liuxinyu95/AlgoXY/blob/algoxy/datastruct/elementary/queue/src/RealtimeQueue.hs

Reference:
[1]. Chris Okasaki. ``Purely functional data structures''. P102. Section
8.2.1. Cambridge University Press. ISBN 0521663504
-- 
Larry, LIU Xinyu
https://sites.google.com/site/algoxy/
https://github.com/liuxinyu95/AlgoXY
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120326/6ca533af/attachment.htm>