lang/C/sorting.and.searching.cormen.algo/src/vpb.txt

   1 Attribute VB_Name = "Bin"
   2 Option Explicit
   3
   4 ' binary tree algorithm, object method
   5
   6 Private Root As CBin            ' root of binary tree
   7
   8 Private Function FindNode(ByVal KeyVal As Variant) As CBin
   9 '   inputs:
  10 '       KeyVal                key of node to find
  11 '   returns:
  12 '       location of node
  13 '   action:
  14 '       Finds node with key KeyVal.
  15 '   errors:
  16 '
  17     Dim x As CBin
  18
  19     ' find node specified by key
  20     Set x = Root
  21     Do While Not x Is Nothing
  22         If x.Key = KeyVal Then
  23             Set FindNode = x
  24             Exit Function
  25         Else
  26             If KeyVal < x.Key Then
  27                 Set x = x.Left
  28             Else
  29                 Set x = x.Right
  30             End If
  31         End If
  32     Loop
  33     Raise errKeyNotFound, "Bin.FindNode"
  34 End Function
  35
  36 Public Sub Insert(ByVal KeyVal, ByRef RecVal As Variant)
  37 '   inputs:
  38 '       KeyVal                key of node to insert
  39 '       RecVal                record associated with key
  40 '   action:
  41 '       Inserts record RecVal with key KeyVal.
  42 '   error:
  43 '       errDuplicateKey
  44 '
  45     Dim x As CBin
  46     Dim current As CBin
  47     Dim Parent As CBin
  48
  49     ' allocate node for data and insert in tree
  50
  51     ' find x's parent
  52     Set current = Root
  53     Set Parent = Nothing
  54     Do While Not current Is Nothing
  55         If current.Key = KeyVal Then Raise errDuplicateKey, "Bin.Insert"
  56         Set Parent = current
  57         If KeyVal < current.Key Then
  58             Set current = current.Left
  59         Else
  60             Set current = current.Right
  61         End If
  62     Loop
  63
  64     ' setup new node
  65     Set x = New CBin
  66     Set x.Parent = Parent
  67     Set x.Left = Nothing
  68     Set x.Right = Nothing
  69
  70     ' copy fields to node
  71     x.Key = KeyVal
  72     x.Rec = RecVal
  73
  74     ' insert x in tree
  75     If Not Parent Is Nothing Then
  76         If x.Key < Parent.Key Then
  77             Set Parent.Left = x
  78         Else
  79             Set Parent.Right = x
  80         End If
  81     Else
  82         Set Root = x
  83     End If
  84 End Sub
  85
  86 Public Sub Delete(ByVal KeyVal As Variant)
  87 '   inputs:
  88 '       KeyVal                key of node to delete
  89 '   action:
  90 '       Deletes record with key KeyVal.
  91 '   error:
  92 '       errKeyNotFound
  93 '
  94     Dim x As CBin
  95     Dim y As CBin
  96     Dim z As CBin
  97
  98     Set z = FindNode(KeyVal)
  99
 100     ' delete node z from tree
 101
 102     ' find tree successor
 103     If z.Left Is Nothing Or z.Right Is Nothing Then
 104         Set y = z
 105     Else
 106         Set y = z.Right
 107         Do While Not y.Left Is Nothing
 108             Set y = y.Left
 109         Loop
 110     End If
 111
 112     ' x is y's only child
 113     If Not y.Left Is Nothing Then
 114         Set x = y.Left
 115     Else
 116         Set x = y.Right
 117     End If
 118
 119     ' remove y from the parent chain
 120     If Not x Is Nothing Then Set x.Parent = y.Parent
 121     If Not y.Parent Is Nothing Then
 122         If y Is y.Parent.Left Then
 123             Set y.Parent.Left = x
 124         Else
 125             Set y.Parent.Right = x
 126         End If
 127     Else
 128         Set Root = x
 129     End If
 130
 131     ' if z and y are not the same, replace z with y.
 132     If Not y Is z Then
 133         Set y.Left = z.Left
 134         If Not y.Left Is Nothing Then Set y.Left.Parent = y
 135         Set y.Right = z.Right
 136         If Not y.Right Is Nothing Then Set y.Right.Parent = y
 137         Set y.Parent = z.Parent
 138         If Not z.Parent Is Nothing Then
 139             If z Is z.Parent.Left Then
 140                 Set z.Parent.Left = y
 141             Else
 142                 Set z.Parent.Right = y
 143             End If
 144         Else
 145             Set Root = y
 146         End If
 147         ' z is no longer referenced, and is automatically freed
 148     Else
 149         ' y is no longer referenced, and is automatically freed
 150     End If
 151 End Sub
 152
 153 Public Function Find(ByVal KeyVal) As Variant
 154 '   inputs:
 155 '       KeyVal                key of node to delete
 156 '   returns:
 157 '       record associated with key
 158 '   action:
 159 '       Finds record with key KeyVal
 160 '   error:
 161 '       errKeyNotFound
 162 '
 163     Find = FindNode(KeyVal).Rec
 164 End Function
 165
 166 Public Sub Init()
 167 '   action:
 168 '       initialize memory
 169 '
 170     Set Root = Nothing
 171 End Sub
 172
 173 Private Sub ZapNode(x As CBin)
 174 '   inputs:
 175 '       x       pointer to node
 176 '   action
 177 '       recursively set x's parents to Nothing
 178 '
 179     If x Is Nothing Then Exit Sub
 180     Set x.Parent = Nothing
 181     ZapNode x.Left
 182     ZapNode x.Right
 183 End Sub
 184
 185 Public Sub Term()
 186 '   action:
 187 '       free memory
 188 '
 189     If Root Is Nothing Then Exit Sub
 190
 191     ' remove all parent pointers
 192     ZapNode Root.Left
 193     ZapNode Root.Right
 194
 195     ' now, freeing root will free whole tree
 196     Set Root = Nothing
 197 End Sub
 198