⟦d81f051b5⟧

E3 Source Code



generic
    type Value_Type is private; --| Type of values stored in the tree.

    with function Difference (P, Q : Value_Type) return Integer is <>;
    --| Must return a value > 0 if P > Q, 0 if P = Q, and less than
    --| zero otherwise.

package Binary_Trees_Pkg is --| Efficient implementation of binary trees.

--| OVERVIEW

--| This package is an efficient implementation of unbalanced binary trees.
--| These trees have the following properties:
--|-
--|  1. Inserting a value is cheap (log n Differences per insertion).
--|  2. Finding a value is cheap (log n Differences per querey).
--|  3. Can iterate over the values in sorted order in linear time.
--|  4. Space overhead is moderate (2 "pointers" per value stored).
--|+
--| They are thus useful both for sorting sequences of indeterminate size
--| and for lookup tables.
--|
--| OPERATIONS
--|
--|-The following operations are provided:
--|
--| Insert      Insert a node into a tree
--| Insert_if_not_Found Insert a node into a tree if not there already
--| Replace_if_Found    Replace a node if duplicate exists, else insert.
--| Destroy     Destroy a tree
--| Destroy_Deep*   Destroy a tree and its contents
--| Balanced_Tree*  Create a balanced tree from values supplied in order
--| Copy*       Copy a tree.  The copy is balanced.
--|
--| Queries:
--|   Is_Empty      Return TRUE iff a tree is empty.
--|   Find      Search tree for a node
--|   Is_Found      Return TRUE iff tree contains specified value.
--|   Size      Return number of nodes in the tree.
--|
--| Iterators:
--|   Visit*        Apply a procedure to every node in specified order
--|   Make_Iter     Create an iterator for ordered scan
--|   More      Test for exhausted iterator
--|   Next      Bump an iterator to the next element
--|
--| * Indicates generic subprogram
--|
--| USAGE
--|
--| The following example shows how to use this package where nodes in
--| the tree are labeled with a String_Type value (for which a natural
--| Difference function is not available).
--|-
--|     package SP renames String_Pkg;
--|
--|     type my_Value is record
--|       label: SP.string_type;
--|       value: integer;
--|     end record;
--|
--|     function differ_label(P, Q: SP.string_type) return integer is
--|     begin
--|       if SP."<"(P, Q) then return -1;
--|       elsif SP."<"(Q, P) then return 1;
--|       else return 0;
--|       end if;
--|     end differ_label;
--|
--|     package my_Tree is new Binary_Trees_pkg(my_Value, differ_Label);
--|
--| Note that the required Difference function may be easily written in terms
--| of "<" if that is available, but that frequently two comparisons must
--| be done for each Difference.  However, both comparisons would have
--| to be done internally by this package for every instantiation if the
--| generic parameter were "<" instead of Difference.
--|
--| PERFORMANCE
--|
--| Every node can be visited in the tree in linear time.  The cost
--| of creating an iterator is small and independent of the size
--| of the tree.
--|
--| Recognizing that comparing values can be expensive, this package
--| takes a Difference function as a generic parameter.  If it took
--| a comparison function such as "<", then two comparisons would be
--| made per node visited during a search of the tree.  Of course this
--| is more costly when "<" is a trivial operation, but in those cases,
--| Difference can be bound to "-" and the overhead in negligable.
--|
--| Two different kinds of iterators are provided.  The first is the
--| commonly used set of functions Make_Iter, More, and Next.  The second
--| is a generic procedure called Visit.  The generic parameter to Visit is
--| a procedure which is called once for each value in the tree.  Visit
--| is more difficult to use and results in code that is not quite as clear,
--| but its overhead is about 20% of the More/Next style iterator.  It
--| is therefore recommended for use only in time critical inner loops.


----------------------------------------------------------------------------
    -- Exceptions --
----------------------------------------------------------------------------

    Duplicate_Value : exception;
--| Raised on attempt to insert a duplicate node into a tree.

    Not_Found : exception;
--| Raised on attempt to find a node that is not in a tree.

    No_More : exception;
--| Raised on attempt to bump an iterator that has already scanned the
--| entire tree.

    Out_Of_Order : exception;
--| Raised if a problem in the ordering of a tree is detected.

    Invalid_Tree : exception;
--| Value is not a tree or was not properly initialized.

----------------------------------------------------------------------------
    -- Types --
----------------------------------------------------------------------------

    type Scan_Kind is (Inorder, Preorder, Postorder);
--| Used to specify the order in which values should be scanned from a tree:
--|-
--| inorder: Left, Node, Right (nodes visited in increasing order)
--| preorder: Node, Left, Right (top down)
--| postorder: Left, Right, Node (bottom up)

    type Tree is private;
    type Iterator is private;

----------------------------------------------------------------------------
    -- Operations --
----------------------------------------------------------------------------

    function Create     --| Return an empty tree.
                return Tree;

--| Effects: Create and return an empty tree.  Note that this allocates
--| a small amount of storage which can only be reclaimed through
--| a call to Destroy.

----------------------------------------------------------------------------

    procedure Insert (   --| Insert a value into a tree.
                      V : Value_Type;  --| Value to be inserted
                      T : Tree     --| Tree to contain the new value
                      );
--| Raises: Duplicate_Value, Invalid_Tree.

--| Effects: Insert V into T in the proper place.  If a value equal
--| to V (according to the Difference function) is already contained
--| in the tree, the exception Duplicate_Value is raised.
--| Caution: Since this package does not attempt to balance trees as
--| values are inserted, it is important to remember that inserting
--| values in sorted order will create a degenerate tree, where search
--| and insertion is proportional to the N instead of to Log N.  If
--| this pattern is common, use the Balanced_Tree function below.

----------------------------------------------------------------------------

    procedure Insert_If_Not_Found
                 (
--| Insert a value into a tree, provided a duplicate value is not already there
                  V : Value_Type;  --| Value to be inserted
                  T : Tree;        --| Tree to contain the new value
                  Found : out Boolean; --| Becomes True iff V already in tree
                  Duplicate : out
                     Value_Type   --| the duplicate value, if there is one
                  ); --| Raises: Invalid_Tree.

--| Effects: Insert V into T in the proper place.  If a value equal
--| to V (according to the Difference function) is already contained
--| in the tree, Found will be True and Duplicate will be the duplicate
--| value.  This might be a sequence of values with the same key, and
--| V can then be added to the sequence.

----------------------------------------------------------------------------

    procedure Replace_If_Found
                 (
--| Replace a value if label exists, otherwise insert it.
                  V : Value_Type;  --| Value to be inserted
                  T : Tree;        --| Tree to contain the new value
                  Found : out Boolean; --| Becomes True iff L already in tree
                  Old_Value : out
                     Value_Type   --| the duplicate value, if there is one
                  ); --| Raises: Invalid_Tree.

--| Effects: Search for V in T.  If found, replace the old value with V,
--| and return Found => True, Old_Value => the old value.  Otherwise,
--| simply insert V into T and return Found => False.

----------------------------------------------------------------------------

    procedure Destroy (  --| Free space allocated to a tree.
                       T : in out Tree  --| The tree to be reclaimed.
                       );

--| Effects: The space allocated to T is reclaimed.  The space occupied by
--| the values stored in T is not however, recovered.

----------------------------------------------------------------------------

    generic
        with procedure Free_Value (V : in out Value_Type) is <>;

    procedure Destroy_Deep ( --| Free all space allocated to a tree.
                            T : in out Tree  --| The tree to be reclaimed.
                            );

--| Effects: The space allocated to T is reclaimed.  The values stored
--| in T are reclaimed using Free_Value, and the tree nodes themselves
--| are then reclaimed (in a single walk of the tree).

----------------------------------------------------------------------------

    generic
        with function Next_Value return Value_Type is <>;
        --| Each call to this procedure should return the next value to be
        --| inserted into the balanced tree being created.  If necessary,
        --| this function should check that each value is greater than the
        --| previous one, and raise Out_of_Order if necessary.  If values
        --| are not returned in strictly increasing order, the results are
        --| unpredictable.

    function Balanced_Tree (Count : Natural) return Tree;

--| Effects: Create a balanced tree by calling next_Value Count times.
--| Each time Next_Value is called, it must return a value that compares
--| greater than the preceeding value.  This function is useful for balancing
--| an existing tree (next_Value iterates over the unbalanced tree) or
--| for creating a balanced tree when reading data from a file which is
--| already sorted.

----------------------------------------------------------------------------

    generic
        with function Copy_Value (V : Value_Type) return Value_Type is <>;
        --| This function is called to copy a value from the old tree to the
        --| new tree.

    function Copy_Tree (T : Tree) return Tree; --| Raises Invalid_Tree.

--| Effects: Create a balanced tree that is a copy of the tree T.
--| The exception Invalid_Tree is raised if T is not a valid tree.

----------------------------------------------------------------------------

    function Is_Empty (  --| Check for an empty tree.
                       T : Tree) return Boolean;

--| Effects: Return TRUE iff T is an empty tree or if T was not initialized.

----------------------------------------------------------------------------

    function Find (      --| Search a tree for a value.
                   V : Value_Type;  --| Value to be located
                   T : Tree     --| Tree to be searched
                   ) return Value_Type; --| Raises: Not_Found, Invalid_Tree.

--| Effects: Search T for a value that matches V.  The matching value is
--| returned.  If no matching value is found, the exception Not_Found
--| is raised.


    procedure Find
                 (         --| Search a tree for a value.
                  V : Value_Type;      --| Value to be located
                  T : Tree;            --| Tree to be searched
                  Found : out Boolean;     --| TRUE iff a match was found
                  Match : out Value_Type   --| Matching value found in the tree
                  ); --| Raises: Invalid_Tree;

--| Effects: Search T for a value that matches V.  On return, if Found is
--| TRUE then the matching value is returned in Match.  Otherwise, Found
--| is FALSE and Match is undefined.

----------------------------------------------------------------------------

    function Is_Found (  --| Check a tree for a value.
                       V : Value_Type;  --| Value to be located
                       T : Tree     --| Tree to be searched
                       ) return Boolean; --| Raises: Invalid_Tree;

--| Effects: Return TRUE iff V is found in T.

----------------------------------------------------------------------------

    function Size (      --| Return the count of values in T.
                   T : Tree     --| a tree
                   ) return Natural;

--| Effects: Return the number of values stored in T.

----------------------------------------------------------------------------

    generic
        with procedure Process (V : Value_Type) is <>;

    procedure Visit (T : Tree; Order : Scan_Kind); --| Raises: Invalid_Tree;

--| Effects: Invoke Process(V) for each value V in T.  The nodes are visited
--| in the order specified by Order.  Although more limited than using
--| an iterator, this function is also much faster.

----------------------------------------------------------------------------

    function Make_Iter ( --| Create an iterator over a tree
                        T : Tree) return Iterator; --| Raises: Invalid_Tree;

----------------------------------------------------------------------------

    function More (      --| Test for exhausted iterator
                   I : Iterator     --| The iterator to be tested
                   ) return Boolean;

--| Effects: Return TRUE iff unscanned nodes remain in the tree being
--| scanned by I.


----------------------------------------------------------------------------

    procedure Next (     --| Scan the next value in I
                    I : in out Iterator; --| an active iterator
                    V : out Value_Type   --| Next value scanned
                    ); --| Raises: No_More.

--| Effects: Return the next value in the tree being scanned by I.
--| The exception No_More is raised if there are no more values to scan.

----------------------------------------------------------------------------

private

    type Node;
    type Node_Ptr is access Node;

    type Node is
        record
            Value : Value_Type;
            Less : Node_Ptr;
            More : Node_Ptr;
        end record;

    type Tree_Header is
        record
            Count : Natural := 0;
            Root : Node_Ptr := null;
        end record;

    type Tree is access Tree_Header;

    type Iter_State is (Left, Middle, Right, Done);

    type Iterator_Record;
    type Iterator is access Iterator_Record;

    type Iterator_Record is
        record
            State : Iter_State;
            Parent : Iterator;
            Subtree : Node_Ptr;
        end record;


end Binary_Trees_Pkg;
DataMuseum.dk

Rational R1000/400

⟦d81f051b5⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
