2. Numbers

# The "backwards conditional" Perl form is useful here
# to demonstrate the various regexps.  Tcl doesn't have
# this syntax, but it can be fudged very easily:



proc warn {msg cond pattern {string 0}} {
    if {[string equal if $cond]} {
        if {[regexp $pattern $string]} {
            return [format "%s: %s" $string $msg]
        }
    } elseif {[string equal unless $cond]} {
        if {![regexp $pattern $string]} {
            return [format "%s: %s" $string $msg]
        }
    }
    return
}

warn "has nondigits" if {\D}

warn "not a natural number" unless {^\d+$}        ;# rejects -3

warn "not an integer" unless {^[+-]?\d+$}         ;# rejects +3

warn "not a real number" unless {^-?\d+\.?\d*$}   ;# rejects .2

warn "not a C float" unless {^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$}


# Regexps like the above are sometimes necessary for making fine
# distinctions among string representations of numbers.
# If the only thing in questions is whether $x is a number
# or not, or whether it is an integer or a real number, Tcl
# can help:



if {[string is integer $x]} {
    set res "$x is an integer"
} elseif {[string is double $x]} {
    set res "$x is a real number"
} else {
    set res "$x is not a number"
}
set res

# limit number of decimals when determining equality of
# floating point values to avoid rounding errors.
proc floatEqual-1 {num1 num2 accuracy} {
    expr {[format %.${accuracy}f $num1] == [format %.${accuracy}f $num2]}
}


set wage 536                  ;# $5.36/hour
set week [expr {40 * $wage}]  ;# $214.40
format "One week's wage is: \$%.2f" [expr {$week/100.0}]
# => One week's wage is: $214.40

set a 0.255
set b [format %.2f $a]
puts "Unrounded: $a"
puts "Rounded:   $b"
# => Unrounded: 0.255
# => Rounded:   0.26

set res \nnumber\tint\tfloor\tceil\n
set a [list 3.3 3.5 3.7 -3.3]
foreach n $a {
    append res [format %.1f\t $n]
    append res [format %.1f\t [expr {int($n)}]]
    append res [format %.1f\t [expr {floor($n)}]]
    append res [format %.1f\n [expr {ceil($n)}]]
}
puts $res
# => 
# => number     int     floor   ceil
# => 3.3        3.0     3.0     4.0
# => 3.5        3.0     3.0     4.0
# => 3.7        3.0     3.0     4.0
# => -3.3       -3.0    -4.0    -3.0

proc dec2bin {string} {
    binary scan [binary format I $string] B32 str
    return [string trimleft $str 0]
}
dec2bin 54
# => 110110


proc bin2dec {string} {
    set string [format %032s $string]
    binary scan [binary format B32 $string] I str
    return $str
}
bin2dec 110110
# => 54

for {set i $X} {$i <= $Y} {incr i} {
    # $i is set to every integer from X to Y, inclusive
}

for {set i $X} {$i <= $Y} {incr i 7} {
    # $i is set to every integer from X to Y, stepsize = 7
}

set res {}
append res "Infancy is: "
foreach i [list 0 1 2] {
    append res "$i "
}
 
proc .. {low high} {
    for {set i $low} {$i <= $high} {incr i} {
        lappend res $i
    }
    set res
}
append res \n
append res "Toddling is: "
foreach i [.. 3 4] {
    append res "$i "
}
 
append res \n
append res "Childhood is: "
for {set i 5} {$i <= 12} {incr i} {
    append res "$i "
}
 
puts $res
# => Infancy is: 0 1 2 
# => Toddling is: 3 4 
# => Childhood is: 5 6 7 8 9 10 11 12 

# These procedures were written by Richard Suchenwirth.
# See <URL: http://mini.net/tcl/1749.html>



roman:number 15
# => XV


roman:get XV
# => 15

# The rand function returns a floating point number from zero to
# just less than one or, in mathematical notation, the range [0,1).
# The seed comes from the internal clock of the machine or may be
# set manually with the srand function.
         
# The math module of the standard distribution has a wrapper for
# rand called random; it supports generation of pseudo-random
# numbers in the [0,n) and [n,m) ranges.



puts [expr {int(rand()*51)+25}]
# => 32

package require math
puts [::math::random 25 76]
# => 32


set list [split {Demonstrate selecting a random element from a list.}]
package require math
puts [lindex $list [::math::random [llength $list]]]
# => selecting


package require math
set password {}
for {set i 0} {$i < 8} {incr i} {
    append password [lindex $chars [::math::random [llength $chars]]]
}
puts $password
# => JhzQ!p!$

set value 1138
expr {srand($value)}
# => 0.00890640821723

# There is no standard module known to me that implements better
# random number generators than the one in the C library, but at
# <URL: http://www.elf.org/etc/randomnumbers.html> there is Tcl
# and C source for a ``very long period random number generator''.
         
# Also see <URL: http://mini.net/cgi-bin/wikit/1551.html> for a
# `post-processor' that improves the randomness of the output of
# rand().

# @@INCOMPLETE@@

# @@INCOMPLETE@@
# @@INCOMPLETE@@

# You'd typically want a variable like PI to be 
# contained within a namespace and not automatically
# set in the global namespace.  [variable] creates
# a variable in the current namespace, and [namespace
# current] returns the qualified name of the current
# namespace, or :: for the global namespace.



variable PI [expr {acos(-1)}]
puts [set [namespace current]::PI]
# => 3.14159265359


proc deg2rad {degrees} {
    variable PI
    return [expr {$degrees / 180.0 * $PI}]
}


proc rad2deg {radians} {
    variable PI
    return [expr {$radians / $PI * 180}]
}


# The core Tcl command [expr] has most of the commonly
# used trigonometric functions defined, so there is
# less need for a Trig module.



proc degreeSine {degrees} {
    set radians [deg2rad $degrees]
    return [expr {sin($radians)}]
}

# The tangent function is already available in the [expr]
# command, as is the arcus cosine and many more.
         
# In some cases, the [expr] functions raise an error because
# of overflow or division by zero.  To trap such errors, wrap
# in [catch]:



list [catch {expr {1/0}} msg] $msg
# => 1 {divide by zero}

set value 1138
puts [expr {log($value)}]
# => 7.03702761469


set value 1138
puts [expr {log10($value)}]
# => 3.05614226206


proc logN {base value} {
    return [expr {log($value) / log($base)}]
}

# There are a few non-standard matrix modules available for Tcl, e.g.
#  * TiM: <URL: http://www-obs.univ-lyon1.fr/~thiebaut/TiM/TiM.html>.
#    In TiM, matrix multiplication seems to be an "A * B" matter.
#  * La (The Hume Linear Algebra Tcl Package):
#    <URL: http://www.hume.com/la/index.html>.  Matrix multiplication
#    in La looks like this: mmult A B.



# There is also a matrix module in the standard distribution library,
# but it does not contain arithmetic.  I have used it anyway, with
# an adaptation of the mmult subroutine in the Perl Cookbook.



package require struct 1.1.1
proc mmult {m1 m2} {
   set m1rows [$m1 rows]
   set m1cols [$m1 columns]
   set m2rows [$m2 rows]
   set m2cols [$m2 columns]
   if {$m1cols != $m2rows} {
       error "IndexError: matrices don't match: $m1cols != $m2rows"
   }
   
   ::struct::matrix result
   result add rows $m1rows
   result add columns $m2cols
   for {set i 0} {$i < $m1rows} {incr i} {
       for {set j 0} {$j < $m2cols} {incr j} {
           set v 0
           for {set k 0} {$k < $m1cols} {incr k} {
               incr v [expr {[$m1 get cell $k $i] * [$m2 get cell $j $k]}]
           }
           result set cell $j $i $v
       }
   }
   return result
}

::struct::matrix x
x add columns 3
x add row [list 3 2 3]
x add row [list 5 9 8]
::struct::matrix y
y add rows 3
y add column [list 4 9 3]
y add column [list 7 3 1]
set res [mmult x y]
$res get rect 0 0 end end
# => {39 30} {125 70}

# See <URL: http://www.mini.net/tcl/Complex> for complex
# arithmetic routines by Richard Suchenwirth.



complex::* 3+5i 2-2i
# => 16+4i

# Tcl does not have hex/oct functions, but
# they are easy to implement.  If [expr]
# gets handed an invalid octal/hex number,
# it raises an error instead of returning
# 0 as the Perl functions do.



proc hex {string} {
    if {[regexp -nocase {^0x} $string]} {
        return [expr $string]
    } else {
        return [expr 0x$string]
    }
}


# This simpler version does not raise errors for invalid input:
#     proc hex {string} {
#         scan $string %x
#     }



proc oct {string} {
    if {[regexp -nocase {^0x} $string]} {
        return [hex $string]
    } else {
        return [expr 0$string]
    }
}


# This simpler version does not raise errors for invalid input:
#     proc oct {string} {
#         scan $string %o
#     }



if {[string match *.test [info script]]} {
    # we are testing, supply known value
    set num 0x39a
} else {
    puts "Gimme a number in decimal, octal, or hex: "
    set num [gets stdin]
}
if {[string length $num]} {
    if {[regexp ^0 $num]} {
        set num [oct $num]
    }
    format "%d %x %o" $num $num $num
}
# => 922 39a 1632

# This procedure is written by Keith Vetter and is part of the Tcl
# Cookbook (<URL: #http://aspn.activestate.com/ASPN/Cookbook/Tcl/Recipe/68381>)
proc comma {num {sep ,}} {
    while {[regsub {^([-+]?\d+)(\d\d\d)} $num "\\1$sep\\2" num]} {}
    return $num
}

# See <URL: http://mini.net/tcl/EnglishPlurals> for an
# English pluralization function by Richard Suchenwirth.



set data [join {fish fly ox
species genus phylum
cherub radius jockey
index matrix mythos
phenomenon formula}]
set res {}
foreach word $data {
    append res "One $word, two [en:pl $word]\n"
}
puts $res
# => One fish, two fish
# => One fly, two flies
# => One ox, two oxen
# => One species, two species
# => One genus, two genera
# => One phylum, two phyla
# => One cherub, two cherubim
# => One radius, two radii
# => One jockey, two jockeys
# => One index, two indices
# => One matrix, two matrices
# => One mythos, two mythoi
# => One phenomenon, two phenomena
# => One formula, two formulae

# See <URL: http://www.mini.net/tcl/AdditionalMath>:
# the primefactors function by Richard Suchenwirth.



primefactors 2178
# => 2 3 3 11 11

primefactors 2099999990
# => 2 5 11 19090909