TEAM-ADA Archives

Team Ada: Ada Programming Language Advocacy

TEAM-ADA@LISTSERV.ACM.ORG

Options: Use Classic View

Use Monospaced Font
Show Text Part by Default
Show All Mail Headers

Topic: [<< First] [< Prev] [Next >] [Last >>]

Print Reply
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;

ATOM RSS1 RSS2