Posted to tcl by patthoyts at Fri Jun 12 13:30:31 GMT 2009view raw
- # 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 -estimate 100
- # 354224848179263111168 32.6
- #
- # C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -iterative 100
- # 354224848179261915075 153.0
- #
- # C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -tailcall 100
- # 354224848179261915075 550.0
- #
- # C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -memoized 100
- # 354224848179261915075 955.2
- #
- # NOTE that I didn't dare to try -rec 100 as it is too slow and will run out
- # of stack for n=100.
- # Tail-recursive
- 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]
- }
- # Fully recursive
- proc fibR {n} {
- if {$n < 3} then {
- expr 1
- } else {
- expr {[fibR [expr {$n-1}]]+[fibR [expr {$n-2}]]}
- }
- }
- # Iterative
- 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
- }
- # Estimated version - good up to about 70
- proc fibE {n} {expr {round((.5 + .5*sqrt(5)) ** $n / sqrt(5))}}
- # Memoized - ie: cache the calculated numbers
- # RS version...
- proc memoize {} {
- global memo
- set cmd [info level -1]
- if {[info level] > 2 && [lindex [info level -2] 0] eq "memoize"} return
- if { ! [info exists memo($cmd)]} {set memo($cmd) [eval $cmd]}
- return -code return $memo($cmd)
- }
- proc fibM {n} {
- memoize
- expr {$n < 3 ? 1 : [fibM [expr {$n - 1}]] + [fibM [expr {$n - 2}]]}
- }
- # Now NEM's version ...
- proc xmemoize f {
- variable $f [dict create]
- rename $f _cache_$f
- interp alias {} $f {} xremember $f
- }
- proc xremember {f args} {
- upvar #0 $f cache
- if {![dict exists $cache $args]} {
- dict set cache $args [uplevel 1 [linsert $args 0 _cache_$f]]
- }
- dict get $cache $args
- }
- proc func {name params body} { proc $name $params [list expr $body] }
- func fibN n {
- $n < 2 ? $n
- : [fibN [expr {$n-1}]] +
- [fibN [expr {$n-2}]]
- }
- xmemoize fibN
- 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 }
- "-e*" { set cmd fibE }
- "-m*" { set cmd fibM }
- "-n*" { set cmd fibN }
- default {
- puts "usage: fib ?-tail-recursive? ?-estimated?\
- ?-iterative? ?-recursive? ?-memoized? number"
- }
- }
- set argv [lrange $argv 1 end]
- }
- set t [time {set r [catch [linsert $argv 0 $cmd] err]} 5]
- if {$r} {puts $errorInfo} else {puts "$err [lindex $t 0]"}
- exit $r
- }