**Discipline of [Computer Language Benchmarks Game].** ---- ====== #!/usr/bin/tclsh ## ## The Computer Lannguage Shootout ## http://shootout.alioth.debian.org/ ## Contributed by Heiner Marxen ## ## "binary-trees" for Tcl ## Call: tclsh binarytrees.tcl 16 ## ## $Id: binarytrees-tcl.code,v 1.21 2007-11-17 01:27:15 igouy-guest Exp $ ## A tree node is implemented as a [list] with 3 elements: ## [0] left subtree ## [1] right subtree ## [2] item ## An empty tree is an empty list {}, an thus has [llength] 0. proc ItemCheck {tree} { if {![llength [lindex $tree 0]]} { return [lindex $tree 2] } else { return [expr { [lindex $tree 2] + [ItemCheck [lindex $tree 0]] - [ItemCheck [lindex $tree 1]]}] } } proc BottomUpTree {item depth} { if {$depth > 0} { set ndepth [expr {$depth - 1}] return [list [BottomUpTree [expr {2 * $item - 1}] $ndepth] \ [BottomUpTree [expr {2 * $item }] $ndepth] \ $item ] } else { return [list {} {} $item] } } proc tellTree {typ depth check} { puts "$typ tree of depth $depth\t check: $check" } proc main {argv} { set N [lindex $argv 0] set minDepth 4 if {($minDepth + 2) > $N} { set maxDepth [expr {$minDepth + 2}] } else { set maxDepth $N } set stretchDepth [expr {$maxDepth + 1}] set stretchTree [BottomUpTree 0 $stretchDepth] tellTree "stretch" $stretchDepth [ItemCheck $stretchTree] set stretchTree {} set longLivedTree [BottomUpTree 0 $maxDepth] for {set dep $minDepth} {$dep <= $maxDepth} {incr dep 2} { set iterations [expr {1 << ($maxDepth - $dep + $minDepth)}] set check 0 for {set i 1} {$i <= $iterations} {incr i} { set tempTree [BottomUpTree $i $dep] set check [expr {$check + [ItemCheck $tempTree]}] set tempTree {} set tempTree [BottomUpTree [expr {-$i}] $dep] set check [expr {$check + [ItemCheck $tempTree]}] set tempTree {} } puts "[expr {$iterations * 2}]\t trees of depth $dep\t check: $check" } tellTree "long lived" $maxDepth [ItemCheck $longLivedTree] return 0 } main $argv ====== <> Performance