2
$\begingroup$

Good day,

I am trying to implement the HeapSort Algorithm using WL. My attempt is shown below.

ClearAll[BubbleDown];
SetAttributes[BubbleDown, HoldFirst]; 
BubbleDown[H_, i_] := Module[{k, j, v, n = Length[H], heap},
  k = i; v = H[[k]]; heap = False;
  While[! heap && 2*k <= n,
   j = 2*k;
   If[j < n, If[H[[j]] < H[[j + 1]], j++]];
   If[v >= H[[j]], heap = True, H[[k]] = H[[j]]; k = j];
   ];
  H[[k]] = v]

ClearAll[HeapBottomUp];
SetAttributes[HeapBottomUp, HoldFirst];
HeapBottomUp[H_] := Module[{i, n = Length[H]},
  For[i = Floor[n/2], i >= 1, i--,
   BubbleDown[H, i]];
  H
  ]

ClearAll[HeapSort];
SetAttributes[HeapSort, HoldFirst];
HeapSort[H_] := Module[{n = Length[H], T = H, i},
  H = HeapBottomUp[H];
  For[i = n, i >= 2, i--,
   T[[i]] = H[[1]];
   H[[{1, i}]] = H[[{i, 1}]];
   H = H[[;; i - 1]];
   BubbleDown[H, 1]
   ];
  T
  ]

My main problem is that I do not want to use the local variable T in the HeapSort function. When I tried BubbleDown[H[[;;I-1]], it did not work because of the HoldFirst setting for the function.

Is there a way to address this in order to make my implementation in place (space complexity of O(1))?

Many thanks!

Improve this question
$\endgroup$
4
  • 1
    $\begingroup$ Is there some reason you wouldn't want to use the built in one reference.wolfram.com/language/Combinatorica/ref/HeapSort.html? $\endgroup$
    – Moo
    Commented Nov 20, 2023 at 12:37
  • $\begingroup$ I am trying to implement all the algorithms (listed in pseudocode) in Levitin's Algorithms book. So, I know, for example, that we have to avoid procedural programming, but I want to implement the algorithms in exactly the way described in the book. $\endgroup$
    – LambdaHaskell
    Commented Nov 20, 2023 at 13:52
  • 1
    $\begingroup$ Heapsort works by first queuing elements in a heap and then dequeuing them. It is difficult to see where your code is doing that. Which makes it difficult to offer advice. On a general note, it one wants to use Hold* attributes and operate on only a part of the object, functions such as HeapBottomUp should accept an index argument and use that to determine where to operate. That way copies are avoided (and they would mess up the algorithm complexity). $\endgroup$
    – Daniel Lichtblau
    Commented Nov 20, 2023 at 17:22
  • $\begingroup$ Many thanks, Daniel! It works now! $\endgroup$
    – LambdaHaskell
    Commented Nov 20, 2023 at 18:23

2 Answers 2

Reset to default
1
$\begingroup$

As of V12.1, the "PriorityQueue" data structure is built in:

SeedRandom[1];
data = RandomInteger[{1, 1000}, 40];

ds = CreateDataStructure["PriorityQueue", data];

Table[ds["Pop"], ds["Length"]]

{990, 989, 981, 965, 862, 838, 835, 826, 813, 780, 772, 726, 715,
 647, 630, 613, 556, 543, 536, 487, 399, 395, 385, 365, 325, 278,
 276, 228, 179, 173, 147, 125, 97, 88, 70, 68, 29, 8, 5, 3}

We can use a custom ordering function to sort in ascending order:

ds = CreateDataStructure["PriorityQueue", data, Order[Minus[#1], Minus[#2]]&];

Table[ds["Pop"], ds["Length"]]

{3, 5, 8, 29, 68, 70, 88, 97, 125, 147, 173, 179, 228, 276, 278,
 325, 365, 385, 395, 399, 487, 536, 543, 556, 613, 630, 647, 715,
 726, 772, 780, 813, 826, 835, 838, 862, 965, 981, 989, 990}
Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ Thank you so much! I really appreciate your answer. However, as I mentioned in my other comment, I want to avoid using built-in data structures and implement the pseudocode of the HeapSort as in Levitin's book. $\endgroup$
    – LambdaHaskell
    Commented Nov 20, 2023 at 13:53
1
$\begingroup$

Thanks go for Daniel for helping me to fix my problem. The fixed code is shown below:

ClearAll[BubbleDown];
SetAttributes[BubbleDown, HoldFirst]; 
BubbleDown[H_, n_, i_] := Module[{k, j, v, heap},
  k = i; v = H[[k]]; heap = False;
  While[! heap && 2*k <= n,
   j = 2*k;
   If[j < n, If[H[[j]] < H[[j + 1]], j++]];
   If[v >= H[[j]], heap = True, H[[k]] = H[[j]]; k = j];
   ];
  H[[k]] = v]

ClearAll[HeapBottomUp];
SetAttributes[HeapBottomUp, HoldFirst];
HeapBottomUp[H_] := Module[{i, n = Length[H]},
  For[i = Floor[n/2], i >= 1, i--,
   BubbleDown[H, n, i]];
  H
  ]

ClearAll[HeapSort];
SetAttributes[HeapSort, HoldFirst];
HeapSort[H_] := Module[{n = Length[H], i},
  H = HeapBottomUp[H];
  For[i = n, i >= 2, i--,
   H[[{1, i}]] = H[[{i, 1}]];
   BubbleDown[H, i - 1, 1]
   ];
  H
  ]
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.