Advertisement
ttaaa

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
  29. headRank [] = 0
  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.  
Advertisement
Advertisement
Advertisement
RAW Paste Data Copied
Advertisement