Re: sorting code Steven Deller <[log in to unmask]> Mon, 18 Dec 2000 16:42:13 -0500 text/plain (189 lines) ```Jesse, As I mentioned, the "indirect" sort may be preferable if you have large elements. After having mentioned the solution to numerous people over the years, I thought I'd take a moment or two to whip one up. It is below for anyone to use. This particular version uses the generic sorting algorithms from Rational, in its package "ordering". The spec for that package was previously emailed. The key item is the Rearrange_List procedure. WARNING: THIS IS NOT TESTED (it is compiled, and I did hand check it, but I have not had time to run the code to test its correctness). I have occasionally been known to produce faulty code that fails on execution, so beware. It should be a simple matter to change this code over to use any generic sorting code you might have. Obviously you only need one of the sorting routines. I just did all three so we had them available. As mentioned the indirect sort ensures O(N) moves of the original elements, while most sorting algorithms have O(NlnN) element moves or greater. An indirect sort can be quite a win when the original elements are large. On the negative side, indirect sort does use O(N) space, more specifically, N*4 bytes for the "indirect" array, and has the O(N) overhead of the Rearrange_List routine. Regards, Steve generic     type Element is private;     type Index is (<>);     with function "<" (Left, Right : Element) return Boolean is <>; package Indirectsort is     type List is array (Index range <>) of Element;     procedure Quicksort (L : in out List);     procedure Heapsort (L : in out List);     procedure Insertionsort (L : in out List); end Indirectsort; --generic -- type Element is private; -- type Index is (<>); -- with function "<" ( left, right: Element ) return Boolean is <>; with Ordering; package body Indirectsort is -- type List is array (Index range <>) of Element;     type List_Indirect is array (Integer range <>) of Index;     procedure Rearrange_List (L : in out List; Li : in out List_Indirect) is         Temp : Element;         I, Current_Integer : Integer;         Ind, Current_Index, Next_Index : Index;         -- Index_Base is subtracted from an Index'pos value to produce         -- a corresponding Integer index into Li. It is added         -- to an Li integer index as input to Index'val to produce         -- a corresponding Index in L.         Index_Base : constant Integer := Index'Pos (L'First) - Li'First;     begin         -- The outer loop walks each list item until it finds one whose Index does not         -- match the Index of the original List. It does not check the last item         -- because, by the time it gets there, it is correct (either originally it was         -- correct, or it was changed by an ealier inner loop).         --         -- The internal loop starts with a mismatched item and walks all items in         -- a "circuit" within the list, so that only one move to Temp and then one         -- move to the final location occurs.         --         -- As the proper Element is put into the L array, the corresponding Li         -- array item is "marked" as sorted by putting the proper corresponding         -- Index value into the Li entry.         --         -- Note: The loops are O(N) even though it appears they         -- might be O(N**2). Each list element is moved at most once         -- by the sum of all executions of the inner loop.         --         Ind := L'First;         I := Li'First;         while I < Li'Last loop             -- If the correct index is not in this Li position             if Li (I) /= Ind then                 -- Current index (and integer) for rearranging are this Li position                 Current_Index := Li (I);                 Current_Integer := Index'Pos (Current_Index) - Index_Base;                 -- Put corresponding Element into Temp                 Temp := L (Current_Index);                 while Current_Integer /= I loop                     -- Get Index of next item in "circuit"                     Next_Index := Li (Current_Integer);                     -- Move proper Element into Current_Index position                     L (Current_Index) := L (Next_Index);                     -- Mark position in Li as "sorted"                     Li (Current_Integer) := Current_Index;                     -- Step to next item in "circuit"                     Current_Index := Next_Index;                     Current_Integer := Index'Pos (Current_Index) - Index_Base;                 end loop;                 -- Now store Temp into the proper element position                 L (Current_Index) := Temp;                 -- and mark this Li position as "sorted"                 Li (Current_Integer) := Current_Index;             end if;             Ind := Index'Succ (Ind);             I := Integer'Succ (I);         end loop;     end Rearrange_List; -- procedure QuickSort ( L: in out List );     procedure Quicksort (L : in out List) is         Li : List_Indirect (Integer range 0 .. L'Size - 1);         Ind : Index := L'First;         function Lessthan (Left, Right : Index) return Boolean;         package Sort is new Ordering.Quicksort (Index, Integer, Lessthan);         function Lessthan (Left, Right : Index) return Boolean is         begin             return L (Left) < L (Right);         end Lessthan;     begin         for I in Li'Range loop             Li (I) := Ind;             Ind := Index'Succ (Ind);         end loop;         Sort.Quicksort (Sort.List (Li));         Rearrange_List (L, Li);     end Quicksort; -- procedure HeapSort ( L : in out List ) ;     procedure Heapsort (L : in out List) is         Li : List_Indirect (Integer range 0 .. L'Size - 1);         Ind : Index := L'First;         function Lessthan (Left, Right : Index) return Boolean;         package Sort is new Ordering.Heapsort (Index, Integer, Lessthan);         function Lessthan (Left, Right : Index) return Boolean is         begin             return L (Left) < L (Right);         end Lessthan;     begin         for I in Li'Range loop             Li (I) := Ind;             Ind := Index'Succ (Ind);         end loop;         Sort.Heapsort (Sort.List (Li));         Rearrange_List (L, Li);     end Heapsort; -- procedure InsertionSort ( L : in out List ) :     procedure Insertionsort (L : in out List) is         Li : List_Indirect (Integer range 0 .. L'Size - 1);         Ind : Index := L'First;         function Lessthan (Left, Right : Index) return Boolean;         package Sort is new Ordering.Insertionsort (Index, Integer, Lessthan);         function Lessthan (Left, Right : Index) return Boolean is         begin             return L (Left) < L (Right);         end Lessthan;     begin         for I in Li'Range loop             Li (I) := Ind;             Ind := Index'Succ (Ind);         end loop;         Sort.Insertionsort (Sort.List (Li));         Rearrange_List (L, Li);     end Insertionsort; end Indirectsort; ```