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