#!/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