HI,
I would then suggest to use a nested-set approach, if the data does not
change too often. Like indexes on data, once "compiled", they are incredible
when it is time to find values, nested sets required some "compilation" but
once done, recursions on tree become almost effortless.
I supply here below some code allowing you to create a nested-set "table"
from a parent-child table. It requires there is just one "root", a root
being a node having no parent or having itself as parent.
Once you would get the nested set table, you can easily get the following
simple formulations. Among others:
-- Nodes under z.id, ( associated values z.lft, z.rgt ) are:
SELECT x.id FROM nestedSet As x WHERE x.lft BETWEEN z.lft AND z.rgt
-- Nodes above z.id (bosses of z.id, including z itself)
SELECT x.id FROM nestedSet As x WHERE z.lft BETWEEN x.lft AND x.rgt
-- Number of nodes below x.id
( 1+x.rgt-x.lft ) / 2
-- Nodes without child (terminal leaves )
SELECT x.id FROM nestedSet As x WHERE x.lft+1 = x.rgt
So, how to use the sub below?
FromParentToNested(ByVal ParentTable As String, _
ByVal NodeID As String, _
ByVal ParentID As String, _
ByVal NestedSet As String)
ParentTable is the table name with the Parent-Child description.
NodeID is the field name being the "child"
ParentID is the field name being the "parent"
NestedSet is the table name to produce that would be your nested set. It
will have the fields NodeID, lft, rgt and lvl. In theory, lvl can be
obtained with a simple query, it is the "level" of the node in the tree (the
root has a level of one, its immediate children has a level of two, etc.)
but we can get it effortless and it simplifies some queries if it is already
available with the lft and rgt values.
To get more on nested set, an original concept by Joe Celko, you may
take a look, among other places, at
http://www.intelligententerprise.com/001020/celko.shtml. (or make a Google
search on Joe name, and nested sets). I also supply an example of a list of
material based on nested sets at
http://www.mvps.org/access/queries/qry0023.htm, on Jet ( MS Access
required ), getting the required number of pieces, to build an item in the
tree, without a single line of iteration/recursion, just in standard SQL.
Joe once reported that using Nested Sets was timed to be up to 1000 faster
than the iterative technique implemented in Oracle.
Hoping it may help,
Vanderghast, Access MVP
=============
Option Compare Database
Option Explicit
Private Const MyName As String = "NestedSets"
Private Const errParentTable As String = "Parent Table in error."
Private Const errParentTableKey As String = "Specified 'node' field in
Parent Table has null and so can't be use for primary key."
Private Const errNoRoot As String = "The Parent table has no identifiable
root node; fix and submit again."
Private Const errNoUniqueRoot As String = "The Parent table has more than
one possible root; fix and submit again."
Private Const errCantCreate As String = "Cannot create the nested set table
("
Private Const errCantInsert As String = "Cannot insert the nodeID "
Private Const errUnknownParent As String = "At least one ParentID is unknown
as NodeID in the supplied table."
Private Const errUnusedRecords As String = "Not all the records from the
table have been used."
Private db As Database ' To avoid using CurrentDb each time
Private OpeningString As String ' string to open the recordset with all
children
Private InsertInto As String ' string to insert a record
-----------------------
Private Sub RaiseError(ByVal Desc As String, Optional ErrNumber As Long =
513)
Err.Raise vbObjectError + ErrNumber, MyName, Desc
End Sub
-----------------------
Public Sub FromNestedToParent(ByVal NestedTable As String, _
ByVal ParentTableName As String, _
ByVal NodeFieldName As String, _
ByVal ParentFieldName As String)
Dim db As Database: Set db = CurrentDb
On Error Resume Next
db.Execute "DROP TABLE " & ParentTableName
Err.Clear
db.Execute "SELECT c.NodeID as " & NodeFieldName & _
", p.NodeID As " & ParentFieldName & _
" INTO " & ParentTableName & _
" FROM " & NestedTable & " AS c LEFT JOIN " & NestedTable & " AS p "
& _
" ON (c.lft BETWEEN p.lft AND p.rgt) AND c.lvl = p.lvl+1 ",
dbFailOnError
If 0 <> Err.Number Then
RaiseError Err.Description, Err.Number
End If
Debug.Assert 0 = Err.Number
End Sub
-----------------------
Public Sub FromParentToNested(ByVal ParentTable As String, _
ByVal NodeID As String, _
ByVal ParentID As String, _
ByVal NestedSet As String)
Dim nCount As Long
' Check if the table exists, and if the fields NodeID and ParentID exist
On Error Resume Next
DCount "*", ParentTable, NodeID & "=" & ParentID
If 0 <> Err.Number Then
RaiseError errParentTable
Exit Sub
End If
' Check if there are NULL under the nodeID
If 0 <> DCount("*", ParentTable, NodeID & " IS NULL") Then
RaiseError errParentTableKey
Exit Sub
End If
Set db = CurrentDb
If 0 <> db.OpenRecordset("SELECT COUNT(*) FROM (SELECT * FROM " &
ParentTable & " AS a LEFT JOIN " & _
ParentTable & " AS b ON a." & ParentID & "= b." & NodeID & _
" WHERE (NOT a." & ParentID & " IS NULL) AND b." & NodeID & " IS
NULL)").Fields(0).Value Then
RaiseError errUnknownParent
Exit Sub
End If
' Create the nested set table. Its three fields are NodeID, lft and rgt.
db.Execute "DROP TABLE " & NestedSet: Err.Clear
' We tried to drop a table, maybe it was not there... not important...
db.Execute "CREATE TABLE " & NestedSet & _
"(NodeID LONG CONSTRAINT PrimaryKey PRIMARY KEY," & _
" lft LONG NOT NULL CONSTRAINT UniqueLft UNIQUE, " & _
" rgt LONG NOT NULL CONSTRAINT UniqueRgt UNIQUE, " & _
" lvl LONG NOT NULL ); "
'In theory, we can compute the level, lvl, with a query, but there
is
' nothing wrong in storing it in the table too.
If 0 <> Err.Number Then
RaiseError errCantCreate & Err.Description & ")."
Exit Sub
End If
' Find the root, the node with a Null as ParentID, or the one with
itself.
Dim root As Long
Select Case DCount("*", ParentTable, NodeID & "=" & ParentID)
Case 0
' There is no node where NodeID=ParentID... look for a Parent Is
Null
Select Case DCount("*", ParentTable, ParentID & " IS Null")
Case 0
' There is no node where Parent Is Null, ... error...
RaiseError errNoRoot
Exit Sub
Case 1
' there is just one such node, perfect...
root = DLookup(NodeID, ParentTable, ParentID & " IS NULL")
Case Else
' there is more than one node with a parent Is Null... what to
do?
RaiseError errNoUniqueRoot
Exit Sub
End Select
Case 1
' There is just one node where parentID=NodeID... what about
' a node with a NULL parent???
If 0 <> DCount("*", ParentTable, ParentID & " Is Null") Then
RaiseError errNoUniqueRoot
Exit Sub
End If
root = DLookup(NodeID, ParentTable, ParentID & "=" & NodeID)
Case Else
' We have more than one node with ParentID=NodeID, someone has to
fix it...
RaiseError errNoUniqueRoot
Exit Sub
End Select
If 0 <> Err.Number Then
RaiseError errCantInsert & root
Exit Sub
End If
' Prepare the recursion
InsertInto = "INSERT INTO " & NestedSet & "(NodeID, lft, rgt, lvl)
VALUES("
OpeningString = "SELECT " & NodeID & " FROM " & ParentTable & " WHERE "
& ParentID & "="
Dim counting As Long
counting = 2
'Make some nasty recursion about calling for each of the children
CallChildren root, counting, 2
' Append the root...
db.Execute InsertInto & root & ", 1, " & counting & ", 1 ); "
'Job is done... we can alter the rgt field so it doesn't accept NULLs
anymore
' but that is not 'strictly' required...
db.Execute "CREATE INDEX level ON " & NestedSet & "(lvl)"
If counting <> 2 * DCount("*", ParentTable) Then
RaiseError errUnusedRecords
Exit Sub
End If
If 0 <> Err.Number Then
RaiseError Err.Description, Err.Number
Exit Sub
End If
End Sub
-------------------------------------
Private Sub CallChildren(ByVal ParentNodeID As Long, ByRef counting As Long,
ByVal level As Long)
Dim rst As DAO.Recordset
Dim opening As Long ' the current worm counter, the lft value
' for a given node
On Error Resume Next
' Open a recordset will al the children of the given parent...
Set rst = db.OpenRecordset(OpeningString & ParentNodeID,
dbOpenForwardOnly, dbReadOnly)
' For each, remember the lft, call the children, then having the rgt
value, insert the record.
Do Until rst.EOF
opening = counting ' get a copy, that is our rgt value.
' we can't insert the whole record,now, since we ignore the rgt
value
' We need to increase the running worm counter...
counting = counting + 1
CallChildren rst.Fields(0).Value, counting, level + 1 ' recursive
call on all the actual children
db.Execute InsertInto & rst.Fields(0).Value & ", " & opening & ", "
& counting & ", " & level & ") ;"
' Increase the running worm counter
counting = counting + 1
rst.MoveNext
Loop
Debug.Assert 0 = Err.Number
End Sub
======================
