cubbi.com: fibonacci numbers in tcl
Tcl
Date: 1990
Type: Imperative scripting language
Usage: scripting language for many software packages, main part of Tcl/Tk GUI developement package and of the automated testing language "expect", among other things.

ALGORITHM 1A: NAIVE BINARY RECURSION
# This program calculates the nth fibonacci number
# using alrogirhtm 1A: naive binary recursion
#
# compiled: n/a
# executed tclsh f1a.tcl n
#

# Naive binary recursion: F(n) = F(n-1) + F(n-2)
proc fib {n} {
    return [expr {$n<2 ? $n : [fib [expr $n-1]] + [fib [expr $n-2]]}]
}

# Procedure f(n) handles the negative arguments: F(-n) = F(n)*(-1)^(n+1) 
proc f {n} {
    if {$n < 0} {
        return [expr {$n%2 ? [fib [expr abs($n)]] : -[fib [expr abs($n)]]}]
    } else {
        return [fib $n]
    }
}

# Procedure fib_print prints the n'th Fibonacci number
proc fib_print {n} {
   puts [concat $n "th Fibonacci number is " [f $n]]
}

# Entry point: check the number of command line arguments,
# explicitly convert the argument to integer via wide()
# report usage if either fails, and execuute fib_print
if { $argc == 1 } {
    set n [lindex $argv 0]
    if [catch {
        fib_print [expr wide($n)]
        exit 0
        }]
    { }
}
puts "Usage: tclsh f1a.tcl <n>"
exit 1

ALGORITHM 2A-3: DATA STRUCTURE - SIMPLE LIST
# Procedure f returns n'th Fibonacci number
# It uses ALGORITHM 2A-1: DATA STRUCTURE - SIMPLE LIST
proc f {n l} {
 set len [llength $l]
 if {[expr $n>=$len]} {
   set l [lappend l [expr [lindex $l [expr $len - 2]] + [lindex $l [expr $len - 1]]]]
   return [f $n $l]
 }   
 return [lindex $l $n]
}
# Procedure f_print prints the n'th Fibonacci number
proc f_print {n} {
   puts [concat $n "th Fibonacci number is " [f $n [list 1 1]]]
}
# Entry point
f_print 15

ALGORITHM 2B: SIMPLE RECURSION
# Procedure f returns n'th Fibonacci number
# It uses ALGORITHM 2B: SIMPLE RECURSION
proc f {n} { return [l 1 1 $n] }
proc l {x1 x2 c} {
  if { $c < 2 } {return $x1} else {
    return [l [expr $x1+$x2] $x1 [expr $c-1]]
  }
}
# Procedure f_print prints the n'th Fibonacci number
proc f_print {n} {
   puts [concat $n "th Fibonacci number is " [f $n]]
}
# Entry point
f_print 45

ALGORITHM 2C: NON-RECURSIVE LOOP
# Procedure f returns n'th Fibonacci number
# It uses ALGORITHM 2C: NON-RECURSIVE LOOP
proc f {n} {
   set x1 1
   set x2 1
   for {set i 1} {$i <= $n} {incr i} {
      set tmp [expr $x1+$x2]
      set x1 $x2; set x2 $tmp
   }
   return $x1
}
# Procedure f_print prints the n'th Fibonacci number
proc f_print {n} {
   puts [concat $n "th Fibonacci number is " [f $n]]
}
# Entry point
f_print 45

ALGORITHM 3A: MATRIX EQUATION
# Procedure mm multiplies two 2x2 matrices represented as 4-element lists
proc mm {a b} {
 set c1 [expr [lindex $a 0]*[lindex $b 0]+[lindex $a 1]*[lindex $b 2]]
 set c2 [expr [lindex $a 0]*[lindex $b 1]+[lindex $a 1]*[lindex $b 3]]
 set c3 [expr [lindex $a 2]*[lindex $b 0]+[lindex $a 3]*[lindex $b 1]]
 set c4 [expr [lindex $a 2]*[lindex $b 1]+[lindex $a 3]*[lindex $b 3]]
 return [list $c1 $c2 $c3 $c4]
}
# Procedure mp raises matrix a into nth power
proc mp {a n} {
 if {$n > 1} {
   set b [mp $a [expr $n/2]]
   set b [mm $b $b]
   if {[expr $n % 2]} {set b [mm $b $a]}
   return $b
 } else {
   return $a
 }
}
# Procedure f returns n'th Fibonacci number
# It uses ALGORITHM 3A: MATRIX EQUATION
proc f {n} {
  set a {1 1 1 0}
  return [lindex [mp $a $n] 0]
}
# Procedure f_print prints the n'th Fibonacci number
proc f_print {n} {
   puts [concat $n "th Fibonacci number is " [f $n]]
}
# Entry point
f_print 45

ALGORITHM 3B: FAST RECURSION
# Procedure f returns n'th Fibonacci number
# It uses ALGORITHM 3B: FAST RECURSION
proc f {n} { return [lindex [l $n] 0] }
proc l {n} {
   if {$n<2} {return [list 1 1]}
   if {$n==2} {return [list 2 1]}
   if {[expr $n % 2]} {
      set kl [l [expr ($n-1)/2]]
      set k1 [lindex $kl 0]
      set k2 [lindex $kl 1]
      return [list [expr $k1*($k1+$k2)+$k1*$k2] [expr $k1*$k1+$k2*$k2]]
   } else {   
      set kl [l [expr ($n/2)-1]]
      set k1 [lindex $kl 0]
      set k2 [lindex $kl 1]
      return [list [expr ($k1+$k2)*($k1+$k2)+$k1*$k1] [expr ($k1+$k2)*$k1+$k1*$k2]]
   }
}   
# Procedure f_print prints the n'th Fibonacci number
proc f_print {n} {
   puts [concat $n "th Fibonacci number is " [f $n]]
}
# Entry point
f_print 45

ALGORITHM 3C: BINET'S FORMULA
# Procedure f returns n'th Fibonacci number
# It uses ALGORITHM 3C: BINET'S FORMULA
proc f {n} {
   set phi [expr (1+sqrt(5))/2 ]
   return [expr round((pow($phi,($n+1))-pow((1-$phi),($n+1)))/sqrt(5))]
}
# Procedure f_print prints the n'th Fibonacci number
proc f_print {n} {
   puts [concat $n "th Fibonacci number is " [f $n]]
}
# Entry point
f_print 45