DataMuseum.dk

top - metrics - download

    Length: 4333 (0x10ed)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

-- $Source: /nosc/work/abstractions/sort/RCS/sort.bdy,v $

-- $Revision: 1.2 $ -- $Date: 85/02/01 10:10:41 $ -- $Author: ron $
-- $Source: /nosc/work/abstractions/sort/RCS/sort.bdy,v $

-- $Revision: 1.2 $ -- $Date: 85/02/01 10:10:41 $ -- $Author: ron $
procedure Heap_Sort (S : in out Sequence) is

    --| Notes:
    --| Implementation is taken directly from The Design and Analysis of
    --| Computer Algorithms, by Aho, Hopcroft and Ullman.  The only change
    --| of any significance is code to map between the index_type subrange
    --| defined by the sequence bounds and the subrange, 1..s'length, of
    --| the integers.  This mapping is necessary because the algorithm
    --| represents binary trees as an array such that the sons of s(i) are
    --| located at s(2i) and s(2i + 1).

    subtype Int_Range is Integer range 1 .. S'Length;

    function Int_Range_To_Index (I : Int_Range) return Index_Type is
        --| Effects:
        --| Map 1 --> s'first, ..., s'length --> s'last.
    begin
        return Index_Type'Val (I + Index_Type'Pos (S'First) - 1);
    end Int_Range_To_Index;

    function Index_To_Int_Range (I : Index_Type) return Int_Range is
        --| Effects:
        --| Map s'first --> 1, ..., s'last --> s'length.
    begin
        return (Index_Type'Pos (I) - Index_Type'Pos (S'First) + 1);
    end Index_To_Int_Range;

    procedure Swap (I, J : Index_Type) is
        --| Effects:
        --| Exchange the values of s(i) and s(j).

        T : Item_Type := S (I);
    begin
        S (I) := S (J);
        S (J) := T;
    end Swap;

    procedure Heapify (Root, Boundary : Index_Type) is
        --| Effects:
        --|     Give s(root..boundary) the heap property:
        --|        s(i) > s(2i) and s(i) > s(2i + 1).
        --| (provided that 2i, 2i + 1 are less than boundary.  Note that
        --| the property is being expressed in terms of the integer range,
        --| 1..s'last.)
        --| Requires:
        --|     s(i + 1, ..., boundary) already has the heap property.

        Max : Index_Type := Root;
        Boundary_Position : Int_Range := Index_To_Int_Range (Boundary);
        Left_Son_Position : Integer := 2 * Index_To_Int_Range (Root);
        Right_Son_Position : Integer := 2 * Index_To_Int_Range (Root) + 1;
        Left_Son : Index_Type;
        Right_Son : Index_Type;
    begin
        -- If root is not a leaf, and if a son of root contains a larger
        -- value than the root value, then let max be the son with the
        -- largest value.

        if Left_Son_Position <= Boundary_Position then
            -- has left son?
            Left_Son := Int_Range_To_Index (Left_Son_Position);
            if S (Root) <= S (Left_Son) then
                Max := Left_Son;
            end if;
        else
            return;   -- no sons, meets heap property trivially.
        end if;

        if Right_Son_Position <= Boundary_Position then
            -- has right son?
            Right_Son := Int_Range_To_Index (Right_Son_Position);
            if S (Max) <= S (Right_Son) then
                -- biggest so far?
                Max := Right_Son;
            end if;
        end if;

        if Max /= Root then
            -- If a larger son found then
            Swap (Root, Max);         -- carry out exchange and
            Heapify (Max, Boundary);  -- propagate heap propery to subtree
        end if;
    end Heapify;

    procedure Build_Heap is
        --| Effects:
        --| Give all of s the heap property.

        Mid : Index_Type := Int_Range_To_Index
                               (Index_To_Int_Range (S'Last) / 2);
    begin
        for I in reverse S'First .. Mid loop
            Heapify (I, S'Last);
        end loop;
    end Build_Heap;

begin
    -- Make s into a heap.  Then, repeat until sorted:
    --   1. exchange the largest element, located at the root, with the
    --      last element that has not yet been ordered, and
    --   2. reheapify the unsorted portion of s.

    Build_Heap;
    for I in reverse Index_Type'Succ (S'First) .. S'Last loop
        Swap (S'First, I);
        Heapify (S'First, Index_Type'Pred (I));
    end loop;

exception
    when Constraint_Error =>
        -- On succ(s'first) for array of length <= 1.
        return;                 -- Such arrays are trivially sorted.
end Heap_Sort;