Marco Maggi - In this page I present the code for an experimental tree stucture. I don't like it at all because I Believe that complex data structures have to be implemented at the C level. But, I needed a tree structure in my Wiki pages so...
It's probably incorrect in some operations, I'll try to test it when I find time and will to do it.
proc tree_set_root { treevar node } {
upvar $treevar tree
array set tree [list root $node $node:dad {} $node:cld {}]
}
proc tree_get_root { treevar } {
upvar $treevar tree
return $tree(root)
}
proc tree_isroot { treevar node } {
upvar $treevar tree
return [expr {([string equal $tree(root) $node])? 1 : 0}]
}
proc tree_get_children { treevar node } {
upvar $treevar tree
return $tree($node:cld)
}
proc tree_get_father { treevar node } {
upvar $treevar tree
return $tree($node:dad)
}
proc tree_exists { treevar node} {
upvar $treevar tree
return [info exists tree($node:cld)]
}
proc tree_add_children { treevar node children } {
upvar $treevar tree
foreach child $children {
if { [info exists tree($child:dad)] } {
tree_remove_children tree($child:dad) $child
} else {
set tree($child:cld) {}
}
lappend tree($node:cld) $child
set tree($child:dad) $node
}
return
}
proc tree_remove { treevar node } {
upvar $treevar tree
if { [string equal $tree(root) $node] } {
set tree(root) {}
foreach child $tree($node:cld) {
tree_remove tree $child
}
} else {
set dad $tree($node:dad)
tree_remove_child tree $dad $node
}
unset tree($node:dad) tree($node:cld)
}
proc tree_remove_child { treevar node child } {
upvar $treevar tree
set idx [lsearch $tree($node:cld) $node]
set tree($node:cld) [lreplace $tree($node:cld) $idx $idx]
set tree($child:dad) {}
return
}
proc tree_path { treevar node } {
upvar $treevar tree
set path {}
while { ! [string equal $tree(root) $node] } {
set path [linsert $path 0 $node]
set node $tree($node:dad)
}
return [linsert $path 0 $node]
}To test it we can fill it with the following procedure.
proc fill_tree { treevar } {
upvar $treevar tree
tree_set_root tree 0
tree_add_children tree 0 { 1 2 3 4 5 6 7 8 9 }
for {set i 1} {$i < 10} {incr i} {
for {set j 1} {$j < 10} {incr j} {
tree_add_children tree $i $i.$j
for {set k 0} {$k < 10} {incr k} {
tree_add_children tree $i.$j $i.$j.$k
}
}
}
}