00001
00002
00003
00004
00005
00006
00007
00008 package require Tcl 8.5
00009
00010
00011 catch {namespace delete ::math::bigfloat}
00012
00013
00014
00015
00016 namespace ::math::bigfloat {
00017
00018
00019 variable Log2
00020
00021 variable Pi
00022 variable _pi0
00023 }
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068 ret ::math::bigfloat::abs (type number) {
00069 checkNumber $number
00070 if {[isInt $number]} {
00071 # set sign to positive for a BigInt
00072 return [expr {abs($number)}]
00073 }
00074 # set sign to positive for a BigFloat into the Mantissa (index 1)
00075 lset number 1 [expr {abs([lindex $number 1])}]
00076 return $number
00077 }
00078
00079
00080
00081
00082
00083 ret ::math::bigfloat::acos (type x) {
00084 # handy proc for checking datatype
00085 checkFloat $x
00086 foreach {dummy entier exp delta} $x {break}
00087 set precision [expr {($exp<0)?(-$exp):1}]
00088 # acos(0.0)=Pi/2
00089 # 26/07/2005 : changed precision from decimal to binary
00090 # with the second parameter of pi command
00091 set piOverTwo [floatRShift [pi $precision 1]]
00092 if {[iszero $x]} {
00093 # $x is too close to zero -> acos(0)=PI/2
00094 return $piOverTwo
00095 }
00096 # acos(-x)= Pi/2 + asin(x)
00097 if {$entier<0} {
00098 return [add $piOverTwo [asin [abs $x]]]
00099 }
00100 # we always use _asin to compute the result
00101 # but as it is a Taylor development, the value given to [_asin]
00102 # has to be a bit smaller than 1 ; by using that trick : acos(x)=asin(sqrt(1-x^2))
00103 # we can limit the entry of the Taylor development below 1/sqrt(2)
00104 if {[compare $x [fromstr 0.7071]]>0} {
00105 # x > sqrt(2)/2 : trying to make _asin converge quickly
00106 # creating 0 and 1 with the same precision as the entry
00107 set fzero [list F 0 -$precision 1]
00108 # 1.000 with $precision zeros
00109 set fone [list F [expr {1<<$precision}] -$precision 1]
00110 # when $x is close to 1 (acos(1.0)=0.0)
00111 if {[equal $fone $x]} {
00112 return $fzero
00113 }
00114 if {[compare $fone $x]<0} {
00115 # the behavior assumed because acos(x) is not defined
00116 # when |x|>1
00117 error "acos on a number greater than 1"
00118 }
00119 # acos(x) = asin(sqrt(1 - x^2))
00120 # since 1 - cos(x)^2 = sin(x)^2
00121 # x> sqrt(2)/2 so x^2 > 1/2 so 1-x^2<1/2
00122 set x [sqrt [sub $fone [mul $x $x]]]
00123 # the parameter named x is smaller than sqrt(2)/2
00124 return [_asin $x]
00125 }
00126 # acos(x) = Pi/2 - asin(x)
00127 # x<sqrt(2)/2 here too
00128 return [sub $piOverTwo [_asin $x]]
00129 }
00130
00131
00132
00133
00134
00135 ret ::math::bigfloat::add (type a , type b) {
00136 checkNumber $a
00137 checkNumber $b
00138 if {[isInt $a]} {
00139 if {[isInt $b]} {
00140 # intAdd adds two BigInts
00141 return [incr a $b]
00142 }
00143 # adds the BigInt a to the BigFloat b
00144 return [addInt2Float $b $a]
00145 }
00146 if {[isInt $b]} {
00147 # ... and vice-versa
00148 return [addInt2Float $a $b]
00149 }
00150 # retrieving parameters from A and B
00151 foreach {dummy integerA expA deltaA} $a {break}
00152 foreach {dummy integerB expB deltaB} $b {break}
00153 if {$expA<$expB} {
00154 foreach {dummy integerA expA deltaA} $b {break}
00155 foreach {dummy integerB expB deltaB} $a {break}
00156 }
00157 # when we add two numbers which have different digit numbers (after the dot)
00158 # for example : 1.0 and 0.00001
00159 # We promote the one with the less number of digits (1.0) to the same level as
00160 # the other : so 1.00000.
00161 # that is why we shift left the number which has the greater exponent
00162 # But we do not forget the Delta parameter, which is lshift'ed too.
00163 if {$expA>$expB} {
00164 set diff [expr {$expA-$expB}]
00165 set integerA [expr {$integerA<<$diff}]
00166 set deltaA [expr {$deltaA<<$diff}]
00167 incr integerA $integerB
00168 incr deltaA $deltaB
00169 return [normalize [list F $integerA $expB $deltaA]]
00170 } elseif {$expA==$expB} {
00171 # nothing to shift left
00172 return [normalize [list F [incr integerA $integerB] $expA [incr deltaA $deltaB]]]
00173 } else {
00174 error "internal error"
00175 }
00176 }
00177
00178
00179
00180
00181
00182
00183 ret ::math::bigfloat::addInt2Float (type a , type b) {
00184 # type checking
00185 checkFloat $a
00186 if {![isInt $b]} {
00187 error "second argument is not an integer"
00188 }
00189 # retrieving data from $a
00190 foreach {dummy integerA expA deltaA} $a {break}
00191 # to add an int to a BigFloat,...
00192 if {$expA>0} {
00193 # we have to put the integer integerA
00194 # to the level of zero exponent : 1e8 --> 100000000e0
00195 set shift $expA
00196 set integerA [expr {($integerA<<$shift)+$b}]
00197 set deltaA [expr {$deltaA<<$shift}]
00198 # we have to normalize, because we have shifted the mantissa
00199 # and the uncertainty left
00200 return [normalize [list F $integerA 0 $deltaA]]
00201 } elseif {$expA==0} {
00202 # integerA is already at integer level : float=(integerA)e0
00203 return [normalize [list F [incr integerA $b] \
00204 0 $deltaA]]
00205 } else {
00206 # here we have something like 234e-2 + 3
00207 # we have to shift the integer left by the exponent |$expA|
00208 incr integerA [expr {$b<<(-$expA)}]
00209 return [normalize [list F $integerA $expA $deltaA]]
00210 }
00211 }
00212
00213
00214
00215
00216
00217 ret ::math::bigfloat::asin (type x) {
00218 # type checking
00219 checkFloat $x
00220 foreach {dummy entier exp delta} $x {break}
00221 if {$exp>-1} {
00222 error "not enough precision on input (asin)"
00223 }
00224 set precision [expr {-$exp}]
00225 # when x=0, return 0 at the same precision as the input was
00226 if {[iszero $x]} {
00227 return [list F 0 -$precision 1]
00228 }
00229 # asin(-x)=-asin(x)
00230 if {$entier<0} {
00231 return [opp [asin [abs $x]]]
00232 }
00233 # 26/07/2005 : changed precision from decimal to binary
00234 set piOverTwo [floatRShift [pi $precision 1]]
00235 # now a little trick : asin(x)=Pi/2-asin(sqrt(1-x^2))
00236 # so we can limit the entry of the Taylor development
00237 # to 1/sqrt(2)~0.7071
00238 # the comparison is : if x>0.7071 then ...
00239 if {[compare $x [fromstr 0.7071]]>0} {
00240 set fone [list F [expr {1<<$precision}] -$precision 1]
00241 # asin(1)=Pi/2 (with the same precision as the entry has)
00242 if {[equal $fone $x]} {
00243 return $piOverTwo
00244 }
00245 if {[compare $x $fone]>0} {
00246 error "asin on a number greater than 1"
00247 }
00248 # asin(x)=Pi/2-asin(sqrt(1-x^2))
00249 set x [sqrt [sub $fone [mul $x $x]]]
00250 return [sub $piOverTwo [_asin $x]]
00251 }
00252 return [normalize [_asin $x]]
00253 }
00254
00255
00256
00257
00258 ret ::math::bigfloat::_asin (type x) {
00259 # Taylor development
00260 # asin(x)=x + 1/2 x^3/3 + 3/2.4 x^5/5 + 3.5/2.4.6 x^7/7 + ...
00261 # into this iterative form :
00262 # asin(x)=x * (1 + 1/2 * x^2 * (1/3 + 3/4 *x^2 * (...
00263 # ...* (1/(2n-1) + (2n-1)/2n * x^2 / (2n+1))...)))
00264 # we show how is really computed the development :
00265 # we don't need to set a var with x^n or a product of integers
00266 # all we need is : x^2, 2n-1, 2n, 2n+1 and a few variables
00267 foreach {dummy mantissa exp delta} $x {break}
00268 set precision [expr {-$exp}]
00269 if {$precision+1<[bits $mantissa]} {
00270 error "sinus greater than 1"
00271 }
00272 # precision is the number of after-dot digits
00273 set result $mantissa
00274 set delta_final $delta
00275 # resultat is the final result, and delta_final
00276 # will contain the uncertainty of the result
00277 # square is the square of the mantissa
00278 set square [expr {$mantissa*$mantissa>>$precision}]
00279 # dt is the uncertainty of Mantissa
00280 set dt [expr {$mantissa*$delta>>($precision-1)}]
00281 incr dt
00282 set num 1
00283 # two will be used into the loop
00284 set i 3
00285 set denom 2
00286 # the nth factor equals : $num/$denom* $mantissa/$i
00287 set delta [expr {$delta*$square + $dt*($delta+$mantissa)}]
00288 set delta [expr {($delta*$num)/ $denom >>$precision}]
00289 incr delta
00290 # we do not multiply the Mantissa by $num right now because it is 1 !
00291 # but we have Mantissa=$x
00292 # and we want Mantissa*$x^2 * $num / $denom / $i
00293 set mantissa [expr {($mantissa*$square>>$precision)/$denom}]
00294 # do not forget the modified Taylor development :
00295 # asin(x)=x * (1 + 1/2*x^2*(1/3 + 3/4*x^2*(...*(1/(2n-1) + (2n-1)/2n*x^2/(2n+1))...)))
00296 # all we need is : x^2, 2n-1, 2n, 2n+1 and a few variables
00297 # $num=2n-1 $denom=2n $square=x^2 and $i=2n+1
00298 set mantissa_temp [expr {$mantissa/$i}]
00299 set delta_temp [expr {1+$delta/$i}]
00300 # when the Mantissa increment is smaller than the Delta increment,
00301 # we would not get much precision by continuing the development
00302 while {$mantissa_temp!=0} {
00303 # Mantissa = Mantissa * $num/$denom * $square
00304 # Add Mantissa/$i, which is stored in $mantissa_temp, to the result
00305 incr result $mantissa_temp
00306 incr delta_final $delta_temp
00307 # here we have $two instead of [fromstr 2] (optimization)
00308 # num=num+2,i=i+2,denom=denom+2
00309 # because num=2n-1 denom=2n and i=2n+1
00310 incr num 2
00311 incr i 2
00312 incr denom 2
00313 # computes precisly the future Delta parameter
00314 set delta [expr {$delta*$square+$dt*($delta+$mantissa)}]
00315 set delta [expr {($delta*$num)/$denom>>$precision}]
00316 incr delta
00317 set mantissa [expr {$mantissa*$square>>$precision}]
00318 set mantissa [expr {($mantissa*$num)/$denom}]
00319 set mantissa_temp [expr {$mantissa/$i}]
00320 set delta_temp [expr {1+$delta/$i}]
00321 }
00322 return [normalize [list F $result $exp $delta_final]]
00323 }
00324
00325
00326
00327
00328 ret ::math::bigfloat::atan (type x) {
00329 checkFloat $x
00330 foreach {dummy mantissa exp delta} $x {break}
00331 if {$exp>=0} {
00332 error "not enough precision to compute atan"
00333 }
00334 set precision [expr {-$exp}]
00335 # atan(0)=0
00336 if {[iszero $x]} {
00337 return [list F 0 -$precision $delta]
00338 }
00339 # atan(-x)=-atan(x)
00340 if {$mantissa<0} {
00341 return [opp [atan [abs $x]]]
00342 }
00343 # now x is strictly positive
00344 # at this moment, we are trying to limit |x| to a fair acceptable number
00345 # to ensure that Taylor development will converge quickly
00346 set float1 [list F [expr {1<<$precision}] -$precision 1]
00347 if {[compare $float1 $x]<0} {
00348 # compare x to 2.4142
00349 if {[compare $x [fromstr 2.4142]]<0} {
00350 # atan(x)=Pi/4 + atan((x-1)/(x+1))
00351 # as 1<x<2.4142 : (x-1)/(x+1)=1-2/(x+1) belongs to
00352 # the range : ]0,1-2/3.414[
00353 # that equals ]0,0.414[
00354 set pi_sur_quatre [floatRShift [pi $precision 1] 2]
00355 return [add $pi_sur_quatre [atan \
00356 [div [sub $x $float1] [add $x $float1]]]]
00357 }
00358 # atan(x)=Pi/2-atan(1/x)
00359 # 1/x < 1/2.414 so the argument is lower than 0.414
00360 set pi_over_two [floatRShift [pi $precision 1]]
00361 return [sub $pi_over_two [atan [div $float1 $x]]]
00362 }
00363 if {[compare $x [fromstr 0.4142]]>0} {
00364 # atan(x)=Pi/4 + atan((x-1)/(x+1))
00365 # x>0.420 so (x-1)/(x+1)=1 - 2/(x+1) > 1-2/1.414
00366 # > -0.414
00367 # x<1 so (x-1)/(x+1)<0
00368 set pi_sur_quatre [floatRShift [pi $precision 1] 2]
00369 return [add $pi_sur_quatre [atan \
00370 [div [sub $x $float1] [add $x $float1]]]]
00371 }
00372 # precision increment : to have less uncertainty
00373 # we add a little more precision so that the result would be more accurate
00374 # Taylor development : x - x^3/3 + x^5/5 - ... + (-1)^(n+1)*x^(2n-1)/(2n-1)
00375 # when we have n steps in Taylor development : the nth term is :
00376 # x^(2n-1)/(2n-1)
00377 # and the loss of precision is of 2n (n sums and n divisions)
00378 # this command is called with x<sqrt(2)-1
00379 # if we add an increment to the precision, say n:
00380 # (sqrt(2)-1)^(2n-1)/(2n-1) has to be lower than 2^(-precision-n-1)
00381 # (2n-1)*log(sqrt(2)-1)-log(2n-1)<-(precision+n+1)*log(2)
00382 # 2n(log(sqrt(2)-1)-log(sqrt(2)))<-(precision-1)*log(2)+log(2n-1)+log(sqrt(2)-1)
00383 # 2n*log(1-1/sqrt(2))<-(precision-1)*log(2)+log(2n-1)+log(2)/2
00384 # 2n/sqrt(2)>(precision-3/2)*log(2)-log(2n-1)
00385 # hence log(2n-1)<2n-1
00386 # n*sqrt(2)>(precision-1.5)*log(2)+1-2n
00387 # n*(sqrt(2)+2)>(precision-1.5)*log(2)+1
00388 set n [expr {int((log(2)*($precision-1.5)+1)/(sqrt(2)+2)+1)}]
00389 incr precision $n
00390 set mantissa [expr {$mantissa<<$n}]
00391 set delta [expr {$delta<<$n}]
00392 # end of adding precision increment
00393 # now computing Taylor development :
00394 # atan(x)=x - x^3/3 + x^5/5 - x^7/7 ... + (-1)^n*x^(2n+1)/(2n+1)
00395 # atan(x)=x * (1 - x^2 * (1/3 - x^2 * (1/5 - x^2 * (...*(1/(2n-1) - x^2 / (2n+1))...))))
00396 # what do we need to compute this ?
00397 # x^2 ($square), 2n+1 ($divider), $result, the nth term of the development ($t)
00398 # and the nth term multiplied by 2n+1 ($temp)
00399 # then we do this (with care keeping as much precision as possible):
00400 # while ($t <>0) :
00401 # $result=$result+$t
00402 # $temp=$temp * $square
00403 # $divider = $divider+2
00404 # $t=$temp/$divider
00405 # end-while
00406 set result $mantissa
00407 set delta_end $delta
00408 # we store the square of the integer (mantissa)
00409 # Delta of Mantissa^2 = Delta * 2 = Delta << 1
00410 set delta_square [expr {$delta<<1}]
00411 set square [expr {$mantissa*$mantissa>>$precision}]
00412 # the (2n+1) divider
00413 set divider 3
00414 # computing precisely the uncertainty
00415 set delta [expr {1+($delta_square*$mantissa+$delta*$square>>$precision)}]
00416 # temp contains (-1)^n*x^(2n+1)
00417 set temp [expr {-$mantissa*$square>>$precision}]
00418 set t [expr {$temp/$divider}]
00419 set dt [expr {1+$delta/$divider}]
00420 while {$t!=0} {
00421 incr result $t
00422 incr delta_end $dt
00423 incr divider 2
00424 set delta [expr {1+($delta_square*abs($temp)+$delta*($delta_square+$square)>>$precision)}]
00425 set temp [expr {-$temp*$square>>$precision}]
00426 set t [expr {$temp/$divider}]
00427 set dt [expr {1+$delta/$divider}]
00428 }
00429 # we have to normalize because the uncertainty might be greater than 2**16
00430 # moreover it is the most often case
00431 return [normalize [list F $result [expr {$exp-$n}] $delta_end]]
00432 }
00433
00434
00435
00436
00437
00438
00439
00440 ret ::math::bigfloat::_atanfract (type integer , type precision) {
00441 # Taylor development : x - x^3/3 + x^5/5 - ... + (-1)^(n+1)*x^(2n-1)/(2n-1)
00442 # when we have n steps in Taylor development : the nth term is :
00443 # 1/denom^(2n+1)/(2n+1)
00444 # and the loss of precision is of 2n (n sums and n divisions)
00445 # this command is called with integer>=5
00446 #
00447 # We do not want to compute the Delta parameter, so we just
00448 # can increment precision (with lshift) in order for the result to be precise.
00449 # Remember : we compute atan2(1,$integer) with $precision bits
00450 # $integer has no Delta parameter as it is a BigInt, of course, so
00451 # theorically we could compute *any* number of digits.
00452 #
00453 # if we add an increment to the precision, say n:
00454 # (1/5)^(2n-1)/(2n-1) has to be lower than (1/2)^(precision+n-1)
00455 # Calculus :
00456 # log(left term) < log(right term)
00457 # log(1/left term) > log(1/right term)
00458 # (2n-1)*log(5)+log(2n-1)>(precision+n-1)*log(2)
00459 # n(2log(5)-log(2))>(precision-1)*log(2)-log(2n-1)+log(5)
00460 # -log(2n-1)>-(2n-1)
00461 # n(2log(5)-log(2)+2)>(precision-1)*log(2)+1+log(5)
00462 set n [expr {int((($precision-1)*log(2)+1+log(5))/(2*log(5)-log(2)+2)+1)}]
00463 incr precision $n
00464 # first term of the development : 1/integer
00465 set a [expr {(1<<$precision)/$integer}]
00466 # 's' will contain the result
00467 set s $a
00468 # Taylor development : x - x^3/3 + x^5/5 - ... + (-1)^(n+1)*x^(2n-1)/(2n-1)
00469 # equals x (1 - x^2 * (1/3 + x^2 * (... * (1/(2n-3) + (-1)^(n+1) * x^2 / (2n-1))...)))
00470 # all we need to store is : 2n-1 ($denom), x^(2n+1) and x^2 ($square) and two results :
00471 # - the nth term => $u
00472 # - the nth term * (2n-1) => $t
00473 # + of course, the result $s
00474 set square [expr {$integer*$integer}]
00475 set denom 3
00476 # $t is (-1)^n*x^(2n+1)
00477 set t [expr {-$a/$square}]
00478 set u [expr {$t/$denom}]
00479 # we break the loop when the current term of the development is null
00480 while {$u!=0} {
00481 incr s $u
00482 # denominator= (2n+1)
00483 incr denom 2
00484 # div $t by x^2
00485 set t [expr {-$t/$square}]
00486 set u [expr {$t/$denom}]
00487 }
00488 # go back to the initial precision
00489 return [expr {$s>>$n}]
00490 }
00491
00492
00493
00494
00495 ret ::math::bigfloat::bits (type int) {
00496 set l [string length [set int [expr {abs($int)}]]]
00497 # int<10**l -> log_2(int)=l*log_2(10)
00498 set l [expr {int($l*log(10)/log(2))+1}]
00499 if {$int>>$l!=0} {
00500 error "bad result: $l bits"
00501 }
00502 while {($int>>($l-1))==0} {
00503 incr l -1
00504 }
00505 return $l
00506 }
00507
00508
00509
00510
00511
00512
00513 ret ::math::bigfloat::ceil (type number) {
00514 checkFloat $number
00515 set number [normalize $number]
00516 if {[iszero $number]} {
00517 return 0
00518 }
00519 foreach {dummy integer exp delta} $number {break}
00520 if {$exp>=0} {
00521 error "not enough precision to perform rounding (ceil)"
00522 }
00523 # saving the sign ...
00524 set sign [expr {$integer<0}]
00525 set integer [expr {abs($integer)}]
00526 # integer part
00527 set try [expr {$integer>>(-$exp)}]
00528 if {$sign} {
00529 return [opp $try]
00530 }
00531 # fractional part
00532 if {($try<<(-$exp))!=$integer} {
00533 return [incr try]
00534 }
00535 return $try
00536 }
00537
00538
00539
00540
00541
00542
00543 ret ::math::bigfloat::checkFloat (type number) {
00544 if {![isFloat $number]} {
00545 error "BigFloat expected"
00546 }
00547 }
00548
00549
00550
00551
00552
00553 ret ::math::bigfloat::checkNumber (type x) {
00554 if {![isFloat $x] && ![isInt $x]} {
00555 error "input is not an integer, nor a BigFloat"
00556 }
00557 }
00558
00559
00560
00561
00562
00563
00564 ret ::math::bigfloat::compare (type a , type b) {
00565 if {[isInt $a] && [isInt $b]} {
00566 set diff [expr {$a-$b}]
00567 if {$diff>0} {return 1} elseif {$diff<0} {return -1}
00568 return 0
00569 }
00570 checkFloat $a
00571 checkFloat $b
00572 if {[equal $a $b]} {return 0}
00573 if {[lindex [sub $a $b] 1]<0} {return -1}
00574 return 1
00575 }
00576
00577
00578
00579
00580
00581
00582
00583
00584 ret ::math::bigfloat::cos (type x) {
00585 checkFloat $x
00586 foreach {dummy integer exp delta} $x {break}
00587 if {$exp>-2} {
00588 error "not enough precision on floating-point number"
00589 }
00590 set precision [expr {-$exp}]
00591 # cos(2kPi+x)=cos(x)
00592 foreach {n integer} [divPiQuarter $integer $precision] {break}
00593 # now integer>=0 and <Pi/2
00594 set d [expr {$n%4}]
00595 # add trigonometric circle turns number to delta
00596 incr delta [expr {abs($n)}]
00597 set signe 0
00598 # cos(Pi-x)=-cos(x)
00599 # cos(-x)=cos(x)
00600 # cos(Pi/2-x)=sin(x)
00601 switch -- $d {
00602 1 {set signe 1;set l [_sin2 $integer $precision $delta]}
00603 2 {set signe 1;set l [_cos2 $integer $precision $delta]}
00604 0 {set l [_cos2 $integer $precision $delta]}
00605 3 {set l [_sin2 $integer $precision $delta]}
00606 default {error "internal error"}
00607 }
00608 # precision -> exp (multiplied by -1)
00609 #idebug break
00610 lset l 1 [expr {-([lindex $l 1])}]
00611 # set the sign
00612 if {$signe} {
00613 lset l 0 [expr {-[lindex $l 0]}]
00614 }
00615 #idebug break
00616 return [normalize [linsert $l 0 F]]
00617 }
00618
00619
00620
00621
00622
00623
00624
00625
00626 ret ::math::bigfloat::_cos2 (type x , type precision , type delta) {
00627 # precision bits after the dot
00628 set pi [_pi $precision]
00629 set pis2 [expr {$pi>>1}]
00630 set pis4 [expr {$pis2>>1}]
00631 if {$x>=$pis4} {
00632 # cos(Pi/2-x)=sin(x)
00633 set x [expr {$pis2-$x}]
00634 incr delta
00635 return [_sin $x $precision $delta]
00636 }
00637 #idebug break
00638 return [_cos $x $precision $delta]
00639 }
00640
00641
00642
00643
00644
00645
00646
00647
00648 ret ::math::bigfloat::_cos (type x , type precision , type delta) {
00649 set float1 [expr {1<<$precision}]
00650 # Taylor development follows :
00651 # cos(x)=1-x^2/2 + x^4/4! ... + (-1)^(2n)*x^(2n)/2n!
00652 # cos(x)= 1 - x^2/1.2 * (1 - x^2/3.4 * (... * (1 - x^2/(2n.(2n-1))...))
00653 # variables : $s (the Mantissa of the result)
00654 # $denom1 & $denom2 (2n-1 & 2n)
00655 # $x as the square of what is named x in 'cos(x)'
00656 set s $float1
00657 # 'd' is the uncertainty on x^2
00658 set d [expr {$x*($delta<<1)}]
00659 set d [expr {1+($d>>$precision)}]
00660 # x=x^2 (because in this Taylor development, there are only even powers of x)
00661 set x [expr {$x*$x>>$precision}]
00662 set denom1 1
00663 set denom2 2
00664 set t [expr {-($x>>1)}]
00665 set dt $d
00666 while {$t!=0} {
00667 incr s $t
00668 incr delta $dt
00669 incr denom1 2
00670 incr denom2 2
00671 set dt [expr {$x*$dt+($t+$dt)*$d>>$precision}]
00672 incr dt
00673 set t [expr {$x*$t>>$precision}]
00674 set t [expr {-$t/($denom1*$denom2)}]
00675 }
00676 return [list $s $precision $delta]
00677 }
00678
00679
00680
00681
00682 ret ::math::bigfloat::cotan (type x) {
00683 return [::math::bigfloat::div [::math::bigfloat::cos $x] [::math::bigfloat::sin $x]]
00684 }
00685
00686
00687
00688
00689
00690 ret ::math::bigfloat::deg2rad (type x) {
00691 checkFloat $x
00692 set xLen [expr {-[lindex $x 2]}]
00693 if {$xLen<3} {
00694 error "number too loose to convert to radians"
00695 }
00696 set pi [pi $xLen 1]
00697 return [div [mul $x $pi] 180]
00698 }
00699
00700
00701
00702
00703
00704
00705
00706
00707 ret ::math::bigfloat::divPiQuarter (type integer , type precision) {
00708 incr precision 2
00709 set integer [expr {$integer<<1}]
00710 #idebug break
00711 set P [_pi $precision]
00712 # modulo 2Pi
00713 set integer [expr {$integer%$P}]
00714 # end modulo 2Pi
00715 # 2Pi>>1 = Pi of course!
00716 set P [expr {$P>>1}]
00717 set n [expr {$integer/$P}]
00718 set integer [expr {$integer%$P}]
00719 # now divide by Pi/2
00720 # multiply n by 2
00721 set n [expr {$n<<1}]
00722 # pi/2=Pi>>1
00723 set P [expr {$P>>1}]
00724 return [list [incr n [expr {$integer/$P}]] [expr {($integer%$P)>>1}]]
00725 }
00726
00727
00728
00729
00730
00731
00732 ret ::math::bigfloat::div (type a , type b) {
00733 checkNumber $a
00734 checkNumber $b
00735 # dispatch to an appropriate procedure
00736 if {[isInt $a]} {
00737 if {[isInt $b]} {
00738 return [expr {$a/$b}]
00739 }
00740 error "trying to divide an integer by a BigFloat"
00741 }
00742 if {[isInt $b]} {return [divFloatByInt $a $b]}
00743 foreach {dummy integerA expA deltaA} $a {break}
00744 foreach {dummy integerB expB deltaB} $b {break}
00745 # computes the limits of the doubt (or uncertainty) interval
00746 set BMin [expr {$integerB-$deltaB}]
00747 set BMax [expr {$integerB+$deltaB}]
00748 if {$BMin>$BMax} {
00749 # swap BMin and BMax
00750 set temp $BMin
00751 set BMin $BMax
00752 set BMax $temp
00753 }
00754 # multiply by zero gives zero
00755 if {$integerA==0} {
00756 # why not return any number or the integer 0 ?
00757 # because there is an exponent that might be different between two BigFloats
00758 # 0.00 --> exp = -2, 0.000000 -> exp = -6
00759 return $a
00760 }
00761 # test of the division by zero
00762 if {$BMin*$BMax<0 || $BMin==0 || $BMax==0} {
00763 error "divide by zero"
00764 }
00765 # shift A because we need accuracy
00766 set l [bits $integerB]
00767 set integerA [expr {$integerA<<$l}]
00768 set deltaA [expr {$deltaA<<$l}]
00769 set exp [expr {$expA-$l-$expB}]
00770 # relative uncertainties (dX/X) are added
00771 # to give the relative uncertainty of the result
00772 # i.e. 3% on A + 2% on B --> 5% on the quotient
00773 # d(A/B)/(A/B)=dA/A + dB/B
00774 # Q=A/B
00775 # dQ=dA/B + dB*A/B*B
00776 # dQ is "delta"
00777 set delta [expr {($deltaB*abs($integerA))/abs($integerB)}]
00778 set delta [expr {([incr delta]+$deltaA)/abs($integerB)}]
00779 set quotient [expr {$integerA/$integerB}]
00780 if {$integerB*$integerA<0} {
00781 incr quotient -1
00782 }
00783 return [normalize [list F $quotient $exp [incr delta]]]
00784 }
00785
00786
00787
00788
00789
00790
00791
00792
00793 ret ::math::bigfloat::divFloatByInt (type a , type b) {
00794 # type check
00795 checkFloat $a
00796 if {![isInt $b]} {
00797 error "second argument is not an integer"
00798 }
00799 foreach {dummy integer exp delta} $a {break}
00800 # zero divider test
00801 if {$b==0} {
00802 error "divide by zero"
00803 }
00804 # shift left for accuracy ; see other comments in [div] procedure
00805 set l [bits $b]
00806 set integer [expr {$integer<<$l}]
00807 set delta [expr {$delta<<$l}]
00808 incr exp -$l
00809 set integer [expr {$integer/$b}]
00810 # the uncertainty is always evaluated to the ceil value
00811 # and as an absolute value
00812 set delta [expr {$delta/abs($b)+1}]
00813 return [normalize [list F $integer $exp $delta]]
00814 }
00815
00816
00817
00818
00819
00820
00821
00822
00823
00824 ret ::math::bigfloat::equal (type a , type b) {
00825 if {[isInt $a] && [isInt $b]} {
00826 return [expr {$a==$b}]
00827 }
00828 # now a & b should only be BigFloats
00829 checkFloat $a
00830 checkFloat $b
00831 foreach {dummy aint aexp adelta} $a {break}
00832 foreach {dummy bint bexp bdelta} $b {break}
00833 # set all Mantissas and Deltas to the same level (exponent)
00834 # with lshift
00835 set diff [expr {$aexp-$bexp}]
00836 if {$diff<0} {
00837 set diff [expr {-$diff}]
00838 set bint [expr {$bint<<$diff}]
00839 set bdelta [expr {$bdelta<<$diff}]
00840 } elseif {$diff>0} {
00841 set aint [expr {$aint<<$diff}]
00842 set adelta [expr {$adelta<<$diff}]
00843 }
00844 # compute limits of the number's doubt range
00845 set asupInt [expr {$aint+$adelta}]
00846 set ainfInt [expr {$aint-$adelta}]
00847 set bsupInt [expr {$bint+$bdelta}]
00848 set binfInt [expr {$bint-$bdelta}]
00849 # A & B are equal
00850 # if their doubt ranges overlap themselves
00851 if {$bint==$aint} {
00852 return 1
00853 }
00854 if {$bint>$aint} {
00855 set r [expr {$asupInt>=$binfInt}]
00856 } else {
00857 set r [expr {$bsupInt>=$ainfInt}]
00858 }
00859 return $r
00860 }
00861
00862
00863
00864
00865 ret ::math::bigfloat::exp (type x) {
00866 checkFloat $x
00867 foreach {dummy integer exp delta} $x {break}
00868 if {$exp>=0} {
00869 # shift till exp<0 with respect to the internal representation
00870 # of the number
00871 incr exp
00872 set integer [expr {$integer<<$exp}]
00873 set delta [expr {$delta<<$exp}]
00874 set exp -1
00875 }
00876 # add 8 bits of precision for safety
00877 set precision [expr {8-$exp}]
00878 set integer [expr {$integer<<8}]
00879 set delta [expr {$delta<<8}]
00880 set Log2 [_log2 $precision]
00881 set new_exp [expr {$integer/$Log2}]
00882 set integer [expr {$integer%$Log2}]
00883 # $new_exp = integer part of x/log(2)
00884 # $integer = remainder
00885 # exp(K.log(2)+r)=2^K.exp(r)
00886 # so we just have to compute exp(r), r is small so
00887 # the Taylor development will converge quickly
00888 incr delta $new_exp
00889 foreach {integer delta} [_exp $integer $precision $delta] {break}
00890 set delta [expr {$delta>>8}]
00891 incr precision -8
00892 # multiply by 2^K , and take care of the sign
00893 # example : X=-6.log(2)+0.01
00894 # exp(X)=exp(0.01)*2^-6
00895 # if {abs($new_exp)>>30!=0} {
00896 # error "floating-point overflow due to exp"
00897 # }
00898 set exp [expr {$new_exp-$precision}]
00899 incr delta
00900 return [normalize [list F [expr {$integer>>8}] $exp $delta]]
00901 }
00902
00903
00904
00905
00906
00907
00908
00909
00910
00911
00912
00913
00914 ret ::math::bigfloat::_exp (type integer , type precision , type delta) {
00915 if {$integer==0} {
00916 # exp(0)=1
00917 return [list [expr {1<<$precision}] $delta]
00918 }
00919 set s [expr {(1<<$precision)+$integer}]
00920 set d [expr {1+$delta/2}]
00921 incr delta $delta
00922 # dt = uncertainty on x^2
00923 set dt [expr {1+($d*$integer>>$precision)}]
00924 # t= x^2/2 = x^2>>1
00925 set t [expr {$integer*$integer>>$precision+1}]
00926 set denom 2
00927 while {$t!=0} {
00928 # the sum is called 's'
00929 incr s $t
00930 incr delta $dt
00931 # we do not have to keep trace of the factorial, we just iterate divisions
00932 incr denom
00933 # add delta
00934 set d [expr {1+$d/$denom}]
00935 incr dt $d
00936 # get x^n from x^(n-1)
00937 set t [expr {($integer*$t>>$precision)/$denom}]
00938 }
00939 return [list $s $delta]
00940 }
00941
00942
00943
00944 ret ::math::bigfloat::floatRShift (type float , optional n =1) {
00945 return [lset float 2 [expr {[lindex $float 2]-$n}]]
00946 }
00947
00948
00949
00950
00951
00952
00953
00954
00955 ret ::math::bigfloat::floor (type number) {
00956 checkFloat $number
00957 if {[iszero $number]} {
00958 # returns the BigInt 0
00959 return 0
00960 }
00961 foreach {dummy integer exp delta} $number {break}
00962 if {$exp>=0} {
00963 error "not enough precision to perform rounding (floor)"
00964 }
00965 # floor(n.xxxx)=n when n is positive
00966 if {$integer>0} {return [expr {$integer>>(-$exp)}]}
00967 set integer [expr {abs($integer)}]
00968 # integer part
00969 set try [expr {$integer>>(-$exp)}]
00970 # floor(-n.xxxx)=-(n+1) when xxxx!=0
00971 if {$try<<(-$exp)!=$integer} {
00972 incr try
00973 }
00974 return [expr {-$try}]
00975 }
00976
00977
00978
00979
00980
00981
00982
00983
00984
00985
00986
00987
00988
00989
00990 ret ::math::bigfloat::fromstr (type number , optional addzeros =0) {
00991 if {$addzeros<0} {
00992 error "second argument has to be a positive integer"
00993 }
00994 # eliminate the sign problem
00995 # added on 05/08/2005
00996 # setting '$signe' to the sign of the number
00997 set number [string trimleft $number +]
00998 if {[string index $number 0]=="-"} {
00999 set signe 1
01000 set string [string range $number 1 end]
01001 } else {
01002 set signe 0
01003 set string $number
01004 }
01005 # integer case (not a floating-point number)
01006 if {[string is digit $string]} {
01007 if {$addzeros!=0} {
01008 error "second argument not allowed with an integer"
01009 }
01010 # we have completed converting an integer to a BigInt
01011 # please note that most math::bigfloat procs accept BigInts as arguments
01012 return $number
01013 }
01014 # floating-point number : check for an exponent
01015 # scientific notation
01016 set tab [split $string e]
01017 if {[llength $tab]>2} {
01018 # there are more than one 'e' letter in the number
01019 error "syntax error in number : $string"
01020 }
01021 if {[llength $tab]==2} {
01022 set exp [lindex $tab 1]
01023 # now exp can look like +099 so you need to handle octal numbers
01024 # too bad...
01025 # find the sign (if any?)
01026 regexp {^[\+\-]?} $exp expsign
01027 # trim the number with left-side 0's
01028 set found [string length $expsign]
01029 set exp $expsign[string trimleft [string range $exp $found end] 0]
01030 set mantissa [lindex $tab 0]
01031 } else {
01032 set exp 0
01033 set mantissa [lindex $tab 0]
01034 }
01035 # a floating-point number may have a dot
01036 set tab [split [string trimleft $mantissa 0] .]
01037 if {[llength $tab]>2} {error "syntax error in number : $string"}
01038 if {[llength $tab]==2} {
01039 set mantissa [join $tab ""]
01040 # increment by the number of decimals (after the dot)
01041 incr exp -[string length [lindex $tab 1]]
01042 }
01043 # this is necessary to ensure we can call fromstr (recursively) with
01044 # the mantissa ($number)
01045 if {![string is digit $mantissa]} {
01046 error "$number is not a number"
01047 }
01048 # take account of trailing zeros
01049 incr exp -$addzeros
01050 # multiply $number by 10^$trailingZeros
01051 append mantissa [string repeat 0 $addzeros]
01052 # add the sign
01053 # here we avoid octal numbers by trimming the leading zeros!
01054 # 2005-10-28 S.ARNOLD
01055 if {$signe} {set mantissa [expr {-[string trimleft $mantissa 0]}]}
01056 # the F tags a BigFloat
01057 # a BigInt is like any other integer since Tcl 8.5,
01058 # because expr now supports arbitrary length integers
01059 return [_fromstr $mantissa $exp]
01060 }
01061
01062
01063
01064
01065
01066
01067
01068
01069
01070 ret ::math::bigfloat::_fromstr (type number , type exp) {
01071 set number [string trimleft $number 0]
01072 if {$number==""} {
01073 return [list F 0 [expr {int($exp*log(10)/log(2))-15}] [expr {1<<15}]]
01074 }
01075 if {$exp==0} {
01076 return [list F $number 0 1]
01077 }
01078 if {$exp>0} {
01079 # mul by 10^exp, then normalize
01080 set power [expr {10**$exp}]
01081 set number [expr {$number*$power}]
01082 return [normalize [list F $number 0 $power]]
01083 }
01084 # now exp is negative or null
01085 # the closest power of 2 to the 'exp'th power of ten, but greater than it
01086 # 10**$exp<2**$binaryExp
01087 # $binaryExp>$exp*log(10)/log(2)
01088 set binaryExp [expr {int(-$exp*log(10)/log(2))+1+16}]
01089 # then compute n * 2^binaryExp / 10^(-exp)
01090 # (exp is negative)
01091 # equals n * 2^(binaryExp+exp) / 5^(-exp)
01092 set diff [expr {$binaryExp+$exp}]
01093 if {$diff<0} {
01094 error "internal error"
01095 }
01096 set power [expr {5**(-$exp)}]
01097 set number [expr {($number<<$diff)/$power}]
01098 set delta [expr {(1<<$diff)/$power}]
01099 return [normalize [list F $number [expr {-$binaryExp}] [incr delta]]]
01100 }
01101
01102
01103
01104
01105
01106
01107
01108
01109
01110 ret ::math::bigfloat::fromdouble (type double , optional exp ={)} {
01111 set mantissa [lindex [split $double e] 0]
01112 # line added by SArnold on 05/08/2005
01113 set mantissa [string trimleft [string map {+ "" - ""} $mantissa] 0]
01114 precision = [string length [string map {. ""} $mantissa]]
01115 if { $exp != {} && [incr exp]>$precision } {
01116 return [fromstr $double [expr {$exp-$precision}]]
01117 } else {
01118
01119 return [fromstr $double]
01120 }
01121 }
01122
01123
01124
01125
01126
01127 ret ::math::bigfloat::int2float (type int , optional decimals =1) {
01128 # it seems like we need some kind of type handling
01129 # very odd in this Tcl world :-(
01130 if {![isInt $int]} {
01131 error "first argument is not an integer"
01132 }
01133 if {$decimals<1} {
01134 error "non-positive decimals number"
01135 }
01136 # the lowest number of decimals is 1, because
01137 # [tostr [fromstr 10.0]] returns 10.
01138 # (we lose 1 digit when converting back to string)
01139 set int [expr {$int*10**$decimals}]
01140 return [_fromstr $int [expr {-$decimals}]]
01141 }
01142
01143
01144
01145
01146
01147
01148 ret ::math::bigfloat::intMulShift (type leftop , type rightop , type shift) {
01149 return [::math::bignum::rshift [::math::bignum::mul $leftop $rightop] $shift]
01150 }
01151
01152
01153
01154
01155 ret ::math::bigfloat::isFloat (type x) {
01156 # a BigFloat is a list of : "F" mantissa exponent delta
01157 if {[llength $x]!=4} {
01158 return 0
01159 }
01160 # the marker is the letter "F"
01161 if {[string equal [lindex $x 0] F]} {
01162 return 1
01163 }
01164 return 0
01165 }
01166
01167
01168
01169
01170 ret ::math::bigfloat::isInt (type n) {
01171 if {[llength $n]>1} {
01172 return 0
01173 }
01174 # if {[string is digit $n]} {
01175 # return 1
01176 # }
01177 return 1
01178 }
01179
01180
01181
01182
01183
01184
01185 ret ::math::bigfloat::iszero (type x) {
01186 if {[isInt $x]} {
01187 return [expr {$x==0}]
01188 }
01189 checkFloat $x
01190 # now we do some interval rounding : if a number's interval englobs 0,
01191 # it is considered to be equal to zero
01192 foreach {dummy integer exp delta} $x {break}
01193 if {$delta>=abs($integer)} {return 1}
01194 return 0
01195 }
01196
01197
01198
01199
01200
01201 ret ::math::bigfloat::log (type x) {
01202 checkFloat $x
01203 foreach {dummy integer exp delta} $x {break}
01204 if {$integer<=0} {
01205 error "zero logarithm error"
01206 }
01207 if {[iszero $x]} {
01208 error "number equals zero"
01209 }
01210 set precision [bits $integer]
01211 # uncertainty of the logarithm
01212 set delta [_logOnePlusEpsilon $delta $integer $precision]
01213 incr delta
01214 # we got : x = 1xxxxxx (binary number with 'precision' bits) * 2^exp
01215 # we need : x = 0.1xxxxxx(binary) *2^(exp+precision)
01216 incr exp $precision
01217 foreach {integer deltaIncr} [_log $integer] {break}
01218 incr delta $deltaIncr
01219 # log(a * 2^exp)= log(a) + exp*log(2)
01220 # result = log(x) + exp*log(2)
01221 # as x<1 log(x)<0 but 'integer' (result of '_log') is the absolute value
01222 # that is why we substract $integer to log(2)*$exp
01223 set integer [expr {[_log2 $precision]*$exp-$integer}]
01224 incr delta [expr {abs($exp)}]
01225 return [normalize [list F $integer -$precision $delta]]
01226 }
01227
01228
01229
01230
01231
01232
01233
01234
01235
01236
01237
01238
01239
01240
01241
01242 ret ::math::bigfloat::_logOnePlusEpsilon (type epsNum , type epsDenom , type precision) {
01243 if {$epsNum>=$epsDenom} {
01244 error "number is null"
01245 }
01246 set s [expr {($epsNum<<$precision)/$epsDenom}]
01247 set divider 2
01248 set t [expr {$s*$epsNum/$epsDenom}]
01249 set u [expr {$t/$divider}]
01250 # when u (the current term of the development) is zero, we have reached our goal
01251 # it has converged
01252 while {$u!=0} {
01253 incr s $u
01254 # divider = order of the term = 'n'
01255 incr divider
01256 # t = (epsilon)^n
01257 set t [expr {$t*$epsNum/$epsDenom}]
01258 # u = t/n = (epsilon)^n/n and is the nth term of the Taylor development
01259 set u [expr {$t/$divider}]
01260 }
01261 return $s
01262 }
01263
01264
01265
01266
01267
01268 ret ::math::bigfloat::_log (type integer) {
01269 # the uncertainty is nbSteps with nbSteps<=nbBits
01270 # take nbSteps=nbBits (the worse case) and log(nbBits+increment)=increment
01271 set precision [bits $integer]
01272 set n [expr {int(log($precision+2*log($precision)))}]
01273 set integer [expr {$integer<<$n}]
01274 incr precision $n
01275 set delta 3
01276 # 1-epsilon=integer
01277 set integer [expr {(1<<$precision)-$integer}]
01278 set s $integer
01279 # t=x^2
01280 set t [expr {$integer*$integer>>$precision}]
01281 set denom 2
01282 # u=x^2/2 (second term)
01283 set u [expr {$t/$denom}]
01284 while {$u!=0} {
01285 # while the current term is not zero, it has not converged
01286 incr s $u
01287 incr delta
01288 # t=x^n
01289 set t [expr {$t*$integer>>$precision}]
01290 # denom = n (the order of the current development term)
01291 # u = x^n/n (the nth term of Taylor development)
01292 set u [expr {$t/[incr denom]}]
01293 }
01294 # shift right to restore the precision
01295 set delta
01296 return [list [expr {$s>>$n}] [expr {($delta>>$n)+1}]]
01297 }
01298
01299
01300
01301
01302
01303
01304
01305 ret ::math::bigfloat::__log (type num , type denom , type precision) {
01306 # Please Note : we here need a precision increment, in order to
01307 # keep accuracy at $precision digits. If we just hold $precision digits,
01308 # each number being precise at the last digit +/- 1,
01309 # we would lose accuracy because small uncertainties add to themselves.
01310 # Example : 0.0001 + 0.0010 = 0.0011 +/- 0.0002
01311 # This is quite the same reason that made tcl_precision defaults to 12 :
01312 # internally, doubles are computed with 17 digits, but to keep precision
01313 # we need to limit our results to 12.
01314 # The solution : given a precision target, increment precision with a
01315 # computed value so that all digits of he result are exacts.
01316 #
01317 # p is the precision
01318 # pk is the precision increment
01319 # 2 power pk is also the maximum number of iterations
01320 # for a number close to 1 but lower than 1,
01321 # (denom-num)/denum is (in our case) lower than 1/5
01322 # so the maximum nb of iterations is for:
01323 # 1/5*(1+1/5*(1/2+1/5*(1/3+1/5*(...))))
01324 # the last term is 1/n*(1/5)^n
01325 # for the last term to be lower than 2^(-p-pk)
01326 # the number of iterations has to be
01327 # 2^(-pk).(1/5)^(2^pk) < 2^(-p-pk)
01328 # log(1/5).2^pk < -p
01329 # 2^pk > p/log(5)
01330 # pk > log(2)*log(p/log(5))
01331 # now set the variable n to the precision increment i.e. pk
01332 set n [expr {int(log(2)*log($precision/log(5)))+1}]
01333 incr precision $n
01334 # log(num/denom)=log(1-(denom-num)/denom)
01335 # log(1+x) = x + x^2/2 + x^3/3 + ... + x^n/n
01336 # = x(1 + x(1/2 + x(1/3 + x(...+ x(1/(n-1) + x/n)...))))
01337 set num [expr {$denom-$num}]
01338 # $s holds the result
01339 set s [expr {($num<<$precision)/$denom}]
01340 # $t holds x^n
01341 set t [expr {$s*$num/$denom}]
01342 set d 2
01343 # $u holds x^n/n
01344 set u [expr {$t/$d}]
01345 while {$u!=0} {
01346 incr s $u
01347 # get x^n * x
01348 set t [expr {$t*$num/$denom}]
01349 # get n+1
01350 incr d
01351 # then : $u = x^(n+1)/(n+1)
01352 set u [expr {$t/$d}]
01353 }
01354 # see head of the proc : we return the value with its target precision
01355 return [expr {$s>>$n}]
01356 }
01357
01358
01359
01360
01361 ret ::math::bigfloat::__logbis (type precision) {
01362 set increment [expr {int(log($precision)/log(2)+1)}]
01363 incr precision $increment
01364 # ln(2)=3*ln(1-4/5)+ln(1-125/128)
01365 set a [__log 125 128 $precision]
01366 set b [__log 4 5 $precision]
01367 set r [expr {$b*3+$a}]
01368 set ::math::bigfloat::Log2 [expr {$r>>$increment}]
01369 # formerly (when BigFloats were stored in ten radix) we had to compute log(10)
01370 # ln(10)=10.ln(1-4/5)+3*ln(1-125/128)
01371 }
01372
01373
01374
01375
01376
01377 ret ::math::bigfloat::_log2 (type precision) {
01378 variable Log2
01379 if {![info exists Log2]} {
01380 __logbis $precision
01381 } else {
01382 # the constant is cached and computed again when more precision is needed
01383 set l [bits $Log2]
01384 if {$precision>$l} {
01385 __logbis $precision
01386 }
01387 }
01388 # return log(2) with 'precision' bits even when the cached value has more bits
01389 return [_round $Log2 $precision]
01390 }
01391
01392
01393
01394
01395
01396 ret ::math::bigfloat::mod (type a , type b) {
01397 checkNumber $a
01398 checkNumber $b
01399 if {[isInt $a] && [isInt $b]} {return [expr {$a%$b}]}
01400 if {[isInt $a]} {error "trying to divide an integer by a BigFloat"}
01401 set quotient [div $a $b]
01402 # examples : fmod(3,2)=1 quotient=1.5
01403 # fmod(1,2)=1 quotient=0.5
01404 # quotient>0 and b>0 : get floor(quotient)
01405 # fmod(-3,-2)=-1 quotient=1.5
01406 # fmod(-1,-2)=-1 quotient=0.5
01407 # quotient>0 and b<0 : get floor(quotient)
01408 # fmod(-3,2)=-1 quotient=-1.5
01409 # fmod(-1,2)=-1 quotient=-0.5
01410 # quotient<0 and b>0 : get ceil(quotient)
01411 # fmod(3,-2)=1 quotient=-1.5
01412 # fmod(1,-2)=1 quotient=-0.5
01413 # quotient<0 and b<0 : get ceil(quotient)
01414 if {[sign $quotient]} {
01415 set quotient [ceil $quotient]
01416 } else {
01417 set quotient [floor $quotient]
01418 }
01419 return [sub $a [mul $quotient $b]]
01420 }
01421
01422
01423
01424
01425 ret ::math::bigfloat::mul (type a , type b) {
01426 checkNumber $a
01427 checkNumber $b
01428 # dispatch the command to appropriate commands regarding types (BigInt & BigFloat)
01429 if {[isInt $a]} {
01430 if {[isInt $b]} {
01431 return [expr {$a*$b}]
01432 }
01433 return [mulFloatByInt $b $a]
01434 }
01435 if {[isInt $b]} {return [mulFloatByInt $a $b]}
01436 # now we are sure that 'a' and 'b' are BigFloats
01437 foreach {dummy integerA expA deltaA} $a {break}
01438 foreach {dummy integerB expB deltaB} $b {break}
01439 # 2^expA * 2^expB = 2^(expA+expB)
01440 set exp [expr {$expA+$expB}]
01441 # mantissas are multiplied
01442 set integer [expr {$integerA*$integerB}]
01443 # compute precisely the uncertainty
01444 set delta [expr {$deltaA*(abs($integerB)+$deltaB)+abs($integerA)*$deltaB+1}]
01445 # we have to normalize because 'delta' may be too big
01446 return [normalize [list F $integer $exp $delta]]
01447 }
01448
01449
01450
01451
01452 ret ::math::bigfloat::mulFloatByInt (type a , type b) {
01453 checkFloat $a
01454 foreach {dummy integer exp delta} $a {break}
01455 if {$b==0} {
01456 return [list F 0 $exp $delta]
01457 }
01458 # Mantissa and Delta are simply multplied by $b
01459 set integer [expr {$integer*$b}]
01460 set delta [expr {$delta*$b}]
01461 # We normalize because Delta could have seriously increased
01462 return [normalize [list F $integer $exp $delta]]
01463 }
01464
01465
01466
01467
01468
01469
01470
01471
01472 ret ::math::bigfloat::normalize (type number) {
01473 checkFloat $number
01474 foreach {dummy integer exp delta} $number {break}
01475 set l [bits $delta]
01476 if {$l>16} {
01477 incr l -16
01478 # $l holds the supplementary size (in bits)
01479 # now we can shift right by $l bits
01480 # always round upper the Delta
01481 set delta [expr {$delta>>$l}]
01482 incr delta
01483 set integer [expr {$integer>>$l}]
01484 incr exp $l
01485 }
01486 return [list F $integer $exp $delta]
01487 }
01488
01489
01490
01491
01492
01493
01494 ret ::math::bigfloat::opp (type a) {
01495 checkNumber $a
01496 if {[iszero $a]} {
01497 return $a
01498 }
01499 if {[isInt $a]} {
01500 return [expr {-$a}]
01501 }
01502 # recursive call
01503 lset a 1 [expr {-[lindex $a 1]}]
01504 return $a
01505 }
01506
01507
01508
01509
01510
01511 ret ::math::bigfloat::pi (type precision , optional binary =0) {
01512 if {![isInt $precision]} {
01513 error "'$precision' expected to be an integer"
01514 }
01515 if {!$binary} {
01516 # convert decimal digit length into bit length
01517 set precision [expr {int(ceil($precision*log(10)/log(2)))}]
01518 }
01519 return [list F [_pi $precision] -$precision 1]
01520 }
01521
01522
01523
01524
01525 ret ::math::bigfloat::reset () {
01526 variable _pi0
01527 if {[info exists _pi0]} {unset _pi0}
01528 }
01529
01530 ret ::math::bigfloat::_pi (type precision) {
01531 # the constant Pi begins with 3.xxx
01532 # so we need 2 digits to store the digit '3'
01533 # and then we will have precision+2 bits in the mantissa
01534 variable _pi0
01535 if {![info exists _pi0]} {
01536 set _pi0 [__pi $precision]
01537 }
01538 set lenPiGlobal [bits $_pi0]
01539 if {$lenPiGlobal<$precision} {
01540 set _pi0 [__pi $precision]
01541 }
01542 return [expr {$_pi0 >> [bits $_pi0]-2-$precision}]
01543 }
01544
01545
01546
01547
01548 ret ::math::bigfloat::__pi (type precision) {
01549 set safetyLimit 8
01550 # for safety and for the better precision, we do so ...
01551 incr precision $safetyLimit
01552 # formula found in the Math litterature (on Wikipedia
01553 # Pi/4 = 44.atan(1/57) + 7.atan(1/239) - 12.atan(1/682) + 24.atan(1/12943)
01554 set a [expr {[_atanfract 57 $precision]*44}]
01555 incr a [expr {[_atanfract 239 $precision]*7}]
01556 set a [expr {$a - [_atanfract 682 $precision]*12}]
01557 incr a [expr {[_atanfract 12943 $precision]*24}]
01558 return [expr {$a>>$safetyLimit-2}]
01559 }
01560
01561
01562
01563
01564
01565 ret ::math::bigfloat::_round (type integer , type precision) {
01566 set shift [expr {[bits $integer]-$precision}]
01567 if {$shift==0} {
01568 return $integer
01569 }
01570 # $result holds the shifted integer
01571 set result [expr {$integer>>$shift}]
01572 # $shift-1 is the bit just rights the last bit of the result
01573 # Example : integer=1000010 shift=2
01574 # => result=10000 and the tested bit is '1'
01575 if {$integer & (1<<($shift-1))} {
01576 # we round to the upper limit
01577 return [incr result]
01578 }
01579 return $result
01580 }
01581
01582
01583
01584
01585 ret ::math::bigfloat::pow (type a , type b) {
01586 checkNumber $a
01587 if {$b<0} {
01588 error "pow : exponent is not a positive integer"
01589 }
01590 # case where it is obvious that we should use the appropriate command
01591 # from math::bignum (added 5th March 2005)
01592 if {[isInt $a]} {
01593 return [expr {$a**$b}]
01594 }
01595 # algorithm : exponent=$b = Sum(i=0..n) b(i)2^i
01596 # $a^$b = $a^( b(0) + 2b(1) + 4b(2) + ... + 2^n*b(n) )
01597 # we have $a^(x+y)=$a^x * $a^y
01598 # then $a^$b = Product(i=0...n) $a^(2^i*b(i))
01599 # b(i) is boolean so $a^(2^i*b(i))= 1 when b(i)=0 and = $a^(2^i) when b(i)=1
01600 # then $a^$b = Product(i=0...n and b(i)=1) $a^(2^i) and 1 when $b=0
01601 if {$b==0} {return 1}
01602 # $res holds the result
01603 set res 1
01604 while {1} {
01605 # at the beginning i=0
01606 # $remainder is b(i)
01607 set remainder [expr {$b&1}]
01608 # $b 'rshift'ed by 1 bit : i=i+1
01609 # so next time we will test bit b(i+1)
01610 set b [expr {$b>>1}]
01611 # if b(i)=1
01612 if {$remainder} {
01613 # mul the result by $a^(2^i)
01614 # if i=0 we multiply by $a^(2^0)=$a^1=$a
01615 set res [mul $res $a]
01616 }
01617 # no more bits at '1' in $b : $res is the result
01618 if {$b==0} {
01619 return [normalize $res]
01620 }
01621 # i=i+1 : $a^(2^(i+1)) = square of $a^(2^i)
01622 set a [mul $a $a]
01623 }
01624 }
01625
01626
01627
01628
01629 ret ::math::bigfloat::rad2deg (type x) {
01630 checkFloat $x
01631 set xLen [expr {-[lindex $x 2]}]
01632 if {$xLen<3} {
01633 error "number too loose to convert to degrees"
01634 }
01635 # $rad/Pi=$deg/180
01636 # so result in deg = $radians*180/Pi
01637 return [div [mul $x 180] [pi $xLen 1]]
01638 }
01639
01640
01641
01642
01643 ret ::math::bigfloat::round (type number) {
01644 checkFloat $number
01645 #set number [normalize $number]
01646 # fetching integers (or BigInts) from the internal representation
01647 foreach {dummy integer exp delta} $number {break}
01648 if {$integer==0} {
01649 return 0
01650 }
01651 if {$exp>=0} {
01652 error "not enough precision to round (in round)"
01653 }
01654 set exp [expr {-$exp}]
01655 # saving the sign, ...
01656 set sign [expr {$integer<0}]
01657 set integer [expr {abs($integer)}]
01658 # integer part of the number
01659 set try [expr {$integer>>$exp}]
01660 # first bit after the dot
01661 set way [expr {$integer>>($exp-1)&1}]
01662 # delta is shifted so it gives the integer part of 2*delta
01663 set delta [expr {$delta>>($exp-1)}]
01664 # when delta is too big to compute rounded value (
01665 if {$delta!=0} {
01666 error "not enough precision to round (in round)"
01667 }
01668 if {$way} {
01669 incr try
01670 }
01671 # ... restore the sign now
01672 if {$sign} {return [expr {-$try}]}
01673 return $try
01674 }
01675
01676
01677
01678
01679 ret ::math::bigfloat::roundshift (type integer , type n) {
01680 # $exp= 10^$n
01681 incr n -1
01682 set exp [expr {10**$n}]
01683 set toround [expr {$integer/$exp}]
01684 if {$toround%10>=5} {
01685 return [expr {$toround/10+1}]
01686 }
01687 return [expr {$toround/10}]
01688 }
01689
01690
01691
01692
01693
01694 ret ::math::bigfloat::sign (type n) {
01695 if {[isInt $n]} {
01696 return [expr {$n<0}]
01697 }
01698 checkFloat $n
01699 # sign of 0=0
01700 if {[iszero $n]} {return 0}
01701 # the sign of the Mantissa, which is a BigInt
01702 return [sign [lindex $n 1]]
01703 }
01704
01705
01706
01707
01708
01709 ret ::math::bigfloat::sin (type x) {
01710 checkFloat $x
01711 foreach {dummy integer exp delta} $x {break}
01712 if {$exp>-2} {
01713 error "sin : not enough precision"
01714 }
01715 set precision [expr {-$exp}]
01716 # sin(2kPi+x)=sin(x)
01717 # $integer is now the modulo of the division of the mantissa by Pi/4
01718 # and $n is the quotient
01719 foreach {n integer} [divPiQuarter $integer $precision] {break}
01720 incr delta $n
01721 set d [expr {$n%4}]
01722 # now integer>=0
01723 # x = $n*Pi/4 + $integer and $n belongs to [0,3]
01724 # sin(2Pi-x)=-sin(x)
01725 # sin(Pi-x)=sin(x)
01726 # sin(Pi/2+x)=cos(x)
01727 set sign 0
01728 switch -- $d {
01729 0 {set l [_sin2 $integer $precision $delta]}
01730 1 {set l [_cos2 $integer $precision $delta]}
01731 2 {set sign 1;set l [_sin2 $integer $precision $delta]}
01732 3 {set sign 1;set l [_cos2 $integer $precision $delta]}
01733 default {error "internal error"}
01734 }
01735 # $l is a list : {Mantissa Precision Delta}
01736 # precision --> the opposite of the exponent
01737 # 1.000 = 1000*10^-3 so exponent=-3 and precision=3 digits
01738 lset l 1 [expr {-([lindex $l 1])}]
01739 # the sign depends on the switch statement below
01740 #::math::bignum::setsign integer $sign
01741 if {$sign} {
01742 lset l 0 [expr {-[lindex $l 0]}]
01743 }
01744 # we insert the Bigfloat tag (F) and normalize the final result
01745 return [normalize [linsert $l 0 F]]
01746 }
01747
01748 ret ::math::bigfloat::_sin2 (type x , type precision , type delta) {
01749 set pi [_pi $precision]
01750 # shift right by 1 = divide by 2
01751 # shift right by 2 = divide by 4
01752 set pis2 [expr {$pi>>1}]
01753 set pis4 [expr {$pis2>>1}]
01754 if {$x>=$pis4} {
01755 # sin(Pi/2-x)=cos(x)
01756 incr delta
01757 set x [expr {$pis2-$x}]
01758 return [_cos $x $precision $delta]
01759 }
01760 return [_sin $x $precision $delta]
01761 }
01762
01763
01764
01765
01766
01767
01768 ret ::math::bigfloat::_sin (type x , type precision , type delta) {
01769 # $s holds the result
01770 set s $x
01771 # sin(x) = x - x^3/3! + x^5/5! - ... + (-1)^n*x^(2n+1)/(2n+1)!
01772 # = x * (1 - x^2/(2*3) * (1 - x^2/(4*5) * (...* (1 - x^2/(2n*(2n+1)) )...)))
01773 # The second expression allows us to compute the less we can
01774
01775 # $double holds the uncertainty (Delta) of x^2 : 2*(Mantissa*Delta) + Delta^2
01776 # (Mantissa+Delta)^2=Mantissa^2 + 2*Mantissa*Delta + Delta^2
01777 set double [expr {$x*$delta>>$precision-1}]
01778 incr double [expr {1+$delta*$delta>>$precision}]
01779 # $x holds the Mantissa of x^2
01780 set x [expr {$x*$x>>$precision}]
01781 set dt [expr {$x*$delta+$double*($s+$delta)>>$precision}]
01782 incr dt
01783 # $t holds $s * -(x^2) / (2n*(2n+1))
01784 # mul by x^2
01785 set t [expr {$s*$x>>$precision}]
01786 set denom2 2
01787 set denom3 3
01788 # mul by -1 (opp) and divide by 2*3
01789 set t [expr {-$t/($denom2*$denom3)}]
01790 while {$t!=0} {
01791 incr s $t
01792 incr delta $dt
01793 # incr n => 2n --> 2n+2 and 2n+1 --> 2n+3
01794 incr denom2 2
01795 incr denom3 2
01796 # $dt is the Delta corresponding to $t
01797 # $double "" "" "" "" $x (x^2)
01798 # ($t+$dt) * ($x+$double) = $t*$x + ($dt*$x + $t*$double) + $dt*$double
01799 # Mantissa^ ^--------Delta-------------------^
01800 set dt [expr {$x*$dt+($t+$dt)*$double>>$precision}]
01801 set t [expr {$t*$x>>$precision}]
01802 # removed 2005/08/31 by sarnold75
01803 #set dt [::math::bignum::add $dt $double]
01804 set denom [expr {$denom2*$denom3}]
01805 # now computing : div by -2n(2n+1)
01806 set dt [expr {1+$dt/$denom}]
01807 set t [expr {-$t/$denom}]
01808 }
01809 return [list $s $precision $delta]
01810 }
01811
01812
01813
01814
01815
01816 ret ::math::bigfloat::sqrt (type x) {
01817 checkFloat $x
01818 foreach {dummy integer exp delta} $x {break}
01819 # if x=0, return 0
01820 if {[iszero $x]} {
01821 # return zero, taking care of its precision ($exp)
01822 return [list F 0 $exp $delta]
01823 }
01824 # we cannot get sqrt(x) if x<0
01825 if {[lindex $integer 0]<0} {
01826 error "negative sqrt input"
01827 }
01828 # (1+epsilon)^p = 1 + epsilon*(p-1) + epsilon^2*(p-1)*(p-2)/2! + ...
01829 # + epsilon^n*(p-1)*...*(p-n)/n!
01830 # sqrt(1 + epsilon) = (1 + epsilon)^(1/2)
01831 # = 1 - epsilon/2 - epsilon^2*3/(4*2!) - ...
01832 # - epsilon^n*(3*5*..*(2n-1))/(2^n*n!)
01833 # sqrt(1 - epsilon) = 1 + Sum(i=1..infinity) epsilon^i*(3*5*...*(2i-1))/(i!*2^i)
01834 # sqrt(n +/- delta)=sqrt(n) * sqrt(1 +/- delta/n)
01835 # so the uncertainty on sqrt(n +/- delta) equals sqrt(n) * (sqrt(1 - delta/n) - 1)
01836 # sqrt(1+eps) < sqrt(1-eps) because their logarithm compare as :
01837 # -ln(2)(1+eps) < -ln(2)(1-eps)
01838 # finally :
01839 # Delta = sqrt(n) * Sum(i=1..infinity) (delta/n)^i*(3*5*...*(2i-1))/(i!*2^i)
01840 # here we compute the second term of the product by _sqrtOnePlusEpsilon
01841 set delta [_sqrtOnePlusEpsilon $delta $integer]
01842 set intLen [bits $integer]
01843 # removed 2005/08/31 by sarnold75, readded 2005/08/31
01844 set precision $intLen
01845 # intLen + exp = number of bits before the dot
01846 #set precision [expr {-$exp}]
01847 # square root extraction
01848 set integer [expr {$integer<<$intLen}]
01849 incr exp -$intLen
01850 incr intLen $intLen
01851 # there is an exponent 2^$exp : when $exp is odd, we would need to compute sqrt(2)
01852 # so we decrement $exp, in order to get it even, and we do not need sqrt(2) anymore !
01853 if {$exp&1} {
01854 incr exp -1
01855 set integer [expr {$integer<<1}]
01856 incr intLen
01857 incr precision
01858 }
01859 # using a low-level (taken from math::bignum) root extraction procedure
01860 # using binary operators
01861 set integer [_sqrt $integer]
01862 # delta has to be multiplied by the square root
01863 set delta [expr {$delta*$integer>>$precision}]
01864 # round to the ceiling the uncertainty (worst precision, the fastest to compute)
01865 incr delta
01866 # we are sure that $exp is even, see above
01867 return [normalize [list F $integer [expr {$exp/2}] $delta]]
01868 }
01869
01870
01871
01872
01873
01874
01875
01876 ret ::math::bigfloat::_sqrtOnePlusEpsilon (type delta , type integer) {
01877 # sqrt(1-x) - 1 = x/2 + x^2*3/(2^2*2!) + x^3*3*5/(2^3*3!) + ...
01878 # = x/2 * (1 + x*3/(2*2) * ( 1 + x*5/(2*3) *
01879 # (...* (1 + x*(2n-1)/(2n) ) )...)))
01880 set l [bits $integer]
01881 # to compute delta/integer we have to shift left to keep the same precision level
01882 # we have a better accuracy computing (delta << lg(integer))/integer
01883 # than computing (delta/integer) << lg(integer)
01884 set x [expr {($delta<<$l)/$integer}]
01885 # denom holds 2n
01886 set denom 4
01887 # x/2
01888 set result [expr {$x>>1}]
01889 # x^2*3/(2!*2^2)
01890 # numerator holds 2n-1
01891 set numerator 3
01892 set temp [expr {($result*$delta*$numerator)/($integer*$denom)}]
01893 incr temp
01894 while {$temp!=0} {
01895 incr result $temp
01896 incr numerator 2
01897 incr denom 2
01898 # n = n+1 ==> num=num+2 denom=denom+2
01899 # num=2n+1 denom=2n+2
01900 set temp [expr {($temp*$delta*$numerator)/($integer*$denom)}]
01901 }
01902 return $result
01903 }
01904
01905
01906
01907
01908
01909 ret ::math::bigfloat::_sqrt (type n) {
01910 set i [expr {(([bits $n]-1)/2)+1}]
01911 set b [expr {$i*2}] ; # Bit to set to get 2^i*2^i
01912
01913 set r 0 ; # guess
01914 set x 0 ; # guess^2
01915 set s 0 ; # guess^2 backup
01916 set t 0 ; # intermediate result
01917 for {} {$i >= 0} {incr i -1; incr b -2} {
01918 set x [expr {$s+($t|(1<<$b))}]
01919 if {abs($x)<= abs($n)} {
01920 set s $x
01921 set r [expr {$r|(1<<$i)}]
01922 set t [expr {$t|(1<<$b+1)}]
01923 }
01924 set t [expr {$t>>1}]
01925 }
01926 return $r
01927 }
01928
01929
01930
01931
01932 ret ::math::bigfloat::sub (type a , type b) {
01933 checkNumber $a
01934 checkNumber $b
01935 if {[isInt $a] && [isInt $b]} {
01936 # the math::bignum::sub proc is designed to work with BigInts
01937 return [expr {$a-$b}]
01938 }
01939 return [add $a [opp $b]]
01940 }
01941
01942
01943
01944
01945 ret ::math::bigfloat::tan (type x) {
01946 return [::math::bigfloat::div [::math::bigfloat::sin $x] [::math::bigfloat::cos $x]]
01947 }
01948
01949
01950
01951
01952 ret ::math::bigfloat::tenPow (type n) {
01953 return [expr {10**$n}]
01954 }
01955
01956
01957
01958
01959
01960
01961 ret ::math::bigfloat::todouble (type x) {
01962 global tcl_precision
01963 set precision $tcl_precision
01964 if {$precision==0} {
01965 # this is a cheat, I must admit, for Tcl 8.5
01966 set precision 16
01967 }
01968 checkFloat $x
01969 # get the string repr of x without the '+' sign
01970 # please note: here we call math::bigfloat::tostr
01971 set result [string trimleft [tostr $x] +]
01972 set minus ""
01973 if {[string index $result 0]=="-"} {
01974 set minus -
01975 set result [string range $result 1 end]
01976 }
01977
01978 set l [split $result e]
01979 set exp 0
01980 if {[llength $l]==2} {
01981 # exp : x=Mantissa*2^Exp
01982 set exp [lindex $l 1]
01983 }
01984 # caution with octal numbers : we have to remove heading zeros
01985 # but count them as digits
01986 regexp {^0*} $result zeros
01987 incr exp -[string length $zeros]
01988 # Mantissa = integerPart.fractionalPart
01989 set l [split [lindex $l 0] .]
01990 set integerPart [lindex $l 0]
01991 set integerLen [string length $integerPart]
01992 set fractionalPart [lindex $l 1]
01993 # The number of digits in Mantissa, excluding the dot and the leading zeros, of course
01994 set integer [string trimleft $integerPart$fractionalPart 0]
01995 if {$integer==""} {
01996 set integer 0
01997 }
01998 set len [string length $integer]
01999 # Now Mantissa is stored in $integer
02000 if {$len>$tcl_precision} {
02001 set lenDiff [expr {$len-$tcl_precision}]
02002 # true when the number begins with a zero
02003 set zeroHead 0
02004 if {[string index $integer 0]==0} {
02005 incr lenDiff -1
02006 set zeroHead 1
02007 }
02008 set integer [roundshift $integer $lenDiff]
02009 if {$zeroHead} {
02010 set integer 0$integer
02011 }
02012 set len [string length $integer]
02013 if {$len<$integerLen} {
02014 set exp [expr {$integerLen-$len}]
02015 # restore the true length
02016 set integerLen $len
02017 }
02018 }
02019 # number = 'sign'*'integer'*10^'exp'
02020 if {$exp==0} {
02021 # no scientific notation
02022 set exp ""
02023 } else {
02024 # scientific notation
02025 set exp e$exp
02026 }
02027 # place the dot just before the index $integerLen in the Mantissa
02028 set result [string range $integer 0 [expr {$integerLen-1}]]
02029 append result .[string range $integer $integerLen end]
02030 # join the Mantissa with the sign before and the exponent after
02031 return $minus$result$exp
02032 }
02033
02034
02035
02036
02037 ret ::math::bigfloat::tostr (type number) {
02038 if {[isInt $number]} {
02039 return $number
02040 }
02041 checkFloat $number
02042 foreach {dummy integer exp delta} $number {break}
02043 if {[iszero $number]} {
02044 # we do matter how much precision $number has :
02045 # it can be 0.0000000 or 0.0, the result is not the same zero
02046 #return 0
02047 }
02048 if {$exp>0} {
02049 # the power of ten the closest but greater than 2^$exp
02050 # if it was lower than the power of 2, we would have more precision
02051 # than existing in the number
02052 set newExp [expr {int(ceil($exp*log(2)/log(10)))}]
02053 # 'integer' <- 'integer' * 2^exp / 10^newExp
02054 # equals 'integer' * 2^(exp-newExp) / 5^newExp
02055 set binExp [expr {$exp-$newExp}]
02056 if {$binExp<0} {
02057 # it cannot happen
02058 error "internal error"
02059 }
02060 # 5^newExp
02061 set fivePower [expr {5**$newExp}]
02062 # 'lshift'ing $integer by $binExp bits is like multiplying it by 2^$binExp
02063 # but much, much faster
02064 set integer [expr {($integer<<$binExp)/$fivePower}]
02065 # $integer is the Mantissa - Delta should follow the same operations
02066 set delta [expr {($delta<<$binExp)/$fivePower}]
02067 set exp $newExp
02068 } elseif {$exp<0} {
02069 # the power of ten the closest but lower than 2^$exp
02070 # same remark about the precision
02071 set newExp [expr {int(floor(-$exp*log(2)/log(10)))}]
02072 # 'integer' <- 'integer' * 10^newExp / 2^(-exp)
02073 # equals 'integer' * 5^(newExp) / 2^(-exp-newExp)
02074 set binShift [expr {-$exp-$newExp}]
02075 set fivePower [expr {5**$newExp}]
02076 # rshifting is like dividing by 2^$binShift, but faster as we said above about lshift
02077 set integer [expr {$integer*$fivePower>>$binShift}]
02078 set delta [expr {$delta*$fivePower>>$binShift}]
02079 set exp -$newExp
02080 }
02081 # saving the sign, to restore it into the result
02082 set result [expr {abs($integer)}]
02083 set sign [expr {$integer<0}]
02084 # rounded 'integer' +/- 'delta'
02085 set up [expr {$result+$delta}]
02086 set down [expr {$result-$delta}]
02087 if {($up<0 && $down>0)||($up>0 && $down<0)} {
02088 # $up>0 and $down<0 or vice-versa : then the number is considered equal to zero
02089 set isZero yes
02090 # delta <= 2**n (n = bits(delta))
02091 # 2**n <= 10**exp , then
02092 # exp >= n.log(2)/log(10)
02093 # delta <= 10**(n.log(2)/log(10))
02094 incr exp [expr {int(ceil([bits $delta]*log(2)/log(10)))}]
02095 set result 0
02096 } else {
02097 # iterate until the convergence of the rounding
02098 # we incr $shift until $up and $down are rounded to the same number
02099 # at each pass we lose one digit of precision, so necessarly it will success
02100 for {set shift 1} {
02101 [roundshift $up $shift]!=[roundshift $down $shift]
02102 } {
02103 incr shift
02104 } {}
02105 incr exp $shift
02106 set result [roundshift $up $shift]
02107 set isZero no
02108 }
02109 set l [string length $result]
02110 # now formatting the number the most nicely for having a clear reading
02111 # would'nt we allow a number being constantly displayed
02112 # as : 0.2947497845e+012 , would we ?
02113 if {$exp>0} {
02114 # we display 423*10^6 as : 4.23e+8
02115 # Length of mantissa : $l
02116 # Increment exp by $l-1 because the first digit is placed before the dot,
02117 # the other ($l-1) digits following the dot.
02118 incr exp [incr l -1]
02119 set result [string index $result 0].[string range $result 1 end]
02120 append result "e+$exp"
02121 } elseif {$exp==0} {
02122 # it must have a dot to be a floating-point number (syntaxically speaking)
02123 append result .
02124 } else {
02125 set exp [expr {-$exp}]
02126 if {$exp < $l} {
02127 # we can display the number nicely as xxxx.yyyy*
02128 # the problem of the sign is solved finally at the bottom of the proc
02129 set n [string range $result 0 end-$exp]
02130 incr exp -1
02131 append n .[string range $result end-$exp end]
02132 set result $n
02133 } elseif {$l==$exp} {
02134 # we avoid to use the scientific notation
02135 # because it is harder to read
02136 set result "0.$result"
02137 } else {
02138 # ... but here there is no choice, we should not represent a number
02139 # with more than one leading zero
02140 set result [string index $result 0].[string range $result 1 end]e-[expr {$exp-$l+1}]
02141 }
02142 }
02143 # restore the sign : we only put a minus on numbers that are different from zero
02144 if {$sign==1 && !$isZero} {set result "-$result"}
02145 return $result
02146 }
02147
02148
02149
02150
02151
02152
02153
02154
02155
02156 ret ::math::bigfloat::cosh (type x) {
02157 # cosh(x) = (exp(x)+exp(-x))/2
02158 # dividing by 2 is done faster by 'rshift'ing
02159 return [floatRShift [add [exp $x] [exp [opp $x]]] 1]
02160 }
02161
02162
02163
02164
02165 ret ::math::bigfloat::sinh (type x) {
02166 # sinh(x) = (exp(x)-exp(-x))/2
02167 # dividing by 2 is done faster by 'rshift'ing
02168 return [floatRShift [sub [exp $x] [exp [opp $x]]] 1]
02169 }
02170
02171
02172
02173
02174 ret ::math::bigfloat::tanh (type x) {
02175 set up [exp $x]
02176 set down [exp [opp $x]]
02177 # tanh(x)=sinh(x)/cosh(x)= (exp(x)-exp(-x))/2/ [(exp(x)+exp(-x))/2]
02178 # =(exp(x)-exp(-x))/(exp(x)+exp(-x))
02179 # =($up-$down)/($up+$down)
02180 return [div [sub $up $down] [add $up $down]]
02181 }
02182
02183
02184 namespace ::math::bigfloat {
02185 foreach function {
02186 add mul sub div mod pow
02187 iszero compare equal
02188 fromstr tostr fromdouble todouble
02189 int2float isInt isFloat
02190 exp log sqrt round ceil floor
02191 sin cos tan cotan asin acos atan
02192 cosh sinh tanh abs opp
02193 pi deg2rad rad2deg
02194 } {
02195 namespace export $function
02196 }
02197 }
02198
02199
02200
02201
02202 package provide math::bigfloat 2.0
02203