SOURCE FILE: heapsort.pas

(*************************************************************)
(***                      HEAPSORT CODE                    ***)
(*************************************************************)

CONST
  MaxElements = 1000;  (* maximum number of elements in list *)

TYPE

  ListElementType = Integer; (* simplified for discussion! *)

  IndexType = 0 .. MaxElements;
  ArrayType = ARRAY [1 .. MaxElements] OF ListElementType;

  ListType = RECORD
    Length : IndexType;
    Info   : ArrayType
  END; (* ListType *)

(*************************************************************)
(*                     PROCEDURE SWAP                        *)
(*************************************************************)

PROCEDURE Swap
  (VAR Element1, Element2 : ListElementType);

  (* Swap the values of Element1 and Element 2. *)

VAR
  Temp : ListElementType;

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

(*************************************************************)
(*                    PROCEDURE HeapSort                     *)
(*************************************************************)
PROCEDURE HeapSort
  (VAR List : ListType);

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

VAR
  Index : IndexType;

  (*************************************************************)
  (*                Nested PROCEDURE ReheapDown                *)
  (*************************************************************)
  PROCEDURE ReheapDown
    (VAR HeapElements : ArrayType;
     Root             : Integer;
     Bottom           : Integer);
  
  VAR
    HeapOK   : Boolean;
    MaxChild : Integer;
  
  BEGIN (* ReheapDown *)
  
    HeapOk := False;
        (* while the current node has a left child  *)
        (* and we are not done re-heaping ...       *)  
    WHILE (Root * 2 <= Bottom) AND NOT HeapOk DO
      BEGIN
           (* if the current node has no right child ... *)
        IF Root * 2 = Bottom
          THEN MaxChild := Root * 2
          ELSE
            IF HeapElements[Root * 2] > HeapElements[Root * 2 + 1]
              THEN MaxChild := Root * 2
              ELSE MaxChild := Root * 2 + 1;
            (* If the current node has a key less than one   *)
            (* of the children, then pick the child with the *)
            (* largest key, and swap keys with it            *)
        IF HeapElements[Root] < HeapElements[MaxChild]
          THEN
            BEGIN
              Swap (HeapElements[Root], HeapElements[MaxChild]);
              Root := MaxChild
            END (* If not yet a heap *)
          ELSE HeapOk := True
  
      END; (* WHILE *)
  END; (* ReheapDown *)
(***************************************************************)
(***************************************************************)
BEGIN (* HeapSort *)

  WITH List DO
    BEGIN

      (* Build the original heap from the unsorted elements. *)
      FOR Index := (Length DIV 2) DOWNTO 1 DO
        ReheapDown (Info, Index, Length);

      (* Sort the elements in the heap by swapping the root *)
      (* (current largest) value with the last unsorted     *)
      (* value, then reheaping remaining part of the list.  *)
      (* Loop invariant: Info[1] .. Info[Index] represents  *)
      (* a heap AND Info[Index + 1] .. Info[Length] are     *)
      (* sorted in ascending order.                         *)
      FOR Index := Length DOWNTO 2 DO
        BEGIN
          Swap (Info[1], Info[Index]);
          ReheapDown (Info, 1, Index - 1)
        END  (* FOR loop *)
    END (* WITH *)
END;   (* HeapSort *)
(*************************************************************)
(*************************************************************)