 # BHeap

Jan 16th, 2022
748
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. module BinomialHeap
2.    (
3.       BinHeap,
4.       insert,
5.       merge,
6.       extractMin,
7.       deleteMin,
8.       binHeapSort,
9.       fromList,
10.       toSortedList,
11.
12.       heapMap,
13.       heapFoldr,
14.       heapFoldl,
15.       heapFilter
16.    ) where
17.
18. import BinomialTree
19.
20. data (Eq a, Ord a) => BinHeap a = BHeap [BinTree a] deriving (Show)
21.
22. extractMin :: Ord a => BinHeap a -> a
23. extractMin (BHeap h) = foldl min (key (head h)) (map key h)
24.
25. merge :: Ord a => BinHeap a -> BinHeap a -> BinHeap a
26. merge (BHeap h1) (BHeap h2) = BHeap (mergeHeaps h1 h2)
27.
28. headRank :: Ord a => [BinTree a] -> Int
30. headRank (hd:_) = rank hd
31.
32. mergeHeaps :: Ord a => [BinTree a] -> [BinTree a] -> [BinTree a]
33. mergeHeaps [] h = h
34. mergeHeaps h [] = h
35. mergeHeaps h1@(t1:h1') h2@(t2:h2') =
36.    if rank t1 < rank t2 then
37.       t1 : mergeHeaps h1' h2
38.   else if rank t2 < rank t1 then
39.      t2 : mergeHeaps h1 h2'
40.    else
41.       let {
42.          merged = mergeTrees t1 t2;
43.          r = rank merged
44.       } in
45.          if r /= headRank h1' then
46.            if r /= headRank h2' then
47.                merged : mergeHeaps h1' h2'
48.             else
49.                mergeHeaps (merged : h1') h2'
50.          else
51.             if r /= headRank h2' then
52.               mergeHeaps h1' (merged : h2')
53.            else
54.               merged : mergeHeaps h1' h2'
55.
56. singleton :: (Ord a) => a -> BinHeap a
57. singleton k = BHeap [createTree k 1 []]
58.
59. insert :: Ord a => a -> BinHeap a -> BinHeap a
60. insert a (BHeap h) = merge (BHeap h) (singleton a)
61.
62. deleteMin :: Ord a => BinHeap a -> BinHeap a
63. deleteMin (BHeap h) = BHeap (deleteRootByKey (extractMin (BHeap h)) [] h)
64.
65. deleteRootByKey :: (Ord a, Eq a) => a -> [BinTree a] -> [BinTree a] -> [BinTree a]
66. deleteRootByKey k f t@(hd:tl) =
67.   if (key hd == k) then
68.      mergeHeaps (f ++ tl) (children hd)
69.   else
70.      deleteRootByKey k (hd : f) tl
71.
72. fromList :: Ord a => [a] -> BinHeap a
73. fromList [] = BHeap []
74. fromList a = foldl merge (BHeap []) (map singleton a)
75.
76. toSortedList :: Ord a => BinHeap a -> [a]
77. toSortedList (BHeap []) = []
78. toSortedList h = extractMin h : toSortedList (deleteMin h)
79.
80. binHeapSort :: Ord a => [a] -> [a]
81. binHeapSort [] = []
82. binHeapSort a = toSortedList (fromList a)
83.
84. heapMap :: (Ord a, Ord b) => (a -> b) -> BinHeap a -> BinHeap b
85. heapMap f h = fromList (map f (toSortedList h))
86.
87. heapFoldr :: Ord a => (a -> b -> b) -> b -> BinHeap a -> b
88. heapFoldr _ z (BHeap []) = z
89. heapFoldr f z (BHeap (hd:tl)) = heapFoldr f (treeFoldr f z hd) (BHeap tl)
90.
91. heapFoldl :: Ord a => (b -> a -> b) -> b -> BinHeap a -> b
92. heapFoldl _ z (BHeap []) = z
93. heapFoldl f z (BHeap (hd:tl)) = treeFoldl f (heapFoldl f z (BHeap tl)) hd
94.
95. heapFilter :: Ord a => (a -> Bool) -> BinHeap a -> BinHeap a
96. heapFilter f h = fromList(filter f (toSortedList h))
97.