okasaki

Okasaki's Purely Functional Data Structures
git clone git://git.jtobin.io/okasaki.git
Log | Files | Refs | LICENSE

WeightBiasedLeftistHeap.hs (1907B)

      1 {-# OPTIONS_GHC -Wall #-}
      2 
      3 -- todo 3.4d, size of any subtree should be O(1)
      4 
      5 module WeightBiasedLeftistHeap where
      6 
      7 import Control.Arrow
      8 
      9 -- exercise 3.4a (prove size is floor(log n + 1))
     10 -- rationale is exactly equivalent to standard leftist heap
     11 
     12 -- exercise 3.4b (rewrite leftist heap to use weight-biased property)
     13 data Heap a = Leaf | Node a (Heap a) (Heap a) deriving (Eq, Show)
     14 
     15 empty :: Heap a
     16 empty = Leaf
     17 
     18 isEmpty :: Heap a -> Bool
     19 isEmpty Leaf = True
     20 isEmpty _    = False
     21 
     22 size :: Heap a -> Int
     23 size Leaf         = 0
     24 size (Node _ l r) = 1 + size l + size r
     25 
     26 merge :: Ord a => Heap a -> Heap a -> Heap a
     27 merge h Leaf = h
     28 merge Leaf h = h
     29 merge h0@(Node e0 l0 r0) h1@(Node e1 l1 r1)
     30   | e0 <= e1  = create e0 l0 (merge r0 h1)
     31   | otherwise = create e1 l1 (merge h0 r1)
     32 
     33 create :: a -> Heap a -> Heap a -> Heap a
     34 create e l r
     35   | size l >= size r = Node e l r
     36   | otherwise        = Node e r l
     37 
     38 singleton :: Ord a => a -> Heap a
     39 singleton e = Node e Leaf Leaf
     40 
     41 insert :: Ord a => a -> Heap a -> Heap a
     42 insert e = merge (singleton e)
     43 
     44 findMin :: Heap a -> Maybe a
     45 findMin Leaf = Nothing
     46 findMin (Node e _ _) = return e
     47 
     48 deleteMin :: Ord a => Heap a -> Heap a
     49 deleteMin Leaf = Leaf
     50 deleteMin (Node _ l r) = merge l r
     51 
     52 fromList :: Ord a => [a] -> Heap a
     53 fromList = foldr insert empty
     54 
     55 -- exercise 3.4c (make merge operate in a single top-down pass)
     56 altMerge :: Ord a => Heap a -> Heap a -> Heap a
     57 altMerge h Leaf = h
     58 altMerge Leaf h = h
     59 altMerge h0@(Node e0 l0 r0) h1@(Node e1 l1 r1) = Node e l r where
     60   (e, branches@(l2, r2), h)
     61     | e0 < e1   = (e0, (l0, r0), h1)
     62     | otherwise = (e1, (l1, r1), h0)
     63 
     64   (l, r)
     65     | size l2 <= size r2 + size h = first  (`altMerge` h) branches
     66     | otherwise                   = second (`altMerge` h) branches
     67 
     68 -- exercise 3.4d (advantages of altMerge)
     69 -- - lazy environment (no buildup of thunks?)
     70 -- - concurrent environment (more opportunity for concurrency?)
     71