As in previous examples, the concern here will not be with the data to be placed in the tree, but with the mechanism for implementing the tree structure itself. This can be done in the same semi-generic fashion as in other examples in the text. Since there is already on hand (in the form of the module Countries) a suitable data type, the module here is called CountryBinaryTree. The usual minor renaming is needed to use any other ADT in the place of Country.
In this version, the three kinds of traverse are distinguished via an enumeration, a parameter of which type must be passed to determine which traverse to perform with the procedure acting on the data items.
DEFINITION MODULE CountryBinaryTree; (* semi-generic tree type by R. Sutcliffe last modified 1995 06 07 *) FROM Countries IMPORT Country, KeyType, ActionProc; TYPE DataType = Country; (* change this line and import as needed *) TreeState = (allRight, empty, entreeFailed, notFound, bad); BinaryTree; (* opaque type *) TraverseOrder = (in, pre, post); PROCEDURE TreeStatus (t : BinaryTree) : TreeState; (* Pre : t is a valid initialized table Post : The State of the tree is returned *) PROCEDURE Create (VAR t : BinaryTree); (* Pre : none Post : t is a newly created empty tree.*) PROCEDURE Insert (t : BinaryTree; data : DataType); (* Pre : t is a valid initialized tree Post : memory is obtained and data has been entreed in the proper place for a binary tree using the ADT compare procedure and the state of the tree is allRight or the entreeing failed and the state is entreeFailed. *) PROCEDURE Fetch (t : BinaryTree; key : KeyType; VAR data : DataType); (* Pre : t is a valid initialized tree Post : data matching key is returned in data and the state of the tree is allRight or the fetch failed and the state is notFound. *) PROCEDURE Update (t : BinaryTree; data : DataType); (* Pre : t is a valid initialized tree Post : data matching the key of the data is updated in the tree and the state of the tree is allRight or the update failed and the state is notFound. *) PROCEDURE Remove (t : BinaryTree; key : KeyType; VAR data : DataType); (* Pre : t is a valid initialized tree Post : data matching key has been removed and returned in data (not disposed of) and the state of the tree is allRight or the removal failed and the state is notFound. *) PROCEDURE Destroy (VAR t : BinaryTree); (* Pre : t is a valid initialized tree Post : the tree memory is returned and the variable is invalid and the memory associated with the items in the tree is removed by calling the ADT module dispose procedure. *) PROCEDURE Traverse (t : BinaryTree; Proc : ActionProc; order : TraverseOrder); (* Pre : t is a valid initialized tree Post : the table items are traversed in the order given and Proc is performed on each one. *) END CountryBinaryTree.
When this was implemented, a number of local procedures were developed, most of which act on nodes rather than on the data in the nodes. Such actions need to be hidden from the outside world, and separating them even from the abstract (and somewhat generic) procedures that handle data is recommended. The reader should note that insertion of new items always takes place at a leaf, but deletion at other than a leaf position is rather complex. If the node to be deleted has only one subtree hanging from it, then that subtree can be drawn up to take its place, as shown in figure 14.6.
If the deletion is at an interior node (a position with two children), one first finds the predecessor node (in the in order sense, not in the tree structure sense). This node will always be a leaf (why?), and can be found by looking at the left child of the starting node, then going right as far as possible. This predecessor node has its data swapped with the target node, and then the predecessor leaf node is deleted. (This is not the only possible strategy.) For instance, if in the tree on the left of figure 14.6 the node with the data 4 (happens to be the root) were to be deleted, its in order predecessor (go left, then take as many rights as possible) is 3, which is swapped with the 4, and its node deleted, resulting in the structure shown in figure 14.7.
Here is the implementation of the binary tree, with the specific imports for this same data type. To change the implementation, just change the name of this module and of the ADT module being imported from (write it first) appropriately; nothing else needs to be altered.
IMPLEMENTATION MODULE CountryBinaryTree;
(* semi-generic tree type
by R. Sutcliffe last modified 1995 06 07 *)
FROM Countries IMPORT
Country, KeyType, ActionProc, Compare, GetKey, Assign, New, Valid, Dispose;
FROM Storage IMPORT
ALLOCATE, DEALLOCATE;
FROM STextIO IMPORT
WriteString, WriteLn, WriteChar;
FROM Strings IMPORT
CompareResults;
TYPE
NodePointer = POINTER TO TreeNode;
TreeNode =
RECORD
item : DataType;
leftPoint, rightPoint, parent : NodePointer;
END;
BinaryTree = POINTER TO TreeData;
TreeData =
RECORD
root : NodePointer;
state : TreeState;
END;
NodeProc = PROCEDURE (NodePointer);
(* TreeState = (allRight, empty, entableFailed, notFound, bad); *)
(* Here is a collection of local procs used in this module *)
PROCEDURE MakeNode () : NodePointer;
VAR
temp : NodePointer;
BEGIN
NEW (temp); (* get node memory *)
IF temp # NIL
THEN
New (temp^.item); (* node OK so get data value memory *)
IF NOT Valid (temp^.item)
THEN (* failed so return NIL *)
DISPOSE (temp);
END;
END;
RETURN temp;
END MakeNode;
PROCEDURE InsertNode (VAR root : NodePointer; newNode : NodePointer);
VAR
point : NodePointer;
done : BOOLEAN;
BEGIN
IF root = NIL
THEN (* first item *)
root := newNode;
newNode^.parent := NIL;
ELSE
point := root;
done := FALSE;
REPEAT
IF Compare(GetKey(newNode^.item),GetKey (point^.item)) = greater
THEN
IF point^.rightPoint = NIL (* at end *)
THEN
point^.rightPoint := newNode;
done := TRUE;
ELSE
point := point^.rightPoint
END; (* if point *)
ELSE (* less or equal *)
IF point^.leftPoint = NIL (* at end *)
THEN
point^.leftPoint := newNode;
done := TRUE;
ELSE
point := point^.leftPoint
END; (* if point *)
END; (* if compare *)
UNTIL done;
newNode^.parent := point;
END; (* if root *)
END InsertNode;
PROCEDURE Find (root : NodePointer; key : KeyType; VAR point : NodePointer);
(* get a pointer to the node belonging to the key. Returns NIL if not found *)
BEGIN
IF (root = NIL) (* recursion trapdoor *)
OR (Compare (key, GetKey (root^.item)) = equal) (* got it *)
THEN
point := root;
RETURN;
END; (* if root *)
Find (root^.leftPoint, key, point);
(* if we get it, we don't want to look to the right at all *)
IF point = NIL (* not found yet *)
THEN
Find (root^.rightPoint, key, point);
END; (* if point *)
END Find;
PROCEDURE InOrderPredPoint (node: NodePointer) : NodePointer;
(* Find pointer to Inorder predecessor, i.e. to the rightmost node in left subtree
Pre: the node has a left child
Post: a pointer to its in order predecessor leaf is returned *)
VAR
pred : NodePointer;
BEGIN
pred := node^.leftPoint; (* one left *)
WHILE pred^.rightPoint # NIL
DO (* go as far right as possible *)
pred := pred^.rightPoint;
END; (* while *)
RETURN pred;
END InOrderPredPoint;
PROCEDURE SwapNodeVal (VAR a, b : NodePointer);
VAR
temp : DataType;
BEGIN
temp := a^.item;
a^.item := b^.item;
b^.item := temp
END SwapNodeVal;
PROCEDURE Delete (t : BinaryTree; node : NodePointer);
(* delete a node *)
VAR
temp : NodePointer;
BEGIN
temp := node;
IF temp^.leftPoint = NIL
THEN (* empty left branch *)
IF temp^.rightPoint = NIL (* I am a leaf *)
THEN
IF temp^.parent = NIL (* I am root too *)
THEN
t^.root := NIL;
ELSE (* just leaf *)
IF temp^.parent^.leftPoint = temp
THEN
temp^.parent^.leftPoint := NIL
ELSE
temp^.parent^.rightPoint := NIL
END;
END;
KillNode (temp);
RETURN;
ELSE (* not a leaf so pull up right subtree *)
node := node^.rightPoint;
KillNode (temp);
RETURN;
END;
ELSIF temp^.rightPoint = NIL THEN (* empty right branch *)
node := node^.leftPoint; (* so pull up left subtree *)
KillNode (temp);
RETURN;
ELSE (* no branch empty, find inorder predecessor *)
temp := InOrderPredPoint (node);
SwapNodeVal (node, temp);
Delete (t, temp); (* recursively remove node swapped *)
END; (* if *)
END Delete;
PROCEDURE KillNode (VAR node : NodePointer);
(* give back all memory associated with node *)
BEGIN
IF node # NIL
THEN
Dispose (node^.item);
DISPOSE (node);
END;
END KillNode;
PROCEDURE Erase (VAR r : NodePointer);
(* Pre: r is the root of a subtree
Post: recursive post traverse killing all nodes *)
BEGIN
IF r # NIL
THEN
Erase (r^.leftPoint);
Erase (r^.rightPoint);
KillNode (r);
END;
END Erase;
(* end local procs *)
PROCEDURE TreeStatus (t : BinaryTree) : TreeState;
BEGIN
IF t # NIL
THEN
RETURN t^.state;
ELSE
RETURN bad;
END;
END TreeStatus;
PROCEDURE Create (VAR t : BinaryTree);
BEGIN
NEW (t);
t^.root := NIL;
t^.state := empty;
END Create;
PROCEDURE Insert (t : BinaryTree; data : DataType);
VAR
temp : NodePointer;
state : TreeState;
BEGIN
state := TreeStatus (t);
IF (state = bad) OR (state = entreeFailed)
THEN
t^.state := entreeFailed;
RETURN
END;
temp := MakeNode (); (* status ok so get node memory *)
IF temp = NIL
THEN
t^.state := entreeFailed;
RETURN
END;
(* all OK so put it together *)
Assign (data, temp^.item); (* move data value in *)
temp^.leftPoint := NIL; (* always adding a leaf *)
temp^.rightPoint := NIL;
InsertNode (t^.root, temp);
t^.state := allRight;
END Insert;
PROCEDURE Fetch (t : BinaryTree; key : KeyType; VAR data : DataType);
VAR
point : NodePointer;
BEGIN
IF t = NIL
THEN
t^.state := bad;
RETURN
ELSE
Find (t^.root, key, point);
IF point = NIL
THEN
t^.state := notFound;
ELSE
t^.state := allRight;
data := point^.item;
END; (* if point *)
END; (* if t *)
END Fetch;
PROCEDURE Update (t : BinaryTree; data : DataType);
VAR
point : NodePointer;
BEGIN
IF t = NIL
THEN
t^.state := notFound;
RETURN
ELSE
Find (t^.root, GetKey (data), point);
IF point # NIL
THEN
t^.state := allRight;
point^.item := data;
END;
END;
END Update;
PROCEDURE Remove (t : BinaryTree; key : KeyType; VAR data : DataType);
VAR
point : NodePointer;
BEGIN
IF t = NIL
THEN
t^.state := bad;
RETURN
ELSE
Find (t^.root, key, point);
IF point = NIL
THEN
t^.state := notFound;
ELSE
t^.state := allRight;
data := point^.item;
Delete (t, point);
END;
END;
END Remove;
PROCEDURE Destroy (VAR t : BinaryTree);
BEGIN
Erase (t^.root); (* all nodes *)
DISPOSE (t); (* tree data *)
END Destroy;
(* local procs: three ways to traverse a sub-tree *)
PROCEDURE InTraverse (r : NodePointer; Proc : ActionProc);
BEGIN
IF r = NIL (* recursion trap door *)
THEN
RETURN
END;
InTraverse (r^.leftPoint, Proc);
Proc (r^.item);
InTraverse (r^.rightPoint, Proc);
END InTraverse;
PROCEDURE PreTraverse (r : NodePointer; Proc : ActionProc);
BEGIN
IF r = NIL (* recursion trap door *)
THEN
RETURN
END;
Proc (r^.item);
PreTraverse (r^.leftPoint, Proc);
PreTraverse (r^.rightPoint, Proc);
END PreTraverse;
PROCEDURE PostTraverse (r : NodePointer; Proc : ActionProc);
BEGIN
IF r = NIL (* recursion trap door *)
THEN
RETURN
END;
PostTraverse (r^.leftPoint, Proc);
PostTraverse (r^.rightPoint, Proc);
Proc (r^.item);
END PostTraverse;
(* end local procs *)
PROCEDURE Traverse (t : BinaryTree; Proc : ActionProc; order : TraverseOrder);
BEGIN
IF t = NIL
THEN
RETURN
END;
CASE order OF
in:
InTraverse (t^.root, Proc) |
pre:
PreTraverse (t^.root, Proc) |
post:
PostTraverse (t^.root, Proc)
END;
END Traverse;
END CountryBinaryTree.
As before, a simple test harness is provided. In order to ensure that all aspects of the library were tested, it contains (in, pre, and post) procedures to traverse the tree and to write out enough of the data from the items being entreed to ensure that the structure is correctly maintained.
This module is in the style favoured by some that employs only unqualified import. As can readily be seen, such a style tends to become cumbersome as the module names grow.
MODULE TestCountryBinaryTree;
(* program to test the logic of the Tree library with countries and their gnp
by R. Sutcliffe modified 1995 06 01 *)
IMPORT
Countries, CountryBinaryTree, STextIO, SWholeIO;
VAR
Tree : CountryBinaryTree.BinaryTree;
country, fetched : Countries.Country;
str : Countries.KeyType;
num : Countries.FieldType;
gotIt : BOOLEAN;
PROCEDURE WriteCountryName (c : Countries.Country);
BEGIN
STextIO.WriteString (Countries.GetKey (c));
STextIO.WriteChar (" ");
END WriteCountryName;
PROCEDURE WriteTree; (* all data *)
BEGIN
CountryBinaryTree.Traverse (Tree, Countries.WriteCountryData, CountryBinaryTree.in);
END WriteTree;
(* these three just write the names *)
PROCEDURE WriteTreeIn;
BEGIN
CountryBinaryTree.Traverse (Tree, WriteCountryName, CountryBinaryTree.in);
END WriteTreeIn;
PROCEDURE WriteTreePre;
BEGIN
CountryBinaryTree.Traverse (Tree, WriteCountryName, CountryBinaryTree.pre);
END WriteTreePre;
PROCEDURE WriteTreePost;
BEGIN
CountryBinaryTree.Traverse (Tree, WriteCountryName, CountryBinaryTree.post);
END WriteTreePost;
PROCEDURE WriteTreeAll;
BEGIN
STextIO.WriteString ("InOrder : ");WriteTreeIn; STextIO.WriteLn;
STextIO.WriteString ("PreOrder : ");WriteTreePre; STextIO.WriteLn;
STextIO.WriteString ("PostOrder: ");WriteTreePost; STextIO.WriteLn;
END WriteTreeAll;
PROCEDURE TestFetch (name : Countries.KeyType);
BEGIN
CountryBinaryTree.Fetch (Tree, name, fetched);
gotIt := (CountryBinaryTree.TreeStatus (Tree) # CountryBinaryTree.notFound);
IF gotIt
THEN
str := Countries.GetKey (fetched);
STextIO.WriteString ("Got ");
STextIO.WriteString (str);
ELSE
STextIO.WriteString ("no got ");
STextIO.WriteString (name);
END;
STextIO.WriteLn; STextIO.WriteLn;
END TestFetch;
BEGIN
Countries.New (country); (* do only once *)
CountryBinaryTree.Create (Tree);
(* test Fetch; should fail *)
CountryBinaryTree.Fetch (Tree, "Xanadu", fetched);
gotIt :=
(CountryBinaryTree.TreeStatus (Tree) # CountryBinaryTree.notFound);
IF gotIt
THEN
str := Countries.GetKey (fetched);
STextIO.WriteString ("Got ");
STextIO.WriteString (str);
ELSE
STextIO.WriteString ("no got Xanadu");
END;
STextIO.WriteLn; STextIO.WriteLn;
(* now get the Tree filled up *)
Countries.SetKey (country, "Samovia");
Countries.SetField (country, 13000000);
CountryBinaryTree.Insert (Tree, country);
Countries.SetKey (country, "Xanadu");
Countries.SetField (country, 3000);
CountryBinaryTree.Insert (Tree, country);
Countries.SetKey (country, "Lundy");
Countries.SetField (country, 42000);
CountryBinaryTree.Insert (Tree, country);
Countries.SetKey (country, "Pompey");
Countries.SetField (country, 13000);
CountryBinaryTree.Insert (Tree, country);
Countries.SetKey (country, "Alberta");
Countries.SetField (country, 43000);
CountryBinaryTree.Insert (Tree, country);
Countries.SetKey (country, "Yesterday");
Countries.SetField (country, 11000);
CountryBinaryTree.Insert (Tree, country);
Countries.SetKey (country, "Yahk");
Countries.SetField (country, 3000);
CountryBinaryTree.Insert (Tree, country);
Countries.SetKey (country, "Toronto");
Countries.SetField (country, 0);
CountryBinaryTree.Insert (Tree, country);
WriteTreeAll;
(* test Fetchs *)
TestFetch ("Xanadu"); (* should be ok *)
TestFetch ("Pompey"); (* should be ok *)
TestFetch ("Canada"); (* should Not be ok *)
TestFetch ("Toronto"); (* should be ok *)
(* test update *)
STextIO.WriteString ("Before Update");
STextIO.WriteLn;
WriteTree;
STextIO.WriteLn;
Countries.SetField (country, 10); (* should still be on Toronto *)
CountryBinaryTree.Update (Tree, country);
STextIO.WriteString ("After Update");
STextIO.WriteLn;
WriteTree;
STextIO.WriteLn;
(* test removes *)
CountryBinaryTree.Remove (Tree, "Pompey", fetched);
IF CountryBinaryTree.TreeStatus (Tree) = CountryBinaryTree.allRight
THEN
STextIO.WriteString ("removed Pompey");
ELSE
STextIO.WriteString ("could not remove Pompey");
END;
STextIO.WriteLn; STextIO.WriteLn;
(* now check to ensure its really gone *)
TestFetch ("Pompey"); (* should Not be ok *)
STextIO.WriteString ("after Pompey removal:");
STextIO.WriteLn;
WriteTreeIn;
STextIO.WriteLn; STextIO.WriteLn;
(* now try to remove something not there *)
CountryBinaryTree.Remove (Tree, "Canada", fetched);
IF CountryBinaryTree.TreeStatus (Tree) = CountryBinaryTree.allRight
THEN
STextIO.WriteString ("removed Canada");
ELSE
STextIO.WriteString ("could not remove Canada");
END;
STextIO.WriteLn; STextIO.WriteLn;
(* now remove one at an interior node *)
CountryBinaryTree.Remove (Tree, "Xanadu", fetched);
IF CountryBinaryTree.TreeStatus (Tree) = CountryBinaryTree.allRight
THEN
STextIO.WriteString ("removed Xanadu");
ELSE
STextIO.WriteString ("could not remove Xanadu");
END;
STextIO.WriteLn; STextIO.WriteLn;
STextIO.WriteString ("after Xanadu removal ");
STextIO.WriteLn;
WriteTreeIn;
STextIO.WriteLn; STextIO.WriteLn;
(* now see if destroy seems to work *)
CountryBinaryTree.Destroy (Tree);
IF CountryBinaryTree.TreeStatus (Tree) = CountryBinaryTree.bad
THEN
STextIO.WriteString ("Tree deleted");
ELSE
STextIO.WriteString ("could not destroy");
END;
STextIO.WriteLn; STextIO.WriteLn;
END TestCountryBinaryTree.
A run of the above test harness yielded the following results. The reader should check these results against the expected ones.
** Run log starts here ** no got Xanadu InOrder : Alberta Lundy Pompey Samovia Toronto Xanadu Yahk Yesterday PreOrder : Samovia Lundy Alberta Pompey Xanadu Toronto Yesterday Yahk PostOrder: Alberta Pompey Lundy Toronto Yahk Yesterday Xanadu Samovia Got Xanadu Got Pompey no got Canada Got Toronto Before Update Alberta 43000 Lundy 42000 Pompey 13000 Samovia 13000000 Toronto 0 Xanadu 3000 Yahk 3000 Yesterday 11000 After Update Alberta 43000 Lundy 42000 Pompey 13000 Samovia 13000000 Toronto 10 Xanadu 3000 Yahk 3000 Yesterday 11000 removed Pompey no got Pompey after Pompey removal: Alberta Lundy Samovia Toronto Xanadu Yahk Yesterday could not remove Canada removed Xanadu after Xanadu removal Alberta Lundy Samovia Toronto Yahk Yesterday Tree deleted