11.4 Problem Solving: A Generic Sorting Program

Let us continue our study of generics with the development of a generic sort procedure that uses much of what we have done in the chapter. We develop a sort procedure that will work correctly for any variable of any unconstrained array type, regardless of its bounds, index type, or element type.

In Program 11.2 we developed SelectSort, which works for any array of a particular unconstrained array type. We just need to modify it to make it generic. We also have our procedure Swap_Generic, which we can instantiate and use to handle exchanges.

Program 11.11 is the specification for the generic sort routine. This is similar to Maximum_Array_Generic from Program 11.9.

Program 11.11
Specification for Generic Sort Procedure

GENERIC 
  
  TYPE ElementType IS PRIVATE;  -- any nonlimited type will do
  TYPE IndexType   IS (<>);     -- any discrete type for index
  TYPE ListType    IS ARRAY (IndexType RANGE <>) OF ElementType;
  WITH FUNCTION Compare (Left, Right : ElementType) RETURN Boolean;

PROCEDURE Sort_Generic(List: IN OUT ListType);
------------------------------------------------------------------------
--| Specification for Generic Exchange Sort - will sort input
--| array in order according to Compare
--| Author: Michael B. Feldman, The George Washington University 
--| Last Modified: September 1995                                     
------------------------------------------------------------------------

With your current knowledge of generics, you can understand this specification easily. The body of the generic sort can be found as Program 11.12. Notice that the body begins with the context clause

    WITH Swap_Generic;

and instantiates this procedure for whatever the element type turns out to be. We have here a case of one generic instantiating another; this is the kind of situation that demonstrates the power of generics to help write very general programs. The rest of the procedure body is very similar to SelectSort ( Program 11.2), with the necessary modifications.

Program 11.12
Body of Generic Sort Procedure

WITH Swap_Generic;
PROCEDURE Sort_Generic(List: IN OUT ListType) IS
------------------------------------------------------------------------
--| Body of Generic Sort Procedure
--| Author: Michael B. Feldman, The George Washington University
--| Last Modified: September 1995
------------------------------------------------------------------------

  -- we need to make an instance of Swap_Generic for this case
  PROCEDURE Exchange IS NEW Swap_Generic (ValueType => ElementType);

  IndexOfMax: IndexType;

BEGIN -- Sort_Generic

  FOR PositionToFill IN List'First .. IndexType'Pred(List'Last) LOOP

    IndexOfMax := PositionToFill;

    FOR ItemToCompare IN 
      IndexType'Succ(PositionToFill) .. List'Last LOOP
      IF Compare(List(ItemToCompare),  List(PositionToFill)) THEN
        IndexOfMax := ItemToCompare;
      END IF;
    END LOOP;

    IF IndexOfMax /= PositionToFill  THEN
      Exchange(List(PositionToFill), List(IndexOfMax));
    END IF;

  END LOOP;

END Sort_Generic;

Using the Generic Sort to Order an Array of Records

GenericSwapSort can be especially useful in sorting arrays of records as we did in Program 8.16 and Program 11.2. Consider the following declarations:

    MaxSize : CONSTANT Positive := 250;
    MaxScore : CONSTANT Positive := 100;
    
    SUBTYPE StudentName IS String(1..20);
    SUBTYPE ClassIndex  IS Positive RANGE 1..MaxSize;
    SUBTYPE ClassRange  IS Natural RANGE 0..MaxSize;
    SUBTYPE ScoreRange  IS Natural RANGE 0..MaxScore;
    
    TYPE ScoreRecord IS RECORD
    	Name:  StudentName;
    	Score: ScoreRange;
    END RECORD;
    
    TYPE ScoreArray IS ARRAY (ClassIndex RANGE <>) OF ScoreRecord;

Here is a "compare" function that tells us whether one record is "less than" another (in the sense that one score is lower than the other):

    FUNCTION ScoreLess(Score1, Score2 : ScoreRecord) RETURN Boolean IS
    BEGIN
      RETURN Score1.Score < Score2.Score;
    END ScoreLess;

This function compares the score fields of the two records, returning True if the first record is "less than" the second and False otherwise. We could have named this function "<", of course, but chose not to do so in the interest of clarity. Given SwapSortGeneric, it takes only a single instantiation statement to create a sort that will order an array of score records in ascending order:

    PROCEDURE SortUpScores IS NEW Sort_Generic
      (ElementType => ScoreRecord,
       IndexType   => ClassIndex,
       ListType    => ScoreArray,
       Compare     => ScoreLess);

Given variables Scores and ClassSize as follows:

    Scores: ScoreArray(ClassIndex'First..ClassIndex'Last);
    ClassSize: ClassRange;

we see that Scores can hold up to 250 records, and ClassSize can be used to determine the actual number of records read from a file into the array. The array can easily be put in ascending order by score, just by calling SortUpScores with the appropriate array slice:

    SortUpScores(List => Scores(1..ClassSize));

Program 11.13 demonstrates the sort for two entirely different array types: an array of float values, and an array of phone call records as we used in Section 11.2.

Program 11.13
Test of Generic Sort Procedure

WITH Ada.Text_IO;
WITH Ada.Integer_Text_IO;
WITH Ada.Float_Text_IO;
WITH Sort_Generic;
PROCEDURE Test_Sort_Generic IS
------------------------------------------------------------------------
--| Demonstrates Sort_Generic using two unrelated kinds of lists;
--| this is not a realistic application, but rather just shows that
--| many instances of a generic can occur within one client program.
--| Author: Michael B. Feldman, The George Washington University 
--| Last Modified: September 1995                                     
------------------------------------------------------------------------

  SUBTYPE Index IS Integer RANGE 1..10;
  TYPE    FloatVector IS ARRAY(Index RANGE <>) OF Float;

  V1 : FloatVector(1..10);

  SUBTYPE DayRange IS Natural  RANGE 0..6;
  SUBTYPE Weekdays IS DayRange RANGE 0..4;
  SUBTYPE Weekend  IS DayRange RANGE 5..6;

  TYPE Days IS (Mon, Tue, Wed, Thu, Fri, Sat, Sun);
  TYPE CallRecord IS RECORD
    DayOfWeek    : Days;
    NumberOfCalls: Natural;
  END RECORD;
    
  TYPE Callers IS ARRAY(DayRange RANGE <>) of CallRecord;

  PACKAGE Days_IO IS NEW Ada.Text_IO.Enumeration_IO(Enum => Days);

  ThisWeek:       Callers(DayRange);

  -- if we are going to sort CallRecords, 
  -- we need to know how to compare them

  FUNCTION "<" (L, R: CallRecord) RETURN Boolean IS
  BEGIN
    RETURN L.NumberOfCalls < R.NumberOfCalls;
  END "<";

  FUNCTION ">" (L, R: CallRecord) RETURN Boolean IS
  BEGIN
    RETURN L.NumberOfCalls > R.NumberOfCalls;
  END ">";

  -- local procedures to display the contents of two kinds of lists

  PROCEDURE DisplayCallers (List: Callers) IS
  BEGIN -- DisplayCallers
    FOR Count IN List'Range LOOP
      Days_IO.Put  (Item=>List(Count).DayOfWeek, Width=>3);
      Ada.Integer_Text_IO.Put
        (Item=>List(Count).NumberOfCalls, Width=>4);
      Ada.Text_IO.New_Line;
    END LOOP;
    Ada.Text_IO.New_Line;
  END DisplayCallers;

  PROCEDURE DisplayFloatVector (V: FloatVector) IS
  BEGIN
    FOR Count IN V'First..V'Last LOOP
      Ada.Float_Text_IO.Put
        (Item=>V(Count), Fore=>4, Aft=>2, Exp=>0);
    END LOOP;
    Ada.Text_IO.New_Line;
  END DisplayFloatVector;

  -- two instances of Sort_Generic for Float vectors;
  -- the first sorts in increasing order, the second in decreasing order

  PROCEDURE SortUpFloat IS NEW Sort_Generic
    (ElementType => Float,
     IndexType   => Index,
     ListType    => FloatVector,
     Compare     => "<");

  PROCEDURE SortDownFloat IS NEW Sort_Generic
    (ElementType => Float,
     IndexType   => Index,
     ListType    => FloatVector,
     Compare     => ">");

  -- two instances of Sort_Generic for Callers;
  -- the first sorts in increasing order, the second in decreasing order

  PROCEDURE SortUpCallers IS NEW Sort_Generic
    (ElementType => CallRecord,
     IndexType   => DayRange,
     ListType    => Callers,
     Compare     => "<");

  PROCEDURE SortDownCallers IS NEW Sort_Generic
    (ElementType => CallRecord,
     IndexType   => DayRange,
     ListType    => Callers,
     Compare     => ">");

BEGIN -- Test_Sort_Generic

  V1 := (0.7, 1.5, 6.9, -3.2, 0.0, 5.1, 2.0, 7.3, 2.2, -5.9);
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put
    (Item=> "Testing Sort_Generic for float vectors");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put(Item=> "Here is the vector before sorting.");
  Ada.Text_IO.New_Line;
  DisplayFloatVector(V => V1);
  Ada.Text_IO.New_Line;
  
  SortUpFloat(List => V1);
  Ada.Text_IO.Put(Item=> "Here is the vector after upward sorting.");
  Ada.Text_IO.New_Line;
  DisplayFloatVector(V => V1);
  Ada.Text_IO.New_Line;

  SortDownFloat(List => V1);
  Ada.Text_IO.Put(Item=> "Here is the vector after downward sorting.");
  Ada.Text_IO.New_Line;
  DisplayFloatVector(V => V1);
  Ada.Text_IO.New_Line;

  ThisWeek := ((Mon, 12), (Tue, 23), (Wed, 100), (Thu, 40), 
               (Fri, 52), (Sat, 17), (Sun,   2));

  Ada.Text_IO.Put
    (Item=> "Testing Sort_Generic for telephone callers");
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put(Item=> "Here is ThisWeek before sorting.");
  Ada.Text_IO.New_Line;
  DisplayCallers(List => ThisWeek);
  Ada.Text_IO.New_Line;
  
  SortUpCallers(List => ThisWeek);
  Ada.Text_IO.Put(Item=> "Here is ThisWeek after upward sorting.");
  Ada.Text_IO.New_Line;
  DisplayCallers(List => ThisWeek);
  Ada.Text_IO.New_Line;

  SortDownCallers(List => ThisWeek);
  Ada.Text_IO.Put(Item=> "Here is ThisWeek after downward sorting.");
  Ada.Text_IO.New_Line;
  DisplayCallers(List => ThisWeek);
  Ada.Text_IO.New_Line;


END Test_Sort_Generic;

Sample Run

Testing Sort_Generic for float vectors
Here is the vector before sorting.
   0.70   1.50   6.90  -3.20   0.00   5.10   2.00   7.30   2.20  -5.90

Here is the vector after upward sorting.
  -5.90   0.70   1.50  -3.20   0.00   2.20   2.00   6.90   5.10   7.30

Here is the vector after downward sorting.
   7.30   5.10   6.90   0.70   1.50   2.20   2.00   0.00  -3.20  -5.90

Testing Sort_Generic for telephone callers
Here is ThisWeek before sorting.
MON  12
TUE  23
WED 100
THU  40
FRI  52
SAT  17
SUN   2


Here is ThisWeek after upward sorting.
SUN   2
MON  12
TUE  23
SAT  17
THU  40
FRI  52
WED 100


Here is ThisWeek after downward sorting.
WED 100
FRI  52
THU  40
TUE  23
SAT  17
MON  12
SUN   2

SYNTAX DISPLAY
Generic Specification

Form:

GENERIC
  list of generic formal parameters
PROCEDURE pname (list of procedure parameters );

GENERIC
  list of generic formal parameters
FUNCTION fname (list of function parameters ) RETURN resulttype;

GENERIC
  list of generic formal parameters
PACKAGE pname IS
  specifications of resources provided by the package
END pname ;

Example:

GENERIC
  
  TYPE ValueType IS PRIVATE;
  TYPE IndexType IS (<>);
  
  WITH FUNCTION "+"(L,R: ValueType) RETURN ValueType;
  WITH FUNCTION "*"(L,R: ValueType) RETURN ValueType;

  Zero: ValueType;

PACKAGE Vectors IS

  TYPE Vector IS 
    ARRAY(IndexType RANGE <>) OF ValueType; 

  Bounds_Error: EXCEPTION;

  FUNCTION "+"(L, R: Vector) RETURN Vector;
  FUNCTION "*"(L, R: Vector) RETURN ValueType;

END Vectors;

Interpretation:

The generic specification defines a generic procedure, function, or package, for which a corresponding body must also be provided. The list of generic formal type, procedure or function, and object parameters indicates the structure of the parameters to be supplied at instantiation of the generic.

Here are the forms of the generic type parameters we have seen here, and their interpretation. There are other generic type parameters, but their discussion is beyond the scope of this book. This form:

TYPE ValueParameterName IS PRIVATE;

most commonly used as a value parameter, indicates that any type can be matched at instantiation, including a PRIVATE type, as long as it is not LIMITED PRIVATE. That is, the operations of assignment and equality testing must be defined for the type. This form:

TYPE IndexParameterName IS (<>);

indicates that any discrete type--that is, an integer or enumeration type or subtype--can be matched at instantiation. This form is commonly used to specify the index type of an array type. This form:

TYPE ArrayParameterName IS 
  ARRAY(IndexParameterName RANGE <>) OF ValueParameterName;

indicates that any unconstrained array type with the given index and value types can be matched at instantiation.

Exercises for Section 11.4

Self-Check

Explain how Sort_Generic could be instantiated to order an array of score records in alphabetical order by the name of the student.
Explain how Sort_Generic could be instantiated to order an array of score records in descending order by score.

Programming

Modify Test_Sort_Generic so that the element type is a type we have defined in this book. Try it for Currency or Date, for example.