Rather than offer pseudocode for the algorithms, the actual code is presented with heavy commenting. The reader should carefully match what is said below with the description given above. Note that inserting and deleting procedures have to proceed recursively as whatever affects a given level may affect the one above it. Thus, several of the procedures are recursive and return a flag to the level above to inform the calling version of the same (or another) procedure about the necessity of splitting or consolidating. Also observe that subsidiary procedures are included inside their main procedures rather than being allowed to be visible in the main module.
IMPLEMENTATION MODULE BTrees; (****************** Design by R. Sutcliffe copyright 1995-1996 Initial Code by Gordon Tisher June 9, 1995; last modified 1999 08 30 Modified and rewritten by R. Sutcliffe 1996 10 10 Bug in rearrange removed 1999 08 30; weren't checking case of no data to right big thanks to Florenz Plassmann, Münster, Deutschland, who had the wit to try the test code with an order three tree and uncovered a huge flaw. also added more and better comments in that section deanonymized main data structure and removed a redundant count variable in DelSpecial This module provides a B-Tree ADT. ******************) FROM Storage IMPORT ALLOCATE, DEALLOCATE; FROM STextIO IMPORT WriteString, WriteLn, SkipLine; FROM SWholeIO IMPORT WriteCard; FROM DataADT IMPORT Assign, GetKey, WriteData, ActionProc, Compare, CompareResults; CONST maxIndex = 2 * order; maxIndexPlus = maxIndex + 1; TYPE BTree = POINTER TO BNode; ItemArray = ARRAY[1..maxIndexPlus] OF ItemType; PointerArray = ARRAY[0..maxIndexPlus] OF BTree; BNode = RECORD numItems : CARDINAL; state : BTreeState; Items : ItemArray; Pointers : PointerArray; END; (* record *) (* There is one extra position in the arrays to aid sorting a new item in. This saves a lot of copying to and from temporaries. *) (* BTreeState = (allRight, empty, entreeFailed) *) (************************************ Utility Procedures ************************************) PROCEDURE FindPos (keyToSearchFor : KeyType; node : BTree; VAR pos : CARDINAL); (* find the position within a node of a data item by search key before or at which the item would go Pre: node is a valid tree Post: the position returned is that at or before keyToSearchFor belongs. If the keyToSearchFor is smaller than any of the data, returns 1; if keyToSearchFor is larger than any of the data, returns node^.numItems+1 *) BEGIN pos := 1; WHILE (pos <= node^.numItems) AND (Compare(keyToSearchFor, GetKey (node^.Items[pos]) ) # less) DO INC (pos); END; (* while *) END FindPos; (************************************ Exported Procedures ************************************) PROCEDURE Status (tree : BTree) : BTreeState; (* Pre : t is a valid initialized BTree Post : The State of the tree is returned *) BEGIN RETURN tree^.state; END Status; PROCEDURE Init (VAR tree : BTree); (* Allocates memory for a new node and initializes it Pre: none Post: if memory is found, sets up the tree structure with NIL pointers and zero items *) VAR count: CARDINAL; temp : BTree; BEGIN NEW (temp); IF (temp # NIL) THEN temp^.numItems := 0; FOR count := 0 TO maxIndexPlus DO temp^.Pointers[count] := NIL; END; (* for *) temp^.state := allRight; tree := temp; END; (* if *) END Init; PROCEDURE Destroy (VAR tree : BTree); (* disposes the whole tree *) PROCEDURE disp (node : BTree; level : CARDINAL); (* recursively remove a node *) VAR count : CARDINAL; BEGIN IF (node # NIL) THEN FOR count := 0 TO node^.numItems DO disp (node^.Pointers[count], level+1); END; (* for *) DISPOSE (node); END; (* if *) END disp; BEGIN disp (tree, 0); END Destroy; PROCEDURE Add (VAR tree : BTree; data : ItemType); (* Adds a new item to the tree. *) PROCEDURE Insert (VAR data : ItemType; pos : CARDINAL; node : BTree; VAR newNode : BTree) : BOOLEAN; (* put the data item into the specified node position and the newNode pointer after it if one is generated. *) (* returns true if inserting is finished, false as a flag to the next higher level to insert the new centre item up there after a split. *) VAR count : CARDINAL; temp : BTree; BEGIN (* first move things over to make room for new item *) FOR count := node^.numItems TO pos BY -1 DO Assign (node^.Items[count], node^.Items[count+1]); node^.Pointers[count+1] := node^.Pointers[count]; END; (* for *) (* pop new one into place *) Assign (data, node^.Items[pos]); node^.Pointers[pos] := newNode; (* check to see if the resulting node needs to be split *) IF (node^.numItems = maxIndex) (* was at max before so split it! *) THEN Init (temp); (* make a new node *) IF (temp # NIL) THEN (* split node *) (* reset number of items in each to order *) node^.numItems := order; temp^.numItems := order; (* store new middle for upstairs to insert recursively *) Assign (node^.Items[order+1], data); (* copy new zeroth pointer *) temp^.Pointers[0] := node^.Pointers[order+1]; (* copy data and rest of pointers into both *) FOR count := 1 TO order DO (* clean up the rest of the node *) node^.Pointers[count+order] := NIL; Assign (node^.Items[count+order+1], temp^.Items[count]); temp^.Pointers[count] := node^.Pointers[count+order+1]; END; (* for *) node^.Pointers[maxIndexPlus] := NIL; (* fix last pointer too; not in loop *) tree^.state := allRight ELSE (* did not work *) tree^.state := entreeFailed; END; (* if temp *) newNode := temp; RETURN FALSE; (* flag for split *) ELSE (* don't split it just adjust count *) INC (node^.numItems); newNode := NIL; RETURN TRUE; (* flag for just did an insert *) END; (* if node*) END Insert; PROCEDURE AddItem (VAR data : ItemType; node : BTree; VAR newNode : BTree): BOOLEAN; (* returns true if added with no split, false if added with split *) VAR pos : CARDINAL; BEGIN (* look for correct position *) FindPos (GetKey (data), node, pos); (* insert the item at or to the left of the position found *) IF (node^.Pointers[pos-1] # NIL) (* there is a node below *) THEN (* go down there *) IF ~AddItem (data, node^.Pointers[pos-1], newNode) (* node below was split *) THEN (* so find spot for dividing item that was passed up here *) FindPos (GetKey (data), node, pos); RETURN Insert (data, pos, node, newNode); ELSE RETURN TRUE; (* tell level up that no split *) END; (* if ~AddItem *) ELSE (* add the item to the current node *) (* and send back the result of doing that *) RETURN Insert (data, pos, node, newNode); END; (* if node *) END AddItem; VAR temp, newNode : BTree; BEGIN (* main for Add *) newNode := NIL; IF ~AddItem (data, tree, newNode) (* got a split on first level below *) THEN (* so, must turn temp into a new root *) Init (temp); (* set up a new node for it *) IF (temp # NIL) THEN temp^.numItems := 1; (* it has only this item for now *) temp^.Pointers[0] := tree; Assign (data, temp^.Items[1]); temp^.Pointers[1] := newNode; tree := temp; END; (* if temp *) END; (* if ~AddItem *) END Add; PROCEDURE Delete (VAR tree : BTree; key : KeyType); (* deletes an item whose key is equal to _key_ from the tree If the item isn't there, nothing happens, but if the tree was empty and we tried to delete the state is set to empty. *) PROCEDURE Rearrange (node : BTree; pos : CARDINAL) : BOOLEAN; (* this sub-procedure is called to rearrange a parent node with respect to its children when a deletion causes the number of items to become too small *) (* pos is that of the data item 1..order in the parent node separating the two child nodes that need combining *) (* returns true if node needs no further rearrangement above, false if it does *) VAR child, sibling : BTree; count, num : CARDINAL; BEGIN child := node^.Pointers[pos-1]; (* look at the child node that's short on data *) (* check to see if we must combine with sibling having lesser data to its left *) IF (* first case *) (node^.Pointers[pos] = NIL) (* no node available to the right *) OR (* second case *) ((pos > 1) (* there is a sibling to the left *) AND (node^.Pointers[pos]^.numItems = order)) (* no surplus among the greater to the right *) (* The 'default' situation is that there is a node to the right and it can be used, else we stay here *) THEN (* must stay here and combine with node of the lesser data *) DEC (pos); sibling := node^.Pointers[pos-1]; (* node from the lesser data position *) (* calculate num to move sibling ==> child *) num := (sibling^.numItems + 1 - order) DIV 2; IF (num > 0) THEN (* move num items from sibling ==> child *) FOR count := (order-1) TO 1 BY -1 (* shift right to make room *) DO Assign (child^.Items[count], child^.Items[count+num]); child^.Pointers[count+num] := child^.Pointers[count]; END; (* for count *) (* move old separator down to child *) Assign (node^.Items[pos], child^.Items[num]); child^.Pointers[num] := child^.Pointers[0]; (* now move stuff over *) FOR count := (num-1) TO 1 BY -1 (* copy from adjacent node *) DO Assign (sibling^.Items[count+(sibling^.numItems+1-num)], child^.Items[count]); child^.Pointers[count] := sibling^.Pointers[count+(sibling^.numItems+1-num)]; sibling^.Pointers[count+(sibling^.numItems+1-num)] := NIL; END; (* for count *) child^.Pointers[0] := sibling^.Pointers[sibling^.numItems+1-num]; (* move last item in node with extras up to be new separator *) Assign (sibling^.Items[sibling^.numItems+1-num], node^.Items[pos]); node^.Pointers[pos] := child; (* adjust item numbers in both nodes *) sibling^.numItems := sibling^.numItems - num; child^.numItems := order - 1 + num; (* adjust last pointer in sibling node *) sibling^.Pointers[sibling^.numItems+1] := NIL; RETURN TRUE; (* tell upstairs all OK *) ELSE (* none avail to move, so just merge nodes *) Assign (node^.Items[pos], sibling^.Items[sibling^.numItems + 1]); sibling^.Pointers[sibling^.numItems + 1] := child^.Pointers[0]; FOR count := 1 TO (order-1) (* copy child to sibling *) DO Assign (child^.Items[count], sibling^.Items[count+sibling^.numItems+1]); sibling^.Pointers[count+sibling^.numItems+1] := child^.Pointers[count]; END; (* for count *) (* shift left node items *) FOR count := pos TO (node^.numItems - 1) DO Assign (node^.Items[count+1], node^.Items[count]); node^.Pointers[count] := node^.Pointers[count+1]; END; (* for count *) sibling^.numItems := maxIndex; (* adjust num of items to max *) node^.Pointers[node^.numItems] := NIL; (* get rid of pointer *) DEC (node^.numItems); DISPOSE (child); RETURN (node^.numItems >= order); (* flag up if consolidation needed *) END; (* if num *) (* this section combines our child node with a sibling on its right *) (* We get here always if the child is the first node, or, in the default, if there is a node to the right of our problem child and it has a surplus available *) ELSE sibling := node^.Pointers[pos]; (* the one after or having greater data, that is, to the child's right *) num := (sibling^.numItems - order + 1) DIV 2;(* calculate num to move *) (* copy item from parent to orderth position first *) Assign (node^.Items[pos], child^.Items[order]); child^.Pointers[order] := sibling^.Pointers[0]; IF (num > 0) THEN (* move items from sibling to this child in next positions *) FOR count := 1 TO (num-1) DO Assign (sibling^.Items[count], child^.Items[count+order]); child^.Pointers[count+order] := sibling^.Pointers[count] END; (* for count *) (* new separator mode from sibling *) Assign (sibling^.Items[num], node^.Items[pos]); (* now, fix sibling up *) sibling^.Pointers[0] := sibling^.Pointers[num]; DEC (sibling^.numItems, num); (* shift left remaining elements of that sibling *) FOR count := 1 TO sibling^.numItems DO Assign (sibling^.Items[count+num], sibling^.Items[count]); sibling^.Pointers[count] := sibling^.Pointers[count+num]; sibling^.Pointers[count+num] := NIL; END; (* for count *) child^.numItems := order - 1 + num; RETURN TRUE; ELSE (* not enough on that side so merge nodes *) FOR count := 1 TO order DO Assign (sibling^.Items[count], child^.Items[count+order]); child^.Pointers[count+order] := sibling^.Pointers[count]; END; (* for count *) (* shift left node items *) FOR count := pos TO (node^.numItems - 1) DO Assign (node^.Items[count+1], node^.Items[count]); node^.Pointers[count] := node^.Pointers[count+1]; END; (* for *) child^.numItems := maxIndex; (* adjust num of items to max *) node^.Pointers[node^.numItems] := NIL; (* get rid of pointer *) DEC (node^.numItems); DISPOSE (sibling); RETURN (node^.numItems >= order); END; (* if num *) END; (* if pos *) END Rearrange; PROCEDURE DelSpecial (node : BTree; VAR data : ItemType) : BOOLEAN; (* after deleting from an interior node, find largest item less than it to remove from a node below and pass it up in "data" to become the new dividor *) (* returns true if node is OK, false if too small & needs work from above *) BEGIN (* check for more nodes and do it recursively to the greater side to get the biggest *) IF (node^.Pointers[node^.numItems] # NIL) THEN (* see if level below says rearrange needed *) IF ~DelSpecial (node^.Pointers[node^.numItems], data) THEN (* so, do it *) RETURN Rearrange (node, node^.numItems+1); ELSE RETURN TRUE; END; (* if *) ELSE (* remove the item *) Assign (node^.Items[node^.numItems], data); (* save in data to send up top *) DEC (node^.numItems); (* decrease this node size *) RETURN (node^.numItems >= order); (* and return fla to next level up *) END; (* if *) END DelSpecial; PROCEDURE Del (node : BTree; key : KeyType) : BOOLEAN; (* finds and delete the item with the key from the node; works recursively down returns true if node is OK now, false if next higher level must work on it as too small *) VAR count, pos : CARDINAL; data : ItemType; BEGIN FindPos (key, node, pos); (* key is at or left of position *) IF (pos > 1) AND (pos <= node^.numItems) (* else, left of 1 or right of numItems means not in this node *) AND (Compare (GetKey (node^.Items[pos-1]),key) = equal) (* check to see if bang on *) THEN (* item actually found in this node *) DEC (pos); (* now at the item to delete *) IF (node^.Pointers[pos-1] # NIL) (* stuff hanging below it & prior to it *) THEN (* use prior pointer to fish below for largest item for possible promotion *) (* see if got it with rearranging needed *) IF ~DelSpecial (node^.Pointers[pos-1], data) THEN (* do a rearrange as node below has too few items *) Assign (data, node^.Items[pos]); (* so put it in place *) RETURN Rearrange (node, pos); (* and do the rearrange on this parent *) ELSE (* no rearrange, so just replace item with one from lower down *) Assign (data, node^.Items[pos]); RETURN TRUE; (* and tell upstairs we're happy *) END; (* if *) ELSE (* nothing below so node of found item is a leaf *) FOR count := pos TO (node^.numItems-1) DO (* move everything over to the left *) Assign (node^.Items[count+1], node^.Items[count]); (* don't need to assign pointers, as the node is a leaf *) END; (* for *) DEC (node^.numItems); RETURN (node^.numItems >= order); (* tell upstairs if rearrange needed *) END; (* if *) ELSE (* item is not in this node so try down below using pointer left of node position# *) IF (node^.Pointers[pos-1] # NIL) (* there is a "below" before it *) AND ~Del (node^.Pointers[pos-1], key) (* and we need to rearrange *) THEN RETURN Rearrange (node, pos); (* rearrange this node; provide position in parent to the left of which lies the node (pointer one less) below that has declined in population and send flag up *) ELSE RETURN TRUE; (* tell upstairs no rearrange *) END; (* if node *) END; (* if pos *) END Del; VAR oldTree : BTree; BEGIN (* main delete proc *) IF tree^.numItems = 0 (* nothing to delete *) THEN (* this is an error; set flag so client can find out if it checks *) tree^.state := empty; END; IF ~Del (tree, key) AND (tree^.numItems = 0) (* after del *) AND (tree^.Pointers[0] # NIL) THEN oldTree := tree; tree := oldTree^.Pointers[0]; DISPOSE (oldTree); tree^.state := allRight; END; (* if *) END Delete; PROCEDURE Depth (tree : BTree) : CARDINAL; (* returns the number of levels in the tree *) BEGIN IF (tree # NIL) THEN RETURN Depth (tree^.Pointers[0]) + 1; ELSE RETURN 0; END; (* if *) END Depth; PROCEDURE Search (tree : BTree; key : KeyType; VAR data : ItemType) : BOOLEAN; (* if found, returns TRUE and _data_ returns item at that point *) VAR pos : CARDINAL; BEGIN IF (tree = NIL) THEN RETURN FALSE; ELSE FindPos (key, tree, pos); IF (pos > 1) AND (pos <= maxIndexPlus) AND (Compare (GetKey (tree^.Items[pos-1]), key) = equal) THEN Assign (tree^.Items[pos-1], data); RETURN TRUE; ELSE RETURN Search (tree^.Pointers[pos-1], key, data); END; (* if pos *) END; (* if tree *) END Search; PROCEDURE WriteTree (tree : BTree); (* writes out the tree *) PROCEDURE WriteInOrder (node : BTree); VAR count : CARDINAL; BEGIN IF (node = NIL) THEN RETURN; END; (* if *) WriteInOrder (node^.Pointers[0]); FOR count := 1 TO node^.numItems DO WriteData (node^.Items[count]); INC (gcount); WriteString (", "); IF (gcount > 10) THEN WriteLn; gcount := 1; END; (* if *) WriteInOrder (node^.Pointers[count]); END; (* for *) END WriteInOrder; PROCEDURE WriteNodes (node : BTree; level : CARDINAL); VAR count : CARDINAL; BEGIN IF (node = NIL) THEN RETURN; END; (* if *) FOR count := 1 TO (level*2) DO WriteString (" "); END; (* for *) IF node^.numItems > 0 THEN WriteData (node^.Items[1]); END; (* if *) FOR count := 2 TO node^.numItems DO WriteString (", "); WriteData (node^.Items[count]); END; (* for *) WriteLn; INC (gcount); IF (gcount > 33) THEN WriteString ("press return to continiue..."); SkipLine; gcount := 1; END; (* if *) FOR count := 0 TO maxIndex DO WriteNodes (node^.Pointers[count], level+1); END; (* for *) END WriteNodes; VAR gcount : CARDINAL; BEGIN WriteString ("*************"); WriteLn; WriteString ("Tree view:"); WriteLn; gcount := 1; WriteNodes (tree, 0); WriteLn; IF gcount > 34 THEN WriteString ("press return to continue..."); SkipLine; END; (* if *) WriteString ("Inorder view:"); WriteLn; gcount := 1; WriteInOrder (tree); WriteLn; WriteString ("*************"); WriteLn; END WriteTree; PROCEDURE Traverse (tree : BTree; Proc : ActionProc); (* Pre : tree is a valid initialized BTree Post : the nodes are traversed inorder and Proc is performed on each data item. *) VAR count : CARDINAL; BEGIN IF (tree = NIL) THEN RETURN; END; (* if *) Traverse (tree^.Pointers[0], Proc); FOR count := 1 TO tree^.numItems DO Proc (tree^.Items[count]); Traverse (tree^.Pointers[count], Proc); END; (* for count *) END Traverse; END BTrees.
This module was given a brief workout using cardinals as the data type, and their own value as the key. Observe that the data type to be entered could have been a complex record as long as some compare procedure was defined on a key field. First, the data type to be imported and entreed is defined:
DEFINITION MODULE DataADT; TYPE CompareResults = (less, equal, greater); KeyFieldType = CARDINAL; DataType = CARDINAL; ActionProc = PROCEDURE (DataType); PROCEDURE Assign (a : DataType; VAR b : DataType); PROCEDURE GetKey (a : DataType) : KeyFieldType; PROCEDURE WriteData (a : DataType); PROCEDURE Compare (a, b : KeyFieldType) : CompareResults; END DataADT. IMPLEMENTATION MODULE DataADT; IMPORT SWholeIO; PROCEDURE Assign (a : DataType; VAR b : DataType);BEGIN b:= a; END Assign; PROCEDURE GetKey (a : DataType) : KeyFieldType; BEGIN RETURN a; END GetKey; PROCEDURE WriteData (a : DataType); BEGIN SWholeIO.WriteCard (a,0); END WriteData; PROCEDURE Compare (a, b : KeyFieldType) : CompareResults; BEGIN IF a = b THEN RETURN equal ELSIF a < b THEN RETURN less ELSE RETURN greater END END Compare; END DataADT.
The actual test uses the same data as in the initial discussion. A few additional insertions (same value as one already there) and deletions (a value not present) are also done. At intervals, the tree is printed out, and at one point, a traverse is done adding all the key values.
MODULE TestBTrees; (* A simple program to test the Binary tree library module. by R. Sutcliffe last modified 1996 10 15 *) IMPORT BTrees, DataADT, SWholeIO, STextIO; VAR theTree : BTrees.BTree; sum : CARDINAL; PROCEDURE Summit (item : DataADT.DataType); BEGIN sum := sum + DataADT.GetKey (item) END Summit; BEGIN BTrees.Init (theTree); BTrees.Add (theTree, 15); BTrees.Add (theTree, 4); BTrees.Add (theTree, 6); BTrees.Add (theTree, 12); BTrees.WriteTree(theTree); BTrees.Add (theTree, 11); BTrees.WriteTree(theTree); BTrees.Add (theTree, 17); BTrees.Add (theTree, 20); BTrees.Add (theTree, 30); BTrees.Add (theTree, 31); BTrees.Add (theTree, 5); BTrees.Add (theTree, 16); BTrees.Add (theTree, 37); BTrees.WriteTree(theTree); sum := 0; BTrees.Traverse (theTree, Summit); STextIO.WriteLn; STextIO.WriteString ("Sum is "); SWholeIO.WriteCard (sum, 10); STextIO.WriteLn; BTrees.Delete (theTree, 15); BTrees.WriteTree(theTree); BTrees.Delete (theTree, 16); BTrees.WriteTree(theTree); BTrees.Delete (theTree, 37); BTrees.Delete (theTree, 12); BTrees.WriteTree(theTree); BTrees.Delete (theTree, 17); BTrees.WriteTree(theTree); BTrees.Delete (theTree, 42); BTrees.WriteTree(theTree); BTrees.Add (theTree, 4); BTrees.WriteTree(theTree); END TestBTrees.
When this program was run, the output looked like this:
************* Tree view: 4, 6, 12, 15 Inorder view: 4, 6, 12, 15, ************* ************* Tree view: 11 4, 6 12, 15 Inorder view: 4, 6, 11, 12, 15, ************* ************* Tree view: 11, 17 4, 5, 6 12, 15, 16 20, 30, 31, 37 Inorder view: 4, 5, 6, 11, 12, 15, 16, 17, 20, 30, 31, 37, ************* Sum is 204 ************* Tree view: 11, 17 4, 5, 6 12, 16 20, 30, 31, 37 Inorder view: 4, 5, 6, 11, 12, 16, 17, 20, 30, 31, 37, ************* ************* Tree view: 11, 20 4, 5, 6 12, 17 30, 31, 37 Inorder view: 4, 5, 6, 11, 12, 17, 20, 30, 31, 37, ************* ************* Tree view: 6, 20 4, 5 11, 17 30, 31 Inorder view: 4, 5, 6, 11, 17, 20, 30, 31, ************* ************* Tree view: 20 4, 5, 6, 11 30, 31 Inorder view: 4, 5, 6, 11, 20, 30, 31, ************* ************* Tree view: 20 4, 5, 6, 11 30, 31 Inorder view: 4, 5, 6, 11, 20, 30, 31, ************* ************* Tree view: 5, 20 4, 4 6, 11 30, 31 Inorder view: 4, 4, 5, 6, 11, 20, 30, 31, *************