' 二叉树左树PrivateleftAs node
' 二叉树右数PrivaterightAs node
PrivatekeyAs Variant
Private value As Variant
Private treeSize AsLongPropertyLet letLeft(ByRef l As node)
assign left, l
EndPropertyPropertyLet letRight(ByRef r As node)
assign right, r
EndPropertyPropertyLet letKey(ByRef k As Variant)
assign key, k
EndPropertyPropertyLet letValue(ByRef v As Variant)
assign value, v
EndPropertyPropertyLet letTreeSize(i AsLong)
treeSize = i
EndPropertyPropertyGet getLeft()As Variant
assign getLeft,leftEndPropertyPropertyGet getRight()As Variant
assign getRight,rightEndPropertyPropertyGet getKey()As Variant
assign getKey,keyEndPropertyPropertyGet getValue()As Variant
assign getValue, value
EndPropertyPropertyGet getTreeSize()AsLong
getTreeSize = treeSize
EndPropertyPrivateSub assign(ByRef x,ByVal y)If IsObject(y)ThenSet x = y
Else
x = y
EndIfEndSub
' 二叉树实现的符号表Private root As node
' 把值加入符号表中,如果值为空,就删除主键Sub putValue(keyAs Variant,valAs Variant)Set root = doPut(root,key,val)EndSubPrivateFunction doPut(x As node,ByRefkeyAs Variant,ByRefvalAs Variant)As node
Dim newNode As node
' 如果节点为空,创建一个新节点返回If x IsNothingThenSet newNode =New node
newNode.letKey =key
newNode.letValue =val
newNode.letTreeSize =1Set doPut = newNode
ExitFunctionEndIfDim nKey As Variant
assign nKey, x.getKey
' 比节点的key更加大,右边查找Ifkey> nKey Then
x.letRight = doPut(x.getRight,key,val)ElseIfkey< nKey Then
x.letLeft = doPut(x.getLeft,key,val)Else
x.letValue =valEndIf
x.letTreeSize = doSize(x.getLeft)+ doSize(x.getRight)+1Set doPut = x
EndFunction' 获取键的值,如果键为空,就返回空Function getValue(keyAs Variant)As Variant
Dim node As node
Set node = doGet(key, root)If node IsNothingThen getValue = Null:ExitFunction
assign getValue, node.getValue
EndFunctionPrivateFunction doGet(keyAs Variant, x As node)As node
Dim xKey As Variant
If x IsNothingThenSet doGet =Nothing:ExitFunction
xKey = x.getKey
Ifkey< xKey ThenSet doGet = doGet(key, x.getLeft)ElseIfkey> xKey ThenSet doGet = doGet(key, x.getRight)ElseSet doGet = x
EndIfEndFunction' 删除最小的键Sub deleteMin()Set root = doDeleteMin(root)EndSubFunction doDeleteMin(x As node)As node
Dim lNode As node
Set lNode = x.getLeft
' 如果左边为空,说明已经到了最小值,返回右边的节点,即使是空If lNode IsNothingThenSet doDeleteMin = x.getRight
Else' 如果左边不为空,则说明没有到最小的节点,继续查找,将返回的节点挂入左边,如果最小节点右边没有节点,将返回nothing,也删除了最小节点,如果最小节点右边有节点,则返回的右边节点,挂入当前节点的左节点
x.letLeft = doDeleteMin(x.getLeft)' 删除一个,数量递归减去一个
x.letTreeSize = x.getTreeSize -1Set doDeleteMin = x
EndIfEndFunction' 删除最大的键Sub deleteMax()Set root = doDeleteMax(root)EndSubFunction doDeleteMax(x As node)As node
Dim rNode As node
Set rNode = x.getRight
If rNode IsNothingThenSet doDeleteMax = x.getLeft
Else
x.letRight = doDeleteMax(x.getRight)
x.letTreeSize = x.getTreeSize -1Set doDeleteMax = x
EndIfEndFunction' 从表中删除主键Subdelete(keyAs Variant)Set root = doDelete(root,key)EndSub' 并没有彻底理解,需要在思考Function doDelete(x As node,keyAs Variant)As node
Dim xKey As Variant
Dim xTemp As node
If x IsNothingThenSet doDelete =Nothing:ExitFunction
assign xKey, x.getKey
Ifkey> xKey Then
x.letRight = doDelete(x.getRight,key)ElseIfkey< xKey Then
x.letLeft = doDelete(x.getLeft,key)Else' 被删除的节点,左右子节点是否存在,如果同时存在,需要特殊处理,如果只存在左子节点或者右子节点,取存在的节点,' 先判断左 或者 右 是否为空,如果有一个为空,最多只存在一个子节点,直接返回就行了' 查看两边是否为空,如果一边为空,另一边不管是否为空,都返回了If x.getRight IsNothingThenSet doDelete = x.getLeft:ExitFunctionIf x.getLeft IsNothingThenSet doDelete = x.getRight:ExitFunction' 左右两边都有值,右边节点取最小值,替换当前节点,然后右边树,删除最小节点,并返回根节点挂入当前节点右侧,左边节点为原x.letSet xTemp = t
Set x = doMin(t.getRight)
x.letRight = doDeleteMin(t.getRight)
x.letLeft = t.getLeft
EndIf
x.letTreeSize = doSize(x.getRight)+ doSize(x.getLeft)+1Set doDelete = x
EndFunction' 主键是否存在于符号表中Function contains(keyAs Variant)AsBooleanEndFunction' 是否为空Function isEmpty()AsBoolean
isEmpty = n =0EndFunction' 最小的主键Functionmin()As Variant
Dim minNode As node
Set minNode = doMin(root)
assign min, minNode.getValue
EndFunctionFunction doMin(x As node)As node
If x.getLeft IsNothingThenSet doMin = x
ElseSet doMin = doMin(x.getLeft)EndIfEndFunction' 最大的主键Functionmax()As Variant
Dim maxNode As node
Set maxNode = doMax(root)
assign max, maxNode.getValue
EndFunctionFunction doMax(x As node)As node
If x.getRight IsNothingThenSet doMax = x
ElseSet doMax = doMax(x.getRight)EndIfEndFunction' 小于等于key的最大键Function floor(keyAs Variant)As Variant
Dim n As node
Set n = doFloor(root,key)If n IsNothingThen assign floor, Null:ExitFunction
assign floor, n.getValue
EndFunction' 抽象出通用操作' 需要取出小于等于key的最大值' 如果相等,返回节点,这没什么说的,后面不讨论相等情况' 如果值从左边返回,结果为null,那么就是没有找到,因为需要找到比key小的 key,排除相等,必须找到一个比key小的key,然后取右边节点。左边返回null,只能说明整颗树或者子树中都没有找到' 如果右边返回null,说明就是当前节点,直接返回当前节点Function doFloor(x As node,keyAs Variant)As node
Dim xKey As Variant
Dim temp As node
If x IsNothingThenSet doFloor =NothingElse
assign xKey, x.getKey
Ifkey= xKey ThenSet doFloor = x:ExitFunctionIfkey< xKey ThenSet doFloor = doFloor(x.getLeft,key):ExitFunctionIfkey> xKey ThenSet temp = doFloor(x.getRight,key)If temp IsNothingThenSet doFloor = x
ElseSet doFloor = temp
EndIfEndIfEndIfEndFunction' 大于等于key的最小键Function ceiling(keyAs Variant)As Variant
Dim n As node
Set n = doCeiling(root,key)If n IsNothingThen assign ceiling, Null:ExitFunction
assign ceiling, n.getValue
EndFunction' 抽象出通用操作' 需要取出大于等于key的最小值' 如果相等,返回节点,这没什么说的,后面不讨论相等情况' 如果值从右边返回,结果为null,那么就是没有找到,因为需要找到比key大的 key,排除相等,必须找到一个比key大的key,然后取左边节点。右边返回null,只能说明整颗树或者子树中都没有找到' 如果左边返回null,说明就是当前节点,直接返回当前节点Function doCeiling(x As node,keyAs Variant)As node
Dim xKey As Variant
Dim temp As node
If x IsNothingThenSet doCeiling =NothingElse
assign xKey, x.getKey
Ifkey= xKey ThenSet doCeiling = x:ExitFunctionIfkey> xKey ThenSet doCeiling = doCeiling(x.getRight,key):ExitFunctionEndIfIfkey< xKey ThenSet temp = doCeiling(x.getLeft,key)If temp IsNothingThenSet doCeiling = x
ElseSet doCeiling = temp
EndIfEndIfEndIfEndFunction' 小于key的数量Function rank(keyAs Variant)AsLong
rank = doRank(root,key)EndFunctionFunction doRank(x As node,keyAs Variant)AsLongDim xKey As Variant
Dim lSize AsLongIf x IsNothingThen doRank =0:ExitFunction
lSize = doSize(x.getLeft)
xKey = x.getKey
Ifkey> xKey Then
doRank = lSize +1+ doRank(x.getRight,key)ElseIfkey< xKey Then
doRank = doRank(x.getLeft,key)Else
doRank = lSize
EndIfEndFunction' 排名为key的键Function find(k AsLong)As Variant
Dim fNode As node
Set fNode = doFind(root, k)If fNode IsNothingThen assign find, Null
assign find, fNode.getKey
EndFunctionFunction doFind(x As node, k AsLong)As node
Dim lSize AsLong' 正常情况下,是不可能到这个地方的。在某个节点必有满足k = lSize的情况If x IsNothingThenSet doFind =Nothing:ExitFunction
lSize = doSize(x.getLeft)If lSize > k Then' 完全满足,可以放心继续探查Set doFind = doFind(x.getLeft, k)ElseIf lSize < k Then' 如果lSize < k 说明左边的节点不能满足k排名,需要向右边继续查找,不过不需要在查找key,需要查找k - lSize - 1Set doFind = doFind(x.getRight, k - lSize -1)ElseSet doFind = x
EndIfEndFunction' 数量Functionsize()AsLongsize= doSize(root)EndFunctionPrivateFunction doSize(ByRef x As node)AsLongIf x IsNothingThen doSize =0:ExitFunction
doSize = x.getTreeSize
EndFunction' 键之间的数量Function sizeRange(low As Variant, high As Variant)
sizeRange = doSizeRange(root, low, high)EndFunctionFunction doSizeRange(x As node, low As Variant, high As Variant)AsLongIf x IsNothingThen doSizeRange =0:ExitFunctionDim xKey As Variant
DimsizeAsLong
assign xKey, x.getKey
If xKey > low Thensize=size+ doSizeRange(x.getLeft, low, high)EndIfIf xKey >= low And xKey <= high Thensize=size+1EndIfIf xKey < high Thensize=size+ doSizeRange(x.getRight, low, high)EndIf
doSizeRange =sizeEndFunction' 键之间的所有主键Function keysRange(low As Variant, high As Variant)As Collection
Dim c AsNew Collection
doKeysRange root, c, low, high
Set keysRange = c
EndFunction' 中序遍历Sub doKeysRange(x As node, c As Collection, low As Variant, high As Variant)If x IsNothingThenExitFunctionDim xKey As Variant
assign xKey, x.getKey
If xKey > low Then
doKeysRange x.getLeft, c, low, high
EndIfIf xKey >= low And xKey <= high Then
c.add xKey
EndIfIf xKey < high Then
doKeysRange x.getRight, c, low, high
EndIfEndSub' 所有主键Function keysAll()As Collection
Dim c AsNew Collection
doKeysRange root, c,min(),max()Set keysAll = c
EndFunctionPrivateSub assign(ByRef x,ByVal y)If IsObject(y)ThenSet x = y
Else
x = y
EndIfEndSub
' 二叉树左树Private left As Node' 二叉树右数Private right As NodePrivate key As VariantPrivate value As VariantPrivate treeSize As LongProperty Let letLeft(ByRef l As Node) assign left, lEnd PropertyProperty Let letRight(ByRef r As Node) ass.