PROGRAM SortDriver (input, output) ;

(* This is the code from the 2nd Edition of Dale and Lilly *)

(*********************************************************)
(*           A COLLECTION OF SORTING ROUTINES            *)
(*********************************************************)
(* NOTE: It is assumed that in the following sorting     *)
(*       routines, ArrayType has been declared as type   *)
(*       ARRAY[1..MaxElements OF ElementType, where      *)
(*       ElementType is some type whose values can be    *)
(*       compared using < and >. The Swap procedure      *)
(*       below is used by nearly all of the sorts.       *)
(*********************************************************)

CONST MaxElements = 1000 ;
TYPE 
       ElementType = integer ;
       ArrayType = array [1..MaxElements] OF ElementType ;

VAR List : ArrayType ;
    indexVar : integer ;

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

    PROCEDURE Swap (VAR This, That : ElementType);

      (* This gets That, and vice versa *)

    VAR
        Temp  : ElementType;

    BEGIN  (* Swap *)

      Temp := This;
      This := That;
      That := Temp

    END;   (* Swap *)


(*********************************************************)
(*                      INSERTSORT                       *)
(*********************************************************)

PROCEDURE InsertSort (VAR DataList    : ArrayType;
                          NumElements : Integer);

(* Sort DataList[1]..DataList[NumElements] in increasing *)
(* order, using the insert sort algorithm.               *)

VAR
    Inner, Outer : Integer;             (* loop controls *)
    PlaceFound   : Boolean;

BEGIN  (* InsertSort *)

  Outer := 2;

  (* Loop Invariant: Outer may range from 2 to NumElements *)
  (*    AND DataList[1]..DataList[Outer-1] is sorted.      *)
  WHILE Outer <= NumElements DO              (* outer loop *)
    BEGIN
      (* Put DataList[Outer] in its proper place,        *)
      (* relative to DataList[1]..DataList[Outer - 1].   *)
      Inner := Outer;
      PlaceFound := False;

      (* Loop invariant: DataList[1]..DataList[Outer] *)
      (* is sorted, with the (possible) exception of  *)
      (* DataList[Inner].                             *)
      WHILE (Inner > 1)                 (* inner loop *)
        AND NOT PlaceFound DO
        BEGIN
          IF DataList[Inner] < DataList[Inner - 1]
            THEN
              BEGIN
                (* Swap the elements and decrement Inner. *)
                Swap (DataList[Inner], DataList[Inner - 1]);
                Inner := Inner - 1
              END  (* IF out of place *)

            ELSE (* in place -- stop the inner loop now *)
              PlaceFound := TRUE
        END;  (* WHILE inner loop *)

      (* Set up for next iteration of outer loop. *)
      Outer := Outer + 1

    END  (* outer loop *)

END;  (* InsertSort *)

(*********************************************************)
(*                       SELECTSORT                      *)
(*********************************************************)

PROCEDURE SelectSort (VAR Data  : ArrayType;
                          N     : Integer);

(* Sorts array Data from index 1 through N in increasing *)
(* order, using the selection sort algorithm.            *)

VAR
    I, J   : Integer;                   (* loop controls *)
    Mindex : Integer;          (* index of minimum value *)

BEGIN  (* InsertSort *)

  I := 1;

  (* Loop through the whole array. *)
  WHILE I <= N DO              (* outer loop *)
    BEGIN

      (* Initialize. *)
      Mindex := I;
      J := I + 1;

      (* Find the index of the minimum unsorted element. *)
      WHILE J <= N DO
        BEGIN (* inner loop *)
          IF Data[J] < Data[Mindex]
            THEN Mindex := J;
          J := J + 1;
        END; (* inner loop *)

      (* Swap the first unsorted element with the minimum *)
      (* unsorted element in the array.                   *)
      Swap (Data[Mindex], Data[I]);
      I := I + 1

    END  (* outer loop *)

END;  (* SelectSort *)


(*********************************************************)
(*                        BUBBLE1                        *)
(*********************************************************)


PROCEDURE Bubble1 (VAR Data  : ArrayType;
                          N  : Integer);

(* Sorts array Data from index 1 through N in increasing *)
(* order, using the bubble sort algorithm.               *)

VAR
    I, J   : Integer;                   (* loop controls *)

BEGIN  (* Bubble1 *)

  I := 1;

  (* Loop through the whole array. *)
  WHILE I < N DO              (* outer loop *)
    BEGIN

      (* Bubble up smallest unsorted value. *)
      J := N;

      WHILE J > I DO
        BEGIN (* inner loop *)
          (* If the bottom value is smaller than its *)
          (* predecessor, swap them.                 *)
          IF Data[J] < Data[J - 1]
            THEN Swap(Data[J], Data[J - 1]);
          J := J - 1
        END; (* inner loop *)

      I := I + 1

    END  (* outer loop *)

END;  (* Bubble1 *)


(*********************************************************)
(*                        BUBBLE2                        *)
(*********************************************************)

PROCEDURE Bubble2 (VAR Data  : ArrayType;
                          N  : Integer);

(* Sorts array Data from index 1 through N in increasing *)
(* order, using the bubble sort algorithm. Stops sorting *)
(* when the array is sorted.                             *)

VAR
    I, J    : Integer;
    Swapped : Boolean;

BEGIN  (* Bubble2 *)

  (* Initialize. *)
  I := 1;
  Swapped := True;

  (* Loop through the whole array; stop when sorted (i.e., *)
  (* when there are no values swapped in the inner loop).  *)
  WHILE (I < N) AND Swapped DO
    BEGIN  (* outer loop *)

      J := N;
      Swapped := False;

      (* Bubble up smallest unsorted value. *)
      WHILE J > I DO
        BEGIN (* inner loop *)

          (* If the bottom value is smaller than its *)
          (* predecessor, swap them. Note that the   *)
          (* swap took place by setting Swapped.     *)
          IF Data[J] < Data[J - 1]
            THEN
              BEGIN
                Swap(Data[J], Data[J - 1]);
                Swapped := True
              END; (* IF *)

          J := J - 1;

        END; (* inner loop *)

      I := I + 1

    END  (* outer loop *)

END;  (* Bubble2 *)


(**********************************************************)
(*                       MERGESORT                        *)
(**********************************************************)

PROCEDURE MergeSort (VAR Data   : ArrayType;
                         First,
                         Last   : Integer);

  (* Sort Data[First]..Data[Last] in increasing order. *)
  (* This is a recursive solution.                     *)

VAR
    Middle : Integer;  (* middle index in range to sort *)

(************** Internal Procedure Merge ***************)

PROCEDURE Merge (VAR Data       : ArrayType;
                     LeftFirst,
                     LeftLast,
                     RightFirst,
                     RightLast  : Integer);

  (* Merge the two sorted subarrays Data[LeftFirst] ..    *)
  (* Data[LeftLast] and Data[RightFirst]..Data[RightLast] *)
  (* into a single sorted subarray Data[LeftFirst] ..     *)
  (* Data[RightLast].                                     *)

VAR
    Temp          :  ArrayType;    (* auxiliary array *)
    Index         :  Integer;      (* index into Temp *)
    CurrentLeft,
    CurrentRight  :  Integer;
 
BEGIN (* Merge *)
 
  (* Initialize indexes before loop. *)
  CurrentLeft  := LeftFirst;
  CurrentRight := RightFirst;
  Index        := LeftFirst;
 
  (* Process while more elements in both subarrays. *)
  WHILE (CurrentLeft  <= LeftLast) AND
        (CurrentRight <= RightLast) DO
    BEGIN
      IF Data[CurrentLeft] < Data[CurrentRight]
        THEN
          BEGIN
            Temp[Index] := Data[CurrentLeft];
            CurrentLeft := CurrentLeft + 1
          END (* left element smaller *)

        ELSE
          BEGIN
            Temp[Index]  := Data[CurrentRight];
            CurrentRight := CurrentRight + 1
          END; (* right element smaller or equal *)
 
      Index := Index + 1
 
    END;  (* WHILE loop *)

  (* Copy any remaining elements from left half to Temp.  *)
  WHILE CurrentLeft <= LeftLast DO
    BEGIN
      Temp[Index]  := Data[CurrentLeft];
      CurrentLeft  := CurrentLeft + 1;
      Index        := Index + 1
    END;  (* WHILE more elements in left half *)

  (* Copy any remaining elements from right half to Temp. *)
  WHILE CurrentRight <= RightLast DO
    BEGIN
      Temp[Index]  := Data[CurrentRight];
      CurrentRight := CurrentRight + 1;
      Index        := Index + 1
    END;  (* WHILE more elements in right half *)
 
  (* Copy the sorted elements from Temp back into Data. *)
  FOR Index := LeftFirst TO RightLast DO
    Data[Index] := Temp[Index]
 
END;  (* Merge *)
 
(********************* Main procedure **********************)

BEGIN (* MergeSort *)

  (* Base Case: Check for empty or single element. *)
  IF First < Last
    THEN
      BEGIN (* General case *)

      (* Cut the array into two halves. *)
      Middle := (First + Last) DIV 2;

      (* Sort the left subarray. *)
      MergeSort (Data, First     , Middle);
 
      (* Sort the right subarray. *)
      MergeSort (Data, Middle + 1, Last);

      (* Merge the two sorted halves together. *)
      Merge (Data,
             First,       (* first index in left  half *)
             Middle,      (* last  index in left  half *)
             Middle + 1,  (* first index in right half *)
             Last)        (* last  index in right half *)

    END (* general case *)

  (* ELSE - do nothing in base case *)
 
END; (* MergeSort *)

(*********************************************************)
(*                      QUICKSORT                        *)
(*********************************************************)

PROCEDURE QuickSort (VAR Data    : ArrayType;
                     First, Last : Integer);

(* Sorts array Data from index 1 through N in increasing *)
(* order, using the quick sort algorithm.                *)

VAR
   SplitPoint : Integer;

(* * * * * * * Internal Procedure Split * * * * * * * * *)

   PROCEDURE Split (VAR Data       : ArrayType;
                    First, Last    : Integer;
                    VAR SplitPoint : Integer);


     (* Chooses a splitting value, V, and rearranges *)
     (* the values in the array Data such that:      *)
     (*   Data[First]..Data[SplitPoint - 1] <= V     *)
     (*   Data[SplitPoint] = V                       *)
     (*   Data[SplitPoint + 1]..Data[Last] > V       *)

   VAR
     Right, Left : Integer;
     V           : ElementType;  (* the splitting value *)

   BEGIN (* Split *)

     V     := Data[First];
     Right := First + 1;
     Left  := Last;

     REPEAT

       (* Move Right to the right until element > V. *)
       WHILE (Right < Left) AND (Data[Right] <= V) DO
         Right := Right + 1;

       (* Check end condition. *)
       IF (Right = Left) AND (Data[Right] <= V)
         THEN Right := Right + 1;

       (* Move Left to the left until element <= V. *)
       WHILE (Right <= Left) AND (Data[Left] > V) DO
         Left := Left - 1;

       IF Right < Left
         THEN
           BEGIN
             Swap(Data[Right], Data[Left]);
             Right := Right + 1;
             Left  := Left - 1
           END; (* IF *)

     UNTIL Right > Left;

     (* Swap first element with SplitPoint element. *)
     Swap(Data[First], Data[Left]);
     SplitPoint := Left

   END;  (* Split *)

(* * * * * * * * Main QuickSort Procedure * * * * * * * *)

BEGIN  (* QuickSort *)

  IF First < Last
    THEN
      BEGIN

        (* Procedure Split chooses the splitting value *)
        (* (V) and rearranges the array such that      *)
        (*   Data[First]..Data[SplitPoint - 1] <= V    *)
        (*   Data[SplitPoint] = V                      *)
        (*   Data[SplitPoint + 1]..Data[Last] > V      *)
        Split(Data, First, Last, SplitPoint);

        (* Sort the two "halves." *)
        QuickSort(Data, First, SplitPoint - 1);
        QuickSort(Data, SplitPoint + 1, Last)

      END (* IF First < Last *)

END;  (* QuickSort *)


(**********************************************************)
(*                        HEAPSORT                        *)
(**********************************************************)
(* NOTE: Procedure HeapSort uses the ReheapDown operation *)
(*       on heaps; this operation has been included here. *)
(**********************************************************)

PROCEDURE ReheapDown (VAR HeapElements : ArrayType;
                          Root, Bottom : Integer);

  (* Restore the Order property of heaps to the subtree  *)
  (* starting at Root. It is assumed that, on invocation *)
  (* of the procedure, the Order property is violated    *)
  (* only by the root node.                              *)

VAR
  HeapOK   : Boolean;     (* the heap repair is finished *)
  MaxChild : Integer; (* index of the larger child value *)

BEGIN  (* ReheapDown *)

  HeapOK := False;

  (* Process until Root value is in its correct place. *)
  WHILE (Root * 2 <= Bottom) AND NOT HeapOK DO
    BEGIN

      (* Calculate the index of child with larger value. *)
      IF Root * 2 = Bottom
        THEN  (* only one child node *)
          MaxChild := Root * 2

        ELSE  (* pick greater of the two children *)
          IF HeapElements[Root * 2] >    (* left  child *)
             HeapElements[Root * 2 + 1]  (* right child *)
            THEN MaxChild := Root * 2
            ELSE MaxChild := Root * 2 + 1;

      (* If heap property is violated, swap values. *)
      IF HeapElements[Root] < HeapElements[MaxChild]
        THEN
          BEGIN   (* not yet a heap *)
            Swap (HeapElements[Root],
                  HeapElements[MaxChild]);
            Root := MaxChild
          END
        ELSE  (* already is a heap *)
          HeapOK := True

    END  (* WHILE loop *)

END;  (* ReheapDown *)

(* * * * * * * * * Main procedure HeapSort * * * * * * * * *)

PROCEDURE HeapSort (VAR Data        : ArrayType;
                        NumElements : Integer);

  (* Sorts the first NumElements values of array Data in *)
  (* ascending order, using the HeapSort algorithm.      *)

VAR
    NodeIndex  : Integer;

BEGIN  (* HeapSort *)

  (* Build the original heap from the unsorted elements. *)
  FOR NodeIndex := (NumElements DIV 2) DOWNTO 1 DO
    ReheapDown (Data, NodeIndex, NumElements);

  (* Sort the elements in the heap by swapping the root    *)
  (* (current largest) value with the last unsorted value, *)
  (* then reheaping the remaining part of the array.       *)
  FOR NodeIndex := NumElements DOWNTO 2 DO
    BEGIN
      Swap (Data[1], Data[NodeIndex]);
      ReheapDown (Data, 1, NodeIndex - 1)
    END  (* FOR loop *)

END;  (* HeapSort *)

BEGIN (* Main Program SortDriver *)

  List[1] := 5 ;
  List[2] := 4 ;
  List[3] := 3 ;
  List[4] := 2 ;
  List[5] := 1 ;

(*
  writeln('This is InsertSort 2.') ; writeln ; 
  InsertSort ( List, 5 ); 
*)
(*
  writeln('This is SelectSort 2.') ; writeln ;
  SelectSort ( List, 5 ); 
*)
(*
  writeln('This is HeapSort 2.') ; writeln ;
  HeapSort   ( List, 5 );  
*)
(*
  writeln('This is QuickSort 2.') ; writeln ;
  QuickSort  ( List, 1, 5); 
*)

  FOR indexVar := 1 TO 5 DO write (List[indexVar]) ;
  writeln ;

END.  (* Main Program SortDriver *)