You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
59 lines
1.5 KiB
Haskell
59 lines
1.5 KiB
Haskell
2 years ago
|
module Heap where
|
||
|
|
|
||
|
|
data Heap a = Nil | Node Int a (Heap a) (Heap a) deriving Show
|
||
|
|
|
||
|
|
emptyHeap :: Heap a
|
||
|
|
emptyHeap = Nil
|
||
|
|
|
||
|
|
isEmpty :: Heap a -> Bool
|
||
|
|
isEmpty Nil = True
|
||
|
|
isEmpty _ = False
|
||
|
|
|
||
|
|
size Nil = 0
|
||
|
|
size (Node s _ _ _) = s
|
||
|
|
|
||
|
|
root (Node _ x _ _) = x
|
||
|
|
|
||
|
|
isHeap (Node s x hl hr) = s == 1 + sl + sr && sl >= sr &&
|
||
|
|
(isEmpty hl || x >= root hl) &&
|
||
|
|
(isEmpty hr || x >= root hr) &&
|
||
|
|
isHeap hl && isHeap hr
|
||
|
|
where (sl, sr) = (size hl, size hr)
|
||
|
|
|
||
|
|
realign :: Heap a -> Heap a
|
||
|
|
realign Nil = Nil
|
||
|
|
realign h@(Node s x hl hr)
|
||
|
|
| size hl >= size hr = h
|
||
|
|
| otherwise = Node s x hr hl
|
||
|
|
|
||
|
|
union :: Ord a => Heap a -> Heap a -> Heap a
|
||
|
|
union h Nil = h
|
||
|
|
union Nil h = h
|
||
|
|
union h1@(Node s1 x h1l h1r) h2@(Node s2 y h2l h2r)
|
||
|
|
| x >= y = realign
|
||
|
|
(Node (s1+s2) x h1l (union h1r h2))
|
||
|
|
| otherwise = realign
|
||
|
|
(Node (s1+s2) y h2l (union h1 h2r))
|
||
|
|
|
||
|
|
insert :: Ord a => a -> Heap a -> Heap a
|
||
|
|
insert x h = union (Node 1 x Nil Nil) h
|
||
|
|
|
||
|
|
findMax :: Heap a -> Maybe a
|
||
|
|
findMax h = if isEmpty h then Nothing
|
||
|
|
else Just (root h)
|
||
|
|
|
||
|
|
deleteMax :: Ord a => Heap a -> (Maybe a, Heap a)
|
||
|
|
deleteMax Nil = (Nothing, Nil)
|
||
|
|
deleteMax (Node _ x hl hr) = (Just x, union hl hr)
|
||
|
|
|
||
|
|
instance Functor Heap where
|
||
|
|
fmap f Nil = Nil
|
||
|
|
fmap f (Node n x left right) = Node n (f x) left' right' where
|
||
|
|
left' = fmap f left
|
||
|
|
right' = fmap f right
|
||
|
|
|
||
|
|
instance Foldable Heap where
|
||
|
|
foldr _ acc Nil = acc
|
||
|
|
foldr f base (Node _ x left right) = f x $ foldr f acc right where
|
||
|
|
acc = foldr f base left
|