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