Updated 2014-10-18 18:33:41 by PeterLewerin

This proc rounds numbers to n significant digits, using the algorithm described in http://perfdynamics.blogspot.de/2010/04/significant-figures-in-r-and-rounding.html, which avoids the bias by the odd-even parity of nearby digits.
#
# round number to significant digits
# according to 
# http://perfdynamics.blogspot.de/2010/04/significant-figures-in-r-and-rounding.html
# round number num to n significant digits
# works only in the range of double
# it is published under the same licence as Tcl
# (c) J. Heidemeier 2014
#
proc signif {num n {decimalPoint .}} {
# arguments:
# num: number to be rounded (integer, real or exponential format)
# n: number of significant digits (positive integer)
# decimalPoint: decimal separator character for the output (default .)
# 
# reasonable figure for significant digits ?
    if {!([string is integer $n] && $n > 0)} \
        {error  "number of significant digits $n is not a positive integer"}
#
# ensure that num is numeric
# and split into sign, integer, decimal and exponent part
#
if {[regexp {^([+,-]?)([0-9]+)(\.?[0-9]*)?([eE][+-]?[0-9]+)?$} $num -> s i d e]} {
# i must contain alt least one digit
if {![string length i]} "error wrong format $num, no digit in Integerpart "
#
# type of number
# 
    set typ ""    
    if {[string length $e]} {set typ e}
    if {[string length $d]} {
        if {$typ ne {e}} {set typ d}
    } else {
        if {$typ ne {e}} {
                set typ i
#
#
#
        } else {
# reformat iexx to i.0exx bringen
            set d {.0}
       }
    }
# remove leading 0, if digits 1-9 in i-part
# or collapse several 0 to 0
#
    if {[string length $i] > 1} {
        regexp  {^(0*)([1-9][0-9]*)$} $i -> NULL DIG
        if {[string length $DIG]} {
            set i $DIG
        } else {
            set i 0 ;# collapse to one 0
        }
    }
#        
# build teststring for rounding process
#
set tstring $i
            
set decpos [expr {[string length $i] -1}]
# skip decimalpoint and append decimalpart
if {[string length $d]} {
       append tstring [string range $d 1 end]
} 
# enough digits for the rounding process       
    set ndigs [string length $tstring]
    if {$ndigs < $n} {error "more significant digits $n requested than available $ndigs"}

# x is the last significant digit
# y and z are the following 2 digits, if y or z are blank
# zeros are appended     
    set x [string index $tstring $n-1]
        if  {$ndigs == $n} {
            set y 0
        } else {
        set y [string index $tstring $n]
    }
    if {$ndigs > $n} {
        set z [string index $tstring $n+1]
    } else {
        set z 0
    }
# the actual test; pad0 pads zeros for the integerpart
    if {$y < 5} {        
        set rstring "[string range $tstring 0 $n-1][pad0 $decpos $n]"
    } elseif {$y > 5} {
         incr x
            set rstring "[string range $tstring 0 $n-2]$x[pad0 $decpos $n]"
    } else {
# y == 5; test for parity jitter
        if {$z >= 1} {
                set rstring "[string range $tstring 0 $n-1][pad0 $decpos $n]"
        } else {
            if {[isOdd $x]} {
                incr x
            }
                set rstring "[string range $tstring 0 $n-2]$x[pad0 $i $n $decpos]"
        }
    }
} else {
 error "number to round \"$num\" is not numeric"
}
# reformatting the output    
    switch -exact -- $typ {
        i {set result "$s$rstring"}
        d {
            set decfrac [string range $rstring $decpos+1 end]
            if {![string length $decfrac]} {
                set result "$s$rstring"
            } else {
                set result "$s[string range $rstring 0 $decpos]$decimalPoint$decfrac"
            }
        }
        e {
            set result "$s[string range $rstring 0 $decpos]$decimalPoint[string range $rstring $decpos+1 end]$e"
        }
    }
return  $result
}
#
# pad integer part with 0 if necessary
# arguments
# decpos:  index of the last digit before the decimal point
# n:  number of significant digits
#
proc pad0 {decpos n} {

    set v {}
    incr decpos
    set x [expr {$decpos - $n}]
    
    if {$x} {
        set v [string repeat 0 $x] 
    }
    return $v
 }
proc isOdd {int} {
    if {[string is integer $int]} {
        return [expr {$int%2}] 
    } else {
        error "no integer $int"
    }
}

PL 2014-10-17: while I'm loath to change someone else's code, this version of ìsOdd is simpler, twice as fast, and works for integer values outside the basic integer range:
proc isOdd n {
    try {
        expr {$n % 2}
    } on error {} {
        error "$n is not an integer"
    }
}

(If speed really is an issue, the expression $n & 1 seems slightly faster than $n % 2.)

Since the argument to isOdd is always a single digit, this one would work too:
proc isOdd n {
    expr {$n in {1 3 5 7 9}}
}

aspect 2014-10-18 objects to heavy-handed on error exception rewriting (do folks call this "pokemon exception handling?"), even in this trivial instance. If you want to return a specific error different than expr's natural one, at least trap:
proc isOdd n {
    try {
        expr {$n % 2}
    } trap {ARITH DOMAIN} {} {
        error "$n is not an integer"
    }
}

PL differing philosophies indeed. I object to non-exhaustive exception handling, and this code really hurts my eyes. OOC, if you're going to trap just that one, why not
proc isOdd n {
    try {
        expr {$n % 2}
    } trap {ARITH DOMAIN} {message options} {
        return -options $options -errorinfo "$n is not an integer"
    }
}

I can definitely think of coding situations where this (using trap) would be useful though, it's just that I'd refactor my way out of those. But there's usually no right or wrong, it's mostly works or doesn't work.