module Data.PSQueue.Internal 
  (
  -- * Binding Type
    Binding(..)
  , key
  , prio
  -- * Priority Search Queue Type
  , PSQ(..)
  -- * Query
  , size
  , null
  , lookup
  -- * Construction
  , empty
  , singleton
  -- * Insertion
  , insert
  , insertWith
  , insertWithKey
  -- * Delete/Update
  , delete
  , adjust
  , adjustWithKey
  , update
  , updateWithKey
  , alter
  -- * Conversion
  , keys
  , fromList
  , fromAscList
  , fromDistinctAscList
  , foldm
  , toList
  , toAscList
  , toAscLists
  , toDescList
  , toDescLists
  -- * Priority Queue
  , findMin
  , deleteMin
  , minView
  , secondBest
  , atMost
  , atMosts
  , atMostRange
  , atMostRanges
  , inrange
  -- * Fold
  , foldr
  , foldl
  -- * Internals
  , Size
  , LTree(..)
  , size'
  , left
  , right
  , maxKey
  , lloser
  , rloser
  , omega
  , lbalance
  , rbalance
  , lbalanceLeft
  , lbalanceRight
  , rbalanceLeft
  , rbalanceRight
  , lsingleLeft
  , rsingleLeft
  , lsingleRight
  , rsingleRight
  , ldoubleLeft
  , ldoubleRight
  , rdoubleLeft
  , rdoubleRight
  , play
  , unsafePlay
  , TourView(..)
  , tourView
  ) where

import           Prelude hiding (foldl, foldr, lookup, null)
import qualified Prelude as P

-- | @k :-> p@ binds the key @k@ with the priority @p@.
data Binding k p = k :-> p deriving (Binding k p -> Binding k p -> Bool
(Binding k p -> Binding k p -> Bool)
-> (Binding k p -> Binding k p -> Bool) -> Eq (Binding k p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k p. (Eq k, Eq p) => Binding k p -> Binding k p -> Bool
/= :: Binding k p -> Binding k p -> Bool
$c/= :: forall k p. (Eq k, Eq p) => Binding k p -> Binding k p -> Bool
== :: Binding k p -> Binding k p -> Bool
$c== :: forall k p. (Eq k, Eq p) => Binding k p -> Binding k p -> Bool
Eq,Eq (Binding k p)
Eq (Binding k p)
-> (Binding k p -> Binding k p -> Ordering)
-> (Binding k p -> Binding k p -> Bool)
-> (Binding k p -> Binding k p -> Bool)
-> (Binding k p -> Binding k p -> Bool)
-> (Binding k p -> Binding k p -> Bool)
-> (Binding k p -> Binding k p -> Binding k p)
-> (Binding k p -> Binding k p -> Binding k p)
-> Ord (Binding k p)
Binding k p -> Binding k p -> Bool
Binding k p -> Binding k p -> Ordering
Binding k p -> Binding k p -> Binding k p
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {k} {p}. (Ord k, Ord p) => Eq (Binding k p)
forall k p. (Ord k, Ord p) => Binding k p -> Binding k p -> Bool
forall k p.
(Ord k, Ord p) =>
Binding k p -> Binding k p -> Ordering
forall k p.
(Ord k, Ord p) =>
Binding k p -> Binding k p -> Binding k p
min :: Binding k p -> Binding k p -> Binding k p
$cmin :: forall k p.
(Ord k, Ord p) =>
Binding k p -> Binding k p -> Binding k p
max :: Binding k p -> Binding k p -> Binding k p
$cmax :: forall k p.
(Ord k, Ord p) =>
Binding k p -> Binding k p -> Binding k p
>= :: Binding k p -> Binding k p -> Bool
$c>= :: forall k p. (Ord k, Ord p) => Binding k p -> Binding k p -> Bool
> :: Binding k p -> Binding k p -> Bool
$c> :: forall k p. (Ord k, Ord p) => Binding k p -> Binding k p -> Bool
<= :: Binding k p -> Binding k p -> Bool
$c<= :: forall k p. (Ord k, Ord p) => Binding k p -> Binding k p -> Bool
< :: Binding k p -> Binding k p -> Bool
$c< :: forall k p. (Ord k, Ord p) => Binding k p -> Binding k p -> Bool
compare :: Binding k p -> Binding k p -> Ordering
$ccompare :: forall k p.
(Ord k, Ord p) =>
Binding k p -> Binding k p -> Ordering
Ord,Int -> Binding k p -> ShowS
[Binding k p] -> ShowS
Binding k p -> String
(Int -> Binding k p -> ShowS)
-> (Binding k p -> String)
-> ([Binding k p] -> ShowS)
-> Show (Binding k p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k p. (Show k, Show p) => Int -> Binding k p -> ShowS
forall k p. (Show k, Show p) => [Binding k p] -> ShowS
forall k p. (Show k, Show p) => Binding k p -> String
showList :: [Binding k p] -> ShowS
$cshowList :: forall k p. (Show k, Show p) => [Binding k p] -> ShowS
show :: Binding k p -> String
$cshow :: forall k p. (Show k, Show p) => Binding k p -> String
showsPrec :: Int -> Binding k p -> ShowS
$cshowsPrec :: forall k p. (Show k, Show p) => Int -> Binding k p -> ShowS
Show,ReadPrec [Binding k p]
ReadPrec (Binding k p)
Int -> ReadS (Binding k p)
ReadS [Binding k p]
(Int -> ReadS (Binding k p))
-> ReadS [Binding k p]
-> ReadPrec (Binding k p)
-> ReadPrec [Binding k p]
-> Read (Binding k p)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k p. (Read k, Read p) => ReadPrec [Binding k p]
forall k p. (Read k, Read p) => ReadPrec (Binding k p)
forall k p. (Read k, Read p) => Int -> ReadS (Binding k p)
forall k p. (Read k, Read p) => ReadS [Binding k p]
readListPrec :: ReadPrec [Binding k p]
$creadListPrec :: forall k p. (Read k, Read p) => ReadPrec [Binding k p]
readPrec :: ReadPrec (Binding k p)
$creadPrec :: forall k p. (Read k, Read p) => ReadPrec (Binding k p)
readList :: ReadS [Binding k p]
$creadList :: forall k p. (Read k, Read p) => ReadS [Binding k p]
readsPrec :: Int -> ReadS (Binding k p)
$creadsPrec :: forall k p. (Read k, Read p) => Int -> ReadS (Binding k p)
Read)

infix 0 :->

-- | The key of a binding
key  :: Binding k p -> k
key :: forall k p. Binding k p -> k
key  (k
k :-> p
_) =  k
k

-- | The priority of a binding
prio :: Binding k p -> p
prio :: forall k p. Binding k p -> p
prio (k
_ :-> p
p) =  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 :: PSQ k p -> String
show = [Binding k p] -> String
forall a. Show a => a -> String
show ([Binding k p] -> String)
-> (PSQ k p -> [Binding k p]) -> PSQ k p -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSQ k p -> [Binding k p]
forall k p. (Ord k, Ord p) => PSQ k p -> [Binding k p]
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 :: forall k p. PSQ k p -> Int
size PSQ k p
Void              = Int
0
size (Winner k
_ p
_ LTree k p
lt k
_) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
lt

-- | /O(1)/ True if the queue is empty.
null :: PSQ k p -> Bool
null :: forall k p. PSQ k p -> Bool
null PSQ k p
Void             = Bool
True
null (Winner k
_ p
_ LTree k p
_ k
_) = Bool
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 :: forall k p. (Ord k, Ord p) => k -> PSQ k p -> Maybe p
lookup k
k PSQ k p
q =
  case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
    TourView k p
Null -> String -> Maybe p
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"PSQueue.lookup: Empty queue"
    Single k
k' p
p
      | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'   -> p -> Maybe p
forall (m :: * -> *) a. Monad m => a -> m a
return p
p
      | Bool
otherwise -> String -> Maybe p
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"PSQueue.lookup: Key not found"
    PSQ k p
tl `Play` PSQ k p
tr
      | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= PSQ k p -> k
forall k p. PSQ k p -> k
maxKey PSQ k p
tl -> k -> PSQ k p -> Maybe p
forall k p. (Ord k, Ord p) => k -> PSQ k p -> Maybe p
lookup k
k PSQ k p
tl
      | Bool
otherwise      -> k -> PSQ k p -> Maybe p
forall k p. (Ord k, Ord p) => k -> PSQ k p -> Maybe p
lookup k
k PSQ k p
tr



empty :: (Ord k, Ord p) => PSQ k p
empty :: forall k p. (Ord k, Ord p) => PSQ k p
empty = PSQ k p
forall k p. PSQ k p
Void

-- | O(1) Build a queue with one binding.
singleton :: (Ord k, Ord p) => k -> p -> PSQ k p
singleton :: forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k p
p =  k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k p
p LTree k p
forall k p. LTree k p
Start k
k


-- | /O(log n)/ Insert a binding into the queue.
insert :: (Ord k, Ord p) => k -> p -> PSQ k p -> PSQ k p
insert :: forall k p. (Ord k, Ord p) => k -> p -> PSQ k p -> PSQ k p
insert k
k p
p PSQ k p
q =
  case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
    TourView k p
Null -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k p
p
    Single k
k' p
p' ->
      case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
k' of
        Ordering
LT -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k  p
p  PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' p
p'
        Ordering
EQ -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k  p
p
        Ordering
GT -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' p
p' PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k  p
p
    PSQ k p
tl `Play` PSQ k p
tr
      | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= PSQ k p -> k
forall k p. PSQ k p -> k
maxKey PSQ k p
tl -> k -> p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p -> PSQ k p
insert k
k p
p PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` PSQ k p
tr
      | Bool
otherwise      -> PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` k -> p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p -> PSQ k p
insert k
k p
p PSQ 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 :: forall k p.
(Ord k, Ord p) =>
(p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
insertWith p -> p -> p
f = (k -> p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(k -> p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
insertWithKey (\k
_ p
p p
p'-> p -> p -> p
f p
p 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 :: forall k p.
(Ord k, Ord p) =>
(k -> p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
insertWithKey k -> p -> p -> p
f k
k p
p PSQ k p
q =
  case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
    TourView k p
Null -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k p
p
    Single k
k' p
p' ->
      case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
k' of
        Ordering
LT -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k  p
p  PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' p
p'
        Ordering
EQ -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k  (k -> p -> p -> p
f k
k p
p p
p')
        Ordering
GT -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' p
p' PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k  p
p
    PSQ k p
tl `Play` PSQ k p
tr
      | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= PSQ k p -> k
forall k p. PSQ k p -> k
maxKey PSQ k p
tl -> (k -> p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(k -> p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
insertWithKey k -> p -> p -> p
f k
k p
p PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`unsafePlay` PSQ k p
tr
      | Bool
otherwise      -> PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`unsafePlay` (k -> p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(k -> p -> p -> p) -> k -> p -> PSQ k p -> PSQ k p
insertWithKey k -> p -> p -> p
f k
k p
p PSQ 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 :: forall k p. (Ord k, Ord p) => k -> PSQ k p -> PSQ k p
delete k
k PSQ k p
q =
  case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
    TourView k p
Null -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p
empty
    Single k
k' p
p
      | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'   -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p
empty
      | Bool
otherwise -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' p
p
    PSQ k p
tl `Play` PSQ k p
tr
      | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= PSQ k p -> k
forall k p. PSQ k p -> k
maxKey PSQ k p
tl -> k -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> PSQ k p -> PSQ k p
delete k
k PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` PSQ k p
tr
      | Bool
otherwise      -> PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` k -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> PSQ k p -> PSQ k p
delete k
k PSQ k p
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 :: forall p k. (Ord p, Ord k) => (p -> p) -> k -> PSQ k p -> PSQ k p
adjust p -> p
f = (k -> p -> p) -> k -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(k -> p -> p) -> k -> PSQ k p -> PSQ k p
adjustWithKey (\k
_ p
p -> p -> p
f p
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 :: forall k p.
(Ord k, Ord p) =>
(k -> p -> p) -> k -> PSQ k p -> PSQ k p
adjustWithKey k -> p -> p
f k
k PSQ k p
q =
  case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
    TourView k p
Null -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p
empty
    Single k
k' p
p
      | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'   -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' (k -> p -> p
f k
k p
p)
      | Bool
otherwise -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' p
p
    PSQ k p
tl `Play` PSQ k p
tr
      | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= PSQ k p -> k
forall k p. PSQ k p -> k
maxKey PSQ k p
tl -> (k -> p -> p) -> k -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(k -> p -> p) -> k -> PSQ k p -> PSQ k p
adjustWithKey k -> p -> p
f k
k PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`unsafePlay` PSQ k p
tr
      | Bool
otherwise      -> PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`unsafePlay` (k -> p -> p) -> k -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(k -> p -> p) -> k -> PSQ k p -> PSQ k p
adjustWithKey k -> p -> p
f k
k PSQ k p
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 :: forall k p.
(Ord k, Ord p) =>
(p -> Maybe p) -> k -> PSQ k p -> PSQ k p
update p -> Maybe p
f = (k -> p -> Maybe p) -> k -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(k -> p -> Maybe p) -> k -> PSQ k p -> PSQ k p
updateWithKey (\k
_ p
p -> p -> Maybe p
f p
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 :: forall k p.
(Ord k, Ord p) =>
(k -> p -> Maybe p) -> k -> PSQ k p -> PSQ k p
updateWithKey k -> p -> Maybe p
f k
k PSQ k p
q =
  case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
    TourView k p
Null -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p
empty
    Single k
k' p
p
      | k
kk -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k' -> case k -> p -> Maybe p
f k
k p
p of
                  Maybe p
Nothing -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p
empty
                  Just p
p' -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k p
p'
      | Bool
otherwise -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' p
p
    PSQ k p
tl `Play` PSQ k p
tr
      | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= PSQ k p -> k
forall k p. PSQ k p -> k
maxKey PSQ k p
tl -> (k -> p -> Maybe p) -> k -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(k -> p -> Maybe p) -> k -> PSQ k p -> PSQ k p
updateWithKey k -> p -> Maybe p
f k
k PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`unsafePlay` PSQ k p
tr
      | Bool
otherwise      -> PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`unsafePlay` (k -> p -> Maybe p) -> k -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(k -> p -> Maybe p) -> k -> PSQ k p -> PSQ k p
updateWithKey k -> p -> Maybe p
f k
k PSQ k p
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 :: forall k p.
(Ord k, Ord p) =>
(Maybe p -> Maybe p) -> k -> PSQ k p -> PSQ k p
alter Maybe p -> Maybe p
f k
k PSQ k p
q =
  case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
    TourView k p
Null ->
      case Maybe p -> Maybe p
f Maybe p
forall a. Maybe a
Nothing of
        Maybe p
Nothing -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p
empty
        Just p
p  -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k p
p
    Single k
k' p
p
      | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'   ->  case Maybe p -> Maybe p
f (p -> Maybe p
forall a. a -> Maybe a
Just p
p) of
                        Maybe p
Nothing -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p
empty
                        Just p
p' -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' p
p'
      | Bool
otherwise ->  case Maybe p -> Maybe p
f Maybe p
forall a. Maybe a
Nothing of
                        Maybe p
Nothing -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' p
p
                        Just p
p' -> k -> p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p -> PSQ k p
insert k
k p
p' (PSQ k p -> PSQ k p) -> PSQ k p -> PSQ k p
forall a b. (a -> b) -> a -> b
$ k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k' p
p
    PSQ k p
tl `Play` PSQ k p
tr
      | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= PSQ k p -> k
forall k p. PSQ k p -> k
maxKey PSQ k p
tl -> (Maybe p -> Maybe p) -> k -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(Maybe p -> Maybe p) -> k -> PSQ k p -> PSQ k p
alter Maybe p -> Maybe p
f k
k PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`unsafePlay` PSQ k p
tr
      | Bool
otherwise      -> PSQ k p
tl PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`unsafePlay` (Maybe p -> Maybe p) -> k -> PSQ k p -> PSQ k p
forall k p.
(Ord k, Ord p) =>
(Maybe p -> Maybe p) -> k -> PSQ k p -> PSQ k p
alter Maybe p -> Maybe p
f k
k PSQ k p
tr



-- | /O(n)/ The keys of a priority queue
keys :: (Ord k, Ord p) => PSQ k p -> [k]
keys :: forall k p. (Ord k, Ord p) => PSQ k p -> [k]
keys = (Binding k p -> k) -> [Binding k p] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map Binding k p -> k
forall k p. Binding k p -> k
key ([Binding k p] -> [k])
-> (PSQ k p -> [Binding k p]) -> PSQ k p -> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSQ k p -> [Binding k p]
forall k p. (Ord k, Ord p) => PSQ k p -> [Binding k p]
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 :: forall k p. (Ord k, Ord p) => [Binding k p] -> PSQ k p
fromList = (Binding k p -> PSQ k p -> PSQ k p)
-> PSQ k p -> [Binding k p] -> PSQ k p
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
P.foldr (\(k
k:->p
p) PSQ k p
q -> k -> p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p -> PSQ k p
insert k
k p
p PSQ k p
q) PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p
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 :: forall k p. (Ord k, Ord p) => [Binding k p] -> PSQ k p
fromAscList = [Binding k p] -> PSQ k p
forall k p. (Ord k, Ord p) => [Binding k p] -> PSQ k p
fromDistinctAscList ([Binding k p] -> PSQ k p)
-> ([Binding k p] -> [Binding k p]) -> [Binding k p] -> PSQ k p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Binding k p] -> [Binding k p]
forall {a}. Eq a => [a] -> [a]
stripEq
  where stripEq :: [a] -> [a]
stripEq []     = []
        stripEq (a
x:[a]
xs) = a -> [a] -> [a]
forall {t}. Eq t => t -> [t] -> [t]
stripEq' a
x [a]
xs
        stripEq' :: t -> [t] -> [t]
stripEq' t
x' []     = [t
x']
        stripEq' t
x' (t
x:[t]
xs)
          | t
x' t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
x   = t -> [t] -> [t]
stripEq' t
x' [t]
xs
          | Bool
otherwise = t
x' t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t] -> [t]
stripEq' t
x [t]
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 :: forall k p. (Ord k, Ord p) => [Binding k p] -> PSQ k p
fromDistinctAscList = (PSQ k p -> PSQ k p -> PSQ k p) -> PSQ k p -> [PSQ k p] -> PSQ k p
forall a. (a -> a -> a) -> a -> [a] -> a
foldm PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
unsafePlay PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p
empty ([PSQ k p] -> PSQ k p)
-> ([Binding k p] -> [PSQ k p]) -> [Binding k p] -> PSQ k p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binding k p -> PSQ k p) -> [Binding k p] -> [PSQ k p]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
k:->p
p) -> k -> p -> PSQ k p
forall k p. (Ord k, Ord p) => k -> p -> PSQ k p
singleton k
k p
p)

-- Folding a list in a binary-subdivision scheme.
foldm :: (a -> a -> a) -> a -> [a] -> a
foldm :: forall a. (a -> a -> a) -> a -> [a] -> a
foldm a -> a -> a
(*) a
e [a]
x
  | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null  [a]
x             = a
e
  | Bool
otherwise             = (a, [a]) -> a
forall a b. (a, b) -> a
fst (Int -> [a] -> (a, [a])
forall {a}. Integral a => a -> [a] -> (a, [a])
rec ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x) [a]
x)
  where rec :: a -> [a] -> (a, [a])
rec a
1 (a
a : [a]
as)    = (a
a, [a]
as)
        rec a
n [a]
as          = (a
a1 a -> a -> a
* a
a2, [a]
as2)
          where m :: a
m         = a
n a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2
                (a
a1, [a]
as1) = a -> [a] -> (a, [a])
rec (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
m) [a]
as
                (a
a2, [a]
as2) = a -> [a] -> (a, [a])
rec a
m       [a]
as1

-- | /O(n)/ Convert a queue to a list.
toList :: (Ord k, Ord p) => PSQ k p -> [Binding k p]
toList :: forall k p. (Ord k, Ord p) => PSQ k p -> [Binding k p]
toList = PSQ k p -> [Binding k p]
forall k p. (Ord k, Ord p) => PSQ k p -> [Binding k p]
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 :: forall k p. (Ord k, Ord p) => PSQ k p -> [Binding k p]
toAscList PSQ k p
q  = Sequ (Binding k p) -> [Binding k p]
forall a. Sequ a -> [a]
seqToList (PSQ k p -> Sequ (Binding k p)
forall k p. (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
toAscLists PSQ k p
q)

toAscLists :: (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
toAscLists :: forall k p. (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
toAscLists PSQ k p
q = case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
  TourView k p
Null         -> Sequ (Binding k p)
forall a. Sequ a
emptySequ
  Single k
k p
p   -> Binding k p -> Sequ (Binding k p)
forall a. a -> Sequ a
singleSequ (k
k k -> p -> Binding k p
forall k p. k -> p -> Binding k p
:-> p
p)
  PSQ k p
tl `Play` PSQ k p
tr -> PSQ k p -> Sequ (Binding k p)
forall k p. (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
toAscLists PSQ k p
tl Sequ (Binding k p) -> Sequ (Binding k p) -> Sequ (Binding k p)
forall a. Sequ a -> Sequ a -> Sequ a
<+> PSQ k p -> Sequ (Binding k p)
forall k p. (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
toAscLists PSQ k p
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 :: forall k p. (Ord k, Ord p) => PSQ k p -> [Binding k p]
toDescList PSQ k p
q = Sequ (Binding k p) -> [Binding k p]
forall a. Sequ a -> [a]
seqToList (PSQ k p -> Sequ (Binding k p)
forall k p. (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
toDescLists PSQ k p
q)

toDescLists :: (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
toDescLists :: forall k p. (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
toDescLists PSQ k p
q = case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
  TourView k p
Null         -> Sequ (Binding k p)
forall a. Sequ a
emptySequ
  Single k
k p
p   -> Binding k p -> Sequ (Binding k p)
forall a. a -> Sequ a
singleSequ (k
k k -> p -> Binding k p
forall k p. k -> p -> Binding k p
:-> p
p)
  PSQ k p
tl `Play` PSQ k p
tr -> PSQ k p -> Sequ (Binding k p)
forall k p. (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
toDescLists PSQ k p
tr Sequ (Binding k p) -> Sequ (Binding k p) -> Sequ (Binding k p)
forall a. Sequ a -> Sequ a -> Sequ a
<+> PSQ k p -> Sequ (Binding k p)
forall k p. (Ord k, Ord p) => PSQ k p -> Sequ (Binding k p)
toDescLists PSQ k p
tl


-- | /O(1)/ The binding with the lowest priority.
findMin :: (Ord k, Ord p) => PSQ k p -> Maybe (Binding k p)
findMin :: forall k p. (Ord k, Ord p) => PSQ k p -> Maybe (Binding k p)
findMin PSQ k p
Void             = Maybe (Binding k p)
forall a. Maybe a
Nothing
findMin (Winner k
k p
p LTree k p
t k
m) = Binding k p -> Maybe (Binding k p)
forall a. a -> Maybe a
Just (k
k k -> p -> Binding k p
forall k p. k -> p -> Binding k p
:-> p
p)

-- | /O(log n)/ Remove the binding with the lowest priority.
deleteMin :: (Ord k, Ord p) => PSQ k p -> PSQ k p
deleteMin :: forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p
deleteMin PSQ k p
Void             = PSQ k p
forall k p. PSQ k p
Void
deleteMin (Winner k
k p
p LTree k p
t k
m) = LTree k p -> k -> PSQ k p
forall k p. (Ord k, Ord p) => LTree k p -> k -> PSQ k p
secondBest LTree k p
t k
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 :: forall k p.
(Ord k, Ord p) =>
PSQ k p -> Maybe (Binding k p, PSQ k p)
minView PSQ k p
Void             = Maybe (Binding k p, PSQ k p)
forall a. Maybe a
Nothing
minView (Winner k
k p
p LTree k p
t k
m) = (Binding k p, PSQ k p) -> Maybe (Binding k p, PSQ k p)
forall a. a -> Maybe a
Just ( k
k k -> p -> Binding k p
forall k p. k -> p -> Binding k p
:-> p
p , LTree k p -> k -> PSQ k p
forall k p. (Ord k, Ord p) => LTree k p -> k -> PSQ k p
secondBest LTree k p
t k
m )

secondBest :: (Ord k, Ord p) => LTree k p -> k -> PSQ k p
secondBest :: forall k p. (Ord k, Ord p) => LTree k p -> k -> PSQ k p
secondBest LTree k p
Start k
_m                  = PSQ k p
forall k p. PSQ k p
Void
secondBest (LLoser Int
_ k
k p
p LTree k p
tl k
m LTree k p
tr) k
m' = k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k p
p LTree k p
tl k
m PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` LTree k p -> k -> PSQ k p
forall k p. (Ord k, Ord p) => LTree k p -> k -> PSQ k p
secondBest LTree k p
tr k
m'
secondBest (RLoser Int
_ k
k p
p LTree k p
tl k
m LTree k p
tr) k
m' = LTree k p -> k -> PSQ k p
forall k p. (Ord k, Ord p) => LTree k p -> k -> PSQ k p
secondBest LTree k p
tl k
m PSQ k p -> PSQ k p -> PSQ k p
forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k p
p LTree k p
tr k
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 :: forall k p. (Ord k, Ord p) => p -> PSQ k p -> [Binding k p]
atMost p
pt PSQ k p
q = Sequ (Binding k p) -> [Binding k p]
forall a. Sequ a -> [a]
seqToList (p -> PSQ k p -> Sequ (Binding k p)
forall k p. (Ord k, Ord p) => p -> PSQ k p -> Sequ (Binding k p)
atMosts p
pt PSQ k p
q)

atMosts :: (Ord k, Ord p) => p -> PSQ k p -> Sequ (Binding k p)
atMosts :: forall k p. (Ord k, Ord p) => p -> PSQ k p -> Sequ (Binding k p)
atMosts p
_pt PSQ k p
Void  = Sequ (Binding k p)
forall a. Sequ a
emptySequ
atMosts p
pt (Winner k
k p
p LTree k p
t k
_) =  k -> p -> LTree k p -> Sequ (Binding k p)
forall {k}. k -> p -> LTree k p -> Sequ (Binding k p)
prune k
k p
p LTree k p
t
  where
  prune :: k -> p -> LTree k p -> Sequ (Binding k p)
prune k
k p
p LTree k p
t
    | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
pt         = Sequ (Binding k p)
forall a. Sequ a
emptySequ
    | Bool
otherwise      = k -> p -> LTree k p -> Sequ (Binding k p)
traverse k
k p
p LTree k p
t
  traverse :: k -> p -> LTree k p -> Sequ (Binding k p)
traverse k
k p
p LTree k p
Start                     = Binding k p -> Sequ (Binding k p)
forall a. a -> Sequ a
singleSequ (k
k k -> p -> Binding k p
forall k p. k -> p -> Binding k p
:-> p
p)
  traverse k
k p
p (LLoser Int
_ k
k' p
p' LTree k p
tl k
_m LTree k p
tr) = k -> p -> LTree k p -> Sequ (Binding k p)
prune k
k' p
p' LTree k p
tl Sequ (Binding k p) -> Sequ (Binding k p) -> Sequ (Binding k p)
forall a. Sequ a -> Sequ a -> Sequ a
<+> k -> p -> LTree k p -> Sequ (Binding k p)
traverse k
k p
p LTree k p
tr
  traverse k
k p
p (RLoser Int
_ k
k' p
p' LTree k p
tl k
_m LTree k p
tr) = k -> p -> LTree k p -> Sequ (Binding k p)
traverse k
k p
p LTree k p
tl Sequ (Binding k p) -> Sequ (Binding k p) -> Sequ (Binding k p)
forall a. Sequ a -> Sequ a -> Sequ a
<+> k -> p -> LTree k p -> Sequ (Binding k p)
prune k
k' p
p' LTree 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 :: forall k p.
(Ord k, Ord p) =>
p -> (k, k) -> PSQ k p -> [Binding k p]
atMostRange p
pt (k
kl, k
kr) PSQ k p
q = Sequ (Binding k p) -> [Binding k p]
forall a. Sequ a -> [a]
seqToList (p -> (k, k) -> PSQ k p -> Sequ (Binding k p)
forall k p.
(Ord k, Ord p) =>
p -> (k, k) -> PSQ k p -> Sequ (Binding k p)
atMostRanges p
pt (k
kl, k
kr) PSQ k p
q)

atMostRanges :: (Ord k, Ord p) => p -> (k, k) -> PSQ k p -> Sequ (Binding k p)

atMostRanges :: forall k p.
(Ord k, Ord p) =>
p -> (k, k) -> PSQ k p -> Sequ (Binding k p)
atMostRanges p
_pt (k, k)
_range PSQ k p
Void = Sequ (Binding k p)
forall a. Sequ a
emptySequ
atMostRanges p
pt range :: (k, k)
range@(k
kl, k
kr) (Winner k
k p
p LTree k p
t k
_) = k -> p -> LTree k p -> Sequ (Binding k p)
prune k
k p
p LTree k p
t
  where
  prune :: k -> p -> LTree k p -> Sequ (Binding k p)
prune k
k p
p LTree k p
t
    | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
pt    = Sequ (Binding k p)
forall a. Sequ a
emptySequ
    | Bool
otherwise = k -> p -> LTree k p -> Sequ (Binding k p)
traverse k
k p
p LTree k p
t
  traverse :: k -> p -> LTree k p -> Sequ (Binding k p)
traverse k
k p
p LTree k p
Start
    | k
k k -> (k, k) -> Bool
forall a. Ord a => a -> (a, a) -> Bool
`inrange` (k, k)
range = Binding k p -> Sequ (Binding k p)
forall a. a -> Sequ a
singleSequ (k
k k -> p -> Binding k p
forall k p. k -> p -> Binding k p
:-> p
p)
    | Bool
otherwise         = Sequ (Binding k p)
forall a. Sequ a
emptySequ
  traverse k
k p
p (LLoser Int
_ k
k' p
p' LTree k p
tl k
m LTree k p
tr) =
    Bool -> Sequ (Binding k p) -> Sequ (Binding k p)
forall a. Bool -> Sequ a -> Sequ a
guard (k
kl k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
m) (k -> p -> LTree k p -> Sequ (Binding k p)
prune k
k' p
p' LTree k p
tl) Sequ (Binding k p) -> Sequ (Binding k p) -> Sequ (Binding k p)
forall a. Sequ a -> Sequ a -> Sequ a
<+> Bool -> Sequ (Binding k p) -> Sequ (Binding k p)
forall a. Bool -> Sequ a -> Sequ a
guard (k
m k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
kr) (k -> p -> LTree k p -> Sequ (Binding k p)
traverse k
k p
p LTree k p
tr)
  traverse k
k p
p (RLoser Int
_ k
k' p
p' LTree k p
tl k
m LTree k p
tr) =
    Bool -> Sequ (Binding k p) -> Sequ (Binding k p)
forall a. Bool -> Sequ a -> Sequ a
guard (k
kl k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
m) (k -> p -> LTree k p -> Sequ (Binding k p)
traverse k
k p
p LTree k p
tl) Sequ (Binding k p) -> Sequ (Binding k p) -> Sequ (Binding k p)
forall a. Sequ a -> Sequ a -> Sequ a
<+> Bool -> Sequ (Binding k p) -> Sequ (Binding k p)
forall a. Bool -> Sequ a -> Sequ a
guard (k
m k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
kr) (k -> p -> LTree k p -> Sequ (Binding k p)
prune k
k' p
p' LTree k p
tr)

inrange :: (Ord a) => a -> (a, a) -> Bool
a
a inrange :: forall a. Ord a => a -> (a, a) -> Bool
`inrange` (a
l, a
r)  =  a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
a Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 :: forall k p b.
(Ord k, Ord p) =>
(Binding k p -> b -> b) -> b -> PSQ k p -> b
foldr Binding k p -> b -> b
f b
z PSQ k p
q =
  case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
    TourView k p
Null       -> b
z
    Single k
k p
p -> Binding k p -> b -> b
f (k
kk -> p -> Binding k p
forall k p. k -> p -> Binding k p
:->p
p) b
z
    PSQ k p
l`Play`PSQ k p
r   -> (Binding k p -> b -> b) -> b -> PSQ k p -> b
forall k p b.
(Ord k, Ord p) =>
(Binding k p -> b -> b) -> b -> PSQ k p -> b
foldr Binding k p -> b -> b
f ((Binding k p -> b -> b) -> b -> PSQ k p -> b
forall k p b.
(Ord k, Ord p) =>
(Binding k p -> b -> b) -> b -> PSQ k p -> b
foldr Binding k p -> b -> b
f b
z PSQ k p
r) PSQ k p
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 :: forall k p b.
(Ord k, Ord p) =>
(b -> Binding k p -> b) -> b -> PSQ k p -> b
foldl b -> Binding k p -> b
f b
z PSQ k p
q =
  case PSQ k p -> TourView k p
forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
q of
    TourView k p
Null       -> b
z
    Single k
k p
p -> b -> Binding k p -> b
f b
z (k
kk -> p -> Binding k p
forall k p. k -> p -> Binding k p
:->p
p)
    PSQ k p
l`Play`PSQ k p
r   -> (b -> Binding k p -> b) -> b -> PSQ k p -> b
forall k p b.
(Ord k, Ord p) =>
(b -> Binding k p -> b) -> b -> PSQ k p -> b
foldl b -> Binding k p -> b
f ((b -> Binding k p -> b) -> b -> PSQ k p -> b
forall k p b.
(Ord k, Ord p) =>
(b -> Binding k p -> b) -> b -> PSQ k p -> b
foldl b -> Binding k p -> b
f b
z PSQ k p
l) PSQ k p
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)


size' :: LTree k p -> Size
size' :: forall k p. LTree k p -> Int
size' LTree k p
Start                = Int
0
size' (LLoser Int
s k
_ p
_ LTree k p
_ k
_ LTree k p
_) = Int
s
size' (RLoser Int
s k
_ p
_ LTree k p
_ k
_ LTree k p
_) = Int
s

left, right :: LTree a b -> LTree a b

left :: forall a b. LTree a b -> LTree a b
left  LTree a b
Start                  =  String -> LTree a b
forall a. HasCallStack => String -> a
error String
"left: empty loser tree"
left  (LLoser Int
_ a
_ b
_ LTree a b
tl a
_ LTree a b
_ ) =  LTree a b
tl
left  (RLoser Int
_ a
_ b
_ LTree a b
tl a
_ LTree a b
_ ) =  LTree a b
tl

right :: forall a b. LTree a b -> LTree a b
right LTree a b
Start                  =  String -> LTree a b
forall a. HasCallStack => String -> a
error String
"right: empty loser tree"
right (LLoser Int
_ a
_ b
_ LTree a b
_  a
_ LTree a b
tr) =  LTree a b
tr
right (RLoser Int
_ a
_ b
_ LTree a b
_  a
_ LTree a b
tr) =  LTree a b
tr

maxKey :: PSQ k p -> k
maxKey :: forall k p. PSQ k p -> k
maxKey PSQ k p
Void                =  String -> k
forall a. HasCallStack => String -> a
error String
"maxKey: empty queue"
maxKey (Winner k
_k p
_p LTree k p
_t k
m) =  k
m

lloser, rloser :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser :: forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k p
p LTree k p
tl k
m LTree k p
tr =  Int -> k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p.
Int -> k -> p -> LTree k p -> k -> LTree k p -> LTree k p
LLoser (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
tl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
tr) k
k p
p LTree k p
tl k
m LTree k p
tr
rloser :: forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k p
p LTree k p
tl k
m LTree k p
tr =  Int -> k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p.
Int -> k -> p -> LTree k p -> k -> LTree k p -> LTree k p
RLoser (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
tl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
tr) k
k p
p LTree k p
tl k
m LTree k p
tr

--balance factor
omega :: Int
omega :: Int
omega = Int
4

lbalance, rbalance ::
  (Ord k, Ord p) => k-> p -> LTree k p -> k -> LTree k p -> LTree k p

lbalance :: forall k p.
(Ord k, Ord p) =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lbalance k
k p
p LTree k p
l k
m LTree k p
r
  | LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2     = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser        k
k p
p LTree k p
l k
m LTree k p
r
  | LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
omega Int -> Int -> Int
forall a. Num a => a -> a -> a
* LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
l = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lbalanceLeft  k
k p
p LTree k p
l k
m LTree k p
r
  | LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
omega Int -> Int -> Int
forall a. Num a => a -> a -> a
* LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
r = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lbalanceRight k
k p
p LTree k p
l k
m LTree k p
r
  | Bool
otherwise               = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser        k
k p
p LTree k p
l k
m LTree k p
r

rbalance :: forall k p.
(Ord k, Ord p) =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rbalance k
k p
p LTree k p
l k
m LTree k p
r
  | LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2     = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser        k
k p
p LTree k p
l k
m LTree k p
r
  | LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
omega Int -> Int -> Int
forall a. Num a => a -> a -> a
* LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
l = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rbalanceLeft  k
k p
p LTree k p
l k
m LTree k p
r
  | LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
omega Int -> Int -> Int
forall a. Num a => a -> a -> a
* LTree k p -> Int
forall k p. LTree k p -> Int
size' LTree k p
r = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rbalanceRight k
k p
p LTree k p
l k
m LTree k p
r
  | Bool
otherwise               = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser        k
k p
p LTree k p
l k
m LTree k p
r

lbalanceLeft :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lbalanceLeft  k
k p
p LTree k p
l k
m LTree k p
r
  | LTree k p -> Int
forall k p. LTree k p -> Int
size' (LTree k p -> LTree k p
forall a b. LTree a b -> LTree a b
left LTree k p
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< LTree k p -> Int
forall k p. LTree k p -> Int
size' (LTree k p -> LTree k p
forall a b. LTree a b -> LTree a b
right LTree k p
r) = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleLeft  k
k p
p LTree k p
l k
m LTree k p
r
  | Bool
otherwise                      = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
ldoubleLeft  k
k p
p LTree k p
l k
m LTree k p
r

lbalanceRight :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lbalanceRight k
k p
p LTree k p
l k
m LTree k p
r
  | LTree k p -> Int
forall k p. LTree k p -> Int
size' (LTree k p -> LTree k p
forall a b. LTree a b -> LTree a b
left LTree k p
l) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LTree k p -> Int
forall k p. LTree k p -> Int
size' (LTree k p -> LTree k p
forall a b. LTree a b -> LTree a b
right LTree k p
l) = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleRight k
k p
p LTree k p
l k
m LTree k p
r
  | Bool
otherwise                      = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
ldoubleRight k
k p
p LTree k p
l k
m LTree k p
r


rbalanceLeft :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rbalanceLeft  k
k p
p LTree k p
l k
m LTree k p
r
  | LTree k p -> Int
forall k p. LTree k p -> Int
size' (LTree k p -> LTree k p
forall a b. LTree a b -> LTree a b
left LTree k p
r) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< LTree k p -> Int
forall k p. LTree k p -> Int
size' (LTree k p -> LTree k p
forall a b. LTree a b -> LTree a b
right LTree k p
r) = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleLeft  k
k p
p LTree k p
l k
m LTree k p
r
  | Bool
otherwise                      = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rdoubleLeft  k
k p
p LTree k p
l k
m LTree k p
r

rbalanceRight :: k -> a -> LTree k a -> k -> LTree k a -> LTree k a
rbalanceRight k
k a
p LTree k a
l k
m LTree k a
r
  | LTree k a -> Int
forall k p. LTree k p -> Int
size' (LTree k a -> LTree k a
forall a b. LTree a b -> LTree a b
left LTree k a
l) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LTree k a -> Int
forall k p. LTree k p -> Int
size' (LTree k a -> LTree k a
forall a b. LTree a b -> LTree a b
right LTree k a
l) = k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleRight k
k a
p LTree k a
l k
m LTree k a
r
  | Bool
otherwise                      = k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rdoubleRight k
k a
p LTree k a
l k
m LTree k a
r




lsingleLeft :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleLeft k
k1 p
p1 LTree k p
t1 k
m1 (LLoser Int
_ k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3)
  | p
p1 p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
p2  = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k1 p
p1 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k2 p
p2 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3
  | Bool
otherwise = k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k2 p
p2 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k1 p
p1 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3

lsingleLeft k
k1 p
p1 LTree k p
t1 k
m1 (RLoser Int
_ k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3) =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k2 p
p2 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k1 p
p1 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3

rsingleLeft :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleLeft k
k1 p
p1 LTree k p
t1 k
m1 (LLoser Int
_ k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3) =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k1 p
p1 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k2 p
p2 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3

rsingleLeft k
k1 p
p1 LTree k p
t1 k
m1 (RLoser Int
_ k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3) =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k2 p
p2 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k1 p
p1 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3

lsingleRight :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleRight k
k1 p
p1 (LLoser Int
_ k
k2 p
p2 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3 =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k2 p
p2 LTree k p
t1 k
m1 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k1 p
p1 LTree k p
t2 k
m2 LTree k p
t3)

lsingleRight k
k1 p
p1 (RLoser Int
_ k
k2 p
p2 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3 =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k1 p
p1 LTree k p
t1 k
m1 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3)

rsingleRight :: k -> a -> LTree k a -> k -> LTree k a -> LTree k a
rsingleRight k
k1 a
p1 (LLoser Int
_ k
k2 a
p2 LTree k a
t1 k
m1 LTree k a
t2) k
m2 LTree k a
t3 =
  k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k2 a
p2 LTree k a
t1 k
m1 (k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k1 a
p1 LTree k a
t2 k
m2 LTree k a
t3)

rsingleRight k
k1 a
p1 (RLoser Int
_ k
k2 a
p2 LTree k a
t1 k
m1 LTree k a
t2) k
m2 LTree k a
t3
  | a
p1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
p2  = k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k1 a
p1 LTree k a
t1 k
m1 (k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lloser k
k2 a
p2 LTree k a
t2 k
m2 LTree k a
t3)
  | Bool
otherwise = k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k2 a
p2 LTree k a
t1 k
m1 (k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rloser k
k1 a
p1 LTree k a
t2 k
m2 LTree k a
t3)



ldoubleLeft :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
ldoubleLeft k
k1 p
p1 LTree k p
t1 k
m1 (LLoser Int
_ k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3) =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleLeft k
k1 p
p1 LTree k p
t1 k
m1 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleRight k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3)

ldoubleLeft k
k1 p
p1 LTree k p
t1 k
m1 (RLoser Int
_ k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3) =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleLeft k
k1 p
p1 LTree k p
t1 k
m1 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleRight k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3)

ldoubleRight :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
ldoubleRight k
k1 p
p1 (LLoser Int
_ k
k2 p
p2 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3 =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleRight k
k1 p
p1 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleLeft k
k2 p
p2 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3

ldoubleRight k
k1 p
p1 (RLoser Int
_ k
k2 p
p2 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3 =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleRight k
k1 p
p1 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleLeft k
k2 p
p2 LTree k p
t1 k
m1 LTree k p
t2) k
m2 LTree k p
t3

rdoubleLeft :: k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rdoubleLeft k
k1 p
p1 LTree k p
t1 k
m1 (LLoser Int
_ k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3) =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleLeft k
k1 p
p1 LTree k p
t1 k
m1 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleRight k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3)

rdoubleLeft k
k1 p
p1 LTree k p
t1 k
m1 (RLoser Int
_ k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3) =
  k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleLeft k
k1 p
p1 LTree k p
t1 k
m1 (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleRight k
k2 p
p2 LTree k p
t2 k
m2 LTree k p
t3)

rdoubleRight :: k -> a -> LTree k a -> k -> LTree k a -> LTree k a
rdoubleRight k
k1 a
p1 (LLoser Int
_ k
k2 a
p2 LTree k a
t1 k
m1 LTree k a
t2) k
m2 LTree k a
t3 =
  k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleRight k
k1 a
p1 (k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lsingleLeft k
k2 a
p2 LTree k a
t1 k
m1 LTree k a
t2) k
m2 LTree k a
t3

rdoubleRight k
k1 a
p1 (RLoser Int
_ k
k2 a
p2 LTree k a
t1 k
m1 LTree k a
t2) k
m2 LTree k a
t3 =
  k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall {p} {k}.
Ord p =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleRight k
k1 a
p1 (k -> a -> LTree k a -> k -> LTree k a -> LTree k a
forall k p. k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rsingleLeft k
k2 a
p2 LTree k a
t1 k
m1 LTree k a
t2) k
m2 LTree k a
t3


play :: (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p

PSQ k p
Void play :: forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`play` PSQ k p
t' = PSQ k p
t'
PSQ k p
t `play` PSQ k p
Void  = PSQ k p
t

Winner k
k p
p LTree k p
t k
m  `play`  Winner k
k' p
p' LTree k p
t' k
m'
  | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
p'   = k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k  p
p  (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p.
(Ord k, Ord p) =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rbalance k
k' p
p' LTree k p
t k
m LTree k p
t') k
m'
  | Bool
otherwise = k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k' p
p' (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p.
(Ord k, Ord p) =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lbalance k
k  p
p  LTree k p
t k
m LTree k p
t') k
m'

unsafePlay :: (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p

PSQ k p
Void unsafePlay :: forall k p. (Ord k, Ord p) => PSQ k p -> PSQ k p -> PSQ k p
`unsafePlay` PSQ k p
t' =  PSQ k p
t'
PSQ k p
t `unsafePlay` PSQ k p
Void  =  PSQ k p
t

Winner k
k p
p LTree k p
t k
m  `unsafePlay`  Winner k
k' p
p' LTree k p
t' k
m'
  | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
p'   = k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k  p
p  (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p.
(Ord k, Ord p) =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
rbalance k
k' p
p' LTree k p
t k
m LTree k p
t') k
m'
  | Bool
otherwise = k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k' p
p' (k -> p -> LTree k p -> k -> LTree k p -> LTree k p
forall k p.
(Ord k, Ord p) =>
k -> p -> LTree k p -> k -> LTree k p -> LTree k p
lbalance k
k  p
p  LTree k p
t k
m LTree k p
t') k
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 :: forall k p. Ord k => PSQ k p -> TourView k p
tourView PSQ k p
Void                  =  TourView k p
forall k p. TourView k p
Null
tourView (Winner k
k p
p LTree k p
Start k
_m) =  k -> p -> TourView k p
forall k p. k -> p -> TourView k p
Single k
k p
p

tourView (Winner k
k p
p (RLoser Int
_ k
k' p
p' LTree k p
tl k
m LTree k p
tr) k
m') =
  k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k  p
p  LTree k p
tl k
m PSQ k p -> PSQ k p -> TourView k p
forall k p. PSQ k p -> PSQ k p -> TourView k p
`Play` k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k' p
p' LTree k p
tr k
m'

tourView (Winner k
k p
p (LLoser Int
_ k
k' p
p' LTree k p
tl k
m LTree k p
tr) k
m') =
  k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k' p
p' LTree k p
tl k
m PSQ k p -> PSQ k p -> TourView k p
forall k p. PSQ k p -> PSQ k p -> TourView k p
`Play` k -> p -> LTree k p -> k -> PSQ k p
forall k p. k -> p -> LTree k p -> k -> PSQ k p
Winner k
k  p
p  LTree k p
tr k
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 :: forall a. Sequ a
emptySequ           = ([a] -> [a]) -> Sequ a
forall a. ([a] -> [a]) -> Sequ a
Sequ (\[a]
as -> [a]
as)
singleSequ :: forall a. a -> Sequ a
singleSequ a
a        = ([a] -> [a]) -> Sequ a
forall a. ([a] -> [a]) -> Sequ a
Sequ (\[a]
as -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)
Sequ [a] -> [a]
x1 <+> :: forall a. Sequ a -> Sequ a -> Sequ a
<+> Sequ [a] -> [a]
x2 = ([a] -> [a]) -> Sequ a
forall a. ([a] -> [a]) -> Sequ a
Sequ (\[a]
as -> [a] -> [a]
x1 ([a] -> [a]
x2 [a]
as))
seqFromList :: forall a. [a] -> Sequ a
seqFromList [a]
as      = ([a] -> [a]) -> Sequ a
forall a. ([a] -> [a]) -> Sequ a
Sequ (\[a]
as' -> [a]
as [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
as')
seqFromListT :: forall a. ([a] -> [a]) -> Sequ a
seqFromListT [a] -> [a]
as     = ([a] -> [a]) -> Sequ a
forall a. ([a] -> [a]) -> Sequ a
Sequ [a] -> [a]
as
seqToList :: forall a. Sequ a -> [a]
seqToList (Sequ [a] -> [a]
x)  = [a] -> [a]
x []

instance Show a => Show (Sequ a) where
    showsPrec :: Int -> Sequ a -> ShowS
showsPrec Int
d Sequ a
a = Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d (Sequ a -> [a]
forall a. Sequ a -> [a]
seqToList Sequ a
a)

guard :: Bool -> Sequ a -> Sequ a
guard :: forall a. Bool -> Sequ a -> Sequ a
guard Bool
False Sequ a
_as = Sequ a
forall a. Sequ a
emptySequ
guard Bool
True  Sequ a
as  = Sequ a
as