module Data.Queue.Leftist
(Leftist(..)
,zygoLeftist)
where
import Data.Queue.Class
import Control.DeepSeq (NFData (rnf))
import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic, Generic1)
data Leftist a
= Leaf
| Node !Int
a
(Leftist a)
(Leftist a)
deriving (Functor,Foldable,Traversable,Data,Typeable,Generic,Generic1)
rank :: Leftist s -> Int
rank Leaf = 0
rank (Node r _ _ _) = r
instance Ord a => Queue Leftist a where
minView Leaf = Nothing
minView (Node _ x l r) = Just (x, merge l r)
singleton x = Node 1 x Leaf Leaf
empty = Leaf
insert = merge . singleton
instance Ord a =>
MeldableQueue Leftist a where
merge Leaf h2 = h2
merge h1 Leaf = h1
merge h1@(Node w1 p1 l1 r1) h2@(Node w2 p2 l2 r2)
| p1 < p2 =
if ll <= lr
then Node (w1 + w2) p1 l1 (merge r1 h2)
else Node (w1 + w2) p1 (merge r1 h2) l1
| otherwise =
if rl <= rr
then Node (w1 + w2) p2 l2 (merge r2 h1)
else Node (w1 + w2) p2 (merge r2 h1) l2
where
ll = rank r1 + w2
lr = rank l1
rl = rank r2 + w1
rr = rank l2
instance Ord a => Monoid (Leftist a) where
mempty = empty
mappend = merge
zygoLeftist
:: b1
-> (Int -> a -> b1 -> b1 -> b1)
-> b
-> (Int -> a -> b1 -> b -> b1 -> b -> b)
-> Leftist a
-> b
zygoLeftist b1 f1 b f = snd . go
where
go Leaf = (b1, b)
go (Node n x l r) =
let (lr1,lr) = go l
(rr1,rr) = go r
in (f1 n x lr1 rr1, f n x lr1 lr rr1 rr)
instance NFData a =>
NFData (Leftist a) where
rnf Leaf = ()
rnf (Node i x l r) = rnf i `seq` rnf x `seq` rnf l `seq` rnf r
instance Ord a => Eq (Leftist a) where
(==) = eqQueue
instance Ord a => Ord (Leftist a) where
compare = cmpQueue
instance (Show a, Ord a) => Show (Leftist a) where
showsPrec = showsPrecQueue
instance (Read a, Ord a) => Read (Leftist a) where
readsPrec = readPrecQueue