Binary Tree
Binary Search Tree
This is a simple unbalanced BST that is implemented with two class modules (TreeNode and BinarySearchTree) and a Random_Main testing module, which contains the macro to run all the BST functions.
The example fills a BST with 10 random integers and completes several functions:
Private Const bstSize As Integer = 10
Private Const upperRnd As Integer = 10
Private Const lowerRnd As Integer = 1
Public WB As Workbook
Public WS As Worksheet
Public outPut As Collection
Public Sub Random_MAIN()
Dim loopCount As Integer
Dim rndNumber As Integer
Dim BST As New BinarySearchTree
Dim root As TreeNode
Set WB = ThisWorkbook
Set WS = WB.Sheets("BST")
Set outPut = New Collection
For loopCount = 1 To bstSize
rndNumber = rndOmizer: Set root = BST.insert(root, rndNumber): outPut.add (rndNumber)
Next loopCount
updateBSTSheet ("A")
myPrint ("Order in which values are inserted.")
myPrint ("")
End Sub
TreeNode Class
Here is the "TreeNode" class module with a variable to hold a value (Value) in the TreeNode, a variable to count duplicates (ValueCount), and links to the left and right child nodes (LeftChild and RightChild).
Everything is declared Public for easy access outside the class.
Public ValueCount As Long
' stores the actual value (integer in this case)
Public Value As Variant
' stores the pointer to the left child node
Public LeftChild As TreeNode
' stores the pointer to the right child node
Public RightChild As TreeNode
BinarySearchTree Class
Here is the "insert" function of the "BinarySearchTree" class module. This function creates the root TreeNode if it doesn't yet exist, adds a ValueCount to existing values instead of allowing duplicates, and recursively goes down to the first left or right Nothing TreeNode to add a new TreeNode then returns a TreeNode.
Recursively insert value with no duplicates
Public Function insert(TN As TreeNode, valToInsert As Variant) As TreeNode
' create node if it doesn't exist
If TN Is Nothing Then
Set TN = New TreeNode
TN.Value = valToInsert
TN.ValueCount = 1
' count duplicates without expanding tree
ElseIf TN.Value = valToInsert Then
TN.ValueCount = TN.ValueCount + 1
' recursively call until empty node is found
Else
' go left or right based on value and recursively call
If valToInsert < TN.Value Then
Set TN.LeftChild = insert(TN.LeftChild, valToInsert)
ElseIf valToInsert > TN.Value Then
Set TN.RightChild = insert(TN.RightChild, valToInsert)
End If
End If
' set the function to the node continually
Set insert = TN
End Function
This function recursively deletes a TreeNode based upon Value, whether that TreeNode is a leaf, has no children, or is a binary tree and then returns a TreeNode.
Public Function delete(TN As TreeNode, valToDelete As Variant) As TreeNode
' go left or right by value to be deleted and reccrsively call
If valToDelete < TN.Value Then
Set TN.LeftChild = delete(TN.LeftChild, valToDelete)
ElseIf valToDelete > TN.Value Then
Set TN.RightChild = delete(TN.RightChild, valToDelete)
' delete node if value is the same
Else
Dim copyNode As TreeNode
' node has no or only one child
If TN.LeftChild Is Nothing Then
Set copyNode = TN.RightChild
Set TN = Nothing
Set delete = copyNode
Exit Function
ElseIf TN.RightChild Is Nothing Then
Set copyNode = TN.LeftChild
Set TN = Nothing
Set delete = copyNode
Exit Function
Else
' node has two children: 1st get inorder successor:
' 2nd copy to this node: 3rd delete inorder successor
Set copyNode = minValueNode(TN.RightChild)
TN.Value = copyNode.Value
Set TN.RightChild = delete(TN.RightChild, copyNode.Value)
End If
End If
' set the function to the node continually
Set delete = TN
End Function
This function loops to find the successor TreeNode to the TreeNode that has two children and is being deleted, then returns a TreeNode.
This function is called by the "delete" function.
Private Function minValueNode(TN As TreeNode) As TreeNode
' loop down to find the leftmost leaf
Dim tempNode As TreeNode: Set tempNode = TN
While Not tempNode.LeftChild Is Nothing
Set tempNode = tempNode.LeftChild
Wend
Set minValueNode = tempNode
End Function
This function recursively finds the Value then returns a boolean.
Public Function search(TN As TreeNode, valToSearch As Variant) As Boolean
Dim searchNode As TreeNode: Set searchNode = TN
' loop until value is found (true) or bst ends (false)
While Not searchNode Is Nothing
If searchNode.Value = valToSearch Then
search = True: Exit Function
ElseIf valToSearch < searchNode.Value Then
Set searchNode = searchNode.LeftChild
Else
Set searchNode = searchNode.RightChild
End If
Wend
End Function
This function loops right to find the maximum Value, then returns a Variant.
Get the max value from right tree recursively
Public Function maxValue(TN As TreeNode) As Variant
Dim maxValueNode As TreeNode: Set maxValueNode = TN
While Not maxValueNode.RightChild Is Nothing
Set maxValueNode = maxValueNode.RightChild
Wend
maxValue = maxValueNode.Value
End Function
This function loops left to find the minmum Value then returns a Variant.
Get the min value from left tree recursively
Public Function minValue(TN As TreeNode) As Variant
Dim minValueNode As TreeNode: Set minValueNode = TN
While Not minValueNode.LeftChild Is Nothing
Set minValueNode = minValueNode.LeftChild
Wend
minValue = minValueNode.Value
End Function
This function recurves the BST in the order of the left TreeNode, then the root TreeNode, then the right TreeNode in order to display the values from smallest to largest.
A Collection is returned but that variable could be an Array.
Display the values in order from lowest to highest (left, root, right) recursively
Public Function InOrder(TN As TreeNode, Optional myCol As Collection) As Collection
If Not TN Is Nothing Then
Call InOrder(TN.LeftChild, myCol)
If myCol Is Nothing Then
Set myCol = New Collection
myCol.add ("#: " & TN.Value & " (" & TN.ValueCount & " Total)")
Else
myCol.add ("#: " & TN.Value & " (" & TN.ValueCount & " Total)")
End If
Call InOrder(TN.RightChild, myCol)
End If
Set InOrder = myCol
End Function
This function recurses the BST in the order of the root TreeNode, then the left TreeNode, then the right TreeNode.
This could be used to get a prefix or to copy the BST but here I am displaying them. A Collection is returned but that variable could be an Array.
Display the values from left to right (root, left, right) recursively
Public Function PreOrder(TN As TreeNode, Optional myCol As Collection) As Collection
If Not TN Is Nothing Then
If myCol Is Nothing Then
Set myCol = New Collection
myCol.add ("#: " & TN.Value & " (" & TN.ValueCount & " Total)")
Else
myCol.add ("#: " & TN.Value & " (" & TN.ValueCount & " Total)")
End If
Call PreOrder(TN.LeftChild, myCol)
Call PreOrder(TN.RightChild, myCol)
End If
Set PreOrder = myCol
End Function
This function recurses the BST in the order of the left TreeNode, then the right TreeNode, then the right root TreeNode.
This could be used to get a postfix or to delete the BST but here I am displaying them. A Collection is returned but that variable could be an Array.
Display the values from right to left (left, right, root) recursively
Public Function PostOrder(TN As TreeNode, Optional myCol As Collection) As Collection
If Not TN Is Nothing Then
Call PostOrder(TN.LeftChild, myCol)
Call PostOrder(TN.RightChild, myCol)
If myCol Is Nothing Then
Set myCol = New Collection: myCol.add ("#: " & TN.Value & " (" & TN.ValueCount & " Total)")
Else
myCol.add ("#: " & TN.Value & " (" & TN.ValueCount & " Total)")
End If
End If
Set PostOrder = myCol
End Function
© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited TopPrevNext