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

   1 VERSION 1.0 CLASS
   2 BEGIN
   3   MultiUse = -1  'True
   4   Persistable = 0  'NotPersistable
   5   DataBindingBehavior = 0  'vbNone
   6   DataSourceBehavior  = 0  'vbNone
   7   MTSTransactionMode  = 0  'NotAnMTSObject
   8 END
   9 Attribute VB_Name = "CBin"
  10 Attribute VB_GlobalNameSpace = False
  11 Attribute VB_Creatable = True
  12 Attribute VB_PredeclaredId = False
  13 Attribute VB_Exposed = False
  14 Option Explicit
  15
  16 ' binary tree, array Method
  17
  18 Private GrowthFactor As Single
  19 Private InitialAlloc As Long
  20
  21 ' fields associated with each node
  22 Private Left() As Long          ' left child
  23 Private Right() As Long         ' right child
  24 Private Parent() As Long        ' parent
  25 Private key() As Variant        ' user's key
  26 Private rec() As Variant        ' user's data associated with key
  27
  28 Private Root As Long            ' root of binary tree
  29 Private Node As CNode           ' class for allocating nodes
  30
  31 Private Function FindNode(ByVal KeyVal As Variant) As Long
  32 '   inputs:
  33 '       KeyVal                key of node to find
  34 '   returns:
  35 '       location of node
  36 '   action:
  37 '       Finds node with key KeyVal.
  38 '   errors:
  39 '
  40     Dim x As Long
  41
  42     ' find node specified by key
  43     x = Root
  44     Do While x <> 0
  45         If key(x) = KeyVal Then
  46             FindNode = x
  47             Exit Function
  48         Else
  49             If KeyVal < key(x) Then
  50                 x = Left(x)
  51             Else
  52                 x = Right(x)
  53             End If
  54         End If
  55     Loop
  56     Raise errKeyNotFound, "CBin.FindNode"
  57 End Function
  58
  59 Public Sub Insert(ByVal KeyVal, ByRef RecVal As Variant)
  60 '   inputs:
  61 '       KeyVal                key of node to insert
  62 '       RecVal                record associated with key
  63 '   action:
  64 '       Inserts record RecVal with key KeyVal.
  65 '   error:
  66 '       errDuplicateKey
  67 '
  68     Dim x As Long
  69     Dim current As Long
  70     Dim p As Long
  71
  72     ' allocate node for data and insert in tree
  73
  74     ' find x's parent
  75     current = Root
  76     p = 0
  77     Do While current <> 0
  78         If key(current) = KeyVal Then Raise errDuplicateKey, "CBin.Insert"
  79         p = current
  80         If KeyVal < key(current) Then
  81             current = Left(current)
  82         Else
  83             current = Right(current)
  84         End If
  85     Loop
  86
  87     ' setup new node
  88     x = Node.Alloc()
  89     If x > UBound(key) Then
  90         ReDim Preserve Left(1 To UBound(Left) * GrowthFactor)
  91         ReDim Preserve Right(1 To UBound(Right) * GrowthFactor)
  92         ReDim Preserve Parent(1 To UBound(Parent) * GrowthFactor)
  93         ReDim Preserve key(1 To UBound(key) * GrowthFactor)
  94         ReDim Preserve rec(1 To UBound(rec) * GrowthFactor)
  95     End If
  96     Parent(x) = p
  97     Left(x) = 0
  98     Right(x) = 0
  99
 100     ' copy fields to node
 101     key(x) = KeyVal
 102     rec(x) = RecVal
 103
 104     ' insert x in tree
 105     If p <> 0 Then
 106         If key(x) < key(p) Then
 107             Left(p) = x
 108         Else
 109             Right(p) = x
 110         End If
 111     Else
 112         Root = x
 113     End If
 114 End Sub
 115
 116 Public Sub Delete(ByVal KeyVal As Variant)
 117 '   inputs:
 118 '       KeyVal                key of node to delete
 119 '   action:
 120 '       Deletes record with key KeyVal.
 121 '   error:
 122 '       errKeyNotFound
 123 '
 124     Dim x As Long
 125     Dim y As Long
 126     Dim z As Long
 127
 128     z = FindNode(KeyVal)
 129
 130     ' delete node z from tree
 131
 132     ' find tree successor
 133     If Left(z) = 0 Or Right(z) = 0 Then
 134         y = z
 135     Else
 136         y = Right(z)
 137         Do While Left(y) <> 0
 138             y = Left(y)
 139         Loop
 140     End If
 141
 142     ' x is y's only child
 143     If Left(y) <> 0 Then
 144         x = Left(y)
 145     Else
 146         x = Right(y)
 147     End If
 148
 149     ' remove y from the parent chain
 150     If x <> 0 Then Parent(x) = Parent(y)
 151     If Parent(y) <> 0 Then
 152         If y = Left(Parent(y)) Then
 153             Left(Parent(y)) = x
 154         Else
 155             Right(Parent(y)) = x
 156         End If
 157     Else
 158         Root = x
 159     End If
 160
 161     ' if z and y are not the same, replace z with y.
 162     If y <> z Then
 163         Left(y) = Left(z)
 164         If Left(y) <> 0 Then Parent(Left(y)) = y
 165         Right(y) = Right(z)
 166         If Right(y) <> 0 Then Parent(Right(y)) = y
 167         Parent(y) = Parent(z)
 168         If Parent(z) <> 0 Then
 169             If z = Left(Parent(z)) Then
 170                 Left(Parent(z)) = y
 171             Else
 172                 Right(Parent(z)) = y
 173             End If
 174         Else
 175             Root = y
 176         End If
 177         Node.Free (z)
 178         Set rec(z) = Nothing
 179     Else
 180         Node.Free (y)
 181         Set rec(y) = Nothing
 182     End If
 183 End Sub
 184
 185 Public Function Find(ByVal KeyVal) As Variant
 186 '   inputs:
 187 '       KeyVal                key of node to delete
 188 '   returns:
 189 '       record associated with key
 190 '   action:
 191 '       Finds record with key KeyVal
 192 '   error:
 193 '       errKeyNotFound
 194 '
 195     Find = rec(FindNode(KeyVal))
 196 End Function
 197
 198 Public Sub Init(ByVal InitialAllocVal As Long, ByVal GrowthFactorVal As Single)
 199 '   inputs:
 200 '       InitialAlloc          initial allocation of nodes
 201 '       GrowthFactor          amount for reallocation of nodes (.GT. 1)
 202 '   action:
 203 '       Initializes Bin class. Call once after allocating class.
 204 '
 205     Root = 0
 206     GrowthFactor = GrowthFactorVal
 207     ReDim Left(1 To InitialAllocVal)
 208     ReDim Right(1 To InitialAllocVal)
 209     ReDim Parent(1 To InitialAllocVal)
 210     ReDim key(1 To InitialAllocVal)
 211     ReDim rec(1 To InitialAllocVal)
 212     Set Node = New CNode
 213     Node.Init InitialAllocVal, GrowthFactorVal
 214 End Sub
 215
 216 Public Sub Class_Terminate()
 217     Set Node = Nothing
 218  End Sub
 219