Implementation

Unbalanced priority search pennants.

>  data PSQ k p                  =  Void | Winner (Binding k p) (LTree k p) k

> 

>  data LTree k p                =  Start | Loser (Binding k p) (LTree k p) k (LTree k p)

> 

>  maxKey                        :: PSQ k p -> k

>  maxKey Void                   =  error "maxKey: empty queue"

>  maxKey (Winner _b _t m)       =  m

Playing a match.

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

>  Void `play` t'                =  t'

>  t `play` Void                 =  t

>  Winner b t m  `play`  Winner b' t' m'

>    | prio b <= prio b'         =  Winner b  (Loser b' t m t') m'

>    | otherwise                 =  Winner b' (Loser b  t m t') m'

Tournament view.

>  data TourView k p             =  Null | Single (Binding k p) | PSQ k p `Play` PSQ k p

> 

>  tourView                      :: (Ord k) => PSQ k p -> TourView k p

>  tourView Void                 =  Null

>  tourView (Winner b Start _m)  =  Single b

>  tourView (Winner b (Loser b' tl k tr) m)

>    | key b' <= k               =  Winner b' tl k `Play` Winner b  tr m

>    | otherwise                 =  Winner b  tl k `Play` Winner b' tr m

Constructors and insertion

>  empty                         =  Void

> 

>  single b                      =  Winner b Start (key b)

> 

>  insert b q                    =  case tourView q of

>    Null                        -> single b

>    Single b'

>      | key b <  key b'         -> single b  `play` single b'

>      | key b == key b'         -> single b

>      | otherwise               -> single b' `play` single b

>    tl `Play` tr

>      | key b <= maxKey tl      -> insert b tl `play` tr

>      | otherwise               -> tl `play` insert b tr

> 

>  fromOrdList                   =  foldm play empty `o` map single

Destructors and deletion

>  minView Void                  =  Empty

>  minView (Winner b t m)        =  Min b (secondBest t m)

> 

>  delete k q                    =  case tourView q of

>    Null                        -> empty

>    Single b

>      | k == key b              -> empty

>      | otherwise               -> single b

>    tl `Play` tr

>      | k <= maxKey tl          -> delete k tl `play` tr

>      | otherwise               -> tl `play` delete k tr

Determining the second-best player.

>  secondBest                    :: (Ord k, Ord p) => LTree k p -> k -> PSQ k p

>  secondBest Start _m           =  Void

>  secondBest (Loser b tl k tr) m

>    | key b <= k                =  Winner b tl k `play` secondBest tr m

>    | otherwise                 =  secondBest tl k `play` Winner b tr m

Observers

>  lookup k q                    =  case tourView q of

>    Null                        -> Nothing

>    Single b

>      | k == key b              -> Just (prio b)

>      | otherwise               -> Nothing

>    tl `Play` tr

>      | k <= maxKey tl          -> lookup k tl

>      | otherwise               -> lookup k tr

> 

>  toOrdList q                   =  case tourView q of

>    Null                        -> []

>    Single b                    -> [b]

>    tl `Play` tr                -> toOrdList tl ++ toOrdList tr

> 

>  atMost pt q                   =  case minView q of

>    Min b _

>      | prio b > pt             -> []

>    _                           -> case tourView q of

>      Null                      -> []

>      Single b                  -> [b]  -  we know that priob<=pt

>      tl `Play` tr              -> atMost pt tl ++ atMost pt tr

> 

>  atMostRange pt range@(kl, kr) q

>                                =  case minView q of

>    Min b _

>      | prio b > pt             -> []

>    _                           -> case tourView q of

>      Null                      -> []

>      Single b

>        | key b `inrange` range -> [b]  -  we know that priob<=pt

>        | otherwise             -> []

>      tl `Play` tr              -> guard (kl <= maxKey tl) (atMostRange pt range tl)

>                                ++ guard (maxKey tl <= kr) (atMostRange pt range tr)

Modifier

>  adjust f k q                  =  case tourView q of

>    Null                        -> empty

>    Single (k' :-> p)

>      | k == k'                 -> single (k' :-> f p)

>      | otherwise               -> single (k' :-> p)

>    tl `Play` tr

>      | k <= maxKey tl          -> adjust f k tl `play` tr

>      | otherwise               -> tl `play` adjust f k tr