Posted to tcl by patthoyts at Fri Jun 12 12:18:15 GMT 2009view pretty

# Recursive functions are a bad thing if there is a lot of recursion
# to be done. Tail recursion is the way to speed up recursion and can
# sometimes express things more simply than iterative approaches while
# still being as fast as iteration.
# 
# For instance the following 3 versions of the fibonacci function use
# iterative, recursive or tail-recursive approaches. Lets see:
#
#  C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -iterative 100
#  279 microseconds per iteration
#  354224848179261915075
#  
#  C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -tail 100
#  656 microseconds per iteration
#  354224848179261915075
#
#  C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -recursive 30
#  1439743 microseconds per iteration
#  832040
#
# NOTE that I didn't dare to try -rec 100 as it is too slow.


proc fibT {n} {
    proc fib' {a b n} {
        if {$n < 1} {
            return $a
        } elseif {$n == 1} {
            return $b
        } else {
            tailcall fib' $b [expr {$a + $b}] [expr {$n - 1}]
        }
    }
    return [fib' 0 1 $n]
}


proc fibR {n} {
    if {$n < 3} then {
        expr 1
    } else {
        expr {[fibR [expr {$n-1}]]+[fibR [expr {$n-2}]]}
    }
}

proc fibI n {
    if {$n < 2} {return $n}
    set prev 1
    set fib 1
    for {set i 2} {$i < $n} {incr i} {
        lassign [list $fib [incr fib $prev]] prev fib
    }
    return $fib
}

if {!$tcl_interactive} {
    set cmd fibT
    if {[llength $argv] > 1} {
        switch -glob -- [lindex $argv 0] {
            "-t*" { set cmd fibT }
            "-i*" { set cmd fibI }
            "-r*" { set cmd fibR }
            default {
                puts "usage: fib ?-tail-recursive?\
                   ?-iterative? ?-recursive? number"
            }
        }
        set argv [lrange $argv 1 end]
    }
    puts [time {set r [catch [linsert $argv 0 $cmd] err]}]
    if {$r} {puts $errorInfo} elseif {[string length $err]} {puts $err}
    exit $r
}