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

  1. # Recursive functions are a bad thing if there is a lot of recursion
  2. # to be done. Tail recursion is the way to speed up recursion and can
  3. # sometimes express things more simply than iterative approaches while
  4. # still being as fast as iteration.
  5. #
  6. # For instance the following 3 versions of the fibonacci function use
  7. # iterative, recursive or tail-recursive approaches. Lets see:
  8. #
  9. # C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -iterative 100
  10. # 279 microseconds per iteration
  11. # 354224848179261915075
  12. #
  13. # C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -tail 100
  14. # 656 microseconds per iteration
  15. # 354224848179261915075
  16. #
  17. # C:\opt\tcl\src>tclkitsh86 fibonacci.tcl -recursive 30
  18. # 1439743 microseconds per iteration
  19. # 832040
  20. #
  21. # NOTE that I didn't dare to try -rec 100 as it is too slow.
  22.  
  23.  
  24. proc fibT {n} {
  25. proc fib' {a b n} {
  26. if {$n < 1} {
  27. return $a
  28. } elseif {$n == 1} {
  29. return $b
  30. } else {
  31. tailcall fib' $b [expr {$a + $b}] [expr {$n - 1}]
  32. }
  33. }
  34. return [fib' 0 1 $n]
  35. }
  36.  
  37.  
  38. proc fibR {n} {
  39. if {$n < 3} then {
  40. expr 1
  41. } else {
  42. expr {[fibR [expr {$n-1}]]+[fibR [expr {$n-2}]]}
  43. }
  44. }
  45.  
  46. proc fibI n {
  47. if {$n < 2} {return $n}
  48. set prev 1
  49. set fib 1
  50. for {set i 2} {$i < $n} {incr i} {
  51. lassign [list $fib [incr fib $prev]] prev fib
  52. }
  53. return $fib
  54. }
  55.  
  56. if {!$tcl_interactive} {
  57. set cmd fibT
  58. if {[llength $argv] > 1} {
  59. switch -glob -- [lindex $argv 0] {
  60. "-t*" { set cmd fibT }
  61. "-i*" { set cmd fibI }
  62. "-r*" { set cmd fibR }
  63. default {
  64. puts "usage: fib ?-tail-recursive?\
  65. ?-iterative? ?-recursive? number"
  66. }
  67. }
  68. set argv [lrange $argv 1 end]
  69. }
  70. puts [time {set r [catch [linsert $argv 0 $cmd] err]}]
  71. if {$r} {puts $errorInfo} elseif {[string length $err]} {puts $err}
  72. exit $r
  73. }