module Data.LimitedPriorityQueue
( Queue
, mkQueue
, insert
, reduce
, toList
, fromList
, pageList
)
where
import Prelude hiding (drop, take)
data Queue v
= Q { _capacity :: !Int
, _size :: !Int
, _elems :: (Heap v)
}
deriving (Show)
data Heap v
= E
| T v (Heap v) (Heap v)
deriving (Show)
mkQueue :: Int -> Queue v
mkQueue c
| c >= 0
= Q c 0 E
| otherwise
= Q maxBound 0 E
insert :: Ord v => v -> Queue v -> Queue v
insert x q@(Q c s h)
| s < c
= Q c (s + 1) (merge h (T x E E))
| x' >= x
= q
| otherwise
= Q c s (merge (merge l r) (T x E E))
where
(T x' l r) = h
reduce :: Ord v => Int -> Queue v -> Queue v
reduce i (Q _ s h)
| i >= s
= Q i s h
| otherwise
= Q i i (drop (s i) h)
toList :: Ord v => Int -> Int -> Queue v -> [v]
toList start len (Q _ s h)
| len < 0
= take (s start) h
| len' < s
= take len $ drop (s len') h
| otherwise
= take (len (len' s)) h
where
len' = start + len
fromList :: Ord v => Int -> [v] -> Queue v
fromList c
= foldl (\ q x -> insert x q) (mkQueue c)
pageList :: Ord v => Int -> Int -> [v] -> [v]
pageList start len
= toList start len . fromList len'
where
len'
| len >= 0 = start + len
| otherwise = len
take :: Ord v => Int -> Heap v -> [v]
take i0 h0
= take' i0 h0 []
where
take' i (T x l r) acc
| i <= 0
= acc
| otherwise
= take' (i 1) (merge l r) (x : acc)
take' _ E acc
= acc
drop :: Ord v => Int -> Heap v -> Heap v
drop i h
| i <= 0
= h
| otherwise
= drop (i 1) (merge l r)
where
(T _x l r) = h
merge :: Ord v => Heap v -> Heap v -> Heap v
merge E q2 = q2
merge q1 E = q1
merge q1@(T x1 l1 r1) q2@(T x2 l2 r2)
| x1 <= x2
= T x1 r1 (merge l1 q2)
| otherwise
= T x2 r2 (merge l2 q1)