module Data.Heap.Leftist (
Leftist(..)
, Rank
, empty
, singleton
, insert
, fromList
, toList
, deleteMin
, null
, merge
, minimum
, valid
, heapSort
) where
import Control.Applicative hiding (empty)
import Data.List (foldl', unfoldr)
import Data.Maybe
import Prelude hiding (minimum, maximum, null)
data Leftist a = Leaf | Node Rank (Leftist a) a (Leftist a) deriving Show
instance (Eq a, Ord a) => Eq (Leftist a) where
h1 == h2 = heapSort h1 == heapSort h2
type Rank = Int
rank :: Leftist a -> Rank
rank Leaf = 0
rank (Node v _ _ _) = v
empty :: Leftist a
empty = Leaf
null :: Leftist t -> Bool
null Leaf = True
null (Node _ _ _ _) = False
singleton :: a -> Leftist a
singleton x = Node 1 Leaf x Leaf
insert :: Ord a => a -> Leftist a -> Leftist a
insert x t = merge (singleton x) t
fromList :: Ord a => [a] -> Leftist a
fromList = foldl' (flip insert) empty
toList :: Leftist a -> [a]
toList t = inorder t []
where
inorder Leaf xs = xs
inorder (Node _ l x r) xs = inorder l (x : inorder r xs)
minimum :: Leftist a -> Maybe a
minimum Leaf = Nothing
minimum (Node _ _ x _) = Just x
deleteMin :: Ord a => Leftist a -> Leftist a
deleteMin Leaf = Leaf
deleteMin (Node _ l _ r) = merge l r
deleteMin2 :: Ord a => Leftist a -> Maybe (a, Leftist a)
deleteMin2 Leaf = Nothing
deleteMin2 h = (\m -> (m, deleteMin h)) <$> minimum h
merge :: Ord a => Leftist a -> Leftist a -> Leftist a
merge t1 Leaf = t1
merge Leaf t2 = t2
merge t1@(Node _ l1 x1 r1) t2@(Node _ l2 x2 r2)
| x1 <= x2 = join l1 x1 (merge r1 t2)
| otherwise = join l2 x2 (merge t1 r2)
join :: Ord a => Leftist a -> a -> Leftist a -> Leftist a
join t1 x t2
| rank t1 >= rank t2 = Node (rank t2 + 1) t1 x t2
| otherwise = Node (rank t1 + 1) t2 x t1
valid :: Ord a => Leftist a -> Bool
valid t = isOrdered (heapSort t)
heapSort :: Ord a => Leftist a -> [a]
heapSort t = unfoldr deleteMin2 t
isOrdered :: Ord a => [a] -> Bool
isOrdered [] = True
isOrdered [_] = True
isOrdered (x:y:xys) = x <= y && isOrdered (y:xys)