# ########################################################################### #
# 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}
  }
}

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