1########################################################################
2# BigFloat for Tcl
3# Copyright (C) 2003-2005  ARNOLD Stephane
4#
5# BIGFLOAT LICENSE TERMS
6#
7# This software is copyrighted by Stephane ARNOLD, (stephanearnold <at> yahoo.fr).
8# The following terms apply to all files associated
9# with the software unless explicitly disclaimed in individual files.
10#
11# The authors hereby grant permission to use, copy, modify, distribute,
12# and license this software and its documentation for any purpose, provided
13# that existing copyright notices are retained in all copies and that this
14# notice is included verbatim in any distributions. No written agreement,
15# license, or royalty fee is required for any of the authorized uses.
16# Modifications to this software may be copyrighted by their authors
17# and need not follow the licensing terms described here, provided that
18# the new terms are clearly indicated on the first page of each file where
19# they apply.
20#
21# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
22# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
23# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
24# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
25# POSSIBILITY OF SUCH DAMAGE.
26#
27# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
28# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
29# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
30# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
31# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
32# MODIFICATIONS.
33#
34# GOVERNMENT USE: If you are acquiring this software on behalf of the
35# U.S. government, the Government shall have only "Restricted Rights"
36# in the software and related documentation as defined in the Federal
37# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
38# are acquiring the software on behalf of the Department of Defense, the
39# software shall be classified as "Commercial Computer Software" and the
40# Government shall have only "Restricted Rights" as defined in Clause
41# 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
42# authors grant the U.S. Government and others acting in its behalf
43# permission to use and distribute the software in accordance with the
44# terms specified in this license.
45#
46########################################################################
47
48package require Tcl 8.4
49package require math::bignum
50
51# this line helps when I want to source this file again and again
52catch {namespace delete ::math::bigfloat}
53
54# private namespace
55# this software works only with Tcl v8.4 and higher
56# it is using the package math::bignum
57namespace eval ::math::bigfloat {
58    # cached constants
59    # ln(2) with arbitrary precision
60    variable Log2
61    # Pi with arb. precision
62    variable Pi
63    variable _pi0
64    # some constants (bignums) : {0 1 2 3 4 5 10}
65    variable zero
66    set zero [::math::bignum::fromstr 0]
67    variable one
68    set one [::math::bignum::fromstr 1]
69    variable two
70    set two [::math::bignum::fromstr 2]
71    variable three
72    set three [::math::bignum::fromstr 3]
73    variable four
74    set four [::math::bignum::fromstr 4]
75    variable five
76    set five [::math::bignum::fromstr 5]
77    variable ten
78    set ten [::math::bignum::fromstr 10]
79}
80
81
82
83
84################################################################################
85# procedures that handle floating-point numbers
86# these procedures are sorted by name (after eventually removing the underscores)
87#
88# BigFloats are internally represented as a list :
89# {"F" Mantissa Exponent Delta} where "F" is a character which determins
90# the datatype, Mantissa and Delta are two Big integers and Exponent a raw integer.
91#
92# The BigFloat value equals to (Mantissa +/- Delta)*2^Exponent
93# So the internal representation is binary, but trying to get as close as possible to
94# the decimal one.
95# When calling fromstr, the Delta parameter is set to the value of the last decimal digit.
96# Example : 1.50 belongs to [1.49,1.51], but internally Delta is probably not equal to 1,
97# because of the binary representation.
98#
99# So Mantissa and Delta are not limited in size, but in practice Delta is kept under
100# 2^32 by the 'normalize' procedure, to avoid a never-ended growth of memory used.
101# Indeed, when you perform some computations, the Delta parameter (which represent
102# the uncertainty on the value of the Mantissa) may increase.
103# Exponent, as a classic integer, is limited to the interval [-2147483648,2147483647]
104
105# Retrieving the parameters of a BigFloat is often done with that command :
106# foreach {dummy int exp delta} $bigfloat {break}
107# (dummy is not used, it is just used to get the "F" marker).
108# The isInt, isFloat, checkNumber and checkFloat procedures are used
109# to check data types
110#
111# Taylor development are often used to compute the analysis functions (like exp(),log()...)
112# To learn how it is done in practice, take a look at ::math::bigfloat::_asin
113# While doing computation on Mantissas, we do not care about the last digit,
114# because if we compute wisely Deltas, the digits that remain will be exact.
115################################################################################
116
117
118################################################################################
119# returns the absolute value
120################################################################################
121proc ::math::bigfloat::abs {number} {
122    checkNumber number
123    if {[isInt $number]} {
124        # set sign to positive for a BigInt
125        return [::math::bignum::abs $number]
126    }
127    # set sign to positive for a BigFloat into the Mantissa (index 1)
128    lset number 1 [::math::bignum::abs [lindex $number 1]]
129    return $number
130}
131
132
133################################################################################
134# arccosinus of a BigFloat
135################################################################################
136proc ::math::bigfloat::acos {x} {
137    # handy proc for checking datatype
138    checkFloat x
139    foreach {dummy entier exp delta} $x {break}
140    set precision [expr {($exp<0)?(-$exp):1}]
141    # acos(0.0)=Pi/2
142    # 26/07/2005 : changed precision from decimal to binary
143    # with the second parameter of pi command
144    set piOverTwo [floatRShift [pi $precision 1]]
145    if {[iszero $x]} {
146        # $x is too close to zero -> acos(0)=PI/2
147        return $piOverTwo
148    }
149    # acos(-x)= Pi/2 + asin(x)
150    if {[::math::bignum::sign $entier]} {
151        return [add $piOverTwo [asin [abs $x]]]
152    }
153    # we always use _asin to compute the result
154    # but as it is a Taylor development, the value given to [_asin]
155    # has to be a bit smaller than 1 ; by using that trick : acos(x)=asin(sqrt(1-x^2))
156    # we can limit the entry of the Taylor development below 1/sqrt(2)
157    if {[compare $x [fromstr 0.7071]]>0} {
158        # x > sqrt(2)/2 : trying to make _asin converge quickly
159        # creating 0 and 1 with the same precision as the entry
160        variable one
161        variable zero
162        set fzero [list F $zero -$precision $one]
163        set fone [list F [::math::bignum::lshift 1 $precision] \
164                -$precision $one]
165        # when $x is close to 1 (acos(1.0)=0.0)
166        if {[equal $fone $x]} {
167            return $fzero
168        }
169        if {[compare $fone $x]<0} {
170            # the behavior assumed because acos(x) is not defined
171            # when |x|>1
172            error "acos on a number greater than 1"
173        }
174        # acos(x) = asin(sqrt(1 - x^2))
175        # since 1 - cos(x)^2 = sin(x)^2
176        # x> sqrt(2)/2 so x^2 > 1/2 so 1-x^2<1/2
177        set x [sqrt [sub $fone [mul $x $x]]]
178        # the parameter named x is smaller than sqrt(2)/2
179        return [_asin $x]
180    }
181    # acos(x) = Pi/2 - asin(x)
182    # x<sqrt(2)/2 here too
183    return [sub $piOverTwo [_asin $x]]
184}
185
186
187################################################################################
188# returns A + B
189################################################################################
190proc ::math::bigfloat::add {a b} {
191    checkNumber a b
192    if {[isInt $a]} {
193        if {[isInt $b]} {
194            # intAdd adds two BigInts
195            return [::math::bignum::add $a $b]
196        }
197        # adds the BigInt a to the BigFloat b
198        return [addInt2Float $b $a]
199    }
200    if {[isInt $b]} {
201        # ... and vice-versa
202        return [addInt2Float $a $b]
203    }
204    # retrieving parameters from A and B
205    foreach {dummy integerA expA deltaA} $a {break}
206    foreach {dummy integerB expB deltaB} $b {break}
207    # when we add two numbers which have different digit numbers (after the dot)
208    # for example : 1.0 and 0.00001
209    # We promote the one with the less number of digits (1.0) to the same level as
210    # the other : so 1.00000.
211    # that is why we shift left the number which has the greater exponent
212    # But we do not forget the Delta parameter, which is lshift'ed too.
213    if {$expA>$expB} {
214        set diff [expr {$expA-$expB}]
215        set integerA [::math::bignum::lshift $integerA $diff]
216        set deltaA [::math::bignum::lshift $deltaA $diff]
217        set integerA [::math::bignum::add $integerA $integerB]
218        set deltaA [::math::bignum::add $deltaA $deltaB]
219        return [normalize [list F $integerA $expB $deltaA]]
220    } elseif {$expA==$expB} {
221        # nothing to shift left
222        return [normalize [list F [::math::bignum::add $integerA $integerB] \
223                $expA [::math::bignum::add $deltaA $deltaB]]]
224    } else {
225        set diff [expr {$expB-$expA}]
226        set integerB [::math::bignum::lshift $integerB $diff]
227        set deltaB [::math::bignum::lshift $deltaB $diff]
228        set integerB [::math::bignum::add $integerA $integerB]
229        set deltaB [::math::bignum::add $deltaB $deltaA]
230        return [normalize [list F $integerB $expA $deltaB]]
231    }
232}
233
234################################################################################
235# returns the sum A(BigFloat) + B(BigInt)
236# the greatest advantage of this method is that the uncertainty
237# of the result remains unchanged, in respect to the entry's uncertainty (deltaA)
238################################################################################
239proc ::math::bigfloat::addInt2Float {a b} {
240    # type checking
241    checkFloat a
242    if {![isInt $b]} {
243        error "'$b' is not a BigInt"
244    }
245    # retrieving data from $a
246    foreach {dummy integerA expA deltaA} $a {break}
247    # to add an int to a BigFloat,...
248    if {$expA>0} {
249        # we have to put the integer integerA
250        # to the level of zero exponent : 1e8 --> 100000000e0
251        set shift $expA
252        set integerA [::math::bignum::lshift $integerA $shift]
253        set deltaA [::math::bignum::lshift $deltaA $shift]
254        set integerA [::math::bignum::add $integerA $b]
255        # we have to normalize, because we have shifted the mantissa
256        # and the uncertainty left
257        return [normalize [list F $integerA 0 $deltaA]]
258    } elseif {$expA==0} {
259        # integerA is already at integer level : float=(integerA)e0
260        return [normalize [list F [::math::bignum::add $integerA $b] \
261                0 $deltaA]]
262    } else {
263        # here we have something like 234e-2 + 3
264        # we have to shift the integer left by the exponent |$expA|
265        set b [::math::bignum::lshift $b [expr {-$expA}]]
266        set integerA [::math::bignum::add $integerA $b]
267        return [normalize [list F $integerA $expA $deltaA]]
268    }
269}
270
271
272################################################################################
273# arcsinus of a BigFloat
274################################################################################
275proc ::math::bigfloat::asin {x} {
276    # type checking
277    checkFloat x
278    foreach {dummy entier exp delta} $x {break}
279    if {$exp>-1} {
280        error "not enough precision on input (asin)"
281    }
282    set precision [expr {-$exp}]
283    # when x=0, return 0 at the same precision as the input was
284    if {[iszero $x]} {
285        variable one
286        variable zero
287        return [list F $zero -$precision $one]
288    }
289    # asin(-x)=-asin(x)
290    if {[::math::bignum::sign $entier]} {
291        return [opp [asin [abs $x]]]
292    }
293    # 26/07/2005 : changed precision from decimal to binary
294    set piOverTwo [floatRShift [pi $precision 1]]
295    # now a little trick : asin(x)=Pi/2-asin(sqrt(1-x^2))
296    # so we can limit the entry of the Taylor development
297    # to 1/sqrt(2)~0.7071
298    # the comparison is : if x>0.7071 then ...
299    if {[compare $x [fromstr 0.7071]]>0} {
300        variable one
301        set fone [list F [::math::bignum::lshift 1 $precision] \
302                -$precision $one]
303        # asin(1)=Pi/2 (with the same precision as the entry has)
304        if {[equal $fone $x]} {
305            return $piOverTwo
306        }
307        if {[compare $x $fone]>0} {
308            error "asin on a number greater than 1"
309        }
310        # asin(x)=Pi/2-asin(sqrt(1-x^2))
311        set x [sqrt [sub $fone [mul $x $x]]]
312        return [sub $piOverTwo [_asin $x]]
313    }
314    return [normalize [_asin $x]]
315}
316
317################################################################################
318# _asin : arcsinus of numbers between 0 and +1
319################################################################################
320proc ::math::bigfloat::_asin {x} {
321    # Taylor development
322    # asin(x)=x + 1/2 x^3/3 + 3/2.4 x^5/5 + 3.5/2.4.6 x^7/7 + ...
323    # into this iterative form :
324    # asin(x)=x * (1 + 1/2 * x^2 * (1/3 + 3/4 *x^2 * (...
325    # ...* (1/(2n-1) + (2n-1)/2n * x^2 / (2n+1))...)))
326    # we show how is really computed the development :
327    # we don't need to set a var with x^n or a product of integers
328    # all we need is : x^2, 2n-1, 2n, 2n+1 and a few variables
329    foreach {dummy mantissa exp delta} $x {break}
330    set precision [expr {-$exp}]
331    if {$precision+1<[::math::bignum::bits $mantissa]} {
332        error "sinus greater than 1"
333    }
334    # precision is the number of after-dot digits
335    set result $mantissa
336    set delta_final $delta
337    # resultat is the final result, and delta_final
338    # will contain the uncertainty of the result
339    # square is the square of the mantissa
340    set square [intMulShift $mantissa $mantissa $precision]
341    # dt is the uncertainty of Mantissa
342    set dt [::math::bignum::add 1 [intMulShift $mantissa $delta [expr {$precision-1}]]]
343    # these three are required to compute the fractions implicated into
344    # the development (of Taylor, see former)
345    variable one
346    set num $one
347    # two will be used into the loop
348    variable two
349    variable three
350    set i $three
351    set denom $two
352    # the nth factor equals : $num/$denom* $mantissa/$i
353    set delta [::math::bignum::add [::math::bignum::mul $delta $square] \
354            [::math::bignum::mul $dt [::math::bignum::add $delta $mantissa]]]
355    set delta [::math::bignum::add 1 [::math::bignum::rshift [::math::bignum::div \
356            [::math::bignum::mul $delta $num] $denom] $precision]]
357    # we do not multiply the Mantissa by $num right now because it is 1 !
358    # but we have Mantissa=$x
359    # and we want Mantissa*$x^2 * $num / $denom / $i
360    set mantissa [intMulShift $mantissa $square $precision]
361    set mantissa [::math::bignum::div $mantissa $denom]
362    # do not forget the modified Taylor development :
363    # asin(x)=x * (1 + 1/2*x^2*(1/3 + 3/4*x^2*(...*(1/(2n-1) + (2n-1)/2n*x^2/(2n+1))...)))
364    # all we need is : x^2, 2n-1, 2n, 2n+1 and a few variables
365    # $num=2n-1 $denom=2n $square=x^2 and $i=2n+1
366    set mantissa_temp [::math::bignum::div $mantissa $i]
367    set delta_temp [::math::bignum::add 1 [::math::bignum::div $delta $i]]
368    # when the Mantissa increment is smaller than the Delta increment,
369    # we would not get much precision by continuing the development
370    while {![::math::bignum::iszero $mantissa_temp]} {
371        # Mantissa = Mantissa * $num/$denom * $square
372        # Add Mantissa/$i, which is stored in $mantissa_temp, to the result
373        set result [::math::bignum::add $result $mantissa_temp]
374        set delta_final [::math::bignum::add $delta_final $delta_temp]
375        # here we have $two instead of [fromstr 2] (optimization)
376        # num=num+2,i=i+2,denom=denom+2
377        # because num=2n-1 denom=2n and i=2n+1
378        set num [::math::bignum::add $num $two]
379        set i [::math::bignum::add $i $two]
380        set denom [::math::bignum::add $denom $two]
381        # computes precisly the future Delta parameter
382        set delta [::math::bignum::add [::math::bignum::mul $delta $square] \
383                [::math::bignum::mul $dt [::math::bignum::add $delta $mantissa]]]
384        set delta [::math::bignum::add 1 [::math::bignum::rshift [::math::bignum::div \
385                [::math::bignum::mul $delta $num] $denom] $precision]]
386        set mantissa [intMulShift $mantissa $square $precision]
387        set mantissa [::math::bignum::div [::math::bignum::mul $mantissa $num] $denom]
388        set mantissa_temp [::math::bignum::div $mantissa $i]
389        set delta_temp [::math::bignum::add 1 [::math::bignum::div $delta $i]]
390    }
391    return [list F $result $exp $delta_final]
392}
393
394################################################################################
395# arctangent : returns atan(x)
396################################################################################
397proc ::math::bigfloat::atan {x} {
398    checkFloat x
399    variable one
400    variable two
401    variable three
402    variable four
403    variable zero
404    foreach {dummy mantissa exp delta} $x {break}
405    if {$exp>=0} {
406        error "not enough precision to compute atan"
407    }
408    set precision [expr {-$exp}]
409    # atan(0)=0
410    if {[iszero $x]} {
411        return [list F $zero -$precision $one]
412    }
413    # atan(-x)=-atan(x)
414    if {[::math::bignum::sign $mantissa]} {
415        return [opp [atan [abs $x]]]
416    }
417    # now x is strictly positive
418    # at this moment, we are trying to limit |x| to a fair acceptable number
419    # to ensure that Taylor development will converge quickly
420    set float1 [list F [::math::bignum::lshift 1 $precision] -$precision $one]
421    if {[compare $float1 $x]<0} {
422        # compare x to 2.4142
423        if {[compare $x [fromstr 2.4142]]<0} {
424            # atan(x)=Pi/4 + atan((x-1)/(x+1))
425            # as 1<x<2.4142 : (x-1)/(x+1)=1-2/(x+1) belongs to
426            # the range :  ]0,1-2/3.414[
427            # that equals  ]0,0.414[
428            set pi_sur_quatre [div [pi $precision 1] $four]
429            return [add $pi_sur_quatre [atan \
430                    [div [sub $x $float1] [add $x $float1]]]]
431        }
432        # atan(x)=Pi/2-atan(1/x)
433        # 1/x < 1/2.414 so the argument is lower than 0.414
434        set pi_over_two [div [pi $precision 1] $two]
435        return [sub $pi_over_two [atan [div $float1 $x]]]
436    }
437    if {[compare $x [fromstr 0.4142]]>0} {
438        # atan(x)=Pi/4 + atan((x-1)/(x+1))
439        # x>0.420 so (x-1)/(x+1)=1 - 2/(x+1) > 1-2/1.414
440        #                                    > -0.414
441        # x<1 so (x-1)/(x+1)<0
442        set pi_sur_quatre [div [pi $precision 1] $four]
443        return [add $pi_sur_quatre [atan \
444                [div [sub $x $float1] [add $x $float1]]]]
445    }
446    # precision increment : to have less uncertainty
447    # we add a little more precision so that the result would be more accurate
448    # Taylor development : x - x^3/3 + x^5/5 - ... + (-1)^(n+1)*x^(2n-1)/(2n-1)
449    # when we have n steps in Taylor development : the nth term is :
450    # x^(2n-1)/(2n-1)
451    # and the loss of precision is of 2n (n sums and n divisions)
452    # this command is called with x<sqrt(2)-1
453    # if we add an increment to the precision, say n:
454    # (sqrt(2)-1)^(2n-1)/(2n-1) has to be lower than 2^(-precision-n-1)
455    # (2n-1)*log(sqrt(2)-1)-log(2n-1)<-(precision+n+1)*log(2)
456    # 2n(log(sqrt(2)-1)-log(sqrt(2)))<-(precision-1)*log(2)+log(2n-1)+log(sqrt(2)-1)
457    # 2n*log(1-1/sqrt(2))<-(precision-1)*log(2)+log(2n-1)+log(2)/2
458    # 2n/sqrt(2)>(precision-3/2)*log(2)-log(2n-1)
459    # hence log(2n-1)<2n-1
460    # n*sqrt(2)>(precision-1.5)*log(2)+1-2n
461    # n*(sqrt(2)+2)>(precision-1.5)*log(2)+1
462    set n [expr {int((log(2)*($precision-1.5)+1)/(sqrt(2)+2)+1)}]
463    incr precision $n
464    set mantissa [::math::bignum::lshift $mantissa $n]
465    set delta [::math::bignum::lshift $delta $n]
466    # end of adding precision increment
467    # now computing Taylor development :
468    # atan(x)=x - x^3/3 + x^5/5 - x^7/7 ... + (-1)^n*x^(2n+1)/(2n+1)
469    # atan(x)=x * (1 - x^2 * (1/3 - x^2 * (1/5 - x^2 * (...*(1/(2n-1) - x^2 / (2n+1))...))))
470    # what do we need to compute this ?
471    # x^2 ($square), 2n+1 ($divider), $result, the nth term of the development ($t)
472    # and the nth term multiplied by 2n+1 ($temp)
473    # then we do this (with care keeping as much precision as possible):
474    # while ($t <>0) :
475    #     $result=$result+$t
476    #     $temp=$temp * $square
477    #     $divider = $divider+2
478    #     $t=$temp/$divider
479    # end-while
480    set result $mantissa
481    set delta_end $delta
482    # we store the square of the integer (mantissa)
483    set delta_square [::math::bignum::lshift $delta 1]
484    set square [intMulShift $mantissa $mantissa $precision]
485    # the (2n+1) divider
486    set divider $three
487    # computing precisely the uncertainty
488    set delta [::math::bignum::add 1 [::math::bignum::rshift [::math::bignum::add \
489            [::math::bignum::mul $delta_square $mantissa] \
490            [::math::bignum::mul $delta $square]] $precision]]
491    # temp contains (-1)^n*x^(2n+1)
492    set temp [opp [intMulShift $mantissa $square $precision]]
493    set t [::math::bignum::div $temp $divider]
494    set dt [::math::bignum::add 1 [::math::bignum::div $delta $divider]]
495    while {![::math::bignum::iszero $t]} {
496        set result [::math::bignum::add $result $t]
497        set delta_end [::math::bignum::add $delta_end $dt]
498        set divider [::math::bignum::add $divider $two]
499        set delta [::math::bignum::add 1 [::math::bignum::rshift [::math::bignum::add \
500                [::math::bignum::mul $delta_square [abs $temp]] [::math::bignum::mul $delta \
501                [::math::bignum::add $delta_square $square]]] $precision]]
502        set temp [opp [intMulShift $temp $square $precision]]
503        set t [::math::bignum::div $temp $divider]
504        set dt [::math::bignum::add [::math::bignum::div $delta $divider] $one]
505    }
506    # we have to normalize because the uncertainty might be greater than 99
507    # moreover it is the most often case
508    return [normalize [list F $result [expr {$exp-$n}] $delta_end]]
509}
510
511
512################################################################################
513# compute atan(1/integer) at a given precision
514# this proc is only used to compute Pi
515# it is using the same Taylor development as [atan]
516################################################################################
517proc ::math::bigfloat::_atanfract {integer precision} {
518    # Taylor development : x - x^3/3 + x^5/5 - ... + (-1)^(n+1)*x^(2n-1)/(2n-1)
519    # when we have n steps in Taylor development : the nth term is :
520    # 1/denom^(2n+1)/(2n+1)
521    # and the loss of precision is of 2n (n sums and n divisions)
522    # this command is called with integer>=5
523    #
524    # We do not want to compute the Delta parameter, so we just
525    # can increment precision (with lshift) in order for the result to be precise.
526    # Remember : we compute atan2(1,$integer) with $precision bits
527    # $integer has no Delta parameter as it is a BigInt, of course, so
528    # theorically we could compute *any* number of digits.
529    #
530    # if we add an increment to the precision, say n:
531    # (1/5)^(2n-1)/(2n-1)     has to be lower than (1/2)^(precision+n-1)
532    # Calculus :
533    # log(left term) < log(right term)
534    # log(1/left term) > log(1/right term)
535    # (2n-1)*log(5)+log(2n-1)>(precision+n-1)*log(2)
536    # n(2log(5)-log(2))>(precision-1)*log(2)-log(2n-1)+log(5)
537    # -log(2n-1)>-(2n-1)
538    # n(2log(5)-log(2)+2)>(precision-1)*log(2)+1+log(5)
539    set n [expr {int((($precision-1)*log(2)+1+log(5))/(2*log(5)-log(2)+2)+1)}]
540    incr precision $n
541    # first term of the development : 1/integer
542    set a [::math::bignum::div [::math::bignum::lshift 1 $precision] $integer]
543    # 's' will contain the result
544    set s $a
545    # Taylor development : x - x^3/3 + x^5/5 - ... + (-1)^(n+1)*x^(2n-1)/(2n-1)
546    # equals x (1 - x^2 * (1/3 + x^2 * (... * (1/(2n-3) + (-1)^(n+1) * x^2 / (2n-1))...)))
547    # all we need to store is : 2n-1 ($denom), x^(2n+1) and x^2 ($square) and two results :
548    # - the nth term => $u
549    # - the nth term * (2n-1) => $t
550    # + of course, the result $s
551    set square [::math::bignum::mul $integer $integer]
552    variable two
553    variable three
554    set denom $three
555    # $t is (-1)^n*x^(2n+1)
556    set t [opp [::math::bignum::div $a $square]]
557    set u [::math::bignum::div $t $denom]
558    # we break the loop when the current term of the development is null
559    while {![::math::bignum::iszero $u]} {
560        set s [::math::bignum::add $s $u]
561        # denominator= (2n+1)
562        set denom [::math::bignum::add $denom $two]
563        # div $t by x^2
564        set t [opp [::math::bignum::div $t $square]]
565        set u [::math::bignum::div $t $denom]
566    }
567    # go back to the initial precision
568    return [::math::bignum::rshift $s $n]
569}
570
571
572################################################################################
573# returns the integer part of a BigFloat, as a BigInt
574# the result is the same one you would have
575# if you had called [expr {ceil($x)}]
576################################################################################
577proc ::math::bigfloat::ceil {number} {
578    checkFloat number
579    set number [normalize $number]
580    if {[iszero $number]} {
581        # returns the BigInt 0
582        variable zero
583        return $zero
584    }
585    foreach {dummy integer exp delta} $number {break}
586    if {$exp>=0} {
587        error "not enough precision to perform rounding (ceil)"
588    }
589    # saving the sign ...
590    set sign [::math::bignum::sign $integer]
591    set integer [abs $integer]
592    # integer part
593    set try [::math::bignum::rshift $integer [expr {-$exp}]]
594    if {$sign} {
595        return [opp $try]
596    }
597    # fractional part
598    if {![equal [::math::bignum::lshift $try [expr {-$exp}]] $integer]} {
599        return [::math::bignum::add 1 $try]
600    }
601    return $try
602}
603
604
605################################################################################
606# checks each variable to be a BigFloat
607# arguments : each argument is the name of a variable to be checked
608################################################################################
609proc ::math::bigfloat::checkFloat {args} {
610    foreach x $args {
611        upvar $x n
612        if {![isFloat $n]} {
613            error "BigFloat expected : received '$n'"
614        }
615    }
616}
617
618################################################################################
619# checks if each number is either a BigFloat or a BigInt
620# arguments : each argument is the name of a variable to be checked
621################################################################################
622proc ::math::bigfloat::checkNumber {args} {
623    foreach i $args {
624        upvar $i x
625        if {![isInt $x] && ![isFloat $x]} {
626            error "'$x' is not a number"
627        }
628    }
629}
630
631
632################################################################################
633# returns 0 if A and B are equal, else returns 1 or -1
634# accordingly to the sign of (A - B)
635################################################################################
636proc ::math::bigfloat::compare {a b} {
637    if {[isInt $a] && [isInt $b]} {
638        return [::math::bignum::cmp $a $b]
639    }
640    checkFloat a b
641    if {[equal $a $b]} {return 0}
642    return [expr {([::math::bignum::sign [lindex [sub $a $b] 1]])?-1:1}]
643}
644
645
646
647
648################################################################################
649# gets cos(x)
650# throws an error if there is not enough precision on the input
651################################################################################
652proc ::math::bigfloat::cos {x} {
653    checkFloat x
654    foreach {dummy integer exp delta} $x {break}
655    if {$exp>-2} {
656        error "not enough precision on floating-point number"
657    }
658    set precision [expr {-$exp}]
659    # cos(2kPi+x)=cos(x)
660    foreach {n integer} [divPiQuarter $integer $precision] {break}
661    # now integer>=0 and <Pi/2
662    set d [expr {[tostr $n]%4}]
663    # add trigonometric circle turns number to delta
664    set delta [::math::bignum::add [abs $n] $delta]
665    set signe 0
666    # cos(Pi-x)=-cos(x)
667    # cos(-x)=cos(x)
668    # cos(Pi/2-x)=sin(x)
669    switch -- $d {
670        1 {set signe 1;set l [_sin2 $integer $precision $delta]}
671        2 {set signe 1;set l [_cos2 $integer $precision $delta]}
672        0 {set l [_cos2 $integer $precision $delta]}
673        3 {set l [_sin2 $integer $precision $delta]}
674        default {error "internal error"}
675    }
676    # precision -> exp (multiplied by -1)
677    lset l 1 [expr {-([lindex $l 1])}]
678    # set the sign
679    set integer [lindex $l 0]
680    ::math::bignum::setsign integer $signe
681    lset l 0 $integer
682    return [normalize [linsert $l 0 F]]
683}
684
685################################################################################
686# compute cos(x) where 0<=x<Pi/2
687# returns : a list formed with :
688# 1. the mantissa
689# 2. the precision (opposite of the exponent)
690# 3. the uncertainty (doubt range)
691################################################################################
692proc ::math::bigfloat::_cos2 {x precision delta} {
693    # precision bits after the dot
694    set pi [_pi $precision]
695    set pis4 [::math::bignum::rshift $pi 2]
696    set pis2 [::math::bignum::rshift $pi 1]
697    if {[::math::bignum::cmp $x $pis4]>=0} {
698        # cos(Pi/2-x)=sin(x)
699        set x [::math::bignum::sub $pis2 $x]
700        set delta [::math::bignum::add 1 $delta]
701        return [_sin $x $precision $delta]
702    }
703    return [_cos $x $precision $delta]
704}
705
706################################################################################
707# compute cos(x) where 0<=x<Pi/4
708# returns : a list formed with :
709# 1. the mantissa
710# 2. the precision (opposite of the exponent)
711# 3. the uncertainty (doubt range)
712################################################################################
713proc ::math::bigfloat::_cos {x precision delta} {
714    variable zero
715    variable one
716    variable two
717    set float1 [::math::bignum::lshift $one $precision]
718    # Taylor development follows :
719    # cos(x)=1-x^2/2 + x^4/4! ... + (-1)^(2n)*x^(2n)/2n!
720    # cos(x)= 1 - x^2/1.2 * (1 - x^2/3.4 * (... * (1 - x^2/(2n.(2n-1))...))
721    # variables : $s (the Mantissa of the result)
722    # $denom1 & $denom2 (2n-1 & 2n)
723    # $x as the square of what is named x in 'cos(x)'
724    set s $float1
725    # 'd' is the uncertainty on x^2
726    set d [::math::bignum::mul $x [::math::bignum::lshift $delta 1]]
727    set d [::math::bignum::add 1 [::math::bignum::rshift $d $precision]]
728    # x=x^2 (because in this Taylor development, there are only even powers of x)
729    set x [intMulShift $x $x $precision]
730    set denom1 $one
731    set denom2 $two
732    set t [opp [::math::bignum::rshift $x 1]]
733    set delta $zero
734    set dt $d
735    while {![::math::bignum::iszero $t]} {
736        set s [::math::bignum::add $s $t]
737        set delta [::math::bignum::add $delta $dt]
738        set denom1 [::math::bignum::add $denom1 $two]
739        set denom2 [::math::bignum::add $denom2 $two]
740        set dt [::math::bignum::rshift [::math::bignum::add [::math::bignum::mul $x $dt]\
741                [::math::bignum::mul [::math::bignum::add $t $dt] $d]] $precision]
742        set dt [::math::bignum::add 1 $dt]
743        set t [intMulShift $x $t $precision]
744        set t [opp [::math::bignum::div $t [::math::bignum::mul $denom1 $denom2]]]
745    }
746    return [list $s $precision $delta]
747}
748
749################################################################################
750# cotangent : the trivial algorithm is used
751################################################################################
752proc ::math::bigfloat::cotan {x} {
753    return [::math::bigfloat::div [::math::bigfloat::cos $x] [::math::bigfloat::sin $x]]
754}
755
756################################################################################
757# converts angles from degrees to radians
758# deg/180=rad/Pi
759################################################################################
760proc ::math::bigfloat::deg2rad {x} {
761    checkFloat x
762    set xLen [expr {-[lindex $x 2]}]
763    if {$xLen<3} {
764        error "number too loose to convert to radians"
765    }
766    set pi [pi $xLen 1]
767    return [div [mul $x $pi] [::math::bignum::fromstr 180]]
768}
769
770
771
772################################################################################
773# private proc to get : x modulo Pi/2
774# and the quotient (x divided by Pi/2)
775# used by cos , sin & others
776################################################################################
777proc ::math::bigfloat::divPiQuarter {integer precision} {
778    incr precision 2
779    set integer [::math::bignum::lshift $integer 1]
780    set dpi [_pi $precision]
781    # modulo 2Pi
782    foreach {n integer} [::math::bignum::divqr $integer $dpi] {break}
783    # end modulo 2Pi
784    set pi [::math::bignum::rshift $dpi 1]
785    foreach {n integer} [::math::bignum::divqr $integer $pi] {break}
786    # now divide by Pi/2
787    # multiply n by 2
788    set n [::math::bignum::lshift $n 1]
789    # pis2=pi/2
790    set pis2 [::math::bignum::rshift $pi 1]
791    foreach {m integer} [::math::bignum::divqr $integer $pis2] {break}
792    return [list [::math::bignum::add $n $m] [::math::bignum::rshift $integer 1]]
793}
794
795
796################################################################################
797# divide A by B and returns the result
798# throw error : divide by zero
799################################################################################
800proc ::math::bigfloat::div {a b} {
801    variable one
802    checkNumber a b
803    # dispatch to an appropriate procedure
804    if {[isInt $a]} {
805        if {[isInt $b]} {
806            return [::math::bignum::div $a $b]
807        }
808        error "trying to divide a BigInt by a BigFloat"
809    }
810    if {[isInt $b]} {return [divFloatByInt $a $b]}
811    foreach {dummy integerA expA deltaA} $a {break}
812    foreach {dummy integerB expB deltaB} $b {break}
813    # computes the limits of the doubt (or uncertainty) interval
814    set BMin [::math::bignum::sub $integerB $deltaB]
815    set BMax [::math::bignum::add $integerB $deltaB]
816    if {[::math::bignum::cmp $BMin $BMax]>0} {
817        # swap BMin and BMax
818        set temp $BMin
819        set BMin $BMax
820        set BMax $temp
821    }
822    # multiply by zero gives zero
823    if {[::math::bignum::iszero $integerA]} {
824        # why not return any number or the integer 0 ?
825        # because there is an exponent that might be different between two BigFloats
826        # 0.00 --> exp = -2, 0.000000 -> exp = -6
827        return $a
828    }
829    # test of the division by zero
830    if {[::math::bignum::sign $BMin]+[::math::bignum::sign $BMax]==1 || \
831                [::math::bignum::iszero $BMin] || [::math::bignum::iszero $BMax]} {
832        error "divide by zero"
833    }
834    # shift A because we need accuracy
835    set l [math::bignum::bits $integerB]
836    set integerA [::math::bignum::lshift $integerA $l]
837    set deltaA [::math::bignum::lshift $deltaA $l]
838    set exp [expr {$expA-$l-$expB}]
839    # relative uncertainties (dX/X) are added
840    # to give the relative uncertainty of the result
841    # i.e. 3% on A + 2% on B --> 5% on the quotient
842    # d(A/B)/(A/B)=dA/A + dB/B
843    # Q=A/B
844    # dQ=dA/B + dB*A/B*B
845    # dQ is "delta"
846    set delta [::math::bignum::div [::math::bignum::mul $deltaB \
847            [abs $integerA]] [abs $integerB]]
848    set delta [::math::bignum::div [::math::bignum::add\
849            [::math::bignum::add 1 $delta]\
850            $deltaA] [abs $integerB]]
851    set quotient [::math::bignum::div $integerA $integerB]
852    if {[::math::bignum::sign $integerB]+[::math::bignum::sign $integerA]==1} {
853        set quotient [::math::bignum::sub $quotient 1]
854    }
855    return [normalize [list F $quotient $exp [::math::bignum::add $delta 1]]]
856}
857
858
859
860
861################################################################################
862# divide a BigFloat A by a BigInt B
863# throw error : divide by zero
864################################################################################
865proc ::math::bigfloat::divFloatByInt {a b} {
866    variable one
867    # type check
868    checkFloat a
869    if {![isInt $b]} {
870        error "'$b' is not a BigInt"
871    }
872    foreach {dummy integer exp delta} $a {break}
873    # zero divider test
874    if {[::math::bignum::iszero $b]} {
875        error "divide by zero"
876    }
877    # shift left for accuracy ; see other comments in [div] procedure
878    set l [::math::bignum::bits $b]
879    set integer [::math::bignum::lshift $integer $l]
880    set delta [::math::bignum::lshift $delta $l]
881    incr exp -$l
882    set integer [::math::bignum::div $integer $b]
883    # the uncertainty is always evaluated to the ceil value
884    # and as an absolute value
885    set delta [::math::bignum::add 1 [::math::bignum::div $delta [abs $b]]]
886    return [normalize [list F $integer $exp $delta]]
887}
888
889
890
891
892
893################################################################################
894# returns 1 if A and B are equal, 0 otherwise
895# IN : a, b (BigFloats)
896################################################################################
897proc ::math::bigfloat::equal {a b} {
898    if {[isInt $a] && [isInt $b]} {
899        return [expr {[::math::bignum::cmp $a $b]==0}]
900    }
901    # now a & b should only be BigFloats
902    checkFloat a b
903    foreach {dummy aint aexp adelta} $a {break}
904    foreach {dummy bint bexp bdelta} $b {break}
905    # set all Mantissas and Deltas to the same level (exponent)
906    # with lshift
907    set diff [expr {$aexp-$bexp}]
908    if {$diff<0} {
909        set diff [expr {-$diff}]
910        set bint [::math::bignum::lshift $bint $diff]
911        set bdelta [::math::bignum::lshift $bdelta $diff]
912    } elseif {$diff>0} {
913        set aint [::math::bignum::lshift $aint $diff]
914        set adelta [::math::bignum::lshift $adelta $diff]
915    }
916    # compute limits of the number's doubt range
917    set asupInt [::math::bignum::add $aint $adelta]
918    set ainfInt [::math::bignum::sub $aint $adelta]
919    set bsupInt [::math::bignum::add $bint $bdelta]
920    set binfInt [::math::bignum::sub $bint $bdelta]
921    # A & B are equal
922    # if their doubt ranges overlap themselves
923    if {[::math::bignum::cmp $bint $aint]==0} {
924        return 1
925    }
926    if {[::math::bignum::cmp $bint $aint]>0} {
927        set r [expr {[::math::bignum::cmp $asupInt $binfInt]>=0}]
928    } else {
929        set r [expr {[::math::bignum::cmp $bsupInt $ainfInt]>=0}]
930    }
931    return $r
932}
933
934################################################################################
935# returns exp(X) where X is a BigFloat
936################################################################################
937proc ::math::bigfloat::exp {x} {
938    checkFloat x
939    foreach {dummy integer exp delta} $x {break}
940    if {$exp>=0} {
941        # shift till exp<0 with respect to the internal representation
942        # of the number
943        incr exp
944        set integer [::math::bignum::lshift $integer $exp]
945        set delta [::math::bignum::lshift $delta $exp]
946        set exp -1
947    }
948    set precision [expr {-$exp}]
949    # add 8 bits of precision for safety
950    incr precision 8
951    set integer [::math::bignum::lshift $integer 8]
952    set delta [::math::bignum::lshift $delta 8]
953    set Log2 [_log2 $precision]
954    foreach {new_exp integer} [::math::bignum::divqr $integer $Log2] {break}
955    # new_exp = integer part of x/log(2)
956    # integer = remainder
957    # exp(K.log(2)+r)=2^K.exp(r)
958    # so we just have to compute exp(r), r is small so
959    # the Taylor development will converge quickly
960    set delta [::math::bignum::add $delta $new_exp]
961    foreach {integer delta} [_exp $integer $precision $delta] {break}
962    set delta [::math::bignum::rshift $delta 8]
963    incr precision -8
964    # multiply by 2^K , and take care of the sign
965    # example : X=-6.log(2)+0.01
966    # exp(X)=exp(0.01)*2^-6
967    if {![::math::bignum::iszero [::math::bignum::rshift [abs $new_exp] 30]]} {
968        error "floating-point overflow due to exp"
969    }
970    set new_exp [tostr $new_exp]
971    set exp [expr {$new_exp-$precision}]
972    set delta [::math::bignum::add 1 $delta]
973    return [normalize [list F [::math::bignum::rshift $integer 8] $exp $delta]]
974}
975
976
977################################################################################
978# private procedure to compute exponentials
979# using Taylor development of exp(x) :
980# exp(x)=1+ x + x^2/2 + x^3/3! +...+x^n/n!
981# input : integer (the mantissa)
982#         precision (the number of decimals)
983#         delta (the doubt limit, or uncertainty)
984# returns a list : 1. the mantissa of the result
985#                  2. the doubt limit, or uncertainty
986################################################################################
987proc ::math::bigfloat::_exp {integer precision delta} {
988    set oneShifted [::math::bignum::lshift 1 $precision]
989    if {[::math::bignum::iszero $integer]} {
990        # exp(0)=1
991        return [list $oneShifted $delta]
992    }
993    set s [::math::bignum::add $oneShifted $integer]
994    variable two
995    set d [::math::bignum::add 1 [::math::bignum::div $delta $two]]
996    set delta [::math::bignum::add $delta $delta]
997    # dt = uncertainty on x^2
998    set dt [::math::bignum::add 1 [intMulShift $d $integer $precision]]
999    # t= x^2/2
1000    set t [intMulShift $integer $integer $precision]
1001    set t [::math::bignum::div $t $two]
1002    set denom $two
1003    while {![::math::bignum::iszero $t]} {
1004        # the sum is called 's'
1005        set s [::math::bignum::add $s $t]
1006        set delta [::math::bignum::add $delta $dt]
1007        # we do not have to keep trace of the factorial, we just iterate divisions
1008        set denom [::math::bignum::add 1 $denom]
1009        # add delta
1010        set d [::math::bignum::add 1 [::math::bignum::div $d $denom]]
1011        set dt [::math::bignum::add $dt $d]
1012        # get x^n from x^(n-1)
1013        set t [intMulShift $integer $t $precision]
1014        # here we divide
1015        set t [::math::bignum::div $t $denom]
1016    }
1017    return [list $s $delta]
1018}
1019################################################################################
1020# divide a BigFloat by 2 power 'n'
1021################################################################################
1022proc ::math::bigfloat::floatRShift {float {n 1}} {
1023    return [lset float 2 [expr {[lindex $float 2]-$n}]]
1024}
1025
1026
1027
1028################################################################################
1029# procedure floor : identical to [expr floor($x)] in functionality
1030# arguments : number IN (a BigFloat)
1031# returns : the floor value as a BigInt
1032################################################################################
1033proc ::math::bigfloat::floor {number} {
1034    variable zero
1035    checkFloat number
1036    set number [normalize $number]
1037    if {[::math::bignum::iszero $number]} {
1038        # returns the BigInt 0
1039        return $zero
1040    }
1041    foreach {dummy integer exp delta} $number {break}
1042    if {$exp>=0} {
1043        error "not enough precision to perform rounding (floor)"
1044    }
1045    # saving the sign ...
1046    set sign [::math::bignum::sign $integer]
1047    set integer [abs $integer]
1048    # integer part
1049    set try [::math::bignum::rshift $integer [expr {-$exp}]]
1050    # floor(n.xxxx)=n
1051    if {!$sign} {
1052        return $try
1053    }
1054    # floor(-n.xxxx)=-(n+1) when xxxx!=0
1055    if {![equal [::math::bignum::lshift $try [expr {-$exp}]] $integer]} {
1056        set try [::math::bignum::add 1 $try]
1057    }
1058    ::math::bignum::setsign try $sign
1059    return $try
1060}
1061
1062
1063################################################################################
1064# returns a list formed by an integer and an exponent
1065# x = (A +/- C) * 10 power B
1066# return [list "F" A B C] (where F is the BigFloat tag)
1067# A and C are BigInts, B is a raw integer
1068# return also a BigInt when there is neither a dot, nor a 'e' exponent
1069#
1070# arguments : -base base integer
1071#          or integer
1072#          or float
1073#          or float trailingZeros
1074################################################################################
1075proc ::math::bigfloat::fromstr {args} {
1076    if {[set string [lindex $args 0]]=="-base"} {
1077        if {[llength $args]!=3} {
1078            error "should be : fromstr -base base number"
1079        }
1080        # converts an integer i expressed in base b with : [fromstr b i]
1081        return [::math::bignum::fromstr [lindex $args 2] [lindex $args 1]]
1082    }
1083    # trailingZeros are zeros appended to the Mantissa (it is optional)
1084    set trailingZeros 0
1085    if {[llength $args]==2} {
1086        set trailingZeros [lindex $args 1]
1087    }
1088    if {$trailingZeros<0} {
1089        error "second argument has to be a positive integer"
1090    }
1091    # eliminate the sign problem
1092    # added on 05/08/2005
1093    # setting '$signe' to the sign of the number
1094    set string [string trimleft $string +]
1095    if {[string index $string 0]=="-"} {
1096        set signe 1
1097        set string2 [string range $string 1 end]
1098    } else  {
1099        set signe 0
1100        set string2 $string
1101    }
1102    # integer case (not a floating-point number)
1103    if {[string is digit $string2]} {
1104        if {$trailingZeros!=0} {
1105            error "second argument not allowed with an integer"
1106        }
1107        # we have completed converting an integer to a BigInt
1108        # please note that most math::bigfloat procs accept BigInts as arguments
1109        return [::math::bignum::fromstr $string]
1110    }
1111    set string $string2
1112    # floating-point number : check for an exponent
1113    # scientific notation
1114    set tab [split $string e]
1115    if {[llength $tab]>2} {
1116        # there are more than one 'e' letter in the number
1117        error "syntax error in number : $string"
1118    }
1119    if {[llength $tab]==2} {
1120        set exp [lindex $tab 1]
1121        # now exp can look like +099 so you need to handle octal numbers
1122        # too bad...
1123        # find the sign (if any?)
1124        regexp {^[\+\-]?} $exp expsign
1125        # trim the number with left-side 0's
1126        set found [string length $expsign]
1127        set exp $expsign[string trimleft [string range $exp $found end] 0]
1128        set number [lindex $tab 0]
1129    } else {
1130        set exp 0
1131        set number [lindex $tab 0]
1132    }
1133    # a floating-point number may have a dot
1134    set tab [split $number .]
1135    if {[llength $tab]>2} {error "syntax error in number : $string"}
1136    if {[llength $tab]==2} {
1137        set number [join $tab ""]
1138        # increment by the number of decimals (after the dot)
1139        incr exp -[string length [lindex $tab 1]]
1140    }
1141    # this is necessary to ensure we can call fromstr (recursively) with
1142    # the mantissa ($number)
1143    if {![string is digit $number]} {
1144        error "$number is not a number"
1145    }
1146    # take account of trailing zeros
1147    incr exp -$trailingZeros
1148    # multiply $number by 10^$trailingZeros
1149    set number [::math::bignum::mul [::math::bignum::fromstr $number]\
1150            [tenPow $trailingZeros]]
1151    ::math::bignum::setsign number $signe
1152    # the F tags a BigFloat
1153    # a BigInt in internal representation begins by the sign
1154    # delta is 1 as a BigInt
1155    return [_fromstr $number $exp]
1156}
1157
1158################################################################################
1159# private procedure to transform decimal floats into binary ones
1160# IN :
1161#     - number : a BigInt representing the Mantissa
1162#     - exp : the decimal exponent (a simple integer)
1163# OUT :
1164#     $number * 10^$exp, as the internal binary representation of a BigFloat
1165################################################################################
1166proc ::math::bigfloat::_fromstr {number exp} {
1167    variable one
1168    variable five
1169    if {$exp==0} {
1170        return [list F $number 0 $one]
1171    }
1172    if {$exp>0} {
1173        # mul by 10^exp, and by 2^4, then normalize
1174        set number [::math::bignum::lshift $number 4]
1175        set exponent [tenPow $exp]
1176        set number [::math::bignum::mul $number $exponent]
1177        # normalize number*2^-4 +/- 2^4*10^exponent
1178        return [normalize [list F $number -4 [::math::bignum::lshift $exponent 4]]]
1179    }
1180    # now exp is negative or null
1181    # the closest power of 2 to the 'exp'th power of ten, but greater than it
1182    set binaryExp [expr {int(ceil(-$exp*log(10)/log(2)))+4}]
1183    # then compute n * 2^binaryExp / 10^(-exp)
1184    # (exp is negative)
1185    # equals n * 2^(binaryExp+exp) / 5^(-exp)
1186    set diff [expr {$binaryExp+$exp}]
1187    if {$diff<0} {
1188        error "internal error"
1189    }
1190    set fivePow [::math::bignum::pow $five [::math::bignum::fromstr [expr {-$exp}]]]
1191    set number [::math::bignum::div [::math::bignum::lshift $number \
1192            $diff] $fivePow]
1193    set delta [::math::bignum::div [::math::bignum::lshift 1 \
1194            $diff] $fivePow]
1195    return [normalize [list F $number [expr {-$binaryExp}] [::math::bignum::add $delta 1]]]
1196}
1197
1198
1199################################################################################
1200# fromdouble :
1201# like fromstr, but for a double scalar value
1202# arguments :
1203# double - the number to convert to a BigFloat
1204# exp (optional) - the total number of digits
1205################################################################################
1206proc ::math::bigfloat::fromdouble {double {exp {}}} {
1207    set mantissa [lindex [split $double e] 0]
1208    # line added by SArnold on 05/08/2005
1209    set mantissa [string trimleft [string map {+ "" - ""} $mantissa] 0]
1210    set precision [string length [string map {. ""} $mantissa]]
1211    if { $exp != {} && [incr exp]>$precision } {
1212        return [fromstr $double [expr {$exp-$precision}]]
1213    } else {
1214        # tests have failed : not enough precision or no exp argument
1215        return [fromstr $double]
1216    }
1217}
1218
1219
1220################################################################################
1221# converts a BigInt into a BigFloat with a given decimal precision
1222################################################################################
1223proc ::math::bigfloat::int2float {int {decimals 1}} {
1224    # it seems like we need some kind of type handling
1225    # very odd in this Tcl world :-(
1226    if {![isInt $int]} {
1227        error "first argument is not an integer"
1228    }
1229    if {$decimals<1} {
1230        error "non-positive decimals number"
1231    }
1232    # the lowest number of decimals is 1, because
1233    # [tostr [fromstr 10.0]] returns 10.
1234    # (we lose 1 digit when converting back to string)
1235    set int [::math::bignum::mul $int [tenPow $decimals]]
1236    return [_fromstr $int [expr {-$decimals}]]
1237
1238}
1239
1240
1241
1242################################################################################
1243# multiplies 'leftop' by 'rightop' and rshift the result by 'shift'
1244################################################################################
1245proc ::math::bigfloat::intMulShift {leftop rightop shift} {
1246    return [::math::bignum::rshift [::math::bignum::mul $leftop $rightop] $shift]
1247}
1248
1249################################################################################
1250# returns 1 if x is a BigFloat, 0 elsewhere
1251################################################################################
1252proc ::math::bigfloat::isFloat {x} {
1253    # a BigFloat is a list of : "F" mantissa exponent delta
1254    if {[llength $x]!=4} {
1255        return 0
1256    }
1257    # the marker is the letter "F"
1258    if {[string equal [lindex $x 0] F]} {
1259        return 1
1260    }
1261    return 0
1262}
1263
1264################################################################################
1265# checks that n is a BigInt (a number create by math::bignum::fromstr)
1266################################################################################
1267proc ::math::bigfloat::isInt {n} {
1268    if {[llength $n]<3} {
1269        return 0
1270    }
1271    if {[string equal [lindex $n 0] bignum]} {
1272        return 1
1273    }
1274    return 0
1275}
1276
1277
1278
1279################################################################################
1280# returns 1 if x is null, 0 otherwise
1281################################################################################
1282proc ::math::bigfloat::iszero {x} {
1283    if {[isInt $x]} {
1284        return [::math::bignum::iszero $x]
1285    }
1286    checkFloat x
1287    # now we do some interval rounding : if a number's interval englobs 0,
1288    # it is considered to be equal to zero
1289    foreach {dummy integer exp delta} $x {break}
1290    set integer [::math::bignum::abs $integer]
1291    if {[::math::bignum::cmp $delta $integer]>=0} {return 1}
1292    return 0
1293}
1294
1295
1296################################################################################
1297# compute log(X)
1298################################################################################
1299proc ::math::bigfloat::log {x} {
1300    checkFloat x
1301    foreach {dummy integer exp delta} $x {break}
1302    if {[::math::bignum::iszero $integer]||[::math::bignum::sign $integer]} {
1303        error "zero logarithm error"
1304    }
1305    if {[iszero $x]} {
1306        error "number is null"
1307    }
1308    set precision [::math::bignum::bits $integer]
1309    # uncertainty of the logarithm
1310    set delta [::math::bignum::add 1 [_logOnePlusEpsilon $delta $integer $precision]]
1311    # we got : x = 1xxxxxx (binary number with 'precision' bits) * 2^exp
1312    # we need : x = 0.1xxxxxx(binary) *2^(exp+precision)
1313    incr exp $precision
1314    foreach {integer deltaIncr} [_log $integer] {break}
1315    set delta [::math::bignum::add $delta $deltaIncr]
1316    # log(a * 2^exp)= log(a) + exp*log(2)
1317    # result = log(x) + exp*log(2)
1318    # as x<1 log(x)<0 but 'integer' (result of '_log') is the absolute value
1319    # that is why we substract $integer to log(2)*$exp
1320    set integer [::math::bignum::sub [::math::bignum::mul [_log2 $precision] \
1321            [set exp [::math::bignum::fromstr $exp]]] $integer]
1322    set delta [::math::bignum::add $delta [abs $exp]]
1323    return [normalize [list F $integer -$precision $delta]]
1324}
1325
1326
1327################################################################################
1328# compute log(1-epsNum/epsDenom)=log(1-'epsilon')
1329# Taylor development gives -x -x^2/2 -x^3/3 -x^4/4 ...
1330# used by 'log' command because log(x+/-epsilon)=log(x)+log(1+/-(epsilon/x))
1331# so the uncertainty equals abs(log(1-epsilon/x))
1332# ================================================
1333# arguments :
1334# epsNum IN (the numerator of epsilon)
1335# epsDenom IN (the denominator of epsilon)
1336# precision IN (the number of bits after the dot)
1337#
1338# 'epsilon' = epsNum*2^-precision/epsDenom
1339################################################################################
1340proc ::math::bigfloat::_logOnePlusEpsilon {epsNum epsDenom precision} {
1341    if {[::math::bignum::cmp $epsNum $epsDenom]>=0} {
1342        error "number is null"
1343    }
1344    set s [::math::bignum::lshift $epsNum $precision]
1345    set s [::math::bignum::div $s $epsDenom]
1346    variable two
1347    set divider $two
1348    set t [::math::bignum::div [::math::bignum::mul $s $epsNum] $epsDenom]
1349    set u [::math::bignum::div $t $divider]
1350    # when u (the current term of the development) is zero, we have reached our goal
1351    # it has converged
1352    while {![::math::bignum::iszero $u]} {
1353        set s [::math::bignum::add $s $u]
1354        # divider = order of the term = 'n'
1355        set divider [::math::bignum::add 1 $divider]
1356        # t = (epsilon)^n
1357        set t [::math::bignum::div [::math::bignum::mul $t $epsNum] $epsDenom]
1358        # u = t/n = (epsilon)^n/n and is the nth term of the Taylor development
1359        set u [::math::bignum::div $t $divider]
1360    }
1361    return $s
1362}
1363
1364
1365################################################################################
1366# compute log(0.xxxxxxxx) : log(1-epsilon)=-eps-eps^2/2-eps^3/3...-eps^n/n
1367################################################################################
1368proc ::math::bigfloat::_log {integer} {
1369    # the uncertainty is nbSteps with nbSteps<=nbBits
1370    # take nbSteps=nbBits (the worse case) and log(nbBits+increment)=increment
1371    set precision [::math::bignum::bits $integer]
1372    set n [expr {int(log($precision+2*log($precision)))}]
1373    set integer [::math::bignum::lshift $integer $n]
1374    incr precision $n
1375    variable three
1376    set delta $three
1377    # 1-epsilon=integer
1378    set integer [::math::bignum::sub [::math::bignum::lshift 1 $precision] $integer]
1379    set s $integer
1380    # t=x^2
1381    set t [intMulShift $integer $integer $precision]
1382    variable two
1383    set denom $two
1384    # u=x^2/2 (second term)
1385    set u [::math::bignum::div $t $denom]
1386    while {![::math::bignum::iszero $u]} {
1387        # while the current term is not zero, it has not converged
1388        set s [::math::bignum::add $s $u]
1389        set delta [::math::bignum::add 1 $delta]
1390        # t=x^n
1391        set t [intMulShift $t $integer $precision]
1392        # denom = n (the order of the current development term)
1393        set denom [::math::bignum::add 1 $denom]
1394        # u = x^n/n (the nth term of Taylor development)
1395        set u [::math::bignum::div $t $denom]
1396    }
1397    # shift right to restore the precision
1398    set delta [::math::bignum::add 1 [::math::bignum::rshift $delta $n]]
1399    return [list [::math::bignum::rshift $s $n] $delta]
1400}
1401
1402################################################################################
1403# computes log(num/denom) with 'precision' bits
1404# used to compute some analysis constants with a given accuracy
1405# you might not call this procedure directly : it assumes 'num/denom'>4/5
1406# and 'num/denom'<1
1407################################################################################
1408proc ::math::bigfloat::__log {num denom precision} {
1409    # Please Note : we here need a precision increment, in order to
1410    # keep accuracy at $precision digits. If we just hold $precision digits,
1411    # each number being precise at the last digit +/- 1,
1412    # we would lose accuracy because small uncertainties add to themselves.
1413    # Example : 0.0001 + 0.0010 = 0.0011 +/- 0.0002
1414    # This is quite the same reason that made tcl_precision defaults to 12 :
1415    # internally, doubles are computed with 17 digits, but to keep precision
1416    # we need to limit our results to 12.
1417    # The solution : given a precision target, increment precision with a
1418    # computed value so that all digits of he result are exacts.
1419    #
1420    # p is the precision
1421    # pk is the precision increment
1422    # 2 power pk is also the maximum number of iterations
1423    # for a number close to 1 but lower than 1,
1424    # (denom-num)/denum is (in our case) lower than 1/5
1425    # so the maximum nb of iterations is for:
1426    # 1/5*(1+1/5*(1/2+1/5*(1/3+1/5*(...))))
1427    # the last term is 1/n*(1/5)^n
1428    # for the last term to be lower than 2^(-p-pk)
1429    # the number of iterations has to be
1430    # 2^(-pk).(1/5)^(2^pk) < 2^(-p-pk)
1431    # log(1/5).2^pk < -p
1432    # 2^pk > p/log(5)
1433    # pk > log(2)*log(p/log(5))
1434    # now set the variable n to the precision increment i.e. pk
1435    set n [expr {int(log(2)*log($precision/log(5)))+1}]
1436    incr precision $n
1437    # log(num/denom)=log(1-(denom-num)/denom)
1438    # log(1+x) = x + x^2/2 + x^3/3 + ... + x^n/n
1439    #          = x(1 + x(1/2 + x(1/3 + x(...+ x(1/(n-1) + x/n)...))))
1440    set num [::math::bignum::fromstr [expr {$denom-$num}]]
1441    set denom [::math::bignum::fromstr $denom]
1442    # $s holds the result
1443    set s [::math::bignum::div [::math::bignum::lshift $num $precision] $denom]
1444    # $t holds x^n
1445    set t [::math::bignum::div [::math::bignum::mul $s $num] $denom]
1446    variable two
1447    set d $two
1448    # $u holds x^n/n
1449    set u [::math::bignum::div $t $d]
1450    while {![::math::bignum::iszero $u]} {
1451        set s [::math::bignum::add $s $u]
1452        # get x^n * x
1453        set t [::math::bignum::div [::math::bignum::mul $t $num] $denom]
1454        # get n+1
1455        set d [::math::bignum::add 1 $d]
1456        # then : $u = x^(n+1)/(n+1)
1457        set u [::math::bignum::div $t $d]
1458    }
1459    # see head of the proc : we return the value with its target precision
1460    return [::math::bignum::rshift $s $n]
1461}
1462
1463################################################################################
1464# computes log(2) with 'precision' bits and caches it into a namespace variable
1465################################################################################
1466proc ::math::bigfloat::__logbis {precision} {
1467    set increment [expr {int(log($precision)/log(2)+1)}]
1468    incr precision $increment
1469    # ln(2)=3*ln(1-4/5)+ln(1-125/128)
1470    set a [__log 125 128 $precision]
1471    set b [__log 4 5 $precision]
1472    variable three
1473    set r [::math::bignum::add [::math::bignum::mul $b $three] $a]
1474    set ::math::bigfloat::Log2 [::math::bignum::rshift $r $increment]
1475    # formerly (when BigFloats were stored in ten radix) we had to compute log(10)
1476    # ln(10)=10.ln(1-4/5)+3*ln(1-125/128)
1477}
1478
1479
1480################################################################################
1481# retrieves log(2) with 'precision' bits ; the result is cached
1482################################################################################
1483proc ::math::bigfloat::_log2 {precision} {
1484    variable Log2
1485    if {![info exists Log2]} {
1486        __logbis $precision
1487    } else {
1488        # the constant is cached and computed again when more precision is needed
1489        set l [::math::bignum::bits $Log2]
1490        if {$precision>$l} {
1491            __logbis $precision
1492        }
1493    }
1494    # return log(2) with 'precision' bits even when the cached value has more bits
1495    return [_round $Log2 $precision]
1496}
1497
1498
1499################################################################################
1500# returns A modulo B (like with fmod() math function)
1501################################################################################
1502proc ::math::bigfloat::mod {a b} {
1503    checkNumber a b
1504    if {[isInt $a] && [isInt $b]} {return [::math::bignum::mod $a $b]}
1505    if {[isInt $a]} {error "trying to divide a BigInt by a BigFloat"}
1506    set quotient [div $a $b]
1507    # examples : fmod(3,2)=1 quotient=1.5
1508    # fmod(1,2)=1 quotient=0.5
1509    # quotient>0 and b>0 : get floor(quotient)
1510    # fmod(-3,-2)=-1 quotient=1.5
1511    # fmod(-1,-2)=-1 quotient=0.5
1512    # quotient>0 and b<0 : get floor(quotient)
1513    # fmod(-3,2)=-1 quotient=-1.5
1514    # fmod(-1,2)=-1 quotient=-0.5
1515    # quotient<0 and b>0 : get ceil(quotient)
1516    # fmod(3,-2)=1 quotient=-1.5
1517    # fmod(1,-2)=1 quotient=-0.5
1518    # quotient<0 and b<0 : get ceil(quotient)
1519    if {[sign $quotient]} {
1520        set quotient [ceil $quotient]
1521    } else  {
1522        set quotient [floor $quotient]
1523    }
1524    return [sub $a [mul $quotient $b]]
1525}
1526
1527################################################################################
1528# returns A times B
1529################################################################################
1530proc ::math::bigfloat::mul {a b} {
1531    checkNumber a b
1532    # dispatch the command to appropriate commands regarding types (BigInt & BigFloat)
1533    if {[isInt $a]} {
1534        if {[isInt $b]} {
1535            return [::math::bignum::mul $a $b]
1536        }
1537        return [mulFloatByInt $b $a]
1538    }
1539    if {[isInt $b]} {return [mulFloatByInt $a $b]}
1540    # now we are sure that 'a' and 'b' are BigFloats
1541    foreach {dummy integerA expA deltaA} $a {break}
1542    foreach {dummy integerB expB deltaB} $b {break}
1543    # 2^expA * 2^expB = 2^(expA+expB)
1544    set exp [expr {$expA+$expB}]
1545    # mantissas are multiplied
1546    set integer [::math::bignum::mul $integerA $integerB]
1547    # compute precisely the uncertainty
1548    set deltaAB [::math::bignum::mul $deltaA $deltaB]
1549    set deltaA [::math::bignum::mul [abs $integerB] $deltaA]
1550    set deltaB [::math::bignum::mul [abs $integerA] $deltaB]
1551    set delta [::math::bignum::add [::math::bignum::add $deltaA $deltaB] \
1552            [::math::bignum::add 1 $deltaAB]]
1553    # we have to normalize because 'delta' may be too big
1554    return [normalize [list F $integer $exp $delta]]
1555}
1556
1557################################################################################
1558# returns A times B, where B is a positive integer
1559################################################################################
1560proc ::math::bigfloat::mulFloatByInt {a b} {
1561    checkFloat a
1562    foreach {dummy integer exp delta} $a {break}
1563    if {![isInt $b]} {
1564        error "second argument expected to be a BigInt"
1565    }
1566    # Mantissa and Delta are simply multplied by $b
1567    set integer [::math::bignum::mul $integer $b]
1568    set delta [::math::bignum::mul $delta $b]
1569    # We normalize because Delta could have seriously increased
1570    return [normalize [list F $integer $exp $delta]]
1571}
1572
1573################################################################################
1574# normalizes a number : Delta (accuracy of the BigFloat)
1575# has to be limited, because the memory use increase
1576# quickly when we do some computations, as the Mantissa and Delta
1577# increase together
1578# The solution : keep the size of Delta under 9 bits
1579################################################################################
1580proc ::math::bigfloat::normalize {number} {
1581    checkFloat number
1582    foreach {dummy integer exp delta} $number {break}
1583    set l [::math::bignum::bits $delta]
1584    if {$l>8} {
1585        # next line : $l holds the supplementary size (in bits)
1586        incr l -8
1587        # now we can shift right by $l bits
1588        # always round upper the Delta
1589        set delta [::math::bignum::add 1 [::math::bignum::rshift $delta $l]]
1590        set integer [::math::bignum::rshift $integer $l]
1591        incr exp $l
1592    }
1593    return [list F $integer $exp $delta]
1594}
1595
1596
1597
1598################################################################################
1599# returns -A (the opposite)
1600################################################################################
1601proc ::math::bigfloat::opp {a} {
1602    checkNumber a
1603    if {[iszero $a]} {
1604        return $a
1605    }
1606    if {[isInt $a]} {
1607        ::math::bignum::setsign a [expr {![::math::bignum::sign $a]}]
1608        return $a
1609    }
1610    # recursive call
1611    lset a 1 [opp [lindex $a 1]]
1612    return $a
1613}
1614
1615################################################################################
1616# gets Pi with precision bits
1617# after the dot (after you call [tostr] on the result)
1618################################################################################
1619proc ::math::bigfloat::pi {precision {binary 0}} {
1620    if {[llength $precision]>1} {
1621        if {[isInt $precision]} {
1622            set precision [tostr $precision]
1623        } else {
1624            error "'$precision' expected to be an integer"
1625        }
1626    }
1627    if {!$binary} {
1628        # convert decimal digit length into bit length
1629        set precision [expr {int(ceil($precision*log(10)/log(2)))}]
1630    }
1631    variable one
1632    return [list F [_pi $precision] -$precision $one]
1633}
1634
1635
1636proc ::math::bigfloat::_pi {precision} {
1637    # the constant Pi begins with 3.xxx
1638    # so we need 2 digits to store the digit '3'
1639    # and then we will have precision+2 bits in the mantissa
1640    variable _pi0
1641    if {![info exists _pi0]} {
1642        set _pi0 [__pi $precision]
1643    }
1644    set lenPiGlobal [::math::bignum::bits $_pi0]
1645    if {$lenPiGlobal<$precision} {
1646        set _pi0 [__pi $precision]
1647    }
1648    return [::math::bignum::rshift $_pi0 [expr {[::math::bignum::bits $_pi0]-2-$precision}]]
1649}
1650
1651################################################################################
1652# computes an integer representing Pi in binary radix, with precision bits
1653################################################################################
1654proc ::math::bigfloat::__pi {precision} {
1655    set safetyLimit 8
1656    # for safety and for the better precision, we do so ...
1657    incr precision $safetyLimit
1658    # formula found in the Math litterature
1659    # Pi/4 = 6.atan(1/18) + 8.atan(1/57) - 5.atan(1/239)
1660    set a [::math::bignum::mul [_atanfract [::math::bignum::fromstr 18] $precision] \
1661            [::math::bignum::fromstr 48]]
1662    set a [::math::bignum::add $a [::math::bignum::mul \
1663            [_atanfract [::math::bignum::fromstr 57] $precision] [::math::bignum::fromstr 32]]]
1664    set a [::math::bignum::sub $a [::math::bignum::mul \
1665            [_atanfract [::math::bignum::fromstr 239] $precision] [::math::bignum::fromstr 20]]]
1666    return [::math::bignum::rshift $a $safetyLimit]
1667}
1668
1669################################################################################
1670# shift right an integer until it haves $precision bits
1671# round at the same time
1672################################################################################
1673proc ::math::bigfloat::_round {integer precision} {
1674    set shift [expr {[::math::bignum::bits $integer]-$precision}]
1675    # $result holds the shifted integer
1676    set result [::math::bignum::rshift $integer $shift]
1677    # $shift-1 is the bit just rights the last bit of the result
1678    # Example : integer=1000010 shift=2
1679    # => result=10000 and the tested bit is '1'
1680    if {[::math::bignum::testbit $integer [expr {$shift-1}]]} {
1681        # we round to the upper limit
1682        return [::math::bignum::add 1 $result]
1683    }
1684    return $result
1685}
1686
1687################################################################################
1688# returns A power B, where B is a positive integer
1689################################################################################
1690proc ::math::bigfloat::pow {a b} {
1691    checkNumber a
1692    if {![isInt $b]} {
1693        error "pow : exponent is not a positive integer"
1694    }
1695    # case where it is obvious that we should use the appropriate command
1696    # from math::bignum (added 5th March 2005)
1697    if {[isInt $a]} {
1698        return [::math::bignum::pow $a $b]
1699    }
1700    # algorithm : exponent=$b = Sum(i=0..n) b(i)2^i
1701    # $a^$b = $a^( b(0) + 2b(1) + 4b(2) + ... + 2^n*b(n) )
1702    # we have $a^(x+y)=$a^x * $a^y
1703    # then $a^$b = Product(i=0...n) $a^(2^i*b(i))
1704    # b(i) is boolean so $a^(2^i*b(i))= 1 when b(i)=0 and = $a^(2^i) when b(i)=1
1705    # then $a^$b = Product(i=0...n and b(i)=1) $a^(2^i) and 1 when $b=0
1706    variable one
1707    if {[::math::bignum::iszero $b]} {return $one}
1708    # $res holds the result
1709    set res $one
1710    while {1} {
1711        # at the beginning i=0
1712        # $remainder is b(i)
1713        set remainder [::math::bignum::testbit $b 0]
1714        # $b 'rshift'ed by 1 bit : i=i+1
1715        # so next time we will test bit b(i+1)
1716        set b [::math::bignum::rshift $b 1]
1717        # if b(i)=1
1718        if {$remainder} {
1719            # mul the result by $a^(2^i)
1720            # if i=0 we multiply by $a^(2^0)=$a^1=$a
1721            set res [mul $res $a]
1722        }
1723        # no more bits at '1' in $b : $res is the result
1724        if {[::math::bignum::iszero $b]} {
1725            if {[isInt $res]} {
1726                # we cannot (and should not) normalize an integer
1727                return $res
1728            }
1729            return [normalize $res]
1730        }
1731        # i=i+1 : $a^(2^(i+1)) = square of $a^(2^i)
1732        set a [mul $a $a]
1733    }
1734}
1735
1736################################################################################
1737# converts angles for radians to degrees
1738################################################################################
1739proc ::math::bigfloat::rad2deg {x} {
1740    checkFloat x
1741    set xLen [expr {-[lindex $x 2]}]
1742    if {$xLen<3} {
1743        error "number too loose to convert to degrees"
1744    }
1745    set pi [pi $xLen 1]
1746    # $rad/Pi=$deg/180
1747    # so result in deg = $radians*180/Pi
1748    return [div [mul $x [::math::bignum::fromstr 180]] $pi]
1749}
1750
1751################################################################################
1752# retourne la partie enti�re (ou 0) du nombre "number"
1753################################################################################
1754proc ::math::bigfloat::round {number} {
1755    checkFloat number
1756    #set number [normalize $number]
1757    # fetching integers (or BigInts) from the internal representation
1758    foreach {dummy integer exp delta} $number {break}
1759    if {[::math::bignum::iszero $integer]} {
1760        # returns the BigInt 0
1761        variable zero
1762        return $zero
1763    }
1764    if {$exp>=0} {
1765        error "not enough precision to round (in round)"
1766    }
1767    set exp [expr {-$exp}]
1768    # saving the sign, ...
1769    set sign [::math::bignum::sign $integer]
1770    set integer [abs $integer]
1771    # integer part of the number
1772    set try [::math::bignum::rshift $integer $exp]
1773    # first bit after the dot
1774    set way [::math::bignum::testbit $integer [expr {$exp-1}]]
1775    # delta is shifted so it gives the integer part of 2*delta
1776    set delta [::math::bignum::rshift $delta [expr {$exp-1}]]
1777    # when delta is too big to compute rounded value (
1778    if {![::math::bignum::iszero $delta]} {
1779        error "not enough precision to round (in round)"
1780    }
1781    if {$way} {
1782        set try [::math::bignum::add 1 $try]
1783    }
1784    # ... restore the sign now
1785    ::math::bignum::setsign try $sign
1786    return $try
1787}
1788
1789################################################################################
1790# round and divide by 10^n
1791################################################################################
1792proc ::math::bigfloat::roundshift {integer n} {
1793    # $exp= 10^$n
1794    set exp [tenPow $n]
1795    foreach {result remainder} [::math::bignum::divqr $integer $exp] {}
1796    # $remainder belongs to the interval [0, $exp-1]
1797    # $remainder >= $exp/2 is the rounding condition
1798    # that is better expressed in this form :
1799    # $remainder*2 >= $exp , as we are treating integers, not rationals
1800    # left shift $remainder by 1 equals to multiplying by 2 and is much faster
1801    if {[::math::bignum::cmp $exp [::math::bignum::lshift $remainder 1]]<=0} {
1802        return [::math::bignum::add 1 $result]
1803    }
1804    return $result
1805}
1806
1807################################################################################
1808# gets the sign of either a bignum, or a BitFloat
1809# we keep the bignum convention : 0 for positive, 1 for negative
1810################################################################################
1811proc ::math::bigfloat::sign {n} {
1812    if {[isInt $n]} {
1813        return [::math::bignum::sign $n]
1814    }
1815    # sign of 0=0
1816    if {[iszero $n]} {return 0}
1817    # the sign of the Mantissa, which is a BigInt
1818    return [::math::bignum::sign [lindex $n 1]]
1819}
1820
1821
1822################################################################################
1823# gets sin(x)
1824################################################################################
1825proc ::math::bigfloat::sin {x} {
1826    checkFloat x
1827    foreach {dummy integer exp delta} $x {break}
1828    if {$exp>-2} {
1829        error "sin : not enough precision"
1830    }
1831    set precision [expr {-$exp}]
1832    # sin(2kPi+x)=sin(x)
1833    # $integer is now the modulo of the division of the mantissa by Pi/4
1834    # and $n is the quotient
1835    foreach {n integer} [divPiQuarter $integer $precision] {break}
1836    set delta [::math::bignum::add $delta $n]
1837    variable four
1838    set d [::math::bignum::mod $n $four]
1839    # now integer>=0
1840    # x = $n*Pi/4 + $integer and $n belongs to [0,3]
1841    # sin(2Pi-x)=-sin(x)
1842    # sin(Pi-x)=sin(x)
1843    # sin(Pi/2+x)=cos(x)
1844    set sign 0
1845    switch  -- [tostr $d] {
1846        0 {set l [_sin2 $integer $precision $delta]}
1847        1 {set l [_cos2 $integer $precision $delta]}
1848        2 {set sign 1;set l [_sin2 $integer $precision $delta]}
1849        3 {set sign 1;set l [_cos2 $integer $precision $delta]}
1850        default {error "internal error"}
1851    }
1852    # $l is a list : {Mantissa Precision Delta}
1853    # precision --> the opposite of the exponent
1854    # 1.000 = 1000*10^-3 so exponent=-3 and precision=3 digits
1855    lset l 1 [expr {-([lindex $l 1])}]
1856    set integer [lindex $l 0]
1857    # the sign depends on the switch statement below
1858    ::math::bignum::setsign integer $sign
1859    lset l 0 $integer
1860    # we insert the Bigfloat tag (F) and normalize the final result
1861    return [normalize [linsert $l 0 F]]
1862}
1863
1864proc ::math::bigfloat::_sin2 {x precision delta} {
1865    set pi [_pi $precision]
1866    # shift right by 1 = divide by 2
1867    # shift right by 2 = divide by 4
1868    set pis2 [::math::bignum::rshift $pi 1]
1869    set pis4 [::math::bignum::rshift $pi 2]
1870    if {[::math::bignum::cmp $x $pis4]>=0} {
1871        # sin(Pi/2-x)=cos(x)
1872        set delta [::math::bignum::add 1 $delta]
1873        set x [::math::bignum::sub $pis2 $x]
1874        return [_cos $x $precision $delta]
1875    }
1876    return [_sin $x $precision $delta]
1877}
1878
1879################################################################################
1880# sin(x) with 'x' lower than Pi/4 and positive
1881# 'x' is the Mantissa - 'delta' is Delta
1882# 'precision' is the opposite of the exponent
1883################################################################################
1884proc ::math::bigfloat::_sin {x precision delta} {
1885    # $s holds the result
1886    set s $x
1887    # sin(x) = x - x^3/3! + x^5/5! - ... + (-1)^n*x^(2n+1)/(2n+1)!
1888    #        = x * (1 - x^2/(2*3) * (1 - x^2/(4*5) * (...* (1 - x^2/(2n*(2n+1)) )...)))
1889    # The second expression allows us to compute the less we can
1890
1891    # $double holds the uncertainty (Delta) of x^2 : 2*(Mantissa*Delta) + Delta^2
1892    # (Mantissa+Delta)^2=Mantissa^2 + 2*Mantissa*Delta + Delta^2
1893    set double [::math::bignum::rshift [::math::bignum::mul $x $delta] [expr {$precision-1}]]
1894    set double [::math::bignum::add [::math::bignum::add 1 $double] [::math::bignum::rshift \
1895            [::math::bignum::mul $delta $delta] $precision]]
1896    # $x holds the Mantissa of x^2
1897    set x [intMulShift $x $x $precision]
1898    set dt [::math::bignum::rshift [::math::bignum::add [::math::bignum::mul $x $delta] \
1899            [::math::bignum::mul [::math::bignum::add $s $delta] $double]] $precision]
1900    set dt [::math::bignum::add 1 $dt]
1901    # $t holds $s * -(x^2) / (2n*(2n+1))
1902    # mul by x^2
1903    set t [intMulShift $s $x $precision]
1904    variable two
1905    set denom2 $two
1906    variable three
1907    set denom3 $three
1908    # mul by -1 (opp) and divide by 2*3
1909    set t [opp [::math::bignum::div $t [::math::bignum::mul $denom2 $denom3]]]
1910    while {![::math::bignum::iszero $t]} {
1911        set s [::math::bignum::add $s $t]
1912        set delta [::math::bignum::add $delta $dt]
1913        # incr n => 2n --> 2n+2 and 2n+1 --> 2n+3
1914        set denom2 [::math::bignum::add $denom2 $two]
1915        set denom3 [::math::bignum::add $denom3 $two]
1916        # $dt is the Delta corresponding to $t
1917        # $double ""     ""    ""     ""    $x (x^2)
1918        # ($t+$dt) * ($x+$double) = $t*$x + ($dt*$x + $t*$double) + $dt*$double
1919        #                   Mantissa^        ^--------Delta-------------------^
1920        set dt [::math::bignum::rshift [::math::bignum::add [::math::bignum::mul $x $dt] \
1921                [::math::bignum::mul [::math::bignum::add $t $dt] $double]] $precision]
1922        set t [intMulShift $t $x $precision]
1923        # removed 2005/08/31 by sarnold75
1924        #set dt [::math::bignum::add $dt $double]
1925        set denom [::math::bignum::mul $denom2 $denom3]
1926        # now computing : div by -2n(2n+1)
1927        set dt [::math::bignum::add 1 [::math::bignum::div $dt $denom]]
1928        set t [opp [::math::bignum::div $t $denom]]
1929    }
1930    return [list $s $precision $delta]
1931}
1932
1933
1934################################################################################
1935# procedure for extracting the square root of a BigFloat
1936################################################################################
1937proc ::math::bigfloat::sqrt {x} {
1938    variable one
1939    checkFloat x
1940    foreach {dummy integer exp delta} $x {break}
1941    # if x=0, return 0
1942    if {[iszero $x]} {
1943        variable zero
1944        # return zero, taking care of its precision ($exp)
1945        return [list F $zero $exp $one]
1946    }
1947    # we cannot get sqrt(x) if x<0
1948    if {[lindex $integer 0]<0} {
1949        error "negative sqrt input"
1950    }
1951    # (1+epsilon)^p = 1 + epsilon*(p-1) + epsilon^2*(p-1)*(p-2)/2! + ...
1952    #                   + epsilon^n*(p-1)*...*(p-n)/n!
1953    # sqrt(1 + epsilon) = (1 + epsilon)^(1/2)
1954    #                   = 1 - epsilon/2 - epsilon^2*3/(4*2!) - ...
1955    #                       - epsilon^n*(3*5*..*(2n-1))/(2^n*n!)
1956    # sqrt(1 - epsilon) = 1 + Sum(i=1..infinity) epsilon^i*(3*5*...*(2i-1))/(i!*2^i)
1957    # sqrt(n +/- delta)=sqrt(n) * sqrt(1 +/- delta/n)
1958    # so the uncertainty on sqrt(n +/- delta) equals sqrt(n) * (sqrt(1 - delta/n) - 1)
1959    #         sqrt(1+eps) < sqrt(1-eps) because their logarithm compare as :
1960    #       -ln(2)(1+eps) < -ln(2)(1-eps)
1961    # finally :
1962    # Delta = sqrt(n) * Sum(i=1..infinity) (delta/n)^i*(3*5*...*(2i-1))/(i!*2^i)
1963    # here we compute the second term of the product by _sqrtOnePlusEpsilon
1964    set delta [_sqrtOnePlusEpsilon $delta $integer]
1965    set intLen [::math::bignum::bits $integer]
1966    # removed 2005/08/31 by sarnold75, readded 2005/08/31
1967    set precision $intLen
1968    # intLen + exp = number of bits before the dot
1969    #set precision [expr {-$exp}]
1970    # square root extraction
1971    set integer [::math::bignum::lshift $integer $intLen]
1972    incr exp -$intLen
1973    incr intLen $intLen
1974    # there is an exponent 2^$exp : when $exp is odd, we would need to compute sqrt(2)
1975    # so we decrement $exp, in order to get it even, and we do not need sqrt(2) anymore !
1976    if {$exp&1} {
1977        incr exp -1
1978        set integer [::math::bignum::lshift $integer 1]
1979        incr intLen
1980        incr precision
1981    }
1982    # using a low-level (in math::bignum) root extraction procedure
1983    set integer [::math::bignum::sqrt $integer]
1984    # delta has to be multiplied by the square root
1985    set delta [::math::bignum::rshift [::math::bignum::mul $delta $integer] $precision]
1986    # round to the ceiling the uncertainty (worst precision, the fastest to compute)
1987    set delta [::math::bignum::add 1 $delta]
1988    # we are sure that $exp is even, see above
1989    return [normalize [list F $integer [expr {$exp/2}] $delta]]
1990}
1991
1992
1993
1994################################################################################
1995# compute abs(sqrt(1-delta/integer)-1)
1996# the returned value is a relative uncertainty
1997################################################################################
1998proc ::math::bigfloat::_sqrtOnePlusEpsilon {delta integer} {
1999    # sqrt(1-x) - 1 = x/2 + x^2*3/(2^2*2!) + x^3*3*5/(2^3*3!) + ...
2000    #               = x/2 * (1 + x*3/(2*2) * ( 1 + x*5/(2*3) *
2001    #                     (...* (1 + x*(2n-1)/(2n) ) )...)))
2002    variable one
2003    set l [::math::bignum::bits $integer]
2004    # to compute delta/integer we have to shift left to keep the same precision level
2005    # we have a better accuracy computing (delta << lg(integer))/integer
2006    # than computing (delta/integer) << lg(integer)
2007    set x [::math::bignum::div [::math::bignum::lshift $delta $l] $integer]
2008    variable four
2009    variable two
2010    # denom holds 2n
2011    set denom $four
2012    # x/2
2013    set result [::math::bignum::div $x $two]
2014    # x^2*3/(2!*2^2)
2015    variable three
2016    # numerator holds 2n-1
2017    set numerator $three
2018    set temp [::math::bignum::mul $result $delta]
2019    set temp [::math::bignum::div [::math::bignum::mul $temp $numerator] $integer]
2020    set temp [::math::bignum::add 1 [::math::bignum::div $temp $denom]]
2021    while {![::math::bignum::iszero $temp]} {
2022        set result [::math::bignum::add $result $temp]
2023        set numerator [::math::bignum::add $numerator $two]
2024        set denom [::math::bignum::add $two $denom]
2025        # n = n+1 ==> num=num+2 denom=denom+2
2026        # num=2n+1 denom=2n+2
2027        set temp [::math::bignum::mul [::math::bignum::mul $temp $delta] $numerator]
2028        set temp [::math::bignum::div [::math::bignum::div $temp $denom] $integer]
2029    }
2030    return $result
2031}
2032
2033################################################################################
2034# substracts B to A
2035################################################################################
2036proc ::math::bigfloat::sub {a b} {
2037    checkNumber a b
2038    if {[isInt $a] && [isInt $b]} {
2039        # the math::bignum::sub proc is designed to work with BigInts
2040        return [::math::bignum::sub $a $b]
2041    }
2042    return [add $a [opp $b]]
2043}
2044
2045################################################################################
2046# tangent (trivial algorithm)
2047################################################################################
2048proc ::math::bigfloat::tan {x} {
2049    return [::math::bigfloat::div [::math::bigfloat::sin $x] [::math::bigfloat::cos $x]]
2050}
2051
2052################################################################################
2053# returns a power of ten
2054################################################################################
2055proc ::math::bigfloat::tenPow {n} {
2056    variable ten
2057    return [::math::bignum::pow $ten [::math::bignum::fromstr $n]]
2058}
2059
2060
2061################################################################################
2062# converts a BigInt to a double (basic floating-point type)
2063# with respect to the global variable 'tcl_precision'
2064################################################################################
2065proc ::math::bigfloat::todouble {x} {
2066    global tcl_precision
2067    checkFloat x
2068    # get the string repr of x without the '+' sign
2069    set result [string trimleft [tostr $x] +]
2070    set minus ""
2071    if {[string index $result 0]=="-"} {
2072        set minus -
2073        set result [string range $result 1 end]
2074    }
2075    set l [split $result e]
2076    set exp 0
2077    if {[llength $l]==2} {
2078        # exp : x=Mantissa*10^Exp
2079        set exp [lindex $l 1]
2080    }
2081    # Mantissa = integerPart.fractionalPart
2082    set l [split [lindex $l 0] .]
2083    set integerPart [lindex $l 0]
2084    set integerLen [string length $integerPart]
2085    set fractionalPart [lindex $l 1]
2086    # The number of digits in Mantissa, excluding the dot and the leading zeros, of course
2087    set len [string length [set integer $integerPart$fractionalPart]]
2088    # Now Mantissa is stored in $integer
2089    if {$len>$tcl_precision} {
2090        set lenDiff [expr {$len-$tcl_precision}]
2091        # true when the number begins with a zero
2092        set zeroHead 0
2093        if {[string index $integer 0]==0} {
2094            incr lenDiff -1
2095            set zeroHead 1
2096        }
2097        set integer [tostr [roundshift [::math::bignum::fromstr $integer] $lenDiff]]
2098        if {$zeroHead} {
2099            set integer 0$integer
2100        }
2101        set len [string length $integer]
2102        if {$len<$integerLen} {
2103            set exp [expr {$integerLen-$len}]
2104            # restore the true length
2105            set integerLen $len
2106        }
2107    }
2108    # number = 'sign'*'integer'*10^'exp'
2109    if {$exp==0} {
2110        # no scientific notation
2111        set exp ""
2112    } else {
2113        # scientific notation
2114        set exp e$exp
2115    }
2116    # place the dot just before the index $integerLen in the Mantissa
2117    set result [string range $integer 0 [expr {$integerLen-1}]]
2118    append result .[string range $integer $integerLen end]
2119    # join the Mantissa with the sign before and the exponent after
2120    return $minus$result$exp
2121}
2122
2123################################################################################
2124# converts a number stored as a list to a string in which all digits are true
2125################################################################################
2126proc ::math::bigfloat::tostr {args} {
2127    variable five
2128	if {[llength $args]==2} {
2129		if {![string equal [lindex $args 0] -nosci]} {error "unknown option: should be -nosci"}
2130		set nosci yes
2131		set number [lindex $args 1]
2132	} else {
2133		if {[llength $args]!=1} {error "syntax error: should be tostr ?-nosci? number"}
2134		set nosci no
2135		set number [lindex $args 0]
2136	}
2137    if {[isInt $number]} {
2138        return [::math::bignum::tostr $number]
2139    }
2140    checkFloat number
2141    foreach {dummy integer exp delta} $number {break}
2142    if {[iszero $number]} {
2143        # we do not matter how much precision $number has :
2144        # it can be 0.0000000 or 0.0, the result is still the same : the "0" string
2145	# not anymore : 0.000 is not 0.0 !
2146    #    return 0
2147    }
2148    if {$exp>0} {
2149        # the power of ten the closest but greater than 2^$exp
2150        # if it was lower than the power of 2, we would have more precision
2151        # than existing in the number
2152        set newExp [expr {int(ceil($exp*log(2)/log(10)))}]
2153        # 'integer' <- 'integer' * 2^exp / 10^newExp
2154        # equals 'integer' * 2^(exp-newExp) / 5^newExp
2155        set binExp [expr {$exp-$newExp}]
2156        if {$binExp<0} {
2157            # it cannot happen
2158            error "internal error"
2159        }
2160        # 5^newExp
2161        set fivePower [::math::bignum::pow $five [::math::bignum::fromstr $newExp]]
2162        # 'lshift'ing $integer by $binExp bits is like multiplying it by 2^$binExp
2163        # but much, much faster
2164        set integer [::math::bignum::div [::math::bignum::lshift $integer $binExp] \
2165                $fivePower]
2166        # $integer is the Mantissa - Delta should follow the same operations
2167        set delta [::math::bignum::div [::math::bignum::lshift $delta $binExp] $fivePower]
2168        set exp $newExp
2169    } elseif {$exp<0} {
2170        # the power of ten the closest but lower than 2^$exp
2171        # same remark about the precision
2172        set newExp [expr {int(floor(-$exp*log(2)/log(10)))}]
2173        # 'integer' <- 'integer' * 10^newExp / 2^(-exp)
2174        # equals 'integer' * 5^(newExp) / 2^(-exp-newExp)
2175        set fivePower [::math::bignum::pow $five \
2176                [::math::bignum::fromstr $newExp]]
2177        set binShift [expr {-$exp-$newExp}]
2178        # rshifting is like dividing by 2^$binShift, but faster as we said above about lshift
2179        set integer [::math::bignum::rshift [::math::bignum::mul $integer $fivePower] \
2180                $binShift]
2181        set delta [::math::bignum::rshift [::math::bignum::mul $delta $fivePower] \
2182                $binShift]
2183        set exp -$newExp
2184    }
2185    # saving the sign, to restore it into the result
2186    set sign [::math::bignum::sign $integer]
2187    set result [::math::bignum::abs $integer]
2188    # rounded 'integer' +/- 'delta'
2189    set up [::math::bignum::add $result $delta]
2190    set down [::math::bignum::sub $result $delta]
2191    if {[sign $up]^[sign $down]} {
2192        # $up>0 and $down<0 and vice-versa : then the number is considered equal to zero
2193		# delta <= 2**n (n = bits(delta))
2194		# 2**n  <= 10**exp , then
2195		# exp >= n.log(2)/log(10)
2196		# delta <= 10**(n.log(2)/log(10))
2197        incr exp [expr {int(ceil([::math::bignum::bits $delta]*log(2)/log(10)))}]
2198        set result 0
2199        set isZero yes
2200    } else {
2201		# iterate until the convergence of the rounding
2202		# we incr $shift until $up and $down are rounded to the same number
2203		# at each pass we lose one digit of precision, so necessarly it will success
2204		for {set shift 1} {
2205			[::math::bignum::cmp [roundshift $up $shift] [roundshift $down $shift]]
2206		} {
2207			incr shift
2208		} {}
2209		incr exp $shift
2210		set result [::math::bignum::tostr [roundshift $up $shift]]
2211		set isZero no
2212    }
2213    set l [string length $result]
2214    # now formatting the number the most nicely for having a clear reading
2215    # would'nt we allow a number being constantly displayed
2216    # as : 0.2947497845e+012 , would we ?
2217	if {$nosci} {
2218		if {$exp >= 0} {
2219			append result [string repeat 0 $exp].
2220		} elseif {$l + $exp > 0} {
2221			set result [string range $result 0 end-[expr {-$exp}]].[string range $result end-[expr {-1-$exp}] end]
2222		} else {
2223			set result 0.[string repeat 0 [expr {-$exp-$l}]]$result
2224		}
2225	} else {
2226		if {$exp>0} {
2227			# we display 423*10^6 as : 4.23e+8
2228			# Length of mantissa : $l
2229			# Increment exp by $l-1 because the first digit is placed before the dot,
2230			# the other ($l-1) digits following the dot.
2231			incr exp [incr l -1]
2232			set result [string index $result 0].[string range $result 1 end]
2233			append result "e+$exp"
2234		} elseif {$exp==0} {
2235			# it must have a dot to be a floating-point number (syntaxically speaking)
2236			append result .
2237		} else {
2238			set exp [expr {-$exp}]
2239			if {$exp < $l} {
2240				# we can display the number nicely as xxxx.yyyy*
2241				# the problem of the sign is solved finally at the bottom of the proc
2242				set n [string range $result 0 end-$exp]
2243				incr exp -1
2244				append n .[string range $result end-$exp end]
2245				set result $n
2246			} elseif {$l==$exp} {
2247				# we avoid to use the scientific notation
2248				# because it is harder to read
2249				set result "0.$result"
2250			} else  {
2251				# ... but here there is no choice, we should not represent a number
2252				# with more than one leading zero
2253				set result [string index $result 0].[string range $result 1 end]e-[expr {$exp-$l+1}]
2254			}
2255		}
2256	}
2257    # restore the sign : we only put a minus on numbers that are different from zero
2258    if {$sign==1 && !$isZero} {set result "-$result"}
2259    return $result
2260}
2261
2262################################################################################
2263# PART IV
2264# HYPERBOLIC FUNCTIONS
2265################################################################################
2266
2267################################################################################
2268# hyperbolic cosinus
2269################################################################################
2270proc ::math::bigfloat::cosh {x} {
2271    # cosh(x) = (exp(x)+exp(-x))/2
2272    # dividing by 2 is done faster by 'rshift'ing
2273    return [floatRShift [add [exp $x] [exp [opp $x]]] 1]
2274}
2275
2276################################################################################
2277# hyperbolic sinus
2278################################################################################
2279proc ::math::bigfloat::sinh {x} {
2280    # sinh(x) = (exp(x)-exp(-x))/2
2281    # dividing by 2 is done faster by 'rshift'ing
2282    return [floatRShift [sub [exp $x] [exp [opp $x]]] 1]
2283}
2284
2285################################################################################
2286# hyperbolic tangent
2287################################################################################
2288proc ::math::bigfloat::tanh {x} {
2289    set up [exp $x]
2290    set down [exp [opp $x]]
2291    # tanh(x)=sinh(x)/cosh(x)= (exp(x)-exp(-x))/2/ [(exp(x)+exp(-x))/2]
2292    #        =(exp(x)-exp(-x))/(exp(x)+exp(-x))
2293    #        =($up-$down)/($up+$down)
2294    return [div [sub $up $down] [add $up $down]]
2295}
2296
2297# exporting public interface
2298namespace eval ::math::bigfloat {
2299    foreach function {
2300        add mul sub div mod pow
2301        iszero compare equal
2302        fromstr tostr fromdouble todouble
2303        int2float isInt isFloat
2304        exp log sqrt round ceil floor
2305        sin cos tan cotan asin acos atan
2306        cosh sinh tanh abs opp
2307        pi deg2rad rad2deg
2308    } {
2309        namespace export $function
2310    }
2311}
2312
2313# (AM) No "namespace import" - this should be left to the user!
2314#namespace import ::math::bigfloat::*
2315
2316package provide math::bigfloat 1.2.2
2317