| |
| Partial Implementation: Nested Sets |
Using Visual BASIC, here's a suggestion for adding new items to a Celko nested set.
He had referred to such a structure as a 'modified preorder traversal tree', thus the "MPTT"
labelling below:
[By the way, to select everything in the box below, in Internet Explorer,
triple click the mouse (click rapidly three times).]
|
Private Const MPT2_SubLast = 1
Private Const MPT2_SubFirst = 2
Private Const MPT2_InsertAfter = 3
Private Const MPT2_InsertBefore = 4
Private Sub sMPTTadd(strNew As String, strRef As String, ByVal bytWhere As Byte)
Dim varRead As Variant, lngLftPivot As Long, lngRgtPivot As Long, lngNewLft As Long
varRead = DLookup("lngR", "mpttTest", "txCategory='" & strRef & "'")
If IsNull(varRead) Then
lngRgtPivot = IIf(CurrentDB.OpenRecordset("SELECT Count(*) FROM mpttTest")(0) > 0, DLookup("lngR", "mpttTest", "lngL=1"), 1)
bytWhere = MPT2_SubLast
Else
lngRgtPivot = varRead
varRead = DLookup("lngL", "mpttTest", "txCategory='" & strRef & "'")
If varRead = 1 Then bytWhere = MPT2_SubLast
End If
lngLftPivot = lngRgtPivot
lngNewLft = lngRgtPivot
Select Case bytWhere
Case MPT2_SubLast
lngRgtPivot = lngRgtPivot - 1
Case MPT2_SubFirst
lngLftPivot = varRead
lngRgtPivot = lngLftPivot
lngNewLft = lngLftPivot + 1
Case MPT2_InsertBefore
lngNewLft = varRead
lngLftPivot = lngNewLft - 1
lngRgtPivot = lngLftPivot
Case MPT2_InsertAfter
lngNewLft = lngNewLft + 1
End Select
CurrentDB.Execute "UPDATE mpttTest SET lngL = iif(lngL > " & lngLftPivot & ", lngL + 2, lngL)," & _
" lngR = iif(lngR > " & lngRgtPivot & ", lngR + 2, lngR)"
CurrentDB.Execute "INSERT INTO mpttTest (txCategory, lngL, lngR) VALUES ('" & strNew & "'," & lngNewLft & "," & lngNewLft + 1 & ")"
End Sub
' and in the 'debug' window, just type, sTestMPTT, and hit Enter
Public Sub sTestMPTT()
' subfirst is one of four options
sMPTTadd InputBox("Add New Category"), InputBox("Selected Ref Category"), MPT2_SubFirst
End Sub
|
And the table, called, mpttTest.
(This is DDL (Data Definition Language). In something like Microsoft Access, just paste this
in a New query, in 'SQL View', and Run.)
CREATE TABLE mpttTest
(txCategory CHAR(100) NOT NULL,
lngL INTEGER,
lngR INTEGER
);
|
Four options are included, for a new category, in reference to another, 'selected', category:
| SubLast | Place new category under selected, and at the end of that sublist |
| SubFirst | Place new category under selected, and at the start of that sublist |
| InsertAfter | Insert new category just after the selected |
| InsertBefore | Insert new category just before selected |
And here's a procedure to delete, including entire subtrees:
|
Private Sub sMPTTdelete(strCat As String)
Dim strPivot As String
strPivot = fLookUp("lngR", "mpttTest", "txCategory='" & strCat & "'")
If Len(strPivot) > 0 Then
CurrentDB.Execute "DELETE * FROM mpttTest WHERE txCategory='" & strCat & "'"
If CurrentDB.OpenRecordset("SELECT Count(*) FROM mpttTest")(0) > 1 Then
CurrentDB.Execute "UPDATE mpttTest" & _
" SET lngL = iif(lngL > " & strPivot & ", lngL - 2" & ", lngL)," & _
" lngR = iif(lngR >= " & strPivot & ", lngR - 2" & ", lngR)" & _
" WHERE lngR >= " & strPivot
Else
CurrentDB.Execute "UPDATE mpttTest SET lngL = 1, lngR = 2"
End If
End If
End Sub
Public Sub sTestMPTTDel()
sMPTTdelete InputBox("Which")
End Sub
|
| Partial Implementation: Nested Intervals |
The 'tri-nav' key can quickly be derived from
the nested interval keys, as mentioned previously.
And the nested interval keys are found, as follows.
|
' Get the numerator
Public Function fTrop_pathNumer(strNum As String)
Dim iNumer As Integer
fTrop_path strNum, iNumer, 0
fTrop_pathNumer = iNumer
End Function
' Denominator
Public Function fTrop_pathDenom(strNum As String)
Dim iDenom As Integer
fTrop_path strNum, 0, iDenom
fTrop_pathDenom = iDenom
End Function
' Functions used to calculate nested interval keys
Public Function fTrop_path(strNum As String, iNumer As Integer, iDenom As Integer)
Dim strPostfix As String, strSibling As String
iNumer = 1
iDenom = 1
strPostfix = Trim(strNum)
strPostfix = IIf(Left(strPostfix, 1) = ".", strPostfix, "." & strPostfix)
strPostfix = IIf(Right(strPostfix, 1) = ".", strPostfix, strPostfix & ".")
Do While Len(strPostfix) > 1
strSibling = Mid(strPostfix, 2, InStr(2, strPostfix, ".") - 1)
strPostfix = Mid(strPostfix, InStr(2, strPostfix, "."))
iNumer = fTrop_subNumer(iNumer, iDenom, CInt((strSibling)))
iDenom = fTrop_subDenom(iNumer, iDenom, CInt((strSibling)))
Loop
End Function
Public Function fTrop_subNumer(iNumer As Integer, iDenom As Integer, iSub As Integer)
fTrop_subNumer = ((2 ^ iSub) * iNumer) - ((2 ^ iSub) - 3)
End Function
Public Function fTrop_subDenom(iNumer As Integer, iDenom As Integer, iSub As Integer)
fTrop_subDenom = (2 ^ iSub) * iDenom
End Function
|
|