SOURCE FILE: heapsort.pas

(*********************************************************)

PROCEDURE Swap
  (VAR Element1, Element2 : ListElementType);

  (* Swap the values of Element1 and Element2. *)

VAR
  Temp : ListElementType;

BEGIN (* Swap *)
  Temp := Element1;
  Element1 := Element2;
  Element2 := Temp
END;   (* Swap *)
(*********************************************************)

PROCEDURE ReheapDown
  (VAR Heap     : HeapType;
   Root, Bottom : Integer);
  (* Pre:  Root and Bottom are between 1 and Heap.NumElements. *)
  (*       Heap property violated only at Heap.Elements[Root], *)
  (*       if at all.                                          *)
  (* Post: Heap.Elements[Root]..Heap.Elements[Bottom] is a heap.*)
VAR
  MaxChild   : Integer; (* index of child with larger value *)
  RightChild : Integer; (* index of the right child node    *)
  LeftChild  : Integer; (* index of the left child node     *)

BEGIN (* ReheapDown *)
  WITH Heap DO
    BEGIN

      LeftChild  := Root * 2;
      RightChild := Root * 2 + 1;
      (* Check for Base Case 1: Heap.Elements[Root] is a leaf *)
      IF LeftChild <= Bottom
        THEN
          BEGIN  (* Heap.Elements[Root] is not a leaf *)
            (* MaxChild : index of child with larger value *)
            IF LeftChild = Bottom
              THEN (* There is only one child node. *)
                MaxChild := LeftChild
            ELSE (* Pick the greater of the two children. *)
               CASE HeapCompare(Elements[LeftChild],
                                Elements[RightChild]) OF
                 Greater  : MaxChild := LeftChild;
                 Less,
                 Equal    : MaxChild := RightChild
               END;  (* CASE *)
            (* Check for Base Case 2: order property intact *)
            CASE HeapCompare(Elements[Root], Elements[MaxChild]) OF
               Less   : (* General Case: swap and reheap *)
                         BEGIN
                           Swap (Elements[Root],
                                 Elements[MaxChild]);

                           ReheapDown (Heap, MaxChild, Bottom)
                         END;
                Equal,
                Greater : (* Order property is restored *);
              END;  (* CASE *)
      END (* IF Heap.Elements[Root] is not a leaf *)
   END (* WITH *)
END;   (* ReheapDown *)

(*********************************************************)

PROCEDURE ReheapUp
  (VAR Heap     : HeapType;
   Root, Bottom : Integer);
  (* Pre:  Root and Bottom are between 1 and Heap.NumElements.   *)
  (*       Order property violated only at Heap.Elements[Bottom] *)
  (*       if at all.                                            *)
  (* Post: Heap.Elements[Root]..Heap.Elements[Bottom] is a heap. *)
VAR
  Parent : Integer; (* index of the parent node *)

BEGIN (* ReheapUp *)
  WITH Heap DO
    (* Check for Base Case 1: Heap.Elements[Bottom] is the root *)
    IF Bottom > Root
      THEN
        BEGIN  (* Heap.Elements[Bottom] is not the root *)
          Parent := Bottom DIV 2;
          (* Check for Base Case 2: order property intact *)
          CASE HeapCompare(Elements[Parent], Elements[Bottom]) OF
            Less    : BEGIN (* General case: swap and reheap *)
                        Swap (Elements[Parent], Elements[Bottom]);
                        ReheapUp (Heap, Root, Parent)
                      END;
            Equal,
            Greater : (* Base case 2: Heap property is restored *);
          END;  (* CASE *)
        END (* IF Heap.Elements[Bottom] is not root *)
END;  (* ReheapUp *)

(*************************************************************)

PROCEDURE HeapSort
  (VAR List : ListType);

  (* Sort the elements in List in ascending order, using *)
  (* the HeapSort algorithm.                             *)

VAR
  Index : IndexType;

BEGIN (* HeapSort *)

  WITH List DO
    BEGIN

      (* Build the original heap from the unsorted elements. *)
      FOR Index := (Length DIV 2) DOWNTO 1 DO
        ReheapDo             *)
      FOR Index := Length DOWNTO 2 DO
        BEGIN
          Swap (Info[1], Info[Index]);
          ReheapDown (Info, 1, Index - 1)
        END  (* FOR loop *)
    END (* WITH *)
END;   (* HeapSort *)