Version 4 of An experimental tree structure

Updated 2011-09-25 06:29:25 by RLE

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

RS: I wouldn't call trees data structures too complex for Tcl (which is implemented in C - our scripts just do the configuration :-) - nested lists are perfectly adequate, compact and efficient for representing tree structures, and easily navigable with multi-index lindex and lset...

Marco Maggi: I have to disagree. There are a lot of methods in a tree structure, and most of them require a set of 4/5 (or more) test cases. So if I have to spend time building a reliable structure of such a complexity, I prefer to do it with C, so that I can use the module with and without TCL.

I'm writing a C library of data structures, and it's not "fun" to make it reliable: I'm writing a lot of tests (handling them with the tcltest package of course) and spending a lot of hours. I want it to be as much reusable as possible, and C is the answer.

I like TCL, but what if tomorrow I get a job and my new boss tells me "Do this with python." ? Or "You have a week to build a C library that does this and that." and I need an AVL tree?

My C data structure library will be in my bag of tools "forever".


See also:

  • Keep your struct away from me