Simple tree structure

I once needed to store data in tree-like structure with the following requirements:

  • Implemented in pure Tcl
  • Not dependent on other packages
  • Not dependent on global variables

So I came up with the code shown below which occupies 146 lines if comments are removed. The code is fully commented in order to make it easier to change according to your needs.

I found it very useful for my purposes and I hope it may serve you too.


# ########################################################################### #
# Description:
#  This script contains the code for handling tree structures as lists. Each
#  node in the tree is a 3-elements list containing the following info:
#    1st element) Parent node ID
#    2nd element) Node ID
#    3rd element) Data
#  The code has been divided in 2 namespaces:
#    1) tree::private
#    2) tree::public
#  The private namespace contains helper procedures which assume that 
#  certain checks have already been performed and, as such, should not be 
#  invoked directly by the user - they are intended to be used by procedures 
#  in the public namespace.
#  The public namespace contains the procedures available to the user and 
#  they all rely on a tree being correctly initialized by calling 
#  'tree::public::init'. For example:
#    > set mytree tree::public::init
#    > set mytree tree::public::add $mytree 0 "The First Node"
#  The 1st command will set the 'mytree' variable with a valid tree 
#  containing the root node (ID=0) and the 2nd command will add a new node as 
#  a child of node 0.
#
# Available public procedures:
#   - init (creates a new tree containing a root node)
#   - add (adds a new node to the tree)
#   - ancestors (returns the IDs of a node's ancestors)
#   - breadthFirst (returns the IDs of a breadth-first walk on the tree)
#   - children (returns a node's children IDs)
#   - data (returns a node's data)
#   - delete (removes a node from the tree)
#   - depthFirst (returns the IDs of a depth-first walk on the tree)
#   - dump (prints a dump of the tree to stdout)
#   - edit (edits a node's data)
#   - exists (checks if a node exists or not)
#   - isDescendant (checks if a node is a descendant of another #
#   - isRoot (checks if the node is the tree's root)
#   - last (returns the ID of the last inserted node)
#   - level (returns the level of a node in the tree)
#   - move (changes a node's parent)
#   - parent (returns a node's parent)
#   - root (returns the tree's root node ID)
#   - siblings (returns a node's siblings (including itself)
#   - dump (prints the tree to stdout)
#   - dumpb (prints a beautified tree to stdout)
# ########################################################################### #

# ########################################################################### #
# Description:
#  The 'tree::private' namespace contains procedures which should not be 
#  invoked directly by the user. They are intended to be used by procedures 
#  in the 'tree::public' namespace.
# ########################################################################### #
namespace eval tree::private {
  # ########################################################################### #
  # Description:
  #  This procedure will create a new node represented by a 3-elements list. 
  # Parameters:
  #  tree : The tree where the new node will be latter inserted.
  #  parentId : The parent ID of the node being created.
  #  data : The new node's data.
  # Returns:
  #  A 3-elements list representing the new node.
  # ########################################################################### #
  proc create {tree parentId data} {
    # Calculate the new node's ID #
    set nodeId [expr [tree::public::last $tree] + 1]
    # Create the 3-elements list which represent the node #
    return [list $parentId $nodeId $data]
  }

  # ########################################################################### #
  # Description:
  #  This procedure will edit the given node's data and parent ID.
  # Parameters:
  #  tree : The tree to be operated on.
  #  parentId : The node's new parent ID.
  #  nodeId : The ID of the node to be edited.
  #  data : The node's new data.
  # Returns:
  #  The modified tree.
  # ########################################################################### #
  proc edit {tree parentId nodeId data} {
    # Find the index of the sub-list corresponding to the given node #
    set index [lsearch -integer -exact -index 1 $tree $nodeId]
    # Replace it with the new data #
    lset tree $index [list $parentId $nodeId $data]
    # Return the new tree #
    return $tree
  }

  # ########################################################################### #
  # Description:
  #  This procedure will return the 3-elements list corresponding to the given 
  #  node ID.
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The ID of the node whose corresponding sub-list is to be returned.
  # Returns:
  #  The 3-elements list corresponding to the given node ID.
  # ########################################################################### #
  proc node {tree nodeId} {
    # Search for the node's index within the tree and return the corresponding sub-list #
    return [lindex $tree [lsearch -integer -exact -index 1 $tree $nodeId]]
  }
}

# ########################################################################### #
# Description:
#  The 'tree::public' namespace contains the procedures available to the 
#  user.
#  NOTE: Before doing any operation on a tree, it must be initialized by 
#        calling 'public::init'
# ########################################################################### #
namespace eval tree::public {
  # ########################################################################### #
  # Description:
  #  This procedure will create a new tree and include its root node.
  # Parameters:
  #  None.
  # Returns:
  #  A new tree containing the root node.
  # ########################################################################### #
  proc init {} {
    return [list [list -1 0 "root"]]
  }

  # ########################################################################### #
  # Description:
  #  This procedure will check if a node is a descendant of another.
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The ancestor ID.
  #  descendantId : The descendant ID.
  # Returns:
  #  true : It is a descendant.
  #  false : It is not a descendant.
  # ########################################################################### #
  proc isDescendant {tree nodeId descendantId} {
    # If the given descendant is not in the depth-first list of the given node, it not a descendant #
    if {[lsearch -exact -integer [depthFirst $tree $nodeId] $descendantId] == -1} {return "false"} else {return "true"}
  }

  # ########################################################################### #
  # Description:
  #  This procedure will check if the given node is a root node (by simply 
  #  checking if its ID is zero).
  # Parameters:
  #  tree : The tree to be parsed (only needed for consistency with the way 
  #         other procedures are invoked).
  #  nodeId : The node ID to be checked.
  # Returns:
  #  true : The node is root.
  #  false : The node is not root.
  # ########################################################################### #
  proc isRoot {tree nodeId} {
    # The root node's ID is always zero #
    if {$nodeId == 0} {return "true"} else {return "false"}
  }

  # ########################################################################### #
  # Description:
  #  This procedure will create a new node with the given data and insert it 
  #  in the tree as a child of the given parent ID.
  # Parameters:
  #  tree : The tree to be parsed.
  #  parentId : The new node's parent ID.
  #  data : The new node's data.
  # Returns:
  #  The given tree with the new node included.
  # ########################################################################### #
  proc add {tree parentId data} {
    # If the given parent does not exist, do nothing #
    if {[exists $tree $parentId] == "false"} {return $tree}
    # Create a new node and append it to the tail of the tree #
    lappend tree [tree::private::create $tree $parentId $data]
    # Return the tree containing the new node #
    return $tree
  }

  # ########################################################################### #
  # Description:
  #  This procedure will remove the given node from the tree and set its 
  #  children one level up.
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The ID of the node to be deleted.
  # Returns:
  #  The new tree with the given node removed.
  # ########################################################################### #
  proc delete {tree nodeId} {
    # If the given node does not exist, do nothing #
    if {[exists $tree $nodeId] == "false"} {return $tree}
    # Get the node's parent #
    set parentId [parent $tree $nodeId]
    # Get the node's children #
    set childrenIds [children $tree $nodeId]
    # Go through all the children
    foreach childId $childrenIds {
      # Edit the child with a new parent #
      set tree [tree::private::edit $tree [parent $tree $nodeId] $childId [data $tree $childId]]
    }
    # Find the index of the sub-list corresponding to the node being deleted #
    set index [lsearch -integer -exact -index 1 $tree $nodeId]
    # Remove the sub-list corresponding to the node being deleted #
    set tree [lreplace $tree $index $index]
    # Return the new tree #
    return $tree
  }

  # ########################################################################### #
  # Description:
  #  This procedure will return the data stored in the given node.
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The ID of the node whose data is to be returned.
  # Returns:
  #  The data stored in the given node.
  # ########################################################################### #
  proc data {tree nodeId} {
    # If the given node does not exist, return an empty string #
    if {[exists $tree $nodeId] == "false"} {return ""}
    # Return the 3rd element of the node sub-list #
    return [lindex [tree::private::node $tree $nodeId] 2]
  }

  # ########################################################################### #
  # Description:
  #  This procedure will change the data stored in the given node.
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The ID of the node to be edited.
  #  data : The node's new data.
  # Returns:
  #  The changed tree.
  # ########################################################################### #
  proc edit {tree nodeId data} {
    # If the given node does not exist, do nothing #
    if {[exists $tree $nodeId] == "false"} {return $tree}
    # Edit the node with the given data and return the resulting tree #
    return [tree::private::edit $tree [parent $tree $nodeId] $nodeId $data]
  }

  # ########################################################################### #
  # Description:
  #  This procedure will change the parent of a given node.
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The ID of the node to be edited.
  #  parentId : The node's new parent ID.
  # Returns:
  #  The changed tree.
  # ########################################################################### #
  proc move {tree nodeId parentId} {
    # If the given node does not exist, do nothing #
    if {[exists $tree $nodeId] == "false"} {return $tree}
    # If the node is being moved into a descendant #
    if {[isDescendant $tree $nodeId $parentId] == "true"} {
      # The descendant will be set as a child of the node's parent #
      set tree [tree::private::edit $tree [parent $tree $nodeId] $parentId [data $tree $parentId]]
    }
    # Edit the node with the given parent ID and return the resulting tree #
    return [tree::private::edit $tree $parentId $nodeId [data $tree $nodeId]]
  }

  # ########################################################################### #
  # Description:
  #  This procedure will check if the given node ID exists in the given tree.
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The ID of the node to be checked for existence.
  # Returns:
  #  true : The given node ID exists in the tree.
  #  false : The given node ID does not exist in the tree.
  # ########################################################################### #
  proc exists {tree nodeId} {
    if {[lsearch -integer -exact -index 1 $tree $nodeId] == -1} {return "false"} else {return "true"}
  }

  # ########################################################################### #
  # Description:
  #  This procedure will return the given tree's root node ID (which is always 
  #  zero).
  # Parameters:
  #  tree : The tree whose root node ID is to be returned (only needed for 
  #         consistency with the way other procedures are invoked).
  # Returns:
  #  The number zero.
  # ########################################################################### #
  proc root {tree} {
    # The root node's ID is always zero #
    return 0
  }
  
  # ########################################################################### #
  # Description:
  #  This procedure will return the given node's parent ID.
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The ID of the node whose parent is to be retrieved.
  # Returns:
  #  The given node's parent ID.
  # ########################################################################### #
  proc parent {tree nodeId} {
    # If the given node does not exist, return an empty string #
    if {[exists $tree $nodeId] == "false"} {return ""}
    # Return the 1st element of the node sub-list #
    return [lindex [tree::private::node $tree $nodeId] 0]
  }

  # ########################################################################### #
  # Description:
  #  This procedure will retrieve the IDs of all the nodes whose parent is 
  #  the given parent ID.
  # Parameters:
  #  tree : The tree to be parsed.
  #  parentId : The ID of the parent whose children are to be retrieved.
  # Returns:
  #  The IDs of all the given parent's children.
  # ########################################################################### #
  proc children {tree parentId} {
    # Initialize the output list #
    set childrenIds [list];
    # Go through all the sub-lists whose index 0 matches the given parent ID #
    foreach childIndex [lsearch -integer -exact -all -index 0 $tree $parentId] {
      # Save the child's ID in the output list #
      lappend childrenIds [lindex [lindex $tree $childIndex] 1]
    }
    # Return the list of children IDs found #
    return $childrenIds
  }

  # ########################################################################### #
  # Description:
  #  This procedure will retrieve the ancestors of a given node.
  # Parameters:
  #  tree : The tree from where the ancestors will be retrieved.
  #  nodeId : The ID of the node whose ancestors are to be retrieved.
  #  first : Flag indicating if the invocation is recursive or not.
  # Returns:
  #  List (from oldest to newest) of all the node's ancestors.
  # ########################################################################### #
  proc ancestors {tree nodeId {first "true"}} {
    # If this is the first call (recursivity did not yet started) #
    if {$first == "true"} {return [ancestors $tree [parent $tree $nodeId] "false"]}
    # If the node ID is -1, recursivity stops #
    if {$nodeId == -1} {return [list]}
    # Go recursive with the node's parent and append the node ID to the result #
    return [concat [ancestors $tree [parent $tree $nodeId] "false"] $nodeId]
  }

  # ########################################################################### #
  # Description:
  #  This procedure will retrieve the siblings of a given node (including 
  #  itself).
  # Parameters:
  #  tree : The tree from where the siblings will be retrieved.
  #  nodeId : The ID of the node whose siblings are to be retrieved.
  # Returns:
  #  List containing all of the given node's siblings (including itself).
  # ########################################################################### #
  proc siblings {tree nodeId} {
    return [children $tree [parent $tree $nodeId]]
  }

  # ########################################################################### #
  # Description:
  #  This procedure will calculate the level of the given node inside the tree
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The ID of the node whose level is to be calculated.
  #  nodeLevel : The intermediate level (to be used when recursing).
  # Returns:
  #  The level of the given node inside the tree.
  # ########################################################################### #
  proc level {tree nodeId {nodeLevel 0}} {
    # If the given node does not exist, return an empty string #
    if {[exists $tree $nodeId] == "false"} {return ""}
    # If the root node has not been reached, go recursive on the node's parent with an additional level #
    if {$nodeId != 0} {set nodeLevel [level $tree [parent $tree $nodeId] [expr $nodeLevel+1]]}
    # Return the calculated level #
    return $nodeLevel
  }

  # ########################################################################### #
  # Description:
  #  This procedure will return the ID of the last node included in the tree.
  # Parameters:
  #  tree : The tree to be parsed.
  # Returns:
  #  The ID of the last node included in the tree.
  # ########################################################################### #
  proc last {tree} { 
    # Return the 2nd element of the last sub-list in the tree #
    return [lindex [lindex $tree end] 1]
  }

  # ########################################################################### #
  # Description:
  #  This procedure will perform a depth-first traversal of the tree and will 
  #  return a list containing the node IDs found.
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The root node ID of the sub-tree (used when recursing).
  # Returns:
  #  A list containing the node IDs found.
  # ########################################################################### #
  proc depthFirst {tree {nodeId 0}} {
    # If the given node does not exist, return an empty string #
    if {[exists $tree $nodeId] == "false"} {return ""}
    # Initialize the output list #
    set depthFirstNodeIds [list $nodeId];
    # Go through each child #
    foreach childId [children $tree $nodeId] {
      # Go recursive on the child #
      set depthFirstNodeIds [concat $depthFirstNodeIds [depthFirst $tree $childId]]
    }
    # Return the depth-first list of node IDs #
    return $depthFirstNodeIds
  }

  # ########################################################################### #
  # Description:
  #  This procedure will perform a breadth-first traversal of the tree and will 
  #  return a list containing the node IDs found.
  # Parameters:
  #  tree : The tree to be parsed.
  #  nodeId : The root node ID of the sub-tree (used when recursing).
  # Returns:
  #  A list containing the node IDs found.
  # ########################################################################### #
  proc breadthFirst {tree {nodeId 0}} {
    # If the given node does not exist, return an empty string #
    if {[exists $tree $nodeId] == "false"} {return ""}
    # Initialize the output list #
    set breadthFirstNodeIds [children $tree $nodeId]
    # Go through each child #
    foreach childId $breadthFirstNodeIds {
      # Go recursive on the child #
      set breadthFirstNodeIds [concat $breadthFirstNodeIds [breadthFirst $tree $childId]]
    }
    # Return the breadth-first list of node IDs #
    return $breadthFirstNodeIds
  }

  # ########################################################################### #
  # Description:
  #  This procedure will print the tree to stdout.
  # Parameters:
  #  tree : The tree to be printed.
  #  nodeId : The current node to be printed (used when recursing).
  # Returns:
  #  None.
  # ########################################################################### #
  proc dump {tree {nodeId 0}} {
    # Retrieve the parent's ID #
    set parentId [parent $tree $nodeId]
    # Fill the begining of the line with as many empty spaces as the node's parent ID and include relevant data #
    puts "[string repeat " " [level $tree $nodeId]]$nodeId [data $tree $nodeId]"
    # Go recursive for each child #
    foreach child [children $tree $nodeId] {dump $tree $child}
  }

  # ########################################################################### #
  # Description:
  #  This procedure will print a beautified tree to stdout.
  # Parameters:
  #  tree : The tree to be printed.
  #  nodeId : The current node to be printed (used when recursing).
  # Returns:
  #  None.
  # ########################################################################### #
  proc dumpb {tree {nodeId 0}} {
    # If the node is not the root node #
    if {$nodeId != 0} {
      foreach ancestorId [ancestors $tree $nodeId] {
        # If the ancestor is the root node #
        if {$ancestorId == 0} {append dumpLine " "; continue;}
        # If the ancestor is the last sibling, insert empty spaces; otherwise, insert a pipe #
        if {[lindex [siblings $tree $ancestorId] end] == $ancestorId} {append dumpLine "   "} else {append dumpLine " │ "}
      }
      # If the node is the last sibling, insert a '└─'; otherwise, insert a '├─' #
      if {[lindex [siblings $tree $nodeId] end] == $nodeId} {append dumpLine " └─"} else {append dumpLine " ├─"}
      # Print the tree characteres and the node's ID+data #
      puts "$dumpLine $nodeId [data $tree $nodeId]"
    # If the node is the root node #
    } else {
      # Just print the node's ID+data #
      puts "$nodeId [data $tree $nodeId]"
    }
    # Go recursive for each child #
    foreach child [children $tree $nodeId] {dumpb $tree $child}
  }
}

Here's an example on how to use it:

tclsh8.5 [~]set mytree [tree::public::init]
{-1 0 root}

tclsh8.5 [~]set mytree [tree::public::add $mytree 0 [list "TAG" html]]
{-1 0 root} {0 1 {TAG html}}

tclsh8.5 [~]set mytree [tree::public::add $mytree 1 [list "TAG" head]]
{-1 0 root} {0 1 {TAG html}} {1 2 {TAG head}}

tclsh8.5 [~]set mytree [tree::public::add $mytree 2 [list "TAG" title]]
{-1 0 root} {0 1 {TAG html}} {1 2 {TAG head}} {2 3 {TAG title}}

tclsh8.5 [~]tree::public::dumpb $mytree
0 root
  └─ 1 TAG html
     └─ 2 TAG head
        └─ 3 TAG title

tclsh8.5 [~]set mytree [tree::public::delete $mytree 1]
{-1 0 root} {0 2 {TAG head}} {2 3 {TAG title}}

tclsh8.5 [~]set mytree [tree::public::move $mytree 2 3]
{-1 0 root} {3 2 {TAG head}} {0 3 {TAG title}}

tclsh8.5 [~]tree::public::dump $mytree 
0 root
 3 TAG title
  2 TAG head