|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 13437 (0x347d)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦1dcd34566⟧
└─⟦this⟧
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