[removed Data.PSQueue.hs
martin.hofmann@uni-bamberg.de**20081208155216] hunk ./src/Data/PSQueue.hs 1
-{- |
-
-A /priority search queue/ (henceforth /queue/) efficiently supports the
-opperations of both a search tree and a priority queue. A 'Binding' is a
-product of a key and a priority. Bindings can be inserted, deleted, modified
-and queried in logarithmic time, and the binding with the least priority can be
-retrieved in constant time. A queue can be built from a list of bindings,
-sorted by keys, in linear time.
-
-This implementation is due to Ralf Hinze.
-
-* Hinze, R., /A Simple Implementation Technique for Priority Search Queues/, ICFP 2001, pp. 110-121
-
-<http://citeseer.ist.psu.edu/hinze01simple.html>
-
--}
-
--- Some modifications by Scott Dillard
-
-
-module Data.PSQueue
-    ( 
-    -- * Binding Type
-    Binding((:->))
-    , key
-    , prio
-    -- * Priority Search Queue Type
-    , PSQ
-    -- * Query
-    , size
-    , null
-    , lookup
-    -- * Construction
-    , empty
-    , singleton
-    -- * Insertion
-    , insert
-    , insertWith
-    -- * Delete/Update 
-    , delete
-    , adjust
-    , adjustWithKey
-    , update
-    , updateWithKey
-    , alter
-    -- * Conversion
-    , keys
-    , toList
-    , toAscList
-    , toDescList
-    , fromList
-    , fromAscList
-    , fromDistinctAscList
-    -- * Priority Queue
-    , findMin
-    , deleteMin
-    , minView
-    , atMost
-    , atMostRange
-    -- * Fold
-    , foldr
-    , foldl
-) where
-
-import Prelude hiding (lookup,null,foldl,foldr)
-import qualified Prelude as P
-
-{-
--- testing
-import Test.QuickCheck
-import Data.List (sort)
--}
-
-
-
-
--- | @k :-> p@ binds the key @k@ with the priority @p@.
-data Binding k p = k :-> p deriving (Eq,Ord,Show,Read)
-
-infix 0 :->
-
--- | The key of a binding
-key  :: Binding k p -> k
-key  (k :-> _) =  k
-
--- | The priority of a binding
-prio :: Binding k p -> p
-prio (_ :-> p) =  p
-
-
-
--- | A mapping from keys @k@ to priorites @p@. 
-
-data PSQ k p = Void | Winner k p (LTree k p) k
-
-instance (Show k, Show p, Ord k, Ord p) => Show (PSQ k p) where
-  --show = show . toAscList
-  show Void = "[]"
-  show (Winner k1 p lt k2) = "Winner "++show k1++" "++show p++" ("++show lt++") "++show k2
-
-
-
-
--- | /O(1)/ The number of bindings in a queue.
-size :: PSQ k p -> Int
-size Void = 0
-size (Winner _ _ lt _) = 1 + size' lt
-
--- | /O(1)/ True if the queue is empty.
-null :: PSQ k p -> Bool
-null Void = True
-null (Winner _ _ _ _) = False
-
--- | /O(log n)/ The priority of a given key, or Nothing if the key is not
--- bound.
-lookup :: (Ord k, Ord p) => k -> PSQ k p -> Maybe p
-lookup k q = 
-  case tourView q of
-    Null -> fail "PSQueue.lookup: Empty queue"
-    Single k' p
-      | k == k'   -> return p
-      | otherwise -> fail "PSQueue.lookup: Key not found"
-    tl `Play` tr
-      | k <= maxKey tl -> lookup k tl
-      | otherwise      -> lookup k tr
-
-
-
-empty :: (Ord k, Ord p) => PSQ k p
-empty = Void
-
--- | O(1) Build a queue with one binding.
-singleton :: (Ord k, Ord p) => k -> p -> PSQ k p
-singleton k p =  Winner k p Start k
-
-
--- | /O(log n)/ Insert a binding into the queue.
-insert :: (Ord k, Ord p) => k -> p -> PSQ k p -> PSQ k p
-insert k p q = 
-  case tourView q of
-    Null -> singleton k p
-    Single k' p' ->
-      case compare k k' of
-        LT -> singleton k  p  `play` singleton k' p'
-        EQ -> singleton k  p
-        GT -> singleton k' p' `play` singleton k  p
-    tl `Play` tr
-      | k <= maxKey tl -> insert k p tl `play` tr
-      | otherwise      -> tl `play` insert k p tr
-
-
--- | /O(log n)/ Insert a binding with a combining function. 
-insertWith :: (Ord k, Ord p) => (p->p->p) -> k -> p -> PSQ k p -> PSQ k p
-insertWith f = insertWithKey (\_ p p'-> f p p')
-
--- | /O(log n)/ Insert a binding with a combining function. 
-insertWithKey :: (Ord k, Ord p) => (k->p->p->p) -> k -> p -> PSQ k p -> PSQ k p
-insertWithKey f k p q =  
-  case tourView q of
-    Null -> singleton k p
-    Single k' p' ->
-      case compare k k' of 
-        LT -> singleton k  p  `play` singleton k' p'
-        EQ -> singleton k  (f k p p')
-        GT -> singleton k' p' `play` singleton k  p
-    tl `Play` tr
-      | k <= maxKey tl -> insertWithKey f k p tl `unsafePlay` tr
-      | otherwise      -> tl `unsafePlay` insertWithKey f k p tr
-
-
-
--- | /O(log n)/ Remove a binding from the queue.
-delete :: (Ord k, Ord p) => k -> PSQ k p -> PSQ k p
-delete k q = 
-  case tourView q of
-    Null -> empty
-    Single k' p
-      | k == k'   -> empty
-      | otherwise -> singleton k' p
-    tl `Play` tr
-      | k <= maxKey tl -> delete k tl `play` tr
-      | otherwise      -> tl `play` delete k tr
-
--- | /O(log n)/ Adjust the priority of a key.
-adjust ::  (Ord p, Ord k) => (p -> p) -> k -> PSQ k p -> PSQ k p
-adjust f = adjustWithKey (\_ p -> f p)
-
--- | /O(log n)/ Adjust the priority of a key.
-adjustWithKey :: (Ord k, Ord p) => (k -> p -> p) -> k -> PSQ k p -> PSQ k p
-adjustWithKey f k q =  
-  case tourView q of
-    Null -> empty
-    Single k' p
-      | k == k'   -> singleton k' (f k p)
-      | otherwise -> singleton k' p
-    tl `Play` tr
-      | k <= maxKey tl -> adjustWithKey f k tl `unsafePlay` tr
-      | otherwise      -> tl `unsafePlay` adjustWithKey f k tr
-
-
--- | /O(log n)/ The expression (@update f k q@) updates the
--- priority @p@ bound @k@ (if it is in the queue). If (@f p@) is 'Nothing',
--- the binding is deleted. If it is (@'Just' z@), the key @k@ is bound
--- to the new priority @z@.
-
-update :: (Ord k, Ord p) => (p -> Maybe p) -> k -> PSQ k p -> PSQ k p
-update f = updateWithKey (\_ p -> f p)
-
--- | /O(log n)/. The expression (@updateWithKey f k q@) updates the
--- priority @p@ bound @k@ (if it is in the queue). If (@f k p@) is 'Nothing',
--- the binding is deleted. If it is (@'Just' z@), the key @k@ is bound
--- to the new priority @z@.
-
-updateWithKey :: (Ord k, Ord p) => (k -> p -> Maybe p) -> k -> PSQ k p -> PSQ k p
-updateWithKey f k q =  
-  case tourView q of
-    Null -> empty
-    Single k' p 
-      | k==k' -> case f k p of
-                  Nothing -> empty
-                  Just p' -> singleton k p'
-      | otherwise -> singleton k' p
-    tl `Play` tr
-      | k <= maxKey tl -> updateWithKey f k tl `unsafePlay` tr
-      | otherwise      -> tl `unsafePlay` updateWithKey f k tr
-
-
--- | /O(log n)/. The expression (@'alter' f k q@) alters the priority @p@ bound to @k@, or absence thereof.
--- alter can be used to insert, delete, or update a priority in a queue.
-alter :: (Ord k, Ord p) => (Maybe p -> Maybe p) -> k -> PSQ k p -> PSQ k p
-alter f k q =
-  case tourView q of
-    Null -> 
-      case f Nothing of
-        Nothing -> empty
-        Just p  -> singleton k p
-    Single k' p 
-      | k == k'   ->  case f (Just p) of
-                        Nothing -> empty
-                        Just p' -> singleton k' p'
-      | otherwise ->  case f Nothing of
-                        Nothing -> singleton k' p
-                        Just p' -> insert k p' $ singleton k' p
-    tl `Play` tr
-      | k <= maxKey tl -> alter f k tl `unsafePlay` tr
-      | otherwise      -> tl `unsafePlay` alter f k tr
-
-
-
--- | /O(n)/ The keys of a priority queue
-keys :: (Ord k, Ord p) => PSQ k p -> [k]
-keys = map key . toList
-
--- | /O(n log n)/ Build a queue from a list of bindings.
-fromList :: (Ord k, Ord p) => [Binding k p] -> PSQ k p
-fromList = P.foldr (\(k:->p) q -> insert k p q) empty
-
--- | /O(n)/ Build a queue from a list of bindings in order of
--- ascending keys. The precondition that the keys are ascending is not checked.
-fromAscList :: (Ord k, Ord p) => [Binding k p] -> PSQ k p
-fromAscList = fromDistinctAscList . stripEq 
-  where stripEq []         = []
-        stripEq (x:xs)     = stripEq' x xs
-        stripEq' x' []     = [x']
-        stripEq' x' (x:xs) 
-          | x' == x   = stripEq' x' xs
-          | otherwise = x' : stripEq' x xs
-
--- | /O(n)/ Build a queue from a list of distinct bindings in order of
--- ascending keys. The precondition that keys are distinct and ascending is not checked.
-fromDistinctAscList :: (Ord k, Ord p) => [Binding k p] -> PSQ k p
-fromDistinctAscList = foldm unsafePlay empty . map (\(k:->p) -> singleton k p)
-
--- Folding a list in a binary-subdivision scheme.
-foldm :: (a -> a -> a) -> a -> [a] -> a
-foldm (*) e x
-  | P.null  x             = e
-  | otherwise             = fst (rec (length x) x)
-  where rec 1 (a : as)    = (a, as)
-        rec n as          = (a1 * a2, as2)
-          where m         = n `div` 2
-                (a1, as1) = rec (n - m) as 
-                (a2, as2) = rec m       as1
-
--- | /O(n)/ Convert a queue to a list.
-toList :: (Ord k, Ord p) => PSQ k p -> [Binding k p]
-toList = toAscList
-
--- | /O(n)/ Convert a queue to a list in ascending order of keys.
-toAscList :: (Ord k, Ord p) => PSQ k p -> [Binding k p]
-toAscList q  = seqToList (toAscLists q)
-
-toAscLists :: (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
-toAscLists q = case tourView q of
-  Null -> emptySequ
-  Single k p -> singleSequ (k :-> p)
-  tl `Play` tr -> toAscLists tl <> toAscLists tr
-
--- | /O(n)/ Convert a queue to a list in descending order of keys.
-toDescList :: (Ord k, Ord p) => PSQ k p -> [ Binding k p ]
-toDescList q = seqToList (toDescLists q)
-
-toDescLists :: (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
-toDescLists q = case tourView q of 
-  Null -> emptySequ
-  Single k p -> singleSequ (k :-> p)
-  tl `Play` tr -> toDescLists tr <> toDescLists tl
-
-
--- | /O(1)/ The binding with the lowest priority.
-findMin :: (Ord k, Ord p) => PSQ k p -> Maybe (Binding k p)
-findMin Void             = Nothing
-findMin (Winner k p t m) = Just (k :-> p) 
-
--- | /O(log n)/ Remove the binding with the lowest priority.
-deleteMin :: (Ord k, Ord p) => PSQ k p -> PSQ k p
-deleteMin Void             = Void
-deleteMin (Winner k p t m) = secondBest t m
-
--- | /O(log n)/ Retrieve the binding with the least priority, and the rest of
--- the queue stripped of that binding. 
-minView :: (Ord k, Ord p) => PSQ k p -> Maybe (Binding k p, PSQ k p)
-minView Void             = Nothing
-minView (Winner k p t m) = Just ( k :-> p , secondBest t m )
-
-secondBest :: (Ord k, Ord p) => LTree k p -> k -> PSQ k p
-secondBest Start _m = Void
-secondBest (LLoser _ k p tl m tr) m' = Winner k p tl m `play` secondBest tr m'
-secondBest (RLoser _ k p tl m tr) m' = secondBest tl m `play` Winner k p tr m'
-
-
-
--- | /O(r(log n - log r)/ @atMost p q@ is a list of all the bindings in @q@ with
--- priority less than @p@, in order of ascending keys.
--- Effectively, 
---
--- @
---   atMost p' q = filter (\\(k:->p) -> p<=p') . toList
--- @
-atMost :: (Ord k, Ord p) => p -> PSQ k p -> [Binding k p]
-atMost pt q = seqToList (atMosts pt q)
-
-atMosts :: (Ord k, Ord p) => p -> PSQ k p -> Sequ (Binding k p)
-atMosts _pt Void  = emptySequ
-atMosts pt (Winner k p t _) =  prune k p t
-  where
-  prune k p t
-    | p > pt         = emptySequ
-    | otherwise      = traverse k p t
-  traverse k p Start = singleSequ (k :-> p)
-  traverse k p (LLoser _ k' p' tl _m tr) = prune k' p' tl <> traverse k p tr
-  traverse k p (RLoser _ k' p' tl _m tr) = traverse k p tl <> prune k' p' tr
-
--- | /O(r(log n - log r))/ @atMostRange p (l,u) q@ is a list of all the bindings in
--- @q@ with a priority less than @p@ and a key in the range @(l,u)@ inclusive.
--- Effectively,
--- 
--- @
---    atMostRange p' (l,u) q = filter (\\(k:->p) -> l<=k && k<=u ) . 'atMost' p'
--- @
-atMostRange :: (Ord k, Ord p) => p -> (k, k) -> PSQ k p -> [Binding k p]
-atMostRange pt (kl, kr) q = seqToList (atMostRanges pt (kl, kr) q)
-
-atMostRanges :: (Ord k, Ord p) => p -> (k, k) -> PSQ k p -> Sequ (Binding k p)
-
-atMostRanges _pt _range Void = emptySequ
-atMostRanges pt range@(kl, kr) (Winner k p t _) = prune k p t
-  where
-  prune k p t
-    | p > pt    = emptySequ
-    | otherwise = traverse k p t
-  traverse k p Start
-    | k `inrange` range = singleSequ (k :-> p)
-    | otherwise         = emptySequ
-  traverse k p (LLoser _ k' p' tl m tr) =  
-    guard (kl <= m) (prune k' p' tl) <> guard (m <= kr) (traverse k p tr)
-  traverse k p (RLoser _ k' p' tl m tr) =  
-    guard (kl <= m) (traverse k p tl) <> guard (m <= kr) (prune k' p' tr)
-
-inrange :: (Ord a) => a -> (a, a) -> Bool
-a `inrange` (l, r)  =  l <= a && a <= r
-
-
-
-
--- | Right fold over the bindings in the queue, in key order.
-foldr :: (Ord k,Ord p) => (Binding k p -> b -> b) -> b -> PSQ k p -> b
-foldr f z q = 
-  case tourView q of
-    Null -> z
-    Single k p -> f (k:->p) z
-    l`Play`r -> foldr f (foldr f z r) l
-    
-
--- | Left fold over the bindings in the queue, in key order.
-foldl :: (Ord k,Ord p) => (b -> Binding k p -> b) -> b -> PSQ k p -> b
-foldl f z q = 
-  case tourView q of
-    Null -> z
-    Single k p -> f z (k:->p)
-    l`Play`r -> foldl f (foldl f z l) r
-
-
-
-
------------------------
-------- Internals -----
-----------------------
-
-type Size = Int
-
-data LTree k p = Start
-               | LLoser {-# UNPACK #-}!Size !k !p (LTree k p) !k (LTree k p)
-               | RLoser {-# UNPACK #-}!Size !k !p (LTree k p) !k (LTree k p)
-    deriving(Show)
-
-size' :: LTree k p -> Size
-size' Start                = 0
-size' (LLoser s _ _ _ _ _) = s
-size' (RLoser s _ _ _ _ _) = s
-
-left, right :: LTree a b -> LTree a b
-
-left  Start                   =  error "left: empty loser tree"
-left  (LLoser _ _ _ tl _ _ ) =  tl
-left  (RLoser _ _ _ tl _ _ ) =  tl
-
-right Start                   =  error "right: empty loser tree"
-right (LLoser _ _ _ _  _ tr) =  tr
-right (RLoser _ _ _ _  _ tr) =  tr
-
-maxKey :: PSQ k p -> k
-maxKey Void                =  error "maxKey: empty queue"
-maxKey (Winner _k _p _t m) =  m
-
-lloser, rloser :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
-lloser k p tl m tr =  LLoser (1 + size' tl + size' tr) k p tl m tr
-rloser k p tl m tr =  RLoser (1 + size' tl + size' tr) k p tl m tr
-
---balance factor
-omega :: Int
-omega = 4
-
-lbalance, rbalance :: 
-  (Ord k, Ord p) => k-> p -> LTree k p -> k -> LTree k p -> LTree k p
-
-lbalance k p l m r
-  | size' l + size' r < 2     = lloser        k p l m r
-  | size' r > omega * size' l = lbalanceLeft  k p l m r
-  | size' l > omega * size' r = lbalanceRight k p l m r
-  | otherwise               = lloser        k p l m r
-
-rbalance k p l m r
-  | size' l + size' r < 2     = rloser        k p l m r
-  | size' r > omega * size' l = rbalanceLeft  k p l m r
-  | size' l > omega * size' r = rbalanceRight k p l m r
-  | otherwise               = rloser        k p l m r
-
-lbalanceLeft  k p l m r
-  | size' (left r) < size' (right r) = lsingleLeft  k p l m r
-  | otherwise                      = ldoubleLeft  k p l m r
-
-lbalanceRight k p l m r
-  | size' (left l) > size' (right l) = lsingleRight k p l m r
-  | otherwise                      = ldoubleRight k p l m r
-
-
-rbalanceLeft  k p l m r
-  | size' (left r) < size' (right r) = rsingleLeft  k p l m r
-  | otherwise                      = rdoubleLeft  k p l m r
-
-rbalanceRight k p l m r
-  | size' (left l) > size' (right l) = rsingleRight k p l m r
-  | otherwise                      = rdoubleRight k p l m r
-
-
-
-
-lsingleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3)
-  | p1 <= p2  = lloser k1 p1 (rloser k2 p2 t1 m1 t2) m2 t3
-  | otherwise = lloser k2 p2 (lloser k1 p1 t1 m1 t2) m2 t3
-
-lsingleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =  
-  rloser k2 p2 (lloser k1 p1 t1 m1 t2) m2 t3
-
-rsingleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3) =  
-  rloser k1 p1 (rloser k2 p2 t1 m1 t2) m2 t3
-
-rsingleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =  
-  rloser k2 p2 (rloser k1 p1 t1 m1 t2) m2 t3
-
-lsingleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =  
-  lloser k2 p2 t1 m1 (lloser k1 p1 t2 m2 t3)
-
-lsingleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3 =  
-  lloser k1 p1 t1 m1 (lloser k2 p2 t2 m2 t3)
-
-rsingleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =  
-  lloser k2 p2 t1 m1 (rloser k1 p1 t2 m2 t3)
-
-rsingleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3
-  | p1 <= p2  = rloser k1 p1 t1 m1 (lloser k2 p2 t2 m2 t3)
-  | otherwise = rloser k2 p2 t1 m1 (rloser k1 p1 t2 m2 t3)
-
-
-
-ldoubleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3) = 
-  lsingleLeft k1 p1 t1 m1 (lsingleRight k2 p2 t2 m2 t3)
-
-ldoubleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =  
-  lsingleLeft k1 p1 t1 m1 (rsingleRight k2 p2 t2 m2 t3)
-
-ldoubleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =  
-  lsingleRight k1 p1 (lsingleLeft k2 p2 t1 m1 t2) m2 t3
-
-ldoubleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3 =  
-  lsingleRight k1 p1 (rsingleLeft k2 p2 t1 m1 t2) m2 t3
-
-rdoubleLeft k1 p1 t1 m1 (LLoser _ k2 p2 t2 m2 t3) = 
-  rsingleLeft k1 p1 t1 m1 (lsingleRight k2 p2 t2 m2 t3)
-
-rdoubleLeft k1 p1 t1 m1 (RLoser _ k2 p2 t2 m2 t3) =  
-  rsingleLeft k1 p1 t1 m1 (rsingleRight k2 p2 t2 m2 t3)
-
-rdoubleRight k1 p1 (LLoser _ k2 p2 t1 m1 t2) m2 t3 =  
-  rsingleRight k1 p1 (lsingleLeft k2 p2 t1 m1 t2) m2 t3
-
-rdoubleRight k1 p1 (RLoser _ k2 p2 t1 m1 t2) m2 t3 =  
-  rsingleRight k1 p1 (rsingleLeft k2 p2 t1 m1 t2) m2 t3
-
-
-play :: (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
-
-Void `play` t' = t'
-t `play` Void  = t
-
-Winner k p t m  `play`  Winner k' p' t' m'
-  | p <= p'   = Winner k  p  (rbalance k' p' t m t') m'
-  | otherwise = Winner k' p' (lbalance k  p  t m t') m'
-
-unsafePlay :: (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
-
-Void `unsafePlay` t' =  t'
-t `unsafePlay` Void  =  t
-
-Winner k p t m  `unsafePlay`  Winner k' p' t' m'
-  | p <= p'   = Winner k  p  (rbalance k' p' t m t') m'
-  | otherwise = Winner k' p' (lbalance k  p  t m t') m'
-
-
-
-data TourView k p = Null | Single k p | PSQ k p `Play` PSQ k p
-
-tourView :: (Ord k) => PSQ k p -> TourView k p
-
-tourView Void                  =  Null
-tourView (Winner k p Start _m) =  Single k p
-
-tourView (Winner k p (RLoser _ k' p' tl m tr) m') =  
-  Winner k  p  tl m `Play` Winner k' p' tr m'
-
-tourView (Winner k p (LLoser _ k' p' tl m tr) m') =  
-  Winner k' p' tl m `Play` Winner k  p  tr m'
-
-
-
-
-
-
---------------------------------------
--- Hughes's efficient sequence type --
---------------------------------------
-
-emptySequ  :: Sequ a
-singleSequ :: a -> Sequ a
-(<>)       :: Sequ a -> Sequ a -> Sequ a
-seqFromList   :: [a] -> Sequ a
-seqFromListT  :: ([a] -> [a]) -> Sequ a
-seqToList     :: Sequ a -> [a] 
-
-infixr 5 <>
-
-newtype Sequ a  =  Sequ ([a] -> [a])
-
-emptySequ          = Sequ (\as -> as)
-singleSequ a       = Sequ (\as -> a : as)
-Sequ x1 <> Sequ x2 = Sequ (\as -> x1 (x2 as))
-seqFromList as     = Sequ (\as' -> as ++ as')
-seqFromListT as    = Sequ as
-seqToList (Sequ x) = x []
-
-instance Show a => Show (Sequ a) where
-    showsPrec d a = showsPrec d (seqToList a)
-
-guard :: Bool -> Sequ a -> Sequ a
-guard False _as = emptySequ
-guard True  as  = as
-
-
-
-
----------------------------------
------------- Tests --------------
----------------------------------
-
-{-
-
-isBalanced Start = True
-isBalanced (LLoser s k p l m r) =
-  (size' l + size' r <= 2 ||(size' l<=omega*size' r && size' r<=omega*size' l))
-  && isBalanced l && isBalanced r
-isBalanced (RLoser s k p l m r) =
-  (size' l + size' r <= 2 ||(size' l<=omega*size' r && size' r<=omega*size' l))
-  && isBalanced l && isBalanced r
-
-instance (Ord k, Ord p, Arbitrary k, Arbitrary p) => Arbitrary (PSQ k p)
-  where 
-    coarbitrary = undefined
-    arbitrary = 
-      do ks <- arbitrary
-         ps <- arbitrary
-         return . fromList $ zipWith (:->) ks ps
-
-prop_Balanced :: PSQ Int Int -> Bool
-prop_Balanced Void = True
-prop_Balanced (Winner _ _ t _) = isBalanced t
-
-prop_OrderedKeys :: PSQ Int Int -> Bool
-prop_OrderedKeys t = let ks = map key . toAscList $ t in sort ks == ks
-
-prop_AtMost :: (PSQ Int Int,Int) -> Bool
-prop_AtMost (t,p) = 
-  let ps = map prio . atMost p $ t 
-  in all (<=p) ps
-
-prop_AtMostRange :: (PSQ Int Int,Int,Int,Int) -> Bool
-prop_AtMostRange (t,p,l_,r_) = 
-  let l = min (abs l_) (abs r_)
-      r = max (abs l_) (abs r_)
-      (ks,ps) = unzip . map (\b -> (key b,prio b)) . atMostRange p (l,r) $ t 
-  in  all (flip inrange (l,r)) ks && all (<=p) ps
-
-prop_MinView :: PSQ Int Int -> Bool
-prop_MinView t = 
-  case minView t of 
-    Nothing -> True
-    Just (b1,t') ->
-      case minView t' of
-        Nothing -> True
-        Just (b2,_) -> prio b1 <= prio b2 && prop_MinView t'
-
-tests =
-  do
-  putStrLn "Balanced"
-  quickCheck prop_Balanced
-  putStrLn "OrderedKeys"
-  quickCheck prop_OrderedKeys
-  putStrLn "MinView"
-  quickCheck prop_MinView
-  putStrLn "AtMost"
-  quickCheck prop_AtMost
-  putStrLn "AtMostRange"
-  quickCheck prop_AtMostRange
--}
-
-
-
-
-
-
rmfile ./src/Data/PSQueue.hs