- Implemented in pure Tcl
- Not dependent on other packages
- Not dependent on global variables
# ########################################################################### # # 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