bigfloat2.tcl

Go to the documentation of this file.
00001 /* */
00002 /*  BigFloat for Tcl*/
00003 /*  Copyright (C) 2003-2005  ARNOLD Stephane*/
00004 /*  It is published with the terms of tcllib's BSD-style license.*/
00005 /*  See the file named license.terms.*/
00006 /* */
00007 
00008 package require Tcl 8.5
00009 
00010 /*  this line helps when I want to source this file again and again*/
00011 catch {namespace delete ::math::bigfloat}
00012 
00013 /*  private namespace*/
00014 /*  this software works only with Tcl v8.4 and higher*/
00015 /*  it is using the package math::bignum*/
00016 namespace ::math::bigfloat {
00017     /*  cached constants*/
00018     /*  ln(2) with arbitrary precision*/
00019     variable Log2
00020     /*  Pi with arb. precision*/
00021     variable Pi
00022     variable _pi0
00023 }
00024 
00025 
00026 
00027 
00028 /* */
00029 /*  procedures that handle floating-point numbers*/
00030 /*  these procedures are sorted by name (after eventually removing the underscores)*/
00031 /*  */
00032 /*  BigFloats are internally represented as a list :*/
00033 /*  {"F" Mantissa Exponent Delta} where "F" is a character which determins*/
00034 /*  the datatype, Mantissa and Delta are two big integers and Exponent another integer.*/
00035 /* */
00036 /*  The BigFloat value equals to (Mantissa +/- Delta)*2^Exponent*/
00037 /*  So the internal representation is binary, but trying to get as close as possible to*/
00038 /*  the decimal one when converted to a string.*/
00039 /*  When calling [fromstr], the Delta parameter is set to the value of 1 at the position*/
00040 /*  of the last decimal digit.*/
00041 /*  Example : 1.50 belongs to [1.49,1.51], but internally Delta may not equal to 1.*/
00042 /*  Because of the binary representation, it is between 1 and 1+(2^-15).*/
00043 /*  */
00044 /*  So Mantissa and Delta are not limited in size, but in practice Delta is kept under*/
00045 /*  2^32 by the 'normalize' procedure, to avoid a never-ended growth of memory used.*/
00046 /*  Indeed, when you perform some computations, the Delta parameter (which represent*/
00047 /*  the uncertainty on the value of the Mantissa) may increase.*/
00048 /*  Exponent, as an integer, is limited to 32 bits, and this limit seems fair.*/
00049 /*  The exponent is indeed involved in logarithmic computations, so it may be*/
00050 /*  a mistake to give it a too large value.*/
00051 
00052 /*  Retrieving the parameters of a BigFloat is often done with that command :*/
00053 /*  foreach {dummy int exp delta} $bigfloat {break}*/
00054 /*  (dummy is not used, it is just used to get the "F" marker).*/
00055 /*  The isInt, isFloat, checkNumber and checkFloat procedures are used*/
00056 /*  to check data types*/
00057 /* */
00058 /*  Taylor development are often used to compute the analysis functions (like exp(),log()...)*/
00059 /*  To learn how it is done in practice, take a look at ::math::bigfloat::_asin*/
00060 /*  While doing computation on Mantissas, we do not care about the last digit,*/
00061 /*  because if we compute correctly Deltas, the digits that remain will be exact.*/
00062 /* */
00063 
00064 
00065 /* */
00066 /*  returns the absolute value*/
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 /*  arccosinus of a BigFloat*/
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 /*  returns A + B*/
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 /*  returns the sum A(BigFloat) + B(BigInt)*/
00180 /*  the greatest advantage of this method is that the uncertainty*/
00181 /*  of the result remains unchanged, in respect to the entry's uncertainty (deltaA)*/
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 /*  arcsinus of a BigFloat*/
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 /*  _asin : arcsinus of numbers between 0 and +1*/
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 /*  arctangent : returns atan(x)*/
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 /*  compute atan(1/integer) at a given precision*/
00437 /*  this proc is only used to compute Pi*/
00438 /*  it is using the same Taylor development as [atan]*/
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 /*  bits : computes the number of bits of an integer, approx.*/
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 /*  returns the integer part of a BigFloat, as a BigInt*/
00510 /*  the result is the same one you would have*/
00511 /*  if you had called [expr {ceil($x)}]*/
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 /*  checks each variable to be a BigFloat*/
00541 /*  arguments : each argument is the name of a variable to be checked*/
00542 /* */
00543 ret  ::math::bigfloat::checkFloat (type number) {
00544     if {![isFloat $number]} {
00545         error "BigFloat expected"
00546     }
00547 }
00548 
00549 /* */
00550 /*  checks if each number is either a BigFloat or a BigInt*/
00551 /*  arguments : each argument is the name of a variable to be checked*/
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 /*  returns 0 if A and B are equal, else returns 1 or -1*/
00562 /*  accordingly to the sign of (A - B)*/
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 /*  gets cos(x)*/
00582 /*  throws an error if there is not enough precision on the input*/
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 /*  compute cos(x) where 0<=x<Pi/2*/
00621 /*  returns : a list formed with :*/
00622 /*  1. the mantissa*/
00623 /*  2. the precision (opposite of the exponent)*/
00624 /*  3. the uncertainty (doubt range)*/
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 /*  compute cos(x) where 0<=x<Pi/4*/
00643 /*  returns : a list formed with :*/
00644 /*  1. the mantissa*/
00645 /*  2. the precision (opposite of the exponent)*/
00646 /*  3. the uncertainty (doubt range)*/
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 /*  cotangent : the trivial algorithm is used*/
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 /*  converts angles from degrees to radians*/
00688 /*  deg/180=rad/Pi*/
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 /*  private proc to get : x modulo Pi/2*/
00704 /*  and the quotient (x divided by Pi/2)*/
00705 /*  used by cos , sin & others*/
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 /*  divide A by B and returns the result*/
00730 /*  throw error : divide by zero*/
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 /*  divide a BigFloat A by a BigInt B*/
00791 /*  throw error : divide by zero*/
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 /*  returns 1 if A and B are equal, 0 otherwise*/
00822 /*  IN : a, b (BigFloats)*/
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 /*  returns exp(X) where X is a BigFloat*/
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 /*  private procedure to compute exponentials*/
00906 /*  using Taylor development of exp(x) :*/
00907 /*  exp(x)=1+ x + x^2/2 + x^3/3! +...+x^n/n!*/
00908 /*  input : integer (the mantissa)*/
00909 /*          precision (the number of decimals)*/
00910 /*          delta (the doubt limit, or uncertainty)*/
00911 /*  returns a list : 1. the mantissa of the result*/
00912 /*                   2. the doubt limit, or uncertainty*/
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 /*  divide a BigFloat by 2 power 'n'*/
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 /*  procedure floor : identical to [expr floor($x)] in functionality*/
00952 /*  arguments : number IN (a BigFloat)*/
00953 /*  returns : the floor value as a BigInt*/
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 /*  returns a list formed by an integer and an exponent*/
00980 /*  x = (A +/- C) * 10 power B*/
00981 /*  return [list "F" A B C] (where F is the BigFloat tag)*/
00982 /*  A and C are BigInts, B is a raw integer*/
00983 /*  return also a BigInt when there is neither a dot, nor a 'e' exponent*/
00984 /* */
00985 /*  arguments : -base base integer*/
00986 /*           or integer*/
00987 /*           or float*/
00988 /*           or float trailingZeros*/
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 /*  private procedure to transform decimal floats into binary ones*/
01064 /*  IN :*/
01065 /*      - number : a BigInt representing the Mantissa*/
01066 /*      - exp : the decimal exponent (a simple integer)*/
01067 /*  OUT :*/
01068 /*      $number * 10^$exp, as the internal binary representation of a BigFloat*/
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 /*  fromdouble :*/
01105 /*  like fromstr, but for a double scalar value*/
01106 /*  arguments :*/
01107 /*  double - the number to convert to a BigFloat*/
01108 /*  exp (optional) - the total number of digits*/
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         /*  tests have failed : not enough precision or no exp argument*/
01119         return [fromstr $double]
01120     }
01121 }
01122 
01123 
01124 /* */
01125 /*  converts a BigInt into a BigFloat with a given decimal precision*/
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 /*  multiplies 'leftop' by 'rightop' and rshift the result by 'shift'*/
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 /*  returns 1 if x is a BigFloat, 0 elsewhere*/
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 /*  checks that n is a BigInt (a number create by math::bignum::fromstr)*/
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 /*  returns 1 if x is null, 0 otherwise*/
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 /*  compute log(X)*/
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 /*  compute log(1-epsNum/epsDenom)=log(1-'epsilon')*/
01231 /*  Taylor development gives -x -x^2/2 -x^3/3 -x^4/4 ...*/
01232 /*  used by 'log' command because log(x+/-epsilon)=log(x)+log(1+/-(epsilon/x))*/
01233 /*  so the uncertainty equals abs(log(1-epsilon/x))*/
01234 /*  ================================================*/
01235 /*  arguments :*/
01236 /*  epsNum IN (the numerator of epsilon)*/
01237 /*  epsDenom IN (the denominator of epsilon)*/
01238 /*  precision IN (the number of bits after the dot)*/
01239 /* */
01240 /*  'epsilon' = epsNum*2^-precision/epsDenom*/
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 /*  compute log(0.xxxxxxxx) : log(1-epsilon)=-eps-eps^2/2-eps^3/3...-eps^n/n*/
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 /*  computes log(num/denom) with 'precision' bits*/
01301 /*  used to compute some analysis constants with a given accuracy*/
01302 /*  you might not call this procedure directly : it assumes 'num/denom'>4/5*/
01303 /*  and 'num/denom'<1*/
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 /*  computes log(2) with 'precision' bits and caches it into a namespace variable*/
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 /*  retrieves log(2) with 'precision' bits ; the result is cached*/
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 /*  returns A modulo B (like with fmod() math function)*/
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 /*  returns A times B*/
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 /*  returns A times B, where B is a positive integer*/
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 /*  normalizes a number : Delta (accuracy of the BigFloat)*/
01467 /*  has to be limited, because the memory use increase*/
01468 /*  quickly when we do some computations, as the Mantissa and Delta*/
01469 /*  increase together*/
01470 /*  The solution : limit the size of Delta to 16 bits*/
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 /*  returns -A (the opposite)*/
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 /*  gets Pi with precision bits*/
01509 /*  after the dot (after you call [tostr] on the result)*/
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 /*  Procedure that resets the stored cached Pi constant*/
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 /*  computes an integer representing Pi in binary radix, with precision bits*/
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 /*  shift right an integer until it haves $precision bits*/
01563 /*  round at the same time*/
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 /*  returns A power B, where B is a positive integer*/
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 /*  converts angles for radians to degrees*/
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 /*  retourne la partie entière (ou 0) du nombre "number"*/
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 /*  round and divide by 10^n*/
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 /*  gets the sign of either a bignum, or a BitFloat*/
01692 /*  we keep the bignum convention : 0 for positive, 1 for negative*/
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 /*  gets sin(x)*/
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 /*  sin(x) with 'x' lower than Pi/4 and positive*/
01765 /*  'x' is the Mantissa - 'delta' is Delta*/
01766 /*  'precision' is the opposite of the exponent*/
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 /*  procedure for extracting the square root of a BigFloat*/
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 /*  compute abs(sqrt(1-delta/integer)-1)*/
01874 /*  the returned value is a relative uncertainty*/
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 /*  Computes the square root of an integer*/
01907 /*  Returns an integer*/
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 /*  substracts B to A*/
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 /*  tangent (trivial algorithm)*/
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 /*  returns a power of ten*/
01951 /* */
01952 ret  ::math::bigfloat::tenPow (type n) {
01953     return [expr {10**$n}]
01954 }
01955 
01956 
01957 /* */
01958 /*  converts a BigInt to a double (basic floating-point type)*/
01959 /*  with respect to the global variable 'tcl_precision'*/
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 /*  converts a number stored as a list to a string in which all digits are true*/
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 /*  PART IV*/
02150 /*  HYPERBOLIC FUNCTIONS*/
02151 /* */
02152 
02153 /* */
02154 /*  hyperbolic cosinus*/
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 /*  hyperbolic sinus*/
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 /*  hyperbolic tangent*/
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 /*  exporting public interface*/
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 /*  (AM) No "namespace import" - this should be left to the user!*/
02200 /* namespace import ::math::bigfloat::**/
02201 
02202 package provide math::bigfloat 2.0
02203 

Generated on 21 Sep 2010 for Gui by  doxygen 1.6.1