1# constants.tcl --
2#    Module defining common mathematical and numerical constants
3#
4# Copyright (c) 2004 by Arjen Markus.  All rights reserved.
5#
6# See the file "license.terms" for information on usage and redistribution
7# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
8#
9# RCS: @(#) $Id: constants.tcl,v 1.8 2005/10/06 05:16:37 andreas_kupries Exp $
10#
11#----------------------------------------------------------------------
12
13package require Tcl 8.2
14
15package provide math::constants 1.0.1
16
17# namespace constants
18#    Create a convenient namespace for the constants
19#
20namespace eval ::math::constants {
21    #
22    # List of constants and their description
23    #
24    variable constants {
25        pi        3.14159265358979323846   "ratio of circle circumference and diameter"
26        e         2.71828182845904523536   "base for natural logarithm"
27        ln10      2.30258509299404568402   "natural logarithm of 10"
28        phi       1.61803398874989484820   "golden ratio"
29        gamma     0.57721566490153286061   "Euler's constant"
30        sqrt2     1.41421356237309504880   "Square root of 2"
31        thirdrt2  1.25992104989487316477   "One-third power of 2"
32        sqrt3     1.73205080756887729533   "Square root of 3"
33        radtodeg  57.2957795131            "Conversion from radians to degrees"
34        degtorad  0.017453292519943        "Conversion from degrees to radians"
35        onethird  1.0/3.0                  "One third (0.3333....)"
36        twothirds 2.0/3.0                  "Two thirds (0.3333....)"
37        onesixth  1.0/6.0                  "One sixth (0.1666....)"
38        huge      [find_huge]              "(Approximately) largest number"
39        tiny      [find_tiny]              "(Approximately) smallest number not equal zero"
40        eps       [find_eps]               "Smallest number such that 1+eps != 1"
41    }
42    namespace export constants print-constants
43}
44
45# constants --
46#    Expose the constants in the caller's routine or namespace
47#
48# Arguments:
49#    args         List of constants to be exposed
50# Result:
51#    None
52#
53proc ::math::constants::constants {args} {
54
55    foreach const $args {
56        uplevel 1 [list variable $const [set ::math::constants::$const]]
57    }
58}
59
60# print-constants --
61#    Print the selected or all constants to the screen
62#
63# Arguments:
64#    args         List of constants to be exposed
65# Result:
66#    None
67#
68proc ::math::constants::print-constants {args} {
69    variable constants
70
71    if { [llength $args] != 0 } {
72        foreach const $args {
73            set idx [lsearch $constants $const]
74            if { $idx >= 0 } {
75                set descr [lindex $constants [expr {$idx+2}]]
76                puts "$const = [set ::math::constants::$const] = $descr"
77            } else {
78                puts "*** $const unknown ***"
79            }
80        }
81    } else {
82        foreach {const value descr} $constants {
83            puts "$const = [set ::math::constants::$const] = $descr"
84        }
85    }
86}
87
88# find_huge --
89#    Find the largest possible number
90#
91# Arguments:
92#    None
93# Result:
94#    Estimate of the largest possible number
95#
96proc ::math::constants::find_huge {} {
97
98    set result 1.0
99    set Inf Inf
100    while {1} {
101	if {[catch {expr {2.0 * $result}} result]} {
102	    break
103	}
104	if { $result == $Inf } {
105	    break
106	}
107	set prev_result $result
108    }
109    set result $prev_result
110    set adder [expr { $result / 2. }]
111    while { $adder != 0.0 } {
112	if {![catch {expr {$adder + $prev_result}} result]} {
113	    if { $result == $prev_result } break
114	    if { $result != $Inf } {
115		set prev_result $result
116	    }
117	}
118	set adder [expr { $adder / 2. }]
119    }
120    return $prev_result
121
122}
123
124# find_tiny --
125#    Find the smallest possible number
126#
127# Arguments:
128#    None
129# Result:
130#    Estimate of the smallest possible number
131#
132proc ::math::constants::find_tiny {} {
133
134    set result 1.0
135
136    while { ! [catch {set result [expr {$result/2.0}]}] && $result > 0.0 } {
137        set prev_result $result
138    }
139    return $prev_result
140}
141
142# find_eps --
143#    Find the smallest number eps such that 1+eps != 1
144#
145# Arguments:
146#    None
147# Result:
148#    Estimate of the machine epsilon
149#
150proc ::math::constants::find_eps { } {
151    set eps 1.0
152    while { [expr {1.0+$eps}] != 1.0 } {
153        set prev_eps $eps
154        set eps  [expr {0.5*$eps}]
155    }
156    return $prev_eps
157}
158
159# Create the variables from the list:
160# - By using expr we ensure that the best double precision
161#   approximation is assigned to the variable, rather than
162#   just the string
163# - It also allows us to rely on IEEE arithmetic if available,
164#   so that for instance 3.0*(1.0/3.0) is exactly 1.0
165#
166namespace eval ::math::constants {
167    foreach {const value descr} $constants {
168        # FRINK: nocheck
169        set [namespace current]::$const [expr 0.0+$value]
170    }
171    unset value
172    unset const
173    unset descr
174
175    rename find_eps  {}
176    rename find_tiny {}
177    rename find_huge {}
178}
179
180# some tests --
181#
182if { [info exists ::argv0]
183     && [string equal $::argv0 [info script]] } {
184    ::math::constants::constants pi e ln10 onethird eps
185    set tcl_precision 17
186    puts "$pi - [expr {1.0/$pi}]"
187    puts $e
188    puts $ln10
189    puts "onethird: [expr {3.0*$onethird}]"
190    ::math::constants::print-constants onethird pi e
191    puts "All defined constants:"
192    ::math::constants::print-constants
193
194    if { 1.0+$eps == 1.0 } {
195        puts "Something went wrong with eps!"
196    } else {
197        puts "Difference: [set ee [expr {1.0+$eps}]] - 1.0 = [expr {$ee-1.0}]"
198    }
199}
200