'
'  BinarySearchTree.lss
'
'  Time-stamp: <2003-03-28 01:56:10 Daniel Eriksson>
'
'  Date        Author           Changes
'  ----------  ---------------  ------------------------------------
'  2003-03-28  Daniel Eriksson  Created
'

Private Const INIT_CAPACITY = 1

Public Class Comparison
' Abstract class for comparing two Variants. Comparison
' functors need to subclass Comparison.
'
  Public Function Compare(lhs As Variant, rhs As Variant) As Integer
  ' Returns a negative integer, zero, or a positive integer as
  ' lhs is less than, equal to, or greater than rhs. 
  End Function
End Class

Public Class IntegerComparison As Comparison
' Functor for comparing integers.
'
  Public Function Compare(lhs As Variant, rhs As Variant) As Integer
    Compare = lhs - rhs
  End Function
End Class

Public Class StringComparison As Comparison
' Functor for comparing strings.
'
  Public Function Compare(lhs As Variant, rhs As Variant) As Integer
    If lhs < rhs Then
      Compare = -1
    Else
      If lhs = rhs Then
        Compare = 0
      Else
        Compare = 1
      End If
    End If
  End Function
End Class

Private Class BinaryNode
  Public element As Variant
  Public left As BinaryNode
  Public right As BinaryNode
  
  Public Sub New(element As Variant, _
  lt As BinaryNode, rt As BinaryNode)
    If RequiresSet(element) Then
      Set Me.element = element
    Else
      Me.element = element
    End If
    
    Set Me.left = lt
    Set Me.right = rt
  End Sub
End Class

Public Class BinarySearchTree
' This data structure can be used to find max and min values 
' of a collection, sorting a collection or to eliminate
' doubles.
'
' A binary search tree is a tree in which no node can have
' more than two children, and in which for every node, X in 
' the tree, the values of all the items in its left subtree 
' are smaller than the item in X, and the values of all the
' items in its right subtree are larger than the item in X.
'
' The average running times of the operations Add and Remove
' are O(log N) (in the absence of prior deletions). However,
' if the input comes into a tree presorted, then a series 
' of inserts will take quadratic time.
'
' Example:
'   Dim int_functor As New IntegerComparison
'   Dim int_tree As New BinarySearchTree(int_functor)
'  
'   print int_tree.Add(1) 'True
'   print int_tree.Add(2) 'True
'   print int_tree.Add(2) 'False
'   print int_tree.Max    '2
'
  
  Private root As BinaryNode
  Private comp As Comparison
  
  Public Sub New(comp As Comparison)
    Set Me.comp = comp
    Set root = Nothing  
  End Sub
  
  Public Function Add(element As Variant) As Variant
  ' Adds element to the tree if it is not already present.
  '
  ' Returns true if the tree did not already contain 
  ' element; otherwise, returns false.
  '
    Dim found As Variant
    found = False
    Set root = AddRecursively(element, root, found)
    Add = Not found
  End Function
  
  Public Function Elements() As Variant
  ' Returns the elements in the tree in a sorted
  ' array.
  '
    If Me.IsEmpty Then
      Set Elements = Nothing
      Exit Function
    End If
    
    Dim result() As Variant
    Redim result(INIT_CAPACITY - 1) As Variant
    
    Dim ndx As Long
    ndx = 0
    
    CollectElements root, result, ndx 
    
    Redim Preserve result(ndx - 1)
    Elements = Result 
  End Function
  
  Public Function Remove(element As Variant) As Variant
  ' Removes element from the tree if it is present.
  '
  ' Returns true if the tree contained element; 
  ' otherwise, returns false.
  '
    Dim found As Variant
    found = False
    Set root = RemoveRecursively(element, root, found)
    Me.Remove = found
  End Function
  
  Public Function Contains(element As Variant) As Variant
  ' Checks if the tree contains element.
  '
  ' Returns true if the set did not already contain 
  ' element; otherwise, returns false
  '
    Contains = Not Find(element, root) Is Nothing
  End Function
  
  Public Sub Clear
  ' Removes all elements from the tree.
  '
    Set root = Nothing
  End Sub
  
  Public Function Min As Variant
  ' Returns the node containing the smallest item.
  '
    Dim tmp As BinaryNode
    Set tmp = FindMin(root)
    If tmp Is Nothing Then
      Set Me.Min = Nothing
    Else
      Min = tmp.element
    End If
  End Function
  
  Public Function Max As Variant
  ' Returns the node containing the largest item.
  '
    Dim tmp As BinaryNode
    Set tmp = FindMax(root)
    If tmp Is Nothing Then
      Set Me.Max = Nothing
    Else
      Max = tmp.element
    End If
  End Function
  
  Private Function FindMin(t As BinaryNode) As BinaryNode
  ' Internal method to find the smallest item in a subtree.
  '  
  ' t - the node that roots the tree.
  ' 
  ' Returns the node containing the smallest item.
  '
    
    If t Is Nothing Then
      Set FindMin = Nothing
    Else 
      If t.left Is Nothing Then
        Set FindMin = t
      Else
        Set FindMin = FindMin(t.left)
      End If
    End If
  End Function
  
  Public Function IsEmpty As Variant
  ' Returns true if the tree has at least one node; 
  ' otherwise returns false.
  '
    Me.IsEmpty = root Is Nothing
  End Function
  
  Public Sub PrintTree
  ' Prints the tree to standard output. Used only for debugging.
  '
    If Me.IsEmpty Then 
      Print "Empty tree"  
    Else
      PrintRecursively root
    End If
  End Sub
  
  Private Function FindMax(t As BinaryNode) As BinaryNode
  ' Internal method to find the largest item in a subtree.
  '  
  ' t - the node that roots the tree.
  ' 
  ' Returns the node containing the largest item.
  '
    If t Is Nothing Then
      Set FindMax = Nothing
    Else 
      If t.right Is Nothing Then
        Set FindMax = t
      Else
        Set FindMax = FindMax(t.right)
      End If
    End If
  End Function
  
  Private Sub PrintRecursively(t As BinaryNode)
  ' Internal method to print a subtree.
  '
    If Not t Is Nothing Then
      PrintRecursively t.left 
      Print t.element
      PrintRecursively t.right
    End If
  End Sub
  
  Private Function Find(x As Variant, t As BinaryNode) As BinaryNode
  ' Internal method to find an item in a subtree.
  '
  ' x - the item to search for.
  ' t - the node that roots the tree.
  '
  ' Returns node containing the matched item, if t contains x; 
  ' otherwise returns Nothing.
  '
    If t Is Nothing Then 
      Set Find = Nothing
    Else      
      If comp.Compare(x, t.element) < 0 Then
        Set Find = Find(x, t.left)
      Else
        If comp.Compare(x, t.element) > 0 Then
          Set Find = Find(x, t.right)
        Else
        'Match
          Set Find = t
        End If
      End If
    End If
  End Function
  
  Private Function AddRecursively(x As Variant, _
  t As BinaryNode, found As Variant) As BinaryNode
  ' Internal method to insert into a subree.
  '
  ' x - the item to insert.
  ' t - the node that roots the tree.
  ' found - a boolean variable that is set to true if and only if t contains x.
  '
  ' Returns the new root.
  '
    If t Is Nothing Then
      Set t = New BinaryNode(x, Nothing, Nothing)
    Else
      If comp.Compare(x, t.element) < 0 Then
        Set t.left = AddRecursively(x, t.left, found)
      Else 
        If comp.Compare(x, t.element) > 0 Then
          Set t.right = AddRecursively(x, t.right, found)
        Else
          ' Duplicate
          found = True
        End If
      End If
    End If
    
    Set AddRecursively = t
  End Function
  
  Private Function RemoveRecursively(x As Variant, t As BinaryNode, _
  found As Variant) As BinaryNode
  ' Internal method to remove from a subrtree.
  '
  ' x - the item to remove.
  ' t - the node tat roots the tree.
  ' found - a boolean variable that is set to true if and only if t contains x.
  '
  ' Returns the new root.
  '    
    If t Is Nothing Then
      ' Item not found. Just return Nothing.
      Set RemoveRecursively = t
      Exit Function
    End If
    
    If comp.Compare(x, t.element) < 0 Then
      Set t.left = RemoveRecursively(x, t.left, found)
    Else
      If comp.Compare(x, t.element) > 0 Then
        Set t.right = RemoveRecursively(x, t.right, found)
      Else
        found = True
        If (Not t.left Is Nothing) And (Not t.right Is Nothing) Then
          ' TODO: Replace with a function, RemoveMin, so that only
          ' one pass is necessary.
          
          ' Two children
          If RequiresSet(t.element) Then
            Set t.element = FindMin(t.right).element
          Else
            t.element = FindMin(t.right).element
          End If
          Set t.right = RemoveRecursively(x, t.right, found)
        Else
          If Not t.left Is Nothing Then
            Set t = t.left
          Else
            Set t = t.right
          End If
        End If
      End If
    End If
    
    Set RemoveRecursively = t
  End Function
  
  Private Sub CollectElements(t As BinaryNode, resultList() As Variant,_
  ndx As Long)
  ' An inorder traversal of the tree, for collecting all
  ' elements.
  '
    If Not t Is Nothing Then
      
      CollectElements t.left, ResultList, ndx
      
      'Double the size of the array if it is too
      'small for one more item.
      Dim upper As Long
      upper = Ubound(resultList)
      If ndx > upper Then
        Redim Preserve resultList((upper + 1) * 2 - 1)
      End If
      
      If RequiresSet(t.element) Then
        Set resultList(ndx) = t.element
      Else
        resultList(ndx) = t.element
      End If
      ndx = ndx + 1
      
      CollectElements t.right, resultList, ndx            
    End If
  End Sub
End Class

Private Function RequiresSet(v As Variant) As Variant
' Returns true if v's data type requires the
' key word "Set" in assignments; otherwise returns
' false.
'
  Dim data_type As Integer
  data_type = Datatype(v)
  If data_type = 9 Or data_type = 34 Or data_type = 35 Then
    RequiresSet = True
  Else
    RequiresSet = False
  End If
End Function