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