-------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : generic package Sort_Utilities -- Version : 1.3 (FRAY297) -- Author : Geoffrey O. Mendal -- : Stanford University -- : Computer Systems Laboratory, ERL 456 -- : Stanford, CA 94305 -- : (415) 723-1414 or 723-1175 -- DDN Address : Mendal@SIERRA.STANFORD.EDU -- Copyright : (c) 1985, 1986, 1987 Geoffrey O. Mendal -- Date created : Mon 11 Nov 85 -- Release date : Sun 25 Dec 85 -- Last update : MENDAL Fri 29 May 87 -- Machine/System Compiled/Run on : DG MV10000, ROLM ADE -- VAX 11/780, DEC ACS -- RATIONAL R1000 -- SEQUENT B21000, VERDIX VADS -- SUN/3, VERDIX VADS -- Dependent Units : package SYSTEM -- -* --------------------------------------------------------------- -- -* -- Keywords : SORT ----------------: SORT UTILITIES -- -- Abstract : This generic package contains several ----------------: array sorting routines. -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- 12/29/85 1.0 (MOOV115) Mendal Initial Release -- 04/11/86 1.1 (FRPR116) Mendal ANNA formal comments -- 12/07/86 1.2 (SUEC076) Mendal more ANNA annotations -- 05/29/87 1.3 (FRAY297) Mendal annotation changes -- -* ------------------ Distribution and Copyright ----------------- -- -* -- This prologue must be included in all copies of this software. -- -- This software is copyright by the author. -- -- This software is released to the Ada community. -- This software is released to the Public Domain (note: -- software released to the Public Domain is not subject -- to copyright protection). -- Restrictions on use or distribution: NONE -- -* ------------------ Disclaimer --------------------------------- -- -* -- This software and its documentation are provided "AS IS" and -- without any expressed or implied warranties whatsoever. -- No warranties as to performance, merchantability, or fitness -- for a particular purpose exist. -- -- Because of the diversity of conditions and hardware under -- which this software may be used, no warranty of fitness for -- a particular purpose is offered. The user is advised to -- test the software thoroughly before relying on it. The user -- must assume the entire risk and liability of using this -- software. -- -- In no event shall any person or organization of people be -- held responsible for any direct, indirect, consequential -- or inconsequential damages or lost profits. -- -* -------------------END-PROLOGUE-------------------------------- -- Sort_Utilities is a generic sorting package. The Sort subprograms -- will sort a one dimensional array of any component type that supports -- assignment, equality, and inequality (private types) indexed by -- discrete type components. The default linear order is ascending order -- but may be overridden by the user. The default sort algorithm, -- Quicksort (non-recursive), may also be overridden. -- Note that the component type can be a record type. The Sort subprograms -- are not restricted to simple data types. If records are to be sorted, -- then the formal generic subprogram parameter "<" must be -- specified with by a linear order, e.g., a function provided -- as an actual generic subprogram parameter at instantiation. -- Note that the component type can be an access type (which can -- point to other objects, improving sort efficiency). If access types -- are to be sorted, then the formal generic subprogram parameter "<" -- must be specified by a linear order (see example #3 below). -- Since access types can be sorted, the Sort routine below can be -- used to sort limited types and unconstrained types (designated by -- an access type). -- For data in which equality does not truly apply (i.e., real types) -- one can use the Equal function to specify an equality operation. -- Hence, one can decide that two numbers are "close enough" to be -- equal (see example #4 below). -- The number of comparisons and exchanges made to sort the array -- can be returned. These numbers should give some indication on how -- much work was actually performed by the sorting algorithms. These -- numbers can also be used to compare the relative efficiency -- of the sorting algorithms. -- This package can be used to sort data on external devices. The user -- should use this package to sort a subset of the external data, then -- use a merge operation on all sorted subsets. For example, if the -- system can only hold 1000 components in RAM, but you need to sort -- 3000 components, bring in components #1-1000 and sort them using this -- routine, and then write them to a file. Next do the same with -- components #1001-2000, and finally with components #2001-3000. Now -- merge the three sorted files using a merge package. -- One of the Sort subprograms is a function which can be used to sort -- an array and test it against another in an inline expression. This -- can be useful when comparing the contents of two arrays which may be -- equal, but not at the identical indices. This will be most useful for -- comparing the equality of sets implemented as arrays (see example #5 -- below). -- Other Sort subprograms allow the user to maintain the original state -- of the array by returning a new array that is sorted. These subprograms -- will be useful in cases where sorting is required, but the original -- (unsorted) data must be preserved. -- This package has been formally annotated using the ANNA specification -- language. For more information, contact the author. Also, the -- design of this package has been documented in the IEEE Computer -- Society Second International Conference on Ada Applications and -- Environments proceedings. Contact the IEEE or the author for a copy -- of the paper. This paper is forthcoming in a special issue of IEEE -- Software also. with SYSTEM; -- predefined package SYSTEM generic type Component_Type is private; -- type of the data components type Index_Type is (<>); -- type of array index -- The following generic formal type is required due to Ada's -- strong typing requirements. The SORT subprograms cannot handle -- anonymous array types. This type will match any unconstrained -- array type definition (so that array slices can be sorted -- too -- see example #3 below). type Array_Type is array (Index_Type range <>) of Component_Type; -- The following formal subprogram parameter defaults to the -- predefined "<" operator which will sort one-dimensional -- arrays of Component_Type in ascending order (by default). -- If composite or access types are to be sorted, a selector -- function must be specified. with function "<" (Left,Right : in Component_Type) return BOOLEAN is <>; -- The following formal subprogram parameter defaults to the predefined -- "=" operator. If user-defined equality is desired, one can write -- an equality function and specify it here. with function Equal (Left,Right : in Component_Type) return BOOLEAN is "="; -- The annotations below formally specify assumptions about the -- generic formals above that must be satisfied in order to perform -- correct sorting. --| for all X, Y, Z : Component_Type => --| (not (X < X)) and --| (Equal (X, Y) xor (X < Y) xor (Y < X)) and --| ((X < Y) and (Y < Z) -> (X < Z)) and --| Equal (X, X) and --| (Equal (X, Y) -> Equal (Y, X)) and --| (Equal (X, Y) and Equal (Y, Z) -> Equal (X, Z)) and --| (Equal (X, Y) and (X < Z) -> (Y < Z)) and --| (Equal (X, Y) and (Z < X) -> (Z < Y)); package Sort_Utilities is function Version return STRING; -- Returns the version number. -- Users can specify the type of sorting algorithm they want by -- specifying an enumeration literal from the type below. The default -- algorithm, Quicksort (non-recursive), generally performs best. -- One note about stability of the algorithms: only the Bubble Sorts -- and Insertion Sort are stable algorithms. Thus, they are the -- only algorithms that preserve the ordering of equal components -- without use of a selector function. In all cases, a selector -- function may be specified to introduce stability into the -- sorting algorithms (see example #3 below). type Sort_Algorithm_Type is (Quicksort, Recursive_Quicksort, Bsort, Bubble_Sort, Bubble_Sort_with_Quick_Exit, Selection_Sort, Heapsort, Insertion_Sort, Merge_Sort); -- Quicksort: O(NlogN). Is most efficient when used with large, unsorted -- arrays. Uses an explicit stack to maintain state and -- partitions. Instable. This is the default algorithm. -- Recursive_Quicksort: O(NlogN). Is most efficient when used with large, -- unsorted arrays. Recursive nature may introduce significant -- memory overhead for very large arrays. Instable. -- Bsort: O(NlogN). Is most efficient when used with large arrays -- that are already sorted, partially sorted, or sorted in -- reverse. Recursive. Instable. -- Bubble_Sort: O(N**2). Is most efficient when used with small -- arrays that are almost already sorted. Non-recursive. -- Brute force. Low memory requirements. Stable. -- Bubble_Sort_with_Quick_Exit: O(N**2). Is most efficient when -- used with small arrays that are almost already sorted. -- Non-recursive. Same as bubble sort above except brute -- force is limited. Stable. -- Selection_Sort: O(N**2). Is most efficient when used with -- small arrays in which the Component_Type is a -- record type. Non-recursive. Brute force. Instable. -- Heapsort: O(NlogN). Is most efficient when used with -- large, unsorted arrays. Non-recursive. Very low -- memory requirements. Instable. -- Insertion_Sort: O(N**2). Is most efficient when used with -- small arrays that are almost already sorted. Non- -- recursive. Brute force. Stable. -- Merge_Sort: O(NlogN). Is most efficient when used with medium-large -- arrays. Non-recursive. Instable. Uses an auxiliary array -- to perform merging. -- The following type declaration should be used to specify the -- instrumentation analysis results that can be returned by the Sort -- subprograms below. -1 is only returned if an overflow in calculations -- has occurred. The Sort subprograms will still sort the array if an -- overflow in instrumentation analysis data calculations -- occurs. type Performance_Instrumentation_Type is range -1 .. SYSTEM.MAX_INT; -- The following exception is raised during execution of the Sort -- subprograms which take two arrays as parameters. These two arrays -- must be of the same length. Sort_Arrays_Length_Mismatch : exception; -- The following virtual functions define the semantics of sorting. -- The use of Index_Type'SUCC and Index_Type'PRED might raise -- CONSTRAINT_ERROR on boundary limits, and need to be enhanced -- in these cases. (An annotation that raises an exception during -- its evaluation is not consistent with the specification.) --: function Ordered (A : in Array_Type) return BOOLEAN; --| where return (A'LENGTH <= 1) or else --| (((A (A'FIRST) < A (Index_Type'SUCC (A'FIRST))) or --| (Equal (A (A'FIRST), A (Index_Type'SUCC (A'FIRST))))) and --| Ordered (A (Index_Type'SUCC (A'FIRST) .. A'LAST))); --: function Permutation (A, B : in Array_Type) return BOOLEAN; --| where A'LENGTH = B'LENGTH, --| Ordered (B), --| return (A'LENGTH = 0) or else --| (exist I : B'RANGE => --| Equal (A (A'FIRST), B (I)) and --| Permutation (A (Index_Type'SUCC (A'FIRST) .. A'LAST), --| B (B'FIRST .. Index_Type'PRED (I)) & --| B (Index_Type'SUCC (I) .. B'LAST))); -- The following procedure will sort a one dimensional array of -- components. It can sort in ascending/descending order or any -- user-defined order. It can sort components of any type that -- support equality, inequality, and assignment (private types). -- The array indices can be of any discrete type. The number of -- comparisons and exchanges can also be returned. procedure Sort ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type; Sort_Algorithm : in Sort_Algorithm_Type := Quicksort); --| where out Ordered (Sort_Array), --| out Permutation (in Sort_Array, Sort_Array), --| out Number_of_Comparisons'DEFINED, --| out Number_of_Exchanges'DEFINED, --| raise Sort_Arrays_Length_Mismatch => FALSE; -- The following overloading of procedure Sort should be specified -- when no instrumentation analysis data are required. procedure Sort ( Sort_Array : in out Array_Type; Sort_Algorithm : in Sort_Algorithm_Type := Quicksort); --| where out Ordered (Sort_Array), --| out Permutation (in Sort_Array, Sort_Array), --| raise Sort_Arrays_Length_Mismatch => FALSE; -- The following overloading of procedure Sort should be used when -- the original data must be preserved and instrumentation analysis -- results are required. procedure Sort ( Unsorted_Array : in Array_Type; Sorted_Array : out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type; Sort_Algorithm : in Sort_Algorithm_Type := Quicksort); --| where out Ordered (Sorted_Array), --| out Permutation (Unsorted_Array, Sorted_Array), --| out Number_of_Comparisons'DEFINED, --| out Number_of_Exchanges'DEFINED, --| Unsorted_Array'LENGTH /= Sorted_Array'LENGTH => --| raise Sort_Arrays_Length_Mismatch; -- The following overloading of procedure Sort should be used when -- the original data must be preserved and no instrumentation analysis -- results are required. procedure Sort ( Unsorted_Array : in Array_Type; Sorted_Array : out Array_Type; Sort_Algorithm : in Sort_Algorithm_Type := Quicksort); --| where out Ordered (Sorted_Array), --| out Permutation (Unsorted_Array, Sorted_Array), --| Unsorted_Array'LENGTH /= Sorted_Array'LENGTH => --| raise Sort_Arrays_Length_Mismatch; -- The following overloading of function Sort should be used when -- sorting is required in an inline expression. function Sort ( Sort_Array : in Array_Type; Sort_Algorithm : in Sort_Algorithm_Type := Quicksort) return Array_Type; --| where return A : Array_Type => --| Ordered (A) and Permutation (Sort_Array, A); --| raise Sort_Arrays_Length_Mismatch => FALSE; end Sort_Utilities; -- Example uses/instantiations: -- -- EXAMPLE #1: Sorting an array of CHARACTERs -- with Sort_Utilities; -- procedure Main is -- type My_Index_Type is (Sun,Mon,Tue,Wed,Thu,Fri,Sat); -- type My_Array_Type is array (My_Index_Type range <>) of CHARACTER; -- package Ascending_Sort is new Sort_Utilities ( -- Component_Type => CHARACTER, -- Index_Type => My_Index_Type, -- Array_Type => My_Array_Type); -- package Descending_Sort is new Sort_Utilities ( -- Component_Type => CHARACTER, -- Index_Type => My_Index_Type, -- Array_Type => My_Array_Type, -- "<" => ">"); -- My_Array : My_Array_Type (Mon .. Fri); -- Number_of_Comparisons, -- Number_of_Exchanges, : Descending_Sort.Performance_Instrumentation_Type; -- begin -- Ascending_Sort.Sort (My_Array); -- Descending_Sort.Sort ( -- Sort_Array => My_Array, -- Number_of_Comparisons => Number_of_Comparisons, -- Number_of_Exchanges => Number_of_Exchanges, -- Sort_Algorithm => Descending_Sort.Bubble_Sort); -- end Main; -- ------------------------------------------------------------------- -- -- EXAMPLE #2: Sorting an array of records based on a key field -- with Sort_Utilities; -- procedure Main is -- type My_Component_Type is -- record -- Field1 : INTEGER; -- Field2 : FLOAT; -- Field3 : CHARACTER; -- end record; -- subtype My_Index_Type is INTEGER range -10 .. 10; -- type My_Array_Type is array (My_Index_Type range <>) of My_Component_Type; -- My_Array : My_Array_Type (-10 .. 10); -- function Ascending_Order_on_Field1 (Left,Right : in My_Component_Type) return BOOLEAN is -- begin -- return Left.Field1 < Right.Field1; -- end Ascending_Order_on_Field1; -- function Descending_Order_on_Field3 (Left,Right : in My_Component_Type) return BOOLEAN is -- begin -- return Left.Field3 > Right.Field3; -- end Descending_Order_on_Field3; -- package Ascending_Sort_on_Field1 is new Sort_Utilities ( -- Component_Type => My_Component_Type, -- Index_Type => My_Index_Type, -- Array_Type => My_Array_Type, -- "<" => Ascending_Order_on_Field1); -- package Descending_Sort_on_Field3 is new Sort_Utilities ( -- Component_Type => My_Component_Type, -- Index_Type => My_Index_Type, -- Array_Type => My_Array_Type, -- "<" => Descending_Order_on_Field3); -- Ascending_Sort_on_Field1.Sort (My_Array); -- Descending_Sort_on_Field3.Sort ( -- Sort_Array => My_Array, -- Sort_Algorithm => Descending_Sort_on_Field3.Selection_Sort); -- end Main; -- ------------------------------------------------------------------- -- EXAMPLE #3: Sorting an array slice of access types that designate -- records. -- with Sort_Utilities; -- procedure Main is -- type Taxpayer_Type is -- record -- Name : STRING (1 .. 40); -- Age : NATURAL; -- ID_Number : POSITIVE; -- social security number -- end record; -- type Taxpayer_Access_Type is access Taxpayer_Type; -- type My_Index_Type is range 1 .. 1_000_000; -- type My_Array_Type is array (My_Index_Type range <>) of Taxpayer_Access_Type; -- My_Array : My_Array_Type (1 .. 1_000_000); -- function Ascending_Taxpayers (Left,Right : in Taxpayer_Access_Type) return BOOLEAN is -- begin -- return (Left.Name < Right.Name) or -- ((Left.Name = Right.Name) and (Left.ID_Number < Right.ID_Number)); -- end Ascending_Taxpayers; -- package Ascending_Taxpayer_Sort is new Sort_Utilities ( -- Taxpayer_Access_Type,My_Index_Type,My_Array_Type,Ascending_Taxpayers); -- Ascending_Taxpayer_Sort.Sort (My_Array(100..1_000)); -- end Main; -- --------------------------------------------------------------------------- -- EXAMPLE #4: Sorting an array of floating point numbers using a -- constrained array subtype -- with Sort_Utilities; -- procedure Main is -- type My_Array_Type is array (POSITIVE range <>) of FLOAT; -- subtype My_Array_Subtype is My_Array_Type (1 .. 10); -- My_Array : My_Array_Subtype; -- function My_Equality (L, R : in FLOAT) is -- begin -- . . . -- check for "close enough" on equality -- return ; -- end My_Equality; -- package My_Sort_Utilities is new Sort_Utilities (FLOAT,POSITIVE,My_Array_Type, -- My_Equality); -- begin -- My_Sort_Utilities.Sort (My_Array); -- end Main; -- --------------------------------------------------------------------------- -- EXAMPLE #5: Sorting in an inline expression -- with Sort_Utilities; -- procedure Main is -- type Set_Type is array (POSITIVE range <>) of CHARACTER; -- Set1, -- Set2 : Set_Type (1 .. 10); -- package My_Sort_Utilities is new Sort_Utilities (CHARACTER,POSITIVE,Set_Type); -- begin -- if My_Sort_Utilities.Sort (Set1) = My_Sort_Utilities.Sort (Set2) then -- . . . -- end if; -- end Main; package body Sort_Utilities is Version_Number : constant STRING := "1.3 (FRAY297)"; --: function Ordered (A : in Array_Type) return BOOLEAN is --: begin --: for I in A'FIRST .. Index_Type'PRED (A'LAST) loop --: if A (Index_Type'SUCC (I)) < A (I) then --: return FALSE; --: end if; --: end loop; --: return TRUE; --: end Ordered; --: function Permutation (A, B : in Array_Type) return BOOLEAN is --: type Mark_Array_Type is array (A'RANGE) of BOOLEAN; --: Mark : Mark_Array_Type := (others => FALSE); --: Mark_Pos : Index_Type; --: Not_Marked : BOOLEAN; --: begin --: for I in A'RANGE loop --: Not_Marked := TRUE; --: for J in B'RANGE loop --: if Equal (A (I), B (J)) and not Mark (J) then --: Mark_Pos := J; --: exit; --: end if; --: end loop; --: if Not_Marked then --: return FALSE; --: else --: Mark (Mark_Pos) := TRUE; --: end if; --: end loop; --: return Mark = (others => TRUE); --: end Permutation; function Version return STRING is begin return Version_Number; end Version; -- The following subprograms are utilities for the sorting -- procedures that follow them. procedure Update_Performance_Instrumentation ( Instrumentation_Count : in out Performance_Instrumentation_Type) is begin -- Bump the counter unless an overflow has occurred. if Instrumentation_Count /= Performance_Instrumentation_Type'FIRST then if Instrumentation_Count /= Performance_Instrumentation_Type'LAST then Instrumentation_Count := Instrumentation_Count + 1; else Instrumentation_Count := Performance_Instrumentation_Type'FIRST; end if; end if; end Update_Performance_Instrumentation; procedure Exchange_Array_Components ( Sort_Array : in out Array_Type; Number_of_Exchanges : in out Performance_Instrumentation_Type) is Temporary_Component : constant Component_Type := Sort_Array (Sort_Array'FIRST); begin Sort_Array (Sort_Array'FIRST) := Sort_Array (Sort_Array'LAST); Sort_Array (Sort_Array'LAST) := Temporary_Component; Update_Performance_Instrumentation (Number_of_Exchanges); end Exchange_Array_Components; -- Procedure Quicksort is the default sort algorithm used. It is -- a non-recursive method of sorting by constantly partitioning the -- array in half and sorting only that half. This algorithm is -- O(NlogN) and is instable. procedure Quicksort ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type) is type Sort_Array_Index_Save_Type is record Left, Right : Index_Type; end record; subtype Stack_Index_Type is NATURAL range 0 .. Sort_Array'LENGTH; type Stack_Array_Type is array (Stack_Index_Type) of Sort_Array_Index_Save_Type; Local_Comparisons, Local_Exchanges : Performance_Instrumentation_Type := 0; I, J, L, R : Index_Type; Temporary_Component : Component_Type; Stack_Pointer : Stack_Index_Type; Stack_Array : Stack_Array_Type; begin if Sort_Array'FIRST < Sort_Array'LAST then Stack_Pointer := 1; Stack_Array (1).Left := Sort_Array'FIRST; Stack_Array (1).Right := Sort_Array'LAST; loop -- Take top request from stack. L := Stack_Array (Stack_Pointer).Left; R := Stack_Array (Stack_Pointer).Right; Stack_Pointer := Stack_Pointer - 1; loop -- Split Sort_Array (Sort_Array'FIRST) .. Sort_Array (R). I := L; J := R; Temporary_Component := Sort_Array (Index_Type'VAL ( ((Index_Type'POS (L) + Index_Type'POS (R)) / 2))); loop loop Update_Performance_Instrumentation (Local_Comparisons); exit when (not (Sort_Array (I) < Temporary_Component)) or (I = Sort_Array'LAST); I := Index_Type'SUCC (I); end loop; loop Update_Performance_Instrumentation (Local_Comparisons); exit when (not (Temporary_Component < Sort_Array (J))) or (J = Sort_Array'FIRST); J := Index_Type'PRED (J); end loop; if I <= J then if I /= J then Exchange_Array_Components (Sort_Array (I .. J),Local_Exchanges); end if; if I /= Sort_Array'LAST then I := Index_Type'SUCC (I); end if; if J /= Sort_Array'FIRST then J := Index_Type'PRED (J); end if; end if; exit when I > J; end loop; if (Index_Type'POS (J) - Index_Type'POS (L)) < (Index_Type'POS (R) - Index_Type'POS (I)) then if I < R then -- Stack request for sorting right partition. Stack_Pointer := Stack_Pointer + 1; Stack_Array (Stack_Pointer).Left := I; Stack_Array (Stack_Pointer).Right := R; end if; R := J; -- Continue sorting left partition. else if L < J then -- Stack request for sorting left partition. Stack_Pointer := Stack_Pointer + 1; Stack_Array (Stack_Pointer).Left := L; Stack_Array (Stack_Pointer).Right := J; end if; L := I; -- Continue sorting right partition. end if; exit when L >= R; end loop; exit when Stack_Pointer = 0; end loop; end if; Number_of_Comparisons := Local_Comparisons; Number_of_Exchanges := Local_Exchanges; end Quicksort; -- The following procedure houses a Quicksort that is identical to -- the one above, except that recursion manages the state and paritions -- instead of an explicit stack. procedure Recursive_Quicksort ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type) is Local_Comparisons, Local_Exchanges : Performance_Instrumentation_Type := 0; -- The recursive nature of the sorting algorithm is found in -- the procedure below. procedure Recursive_Quick (Sort_Array : in out Array_Type) is I : Index_Type := Sort_Array'FIRST; J : Index_Type := Sort_Array'LAST; -- The partitioning of the array in half is found in the -- procedure below. It is this procedure that really sorts -- the array by making the necessary exchanges. -- This algorithm DEPENDS on the fact that there are two or -- more array components. Singleton or null arrays are special cases -- and should be handled by the outermost level of the -- Quicksort algorithm. procedure Partition is Sort_Array_Mid_Value : constant Component_Type := Sort_Array (Index_Type'VAL ((Index_Type'POS (I) + Index_Type'POS (J)) / 2)); begin loop while (Sort_Array (I) < Sort_Array_Mid_Value) and (I /= Sort_Array'LAST) loop Update_Performance_Instrumentation (Local_Comparisons); I := Index_Type'SUCC (I); end loop; while (Sort_Array_Mid_Value < Sort_Array (J)) and (J /= Sort_Array'FIRST) loop Update_Performance_Instrumentation (Local_Comparisons); J := Index_Type'PRED (J); end loop; if I <= J then if I < J then Exchange_Array_Components (Sort_Array (I .. J),Local_Exchanges); end if; if I /= Sort_Array'LAST then I := Index_Type'SUCC (I); end if; if J /= Sort_Array'FIRST then J := Index_Type'PRED (J); end if; end if; exit when (I > J) or ((I = Sort_Array'LAST) and (J = Sort_Array'FIRST)); end loop; end Partition; begin -- Recursive_Quick Partition; if Sort_Array'FIRST < J then Recursive_Quick (Sort_Array (Sort_Array'FIRST .. J)); end if; if I < Sort_Array'LAST then Recursive_Quick (Sort_Array (I .. Sort_Array'LAST)); end if; end Recursive_Quick; begin -- Recursive_Quicksort -- Handle the special cases of singleton and null arrays... -- do nothing. if Sort_Array'FIRST < Sort_Array'LAST then Recursive_Quick (Sort_Array); end if; Number_of_Comparisons := Local_Comparisons; Number_of_Exchanges := Local_Exchanges; end Recursive_Quicksort; -- A variation on Recursive_Quicksort is found in the procedure below. It -- is good for sorting data that is already ordered, partially ordered, -- or reverse ordered. The algorithm is O(NlogN) and instable. It is -- a combination of Recursive_Quicksort and Bubble_Sort_with_Quick_Exit. procedure Bsort ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type) is Local_Comparisons, Local_Exchanges : Performance_Instrumentation_Type := 0; -- The recursive nature of the algorithm is found in the procedure below. procedure Recursive_Bsort ( Low_Index, High_Index : in Index_Type; Mid_Component : in Component_Type) is Flag, Left_Flag, Right_Flag : BOOLEAN; I, J : Index_Type; Size : NATURAL; -- Sort_Array (Low_Index .. High_Index) are the components to be -- sorted, and Mid_Component is the value of the middle component. -- I and J are used to partition the subfiles so that at any time -- Sort_Array (I) < Mid_Component and (Mid_Component < Sort_Array (J) -- or Mid_Component = Sort_Array (J)). Left_Flag is TRUE whenever -- the left subfile is not in sorted order, and Right_Flag is -- TRUE whenever the right subfile is not in sorted order. Flag is -- FALSE when the partitioning processes are completed. begin if Low_Index < High_Index then Left_Flag := FALSE; Right_Flag := FALSE; I := Low_Index; J := High_Index; Flag := TRUE; while Flag loop loop Update_Performance_Instrumentation (Local_Comparisons); exit when (Mid_Component < Sort_Array (I)) or Equal (Mid_Component,Sort_Array (I)) or (I = J); -- Build the left subfile ensuring that the rightmost component -- is always the largest of the subfile. if I /= Low_Index then Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (I) < Sort_Array (Index_Type'PRED (I)) then Exchange_Array_Components ( Sort_Array (Index_Type'PRED (I) .. I),Local_Exchanges); Left_Flag := TRUE; end if; end if; I := Index_Type'SUCC (I); end loop; loop Update_Performance_Instrumentation (Local_Comparisons); exit when (Sort_Array (J) < Mid_Component) or (I = J); -- Build the right subfile ensuring that the leftmost component -- is always the smallest of the subfile. if J /= High_Index then Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (Index_Type'SUCC (J)) < Sort_Array (J) then Exchange_Array_Components ( Sort_Array (J .. Index_Type'SUCC (J)),Local_Exchanges); Right_Flag := TRUE; end if; end if; J := Index_Type'PRED (J); end loop; if I /= J then -- Interchange Sort_Array (I) from the left subfile with -- Sort_Array (J) from the right subfile. Exchange_Array_Components (Sort_Array (I .. J),Local_Exchanges); else -- I = J -- Partitioning into left and right subfiles has been completed. Update_Performance_Instrumentation (Local_Comparisons); if (Mid_Component < Sort_Array (J)) or Equal (Mid_Component,Sort_Array (J)) then -- Check the right subfile to ensure the first component, -- Sort_Array (J), is the smallest. if J /= Sort_Array'LAST then Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (Index_Type'SUCC (J)) < Sort_Array (J) then Exchange_Array_Components ( Sort_Array (J .. Index_Type'SUCC (J)),Local_Exchanges); Right_Flag := TRUE; end if; end if; else -- Check the left subfile to ensure the last component, -- Sort_Array (Index_Type'PRED (I)), is the largest. if I /= Sort_Array'FIRST then Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (I) < Sort_Array (Index_Type'PRED (I)) then Exchange_Array_Components ( Sort_Array (Index_Type'PRED (I) .. I),Local_Exchanges); Left_Flag := TRUE; end if; end if; if I > Index_Type'SUCC (Sort_Array'FIRST) then Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (Index_Type'PRED (I)) < Sort_Array (Index_Type'PRED (Index_Type'PRED (I))) then Exchange_Array_Components ( Sort_Array (Index_Type'PRED (Index_Type'PRED (I)) .. Index_Type'PRED (I)),Local_Exchanges); end if; end if; end if; Flag := FALSE; end if; -- end of "if I /= J" end loop; -- end of "while Flag loop" -- Process the left subfile. Size := Index_Type'POS (I) - Index_Type'POS (Low_Index); if Size > 2 then -- Subfile must have at least three components to process and -- not already sorted. if Left_Flag then if Size = 3 then -- Special case of 3 components; place Sort_Array (Low_Index) -- and Sort_Array (Index_Type'SUCC (Low_Index)) in sorted order. Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (Index_Type'SUCC (Low_Index)) < Sort_Array (Low_Index) then Exchange_Array_Components ( Sort_Array (Low_Index .. Index_Type'SUCC (Low_Index)), Local_Exchanges); end if; else Recursive_Bsort (Low_Index,Index_Type'PRED (Index_Type'PRED (I)), Sort_Array (Index_Type'VAL ( ((Index_Type'POS (Low_Index) + Index_Type'POS (I) - 2) / 2) ))); end if; end if; end if; -- Process the right subfile. Size := Index_Type'POS (High_Index) - Index_Type'POS (J) + 1; if Size > 2 then -- Subfile must have at least 3 components to process and not -- already sorted. if Right_Flag then if Size = 3 then -- Special case of 3 components; place -- Sort_Array (Index_Type'SUCC (J)) and -- Sort_Array (Index_Type'SUCC (Index_Type'SUCC (J))) in sorted -- order. Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (Index_Type'SUCC (Index_Type'SUCC (J))) < Sort_Array (Index_Type'SUCC (J)) then Exchange_Array_Components ( Sort_Array (Index_Type'SUCC (J) .. Index_Type'SUCC (Index_Type'SUCC (J))), Local_Exchanges); end if; else Recursive_Bsort (Index_Type'SUCC (J),High_Index, Sort_Array (Index_Type'VAL ( ((Index_Type'POS (J) + Index_Type'POS (High_Index) + 1) / 2) ))); end if; end if; end if; end if; -- end of "if M < N then" end Recursive_Bsort; begin -- Bsort -- Do not bother with singleton and null arrays. if Sort_Array'FIRST < Sort_Array'LAST then Recursive_Bsort (Sort_Array'FIRST,Sort_Array'LAST, Sort_Array (Index_Type'VAL ( ((Index_Type'POS (Sort_Array'FIRST) + Index_Type'POS (Sort_Array'LAST)) / 2)))); end if; Number_of_Comparisons := Local_Comparisons; Number_of_Exchanges := Local_Exchanges; end Bsort; -- A bubble sort algorithm is found in the procedure below. The -- algorithm used is a standard bubble sort. This algorithm is -- O(N**2) and is stable. procedure Bubble_Sort ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type) is Local_Comparisons, Local_Exchanges : Performance_Instrumentation_Type := 0; begin -- Check for the singleton/null array cases... do nothing. if Sort_Array'FIRST < Sort_Array'LAST then for I in Sort_Array'FIRST .. Index_Type'VAL (Index_Type'POS (Sort_Array'LAST) - 1) loop for J in Sort_Array'FIRST .. Index_Type'VAL ( (Index_Type'POS (Sort_Array'LAST) + Index_Type'POS (Sort_Array'FIRST) - 1 ) - Index_Type'POS (I) ) loop Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (Index_Type'SUCC (J)) < Sort_Array (J) then Exchange_Array_Components (Sort_Array (J .. Index_Type'SUCC (J)), Local_Exchanges); end if; end loop; end loop; end if; Number_of_Comparisons := Local_Comparisons; Number_of_Exchanges := Local_Exchanges; end Bubble_Sort; -- A bubble sort algorithm is found in the procedure below. The -- algorithm used is a standard bubble sort with a quick exit. The -- quick exit is taken if the data just happens to be sorted -- in the middle of the process. Thus, this algorithm may be faster -- than O(N**2) for arrays that are already partially ordered. procedure Bubble_Sort_with_Quick_Exit ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type) is Local_Comparisons, Local_Exchanges : Performance_Instrumentation_Type := 0; Interchange_Made : BOOLEAN; begin -- Check for the singleton/null array cases... do nothing. if Sort_Array'FIRST < Sort_Array'LAST then for I in Sort_Array'FIRST .. Index_Type'VAL ( Index_Type'POS (Sort_Array'LAST) - 1) loop Interchange_Made := FALSE; for J in Sort_Array'FIRST .. Index_Type'VAL ( (Index_Type'POS (Sort_Array'LAST) + Index_Type'POS (Sort_Array'FIRST) - 1 ) - Index_Type'POS (I) ) loop Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (Index_Type'SUCC (J)) < Sort_Array (J) then Interchange_Made := TRUE; Exchange_Array_Components (Sort_Array (J .. Index_Type'SUCC (J)), Local_Exchanges); end if; end loop; exit when not Interchange_Made; end loop; end if; Number_of_Comparisons := Local_Comparisons; Number_of_Exchanges := Local_Exchanges; end Bubble_Sort_with_Quick_Exit; -- A straight selection sort follows below. It is O(N**2) and -- is instable. procedure Selection_Sort ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type) is Local_Comparisons, Local_Exchanges : Performance_Instrumentation_Type := 0; Small : Index_Type; begin -- Check for singelton/null array case... do nothing. if Sort_Array'FIRST < Sort_Array'LAST then for I in Sort_Array'FIRST .. Index_Type'PRED (Sort_Array'LAST) loop Small := I; for J in Index_Type'SUCC (I) .. Sort_Array'LAST loop Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (J) < Sort_Array (Small) then Small := J; end if; end loop; if I /= Small then Exchange_Array_Components (Sort_Array (I .. Small),Local_Exchanges); end if; end loop; end if; Number_of_Comparisons := Local_Comparisons; Number_of_Exchanges := Local_Exchanges; end Selection_Sort; -- Heapsort follows below. It is O(NlogN) and is instable. procedure Heapsort ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type) is Local_Comparisons, Local_Exchanges : Performance_Instrumentation_Type := 0; I,J : Index_Type; Temporary_Component : Component_Type; begin -- Check for special array cases: do nothing on singleton/null, -- must handle an array of 2 elements separate since the algorithm -- assumes that Sort_Array'LENGTH >= 3. if Sort_Array'LENGTH = 2 then Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (Sort_Array'LAST) < Sort_Array (Sort_Array'FIRST) then Exchange_Array_Components (Sort_Array,Local_Exchanges); end if; elsif Sort_Array'FIRST < Sort_Array'LAST then -- Create initial heap. for K in Index_Type'SUCC (Sort_Array'FIRST) .. Sort_Array'LAST loop -- Insert Sort_Array (K) into existing heap of size K-1. I := K; Temporary_Component := Sort_Array (K); -- The complex expression in assigning to J below is necessary -- due to the generic nature of the algorithm. This -- expression is used in other places below too. if Index_Type'POS (I) >= 0 then J := Index_Type'VAL ((Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 1) / 2); elsif ((Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 1) mod 2) = 0 then J := Index_Type'VAL ((Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 1) / 2); else J := Index_Type'VAL ((Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 2) / 2); end if; while J >= Sort_Array'FIRST loop Update_Performance_Instrumentation (Local_Comparisons); exit when (Temporary_Component < Sort_Array (J)) or Equal (Temporary_Component,Sort_Array (J)); Update_Performance_Instrumentation (Local_Exchanges); Sort_Array (I) := Sort_Array (J); I := J; if Index_Type'POS (I) >= 0 then if (((Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 1) / 2) >= Index_Type'POS (Sort_Array'FIRST) ) and (I /= Sort_Array'FIRST) then J := Index_Type'VAL ( (Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 1) / 2); else exit; -- Exit while loop. end if; elsif ((Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 1) mod 2) = 0 then if (((Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 1) / 2) >= Index_Type'POS (Sort_Array'FIRST) ) and (I /= Sort_Array'FIRST) then J := Index_Type'VAL ( (Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 1) / 2); else exit; -- Exit while loop. end if; elsif (((Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 1) / 2) >= Index_Type'POS (Sort_Array'FIRST) ) and (I /= Sort_Array'FIRST) then J := Index_Type'VAL ( (Index_Type'POS (I) + Index_Type'POS (Sort_Array'FIRST) - 2) / 2); else exit; -- Exit while loop. end if; end loop; -- End of while loop. Update_Performance_Instrumentation (Local_Comparisons); if not Equal (Temporary_Component,Sort_Array (I)) then Update_Performance_Instrumentation (Local_Exchanges); Sort_Array (I) := Temporary_Component; end if; end loop; -- End of for loop. -- We remove Sort_Array (Sort_Array'FIRST) and place it in its -- proper position in the array. We then adjust the heap. for K in reverse Index_Type'SUCC (Sort_Array'FIRST) .. Sort_Array'LAST loop Update_Performance_Instrumentation (Local_Exchanges); Temporary_Component := Sort_Array (K); Sort_Array (K) := Sort_Array (Sort_Array'FIRST); -- Readjust the heap of order K-1. Move Temporary_Component down the -- heap for proper position. I := Sort_Array'FIRST; J := Index_Type'SUCC (I); -- The following if statement can be described as follows: -- if (Sort_Array (Element#2) < Sort_Array (Element#3)) and -- (Position of K's predecessor >= Position of Element#3) then -- J := Position of Element#3; -- end if; -- The complications are due to the generic nature of the -- algorithm. Update_Performance_Instrumentation (Local_Comparisons); if ((Sort_Array (Index_Type'SUCC (Sort_Array'FIRST))) < (Sort_Array (Index_Type'SUCC (Index_Type'SUCC (Sort_Array'FIRST)))) ) and (Index_Type'PRED (K) >= Index_Type'SUCC (Index_Type'SUCC (Sort_Array'FIRST)) ) then J := Index_Type'SUCC (Index_Type'SUCC (Sort_Array'FIRST)); end if; -- J is the larger son of I in the heap of size K-1. while J <= Index_Type'PRED (K) loop Update_Performance_Instrumentation (Local_Comparisons); if (Sort_Array (J) < Temporary_Component) or Equal (Sort_Array (J),Temporary_Component) then exit; -- exit while loop end if; Update_Performance_Instrumentation (Local_Exchanges); Sort_Array (I) := Sort_Array (J); I := J; if (((Index_Type'POS (I) * 2) - Index_Type'POS (Sort_Array'FIRST) + 1) <= Index_Type'POS (Index_Type'PRED (Sort_Array'LAST)) ) and (((Index_Type'POS (I) * 2) - Index_Type'POS (Sort_Array'FIRST) + 1) >= Index_Type'POS (Sort_Array'FIRST) ) then J := Index_Type'VAL ( (Index_Type'POS (I) * 2) - Index_Type'POS (Sort_Array'FIRST) + 1); else exit; -- Exit while loop. end if; if Index_Type'SUCC (J) <= Index_Type'PRED (K) then Update_Performance_Instrumentation (Local_Comparisons); if Sort_Array (J) < Sort_Array (Index_Type'SUCC (J)) then J := Index_Type'SUCC (J); end if; end if; end loop; -- End of while loop. Update_Performance_Instrumentation (Local_Exchanges); Sort_Array (I) := Temporary_Component; end loop; -- End of for loop. end if; Number_of_Comparisons := Local_Comparisons; Number_of_Exchanges := Local_Exchanges; end Heapsort; -- Simple insertion sort follows below. It is O(N**2), but usually -- better than a bubble sort. procedure Insertion_Sort ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type) is Local_Comparisons, Local_Exchanges : Performance_Instrumentation_Type := 0; I : Index_Type; Temporary_Component : Component_Type; Found : BOOLEAN; begin -- Handle special cases of singleton/null arrays... -- do nothing. if Sort_Array'FIRST < Sort_Array'LAST then -- Initially Sort_Array (Sort_Array'FIRST) may be thought of -- as a sorted file of one element. After each repetition of -- the following loop, the elements Sort_Array (Sort_Array'FIRST) -- through Sort_Array (K) are in order. for K in Index_Type'SUCC (Sort_Array'FIRST) .. Sort_Array'LAST loop -- insert Sort_Array (K) into the sorted file Temporary_Component := Sort_Array (K); -- Move down one position all elements "greater" than -- Temporary_Component I := Index_Type'PRED (K); Found := FALSE; while (not Found) loop Update_Performance_Instrumentation (Local_Comparisons); if Temporary_Component < Sort_Array (I) then Update_Performance_Instrumentation (Local_Exchanges); Sort_Array (Index_Type'SUCC (I)) := Sort_Array (I); if I /= Sort_Array'FIRST then I := Index_Type'PRED (I); else exit; -- Exit while loop. end if; else Found := TRUE; end if; end loop; -- End of while loop. -- Insert Temporary_Component at proper position. Update_Performance_Instrumentation (Local_Exchanges); if Found then Sort_Array (Index_Type'SUCC (I)) := Temporary_Component; else Sort_Array (Sort_Array'FIRST) := Temporary_Component; end if; end loop; -- End of for loop. end if; Number_of_Comparisons := Local_Comparisons; Number_of_Exchanges := Local_Exchanges; end Insertion_Sort; -- The straight merge sort procedure below is O(NlogN) and is instable. procedure Merge_Sort ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type) is Auxiliary_Array : Array_Type (Sort_Array'FIRST .. Sort_Array'LAST); Lower_Bound1, Lower_Bound2, Upper_Bound1, Upper_Bound2, Auxiliary_Index, I, J : Index_Type; I_Overflow, J_Overflow, Aux_Overflow : BOOLEAN; Size : POSITIVE := 1; -- Merge files of size 1. Local_Comparisons, Local_Exchanges : Performance_Instrumentation_Type := 0; begin while Size < Sort_Array'LENGTH loop Lower_Bound1 := Sort_Array'FIRST; Auxiliary_Index := Auxiliary_Array'FIRST; -- Check if there are two files to merge. while (Index_Type'POS (Lower_Bound1) + Size) <= Index_Type'POS (Sort_Array'LAST) loop I_Overflow := FALSE; J_Overflow := FALSE; Aux_Overflow := FALSE; -- Compute remaining indices. Lower_Bound2 := Index_Type'VAL (Index_Type'POS (Lower_Bound1) + Size); Upper_Bound1 := Index_Type'PRED (Lower_Bound2); if Index_Type'POS (Lower_Bound2) + Size - 1 > Index_Type'POS (Sort_Array'LAST) then Upper_Bound2 := Sort_Array'LAST; else Upper_Bound2 := Index_Type'VAL (Index_Type'POS (Lower_Bound2) + Size - 1); end if; -- Proceed through the two subfiles. I := Lower_Bound1; J := Lower_Bound2; while (I <= Upper_Bound1) and (J <= Upper_Bound2) loop -- Enter smaller into Auxiliary_Array. Update_Performance_Instrumentation (Local_Comparisons); Update_Performance_Instrumentation (Local_Exchanges); if (Sort_Array (I) < Sort_Array (J)) or Equal (Sort_Array (I),Sort_Array (J)) then Auxiliary_Array (Auxiliary_Index) := Sort_Array (I); if Auxiliary_Index /= Auxiliary_Array'LAST then Auxiliary_Index := Index_Type'SUCC (Auxiliary_Index); else Aux_Overflow := TRUE; end if; if I /= Sort_Array'LAST then I := Index_Type'SUCC (I); else I_Overflow := TRUE; exit; end if; else Auxiliary_Array (Auxiliary_Index) := Sort_Array (J); if Auxiliary_Index /= Auxiliary_Array'LAST then Auxiliary_Index := Index_Type'SUCC (Auxiliary_Index); else Aux_Overflow := TRUE; end if; if J /= Sort_Array'LAST then J := Index_Type'SUCC (J); else J_Overflow := TRUE; exit; end if; end if; end loop; -- While loop. -- At this point one of the subfiles has been exhausted. -- Insert any remaining portions of the other file. while (not I_Overflow) and (I <= Upper_Bound1) loop Update_Performance_Instrumentation (Local_Exchanges); Auxiliary_Array (Auxiliary_Index) := Sort_Array (I); if I /= Sort_Array'LAST then I := Index_Type'SUCC (I); else I_Overflow := TRUE; end if; if Auxiliary_Index /= Auxiliary_Array'LAST then Auxiliary_Index := Index_Type'SUCC (Auxiliary_Index); else Aux_Overflow := TRUE; end if; end loop; while (not J_Overflow) and (J <= Upper_Bound2) loop Update_Performance_Instrumentation (Local_Exchanges); Auxiliary_Array (Auxiliary_Index) := Sort_Array (J); if J /= Sort_Array'LAST then J := Index_Type'SUCC (J); else J_Overflow := TRUE; end if; if Auxiliary_Index /= Auxiliary_Array'LAST then Auxiliary_Index := Index_Type'SUCC (Auxiliary_Index); else Aux_Overflow := TRUE; end if; end loop; -- Advance Lower_Bound1 to start of next pair of files. if Index_Type'POS (Upper_Bound2) + 1 <= Index_Type'POS (Sort_Array'LAST) then Lower_Bound1 := Index_Type'SUCC (Upper_Bound2); else Lower_Bound1 := Sort_Array'LAST; end if; end loop; -- While loop. -- Copy any remaining single file. I := Lower_Bound1; while not Aux_Overflow loop Update_Performance_Instrumentation (Local_Exchanges); Auxiliary_Array (Auxiliary_Index) := Sort_Array (I); if Auxiliary_Index /= Auxiliary_Array'LAST then Auxiliary_Index := Index_Type'SUCC (Auxiliary_Index); else Aux_Overflow := TRUE; end if; if I /= Sort_Array'LAST then I := Index_Type'SUCC (I); else I_Overflow := TRUE; end if; end loop; -- Adjust Sort_Array and Size. Sort_Array := Auxiliary_Array; Size := Size * 2; end loop; -- While loop. Number_of_Comparisons := Local_Comparisons; Number_of_Exchanges := Local_Exchanges; end Merge_Sort; procedure Sort ( Sort_Array : in out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type; Sort_Algorithm : in Sort_Algorithm_Type := Quicksort) is begin -- Call the right sorting algorithm. case Sort_Algorithm is when Quicksort => Quicksort (Sort_Array,Number_of_Comparisons,Number_of_Exchanges); when Recursive_Quicksort => Recursive_Quicksort (Sort_Array,Number_of_Comparisons,Number_of_Exchanges); when Bsort => Bsort (Sort_Array,Number_of_Comparisons,Number_of_Exchanges); when Bubble_Sort => Bubble_Sort (Sort_Array,Number_of_Comparisons,Number_of_Exchanges); when Bubble_Sort_with_Quick_Exit => Bubble_Sort_with_Quick_Exit (Sort_Array,Number_of_Comparisons,Number_of_Exchanges); when Selection_Sort => Selection_Sort (Sort_Array,Number_of_Comparisons,Number_of_Exchanges); when Heapsort => Heapsort (Sort_Array,Number_of_Comparisons,Number_of_Exchanges); when Insertion_Sort => Insertion_Sort (Sort_Array,Number_of_Comparisons,Number_of_Exchanges); when Merge_Sort => Merge_Sort (Sort_Array,Number_of_Comparisons,Number_of_Exchanges); end case; end Sort; -- Overloading of procedure Sort that does not return instrumentation -- analysis data follows below. procedure Sort ( Sort_Array : in out Array_Type; Sort_Algorithm : in Sort_Algorithm_Type := Quicksort) is Dummy_Comparisons, Dummy_Exchanges : Performance_Instrumentation_Type; begin Sort (Sort_Array,Dummy_Comparisons,Dummy_Exchanges,Sort_Algorithm); end Sort; -- Overloading of procedure Sort used to preserve original data and to -- return instrumentation analysis results follows below. procedure Sort ( Unsorted_Array : in Array_Type; Sorted_Array : out Array_Type; Number_of_Comparisons, Number_of_Exchanges : out Performance_Instrumentation_Type; Sort_Algorithm : in Sort_Algorithm_Type := Quicksort) is Local_Array : Array_Type (Unsorted_Array'RANGE) := Unsorted_Array; begin Number_of_Comparisons := 0; Number_of_Exchanges := 0; -- Check for equal length of both arrays. if Unsorted_Array'LENGTH /= Sorted_Array'LENGTH then raise Sort_Arrays_Length_Mismatch; end if; Sort (Local_Array,Number_of_Comparisons,Number_of_Exchanges, Sort_Algorithm); Sorted_Array := Local_Array; end Sort; -- Overloading of procedure Sort used to preserve the original data -- follows below. procedure Sort ( Unsorted_Array : in Array_Type; Sorted_Array : out Array_Type; Sort_Algorithm : in Sort_Algorithm_Type := Quicksort) is Local_Array : Array_Type (Unsorted_Array'RANGE) := Unsorted_Array; Dummy_Comparisons, Dummy_Exchanges : Performance_Instrumentation_Type; begin -- Check for equal length of both arrays. if Unsorted_Array'LENGTH /= Sorted_Array'LENGTH then raise Sort_Arrays_Length_Mismatch; end if; Sort (Local_Array,Dummy_Comparisons,Dummy_Exchanges,Sort_Algorithm); Sorted_Array := Local_Array; end Sort; -- Overloading of function Sort used in inline expressions follows below. function Sort ( Sort_Array : in Array_Type; Sort_Algorithm : in Sort_Algorithm_Type := Quicksort) return Array_Type is Sorted_Array : Array_Type (Sort_Array'RANGE) := Sort_Array; Dummy_Comparisons, Dummy_Exchanges : Performance_Instrumentation_Type; begin Sort (Sorted_Array,Dummy_Comparisons,Dummy_Exchanges,Sort_Algorithm); return Sorted_Array; end Sort; end Sort_Utilities;