xref: /openbsd-src/gnu/usr.bin/perl/cpan/Math-BigInt/lib/Math/BigFloat.pm (revision c90a81c56dcebd6a1b73fe4aff9b03385b8e63b3)
1package Math::BigFloat;
2
3#
4# Mike grinned. 'Two down, infinity to go' - Mike Nostrus in 'Before and After'
5#
6
7# The following hash values are internally used:
8#   _e	: exponent (ref to $CALC object)
9#   _m	: mantissa (ref to $CALC object)
10#   _es	: sign of _e
11# sign	: +,-,+inf,-inf, or "NaN" if not a number
12#   _a	: accuracy
13#   _p	: precision
14
15use 5.006001;
16use strict;
17use warnings;
18
19our $VERSION = '1.999715';
20$VERSION = eval $VERSION;
21
22require Exporter;
23our @ISA	= qw/Math::BigInt/;
24our @EXPORT_OK	= qw/bpi/;
25
26# $_trap_inf/$_trap_nan are internal and should never be accessed from outside
27our ($AUTOLOAD, $accuracy, $precision, $div_scale, $round_mode, $rnd_mode,
28     $upgrade, $downgrade, $_trap_nan, $_trap_inf);
29
30my $class = "Math::BigFloat";
31
32use overload
33  '<=>'	=>	sub { my $rc = $_[2] ? ref($_[0])->bcmp($_[1], $_[0])
34                                     : ref($_[0])->bcmp($_[0], $_[1]);
35		      $rc = 1 unless defined $rc;
36		      $rc <=> 0;
37		},
38# we need '>=' to get things like "1 >= NaN" right:
39  '>='	=>	sub { my $rc = $_[2] ? ref($_[0])->bcmp($_[1],$_[0])
40                                     : ref($_[0])->bcmp($_[0],$_[1]);
41		      # if there was a NaN involved, return false
42		      return '' unless defined $rc;
43		      $rc >= 0;
44		},
45  'int'	=>	sub { $_[0]->as_number() },		# 'trunc' to bigint
46;
47
48##############################################################################
49# global constants, flags and assorted stuff
50
51# the following are public, but their usage is not recommended. Use the
52# accessor methods instead.
53
54# class constants, use Class->constant_name() to access
55# one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
56$round_mode = 'even';
57$accuracy   = undef;
58$precision  = undef;
59$div_scale  = 40;
60
61$upgrade = undef;
62$downgrade = undef;
63# the package we are using for our private parts, defaults to:
64# Math::BigInt->config()->{lib}
65my $MBI = 'Math::BigInt::Calc';
66
67# are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config()
68$_trap_nan = 0;
69# the same for infinity
70$_trap_inf = 0;
71
72# constant for easier life
73my $nan = 'NaN';
74
75my $IMPORT = 0;	# was import() called yet? used to make require work
76
77# some digits of accuracy for blog(undef,10); which we use in blog() for speed
78my $LOG_10 =
79 '2.3025850929940456840179914546843642076011014886287729760333279009675726097';
80my $LOG_10_A = length($LOG_10)-1;
81# ditto for log(2)
82my $LOG_2 =
83 '0.6931471805599453094172321214581765680755001343602552541206800094933936220';
84my $LOG_2_A = length($LOG_2)-1;
85my $HALF = '0.5';			# made into an object if nec.
86
87##############################################################################
88# the old code had $rnd_mode, so we need to support it, too
89
90sub TIESCALAR   { my ($class) = @_; bless \$round_mode, $class; }
91sub FETCH       { return $round_mode; }
92sub STORE       { $rnd_mode = $_[0]->round_mode($_[1]); }
93
94BEGIN
95  {
96  # when someone sets $rnd_mode, we catch this and check the value to see
97  # whether it is valid or not.
98  $rnd_mode   = 'even'; tie $rnd_mode, 'Math::BigFloat';
99
100  # we need both of them in this package:
101  *as_int = \&as_number;
102  }
103
104##############################################################################
105
106{
107  # valid method aliases for AUTOLOAD
108  my %methods = map { $_ => 1 }
109   qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
110        fint facmp fcmp fzero fnan finf finc fdec ffac fneg
111	fceil ffloor frsft flsft fone flog froot fexp
112      /;
113  # valid methods that can be handed up (for AUTOLOAD)
114  my %hand_ups = map { $_ => 1 }
115   qw / is_nan is_inf is_negative is_positive is_pos is_neg
116        accuracy precision div_scale round_mode fabs fnot
117        objectify upgrade downgrade
118	bone binf bnan bzero
119	bsub
120      /;
121
122  sub _method_alias { exists $methods{$_[0]||''}; }
123  sub _method_hand_up { exists $hand_ups{$_[0]||''}; }
124}
125
126##############################################################################
127# constructors
128
129sub new {
130    # Create a new BigFloat object from a string or another bigfloat object.
131    # _e: exponent
132    # _m: mantissa
133    # sign  => sign ("+", "-", "+inf", "-inf", or "NaN"
134
135    my $self    = shift;
136    my $selfref = ref $self;
137    my $class   = $selfref || $self;
138
139    my ($wanted, @r) = @_;
140
141    # avoid numify-calls by not using || on $wanted!
142
143    unless (defined $wanted) {
144        require Carp;
145        Carp::carp("Use of uninitialized value in new");
146        return $self->bzero(@r);
147    }
148
149    # Using $wanted->isa("Math::BigFloat") here causes a 'Deep recursion on
150    # subroutine "Math::BigFloat::as_number"' in some tests. Fixme!
151
152    if (UNIVERSAL::isa($wanted, 'Math::BigFloat')) {
153        my $copy = $wanted -> copy();
154        if ($selfref) {                 # if new() called as instance method
155            %$self = %$copy;
156        } else {                        # if new() called as class method
157            $self = $copy;
158        }
159        return $copy;
160    }
161
162    $class->import() if $IMPORT == 0;             # make require work
163
164    # If called as a class method, initialize a new object.
165
166    $self = bless {}, $class unless $selfref;
167
168    # shortcut for bigints and its subclasses
169    if ((ref($wanted)) && $wanted -> can("as_number")) {
170        $self->{_m} = $wanted->as_number()->{value};  # get us a bigint copy
171        $self->{_e} = $MBI->_zero();
172        $self->{_es} = '+';
173        $self->{sign} = $wanted->sign();
174        return $self->bnorm();
175    }
176
177    # else: got a string or something masquerading as number (with overload)
178
179    # Handle Infs.
180
181    if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) {
182        return $downgrade->new($wanted) if $downgrade;
183        my $sgn = $1 || '+';
184        $self->{sign} = $sgn . 'inf';   # set a default sign for bstr()
185        return $self->binf($sgn);
186    }
187
188    # Shortcut for simple forms like '12' that have no trailing zeros.
189    if ($wanted =~ /^([+-]?)0*([1-9][0-9]*[1-9])$/) {
190        $self->{_e} = $MBI->_zero();
191        $self->{_es} = '+';
192        $self->{sign} = $1 || '+';
193        $self->{_m} = $MBI->_new($2);
194        return $self->round(@r) if !$downgrade;
195    }
196
197  my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($wanted);
198  if (!ref $mis)
199    {
200    if ($_trap_nan)
201      {
202      require Carp;
203      Carp::croak ("$wanted is not a number initialized to $class");
204      }
205
206    return $downgrade->bnan() if $downgrade;
207
208    $self->{_e} = $MBI->_zero();
209    $self->{_es} = '+';
210    $self->{_m} = $MBI->_zero();
211    $self->{sign} = $nan;
212    }
213  else
214    {
215    # make integer from mantissa by adjusting exp, then convert to int
216    $self->{_e} = $MBI->_new($$ev);		# exponent
217    $self->{_es} = $$es || '+';
218    my $mantissa = "$$miv$$mfv"; 		# create mant.
219    $mantissa =~ s/^0+(\d)/$1/;			# strip leading zeros
220    $self->{_m} = $MBI->_new($mantissa); 	# create mant.
221
222    # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5
223    if (CORE::length($$mfv) != 0)
224      {
225      my $len = $MBI->_new( CORE::length($$mfv));
226      ($self->{_e}, $self->{_es}) =
227	_e_sub ($self->{_e}, $len, $self->{_es}, '+');
228      }
229    # we can only have trailing zeros on the mantissa if $$mfv eq ''
230    else
231      {
232      # Use a regexp to count the trailing zeros in $$miv instead of _zeros()
233      # because that is faster, especially when _m is not stored in base 10.
234      my $zeros = 0; $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/;
235      if ($zeros != 0)
236        {
237        my $z = $MBI->_new($zeros);
238        # turn '120e2' into '12e3'
239        $MBI->_rsft ( $self->{_m}, $z, 10);
240        ($self->{_e}, $self->{_es}) =
241	  _e_add ( $self->{_e}, $z, $self->{_es}, '+');
242        }
243      }
244    $self->{sign} = $$mis;
245
246    # for something like 0Ey, set y to 0, and -0 => +0
247    # Check $$miv for being '0' and $$mfv eq '', because otherwise _m could not
248    # have become 0. That's faster than to call $MBI->_is_zero().
249    $self->{sign} = '+', $self->{_e} = $MBI->_zero()
250     if $$miv eq '0' and $$mfv eq '';
251
252    return $self->round(@r) if !$downgrade;
253    }
254  # if downgrade, inf, NaN or integers go down
255
256  if ($downgrade && $self->{_es} eq '+')
257    {
258    if ($MBI->_is_zero( $self->{_e} ))
259      {
260      return $downgrade->new($$mis . $MBI->_str( $self->{_m} ));
261      }
262    return $downgrade->new($self->bsstr());
263    }
264  $self->bnorm()->round(@r);			# first normalize, then round
265  }
266
267sub copy {
268    my $self    = shift;
269    my $selfref = ref $self;
270    my $class   = $selfref || $self;
271
272    # If called as a class method, the object to copy is the next argument.
273
274    $self = shift() unless $selfref;
275
276    my $copy = bless {}, $class;
277
278    $copy->{sign} = $self->{sign};
279    $copy->{_es}  = $self->{_es};
280    $copy->{_m}   = $MBI->_copy($self->{_m});
281    $copy->{_e}   = $MBI->_copy($self->{_e});
282    $copy->{_a}   = $self->{_a} if exists $self->{_a};
283    $copy->{_p}   = $self->{_p} if exists $self->{_p};
284
285    return $copy;
286}
287
288sub _bnan
289  {
290  # used by parent class bone() to initialize number to NaN
291  my $self = shift;
292
293  if ($_trap_nan)
294    {
295    require Carp;
296    my $class = ref($self);
297    Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
298    }
299
300  $IMPORT=1;					# call our import only once
301  $self->{_m} = $MBI->_zero();
302  $self->{_e} = $MBI->_zero();
303  $self->{_es} = '+';
304  }
305
306sub _binf
307  {
308  # used by parent class bone() to initialize number to +-inf
309  my $self = shift;
310
311  if ($_trap_inf)
312    {
313    require Carp;
314    my $class = ref($self);
315    Carp::croak ("Tried to set $self to +-inf in $class\::_binf()");
316    }
317
318  $IMPORT=1;					# call our import only once
319  $self->{_m} = $MBI->_zero();
320  $self->{_e} = $MBI->_zero();
321  $self->{_es} = '+';
322  }
323
324sub _bone
325  {
326  # used by parent class bone() to initialize number to 1
327  my $self = shift;
328  $IMPORT=1;					# call our import only once
329  $self->{_m} = $MBI->_one();
330  $self->{_e} = $MBI->_zero();
331  $self->{_es} = '+';
332  }
333
334sub _bzero
335  {
336  # used by parent class bzero() to initialize number to 0
337  my $self = shift;
338  $IMPORT=1;					# call our import only once
339  $self->{_m} = $MBI->_zero();
340  $self->{_e} = $MBI->_zero();
341  $self->{_es} = '+';
342  }
343
344sub isa
345  {
346  my ($self,$class) = @_;
347  return if $class =~ /^Math::BigInt/;		# we aren't one of these
348  UNIVERSAL::isa($self,$class);
349  }
350
351sub config
352  {
353  # return (later set?) configuration data as hash ref
354  my $class = shift || 'Math::BigFloat';
355
356  if (@_ == 1 && ref($_[0]) ne 'HASH')
357    {
358    my $cfg = $class->SUPER::config();
359    return $cfg->{$_[0]};
360    }
361
362  my $cfg = $class->SUPER::config(@_);
363
364  # now we need only to override the ones that are different from our parent
365  $cfg->{class} = $class;
366  $cfg->{with} = $MBI;
367  $cfg;
368  }
369
370##############################################################################
371# string conversion
372
373sub bstr
374  {
375  # (ref to BFLOAT or num_str ) return num_str
376  # Convert number from internal format to (non-scientific) string format.
377  # internal format is always normalized (no leading zeros, "-0" => "+0")
378  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
379
380  if ($x->{sign} !~ /^[+-]$/)
381    {
382    return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
383    return 'inf';                                       # +inf
384    }
385
386  my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.';
387
388  # $x is zero?
389  my $not_zero = !($x->{sign} eq '+' && $MBI->_is_zero($x->{_m}));
390  if ($not_zero)
391    {
392    $es = $MBI->_str($x->{_m});
393    $len = CORE::length($es);
394    my $e = $MBI->_num($x->{_e});
395    $e = -$e if $x->{_es} eq '-';
396    if ($e < 0)
397      {
398      $dot = '';
399      # if _e is bigger than a scalar, the following will blow your memory
400      if ($e <= -$len)
401        {
402        my $r = abs($e) - $len;
403        $es = '0.'. ('0' x $r) . $es; $cad = -($len+$r);
404        }
405      else
406        {
407        substr($es,$e,0) = '.'; $cad = $MBI->_num($x->{_e});
408        $cad = -$cad if $x->{_es} eq '-';
409        }
410      }
411    elsif ($e > 0)
412      {
413      # expand with zeros
414      $es .= '0' x $e; $len += $e; $cad = 0;
415      }
416    } # if not zero
417
418  $es = '-'.$es if $x->{sign} eq '-';
419  # if set accuracy or precision, pad with zeros on the right side
420  if ((defined $x->{_a}) && ($not_zero))
421    {
422    # 123400 => 6, 0.1234 => 4, 0.001234 => 4
423    my $zeros = $x->{_a} - $cad;		# cad == 0 => 12340
424    $zeros = $x->{_a} - $len if $cad != $len;
425    $es .= $dot.'0' x $zeros if $zeros > 0;
426    }
427  elsif ((($x->{_p} || 0) < 0))
428    {
429    # 123400 => 6, 0.1234 => 4, 0.001234 => 6
430    my $zeros = -$x->{_p} + $cad;
431    $es .= $dot.'0' x $zeros if $zeros > 0;
432    }
433  $es;
434  }
435
436sub bsstr
437  {
438  # (ref to BFLOAT or num_str ) return num_str
439  # Convert number from internal format to scientific string format.
440  # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
441  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
442
443  if ($x->{sign} !~ /^[+-]$/)
444    {
445    return $x->{sign} unless $x->{sign} eq '+inf';      # -inf, NaN
446    return 'inf';                                       # +inf
447    }
448  my $sep = 'e'.$x->{_es};
449  my $sign = $x->{sign}; $sign = '' if $sign eq '+';
450  $sign . $MBI->_str($x->{_m}) . $sep . $MBI->_str($x->{_e});
451  }
452
453sub numify
454  {
455  # Make a Perl scalar number from a Math::BigFloat object.
456  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
457
458  if ($x -> is_nan()) {
459      require Math::Complex;
460      my $inf = Math::Complex::Inf();
461      return $inf - $inf;
462  }
463
464  if ($x -> is_inf()) {
465      require Math::Complex;
466      my $inf = Math::Complex::Inf();
467      return $x -> is_negative() ? -$inf : $inf;
468  }
469
470  # Create a string and let Perl's atoi()/atof() handle the rest.
471  return 0 + $x -> bsstr();
472  }
473
474##############################################################################
475# public stuff (usually prefixed with "b")
476
477sub bneg
478  {
479  # (BINT or num_str) return BINT
480  # negate number or make a negated number from string
481  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
482
483  return $x if $x->modify('bneg');
484
485  # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
486  $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_m}));
487  $x;
488  }
489
490# tels 2001-08-04
491# XXX TODO this must be overwritten and return NaN for non-integer values
492# band(), bior(), bxor(), too
493#sub bnot
494#  {
495#  $class->SUPER::bnot($class,@_);
496#  }
497
498sub bcmp
499  {
500  # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
501
502  # set up parameters
503  my ($self,$x,$y) = (ref($_[0]),@_);
504
505  # objectify is costly, so avoid it
506  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
507    {
508    ($self,$x,$y) = objectify(2,@_);
509    }
510
511  return $upgrade->bcmp($x,$y) if defined $upgrade &&
512    ((!$x->isa($self)) || (!$y->isa($self)));
513
514  # Handle all 'nan' cases.
515
516  return undef if ($x->{sign} eq $nan) || ($y->{sign} eq $nan);
517
518  # Handle all '+inf' and '-inf' cases.
519
520  return  0 if ($x->{sign} eq '+inf' && $y->{sign} eq '+inf' ||
521                $x->{sign} eq '-inf' && $y->{sign} eq '-inf');
522  return +1 if $x->{sign} eq '+inf';    # x = +inf and y < +inf
523  return -1 if $x->{sign} eq '-inf';    # x = -inf and y > -inf
524  return -1 if $y->{sign} eq '+inf';    # x < +inf and y = +inf
525  return +1 if $y->{sign} eq '-inf';    # x > -inf and y = -inf
526
527  # Handle all cases with opposite signs.
528
529  return +1 if $x->{sign} eq '+' && $y->{sign} eq '-';  # also does 0 <=> -y
530  return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';  # also does -x <=> 0
531
532  # Handle all remaining zero cases.
533
534  my $xz = $x->is_zero();
535  my $yz = $y->is_zero();
536  return  0 if $xz && $yz;                              # 0 <=> 0
537  return -1 if $xz && $y->{sign} eq '+';                # 0 <=> +y
538  return +1 if $yz && $x->{sign} eq '+';                # +x <=> 0
539
540  # Both arguments are now finite, non-zero numbers with the same sign.
541
542  my $cmp;
543
544  # The next step is to compare the exponents, but since each mantissa is an
545  # integer of arbitrary value, the exponents must be normalized by the length
546  # of the mantissas before we can compare them.
547
548  my $mxl = $MBI->_len($x->{_m});
549  my $myl = $MBI->_len($y->{_m});
550
551  # If the mantissas have the same length, there is no point in normalizing the
552  # exponents by the length of the mantissas, so treat that as a special case.
553
554  if ($mxl == $myl) {
555
556      # First handle the two cases where the exponents have different signs.
557
558      if ($x->{_es} eq '+' && $y->{_es} eq '-') {
559          $cmp = +1;
560      }
561
562      elsif ($x->{_es} eq '-' && $y->{_es} eq '+') {
563          $cmp = -1;
564      }
565
566      # Then handle the case where the exponents have the same sign.
567
568      else {
569          $cmp = $MBI->_acmp($x->{_e}, $y->{_e});
570          $cmp = -$cmp if $x->{_es} eq '-';
571      }
572
573      # Adjust for the sign, which is the same for x and y, and bail out if
574      # we're done.
575
576      $cmp = -$cmp if $x->{sign} eq '-';        # 124 > 123, but -124 < -123
577      return $cmp if $cmp;
578
579  }
580
581  # We must normalize each exponent by the length of the corresponding
582  # mantissa. Life is a lot easier if we first make both exponents
583  # non-negative. We do this by adding the same positive value to both
584  # exponent. This is safe, because when comparing the exponents, only the
585  # relative difference is important.
586
587  my $ex;
588  my $ey;
589
590  if ($x->{_es} eq '+') {
591
592      # If the exponent of x is >= 0 and the exponent of y is >= 0, there is no
593      # need to do anything special.
594
595      if ($y->{_es} eq '+') {
596          $ex = $MBI->_copy($x->{_e});
597          $ey = $MBI->_copy($y->{_e});
598      }
599
600      # If the exponent of x is >= 0 and the exponent of y is < 0, add the
601      # absolute value of the exponent of y to both.
602
603      else {
604          $ex = $MBI->_copy($x->{_e});
605          $ex = $MBI->_add($ex, $y->{_e});      # ex + |ey|
606          $ey = $MBI->_zero();                  # -ex + |ey| = 0
607      }
608
609  } else {
610
611      # If the exponent of x is < 0 and the exponent of y is >= 0, add the
612      # absolute value of the exponent of x to both.
613
614      if ($y->{_es} eq '+') {
615          $ex = $MBI->_zero();                  # -ex + |ex| = 0
616          $ey = $MBI->_copy($y->{_e});
617          $ey = $MBI->_add($ey, $x->{_e});      # ey + |ex|
618      }
619
620      # If the exponent of x is < 0 and the exponent of y is < 0, add the
621      # absolute values of both exponents to both exponents.
622
623      else {
624          $ex = $MBI->_copy($y->{_e});          # -ex + |ey| + |ex| = |ey|
625          $ey = $MBI->_copy($x->{_e});          # -ey + |ex| + |ey| = |ex|
626      }
627
628  }
629
630  # Now we can normalize the exponents by adding lengths of the mantissas.
631
632  $MBI->_add($ex, $MBI->_new($mxl));
633  $MBI->_add($ey, $MBI->_new($myl));
634
635  # We're done if the exponents are different.
636
637  $cmp = $MBI->_acmp($ex, $ey);
638  $cmp = -$cmp if $x->{sign} eq '-';            # 124 > 123, but -124 < -123
639  return $cmp if $cmp;
640
641  # Compare the mantissas, but first normalize them by padding the shorter
642  # mantissa with zeros (shift left) until it has the same length as the longer
643  # mantissa.
644
645  my $mx = $x->{_m};
646  my $my = $y->{_m};
647
648  if ($mxl > $myl) {
649      $my = $MBI->_lsft($MBI->_copy($my), $MBI->_new($mxl - $myl), 10);
650  } elsif ($mxl < $myl) {
651      $mx = $MBI->_lsft($MBI->_copy($mx), $MBI->_new($myl - $mxl), 10);
652  }
653
654  $cmp = $MBI->_acmp($mx, $my);
655  $cmp = -$cmp if $x->{sign} eq '-';            # 124 > 123, but -124 < -123
656  return $cmp;
657
658  }
659
660sub bacmp
661  {
662  # Compares 2 values, ignoring their signs.
663  # Returns one of undef, <0, =0, >0. (suitable for sort)
664
665  # set up parameters
666  my ($self,$x,$y) = (ref($_[0]),@_);
667  # objectify is costly, so avoid it
668  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
669    {
670    ($self,$x,$y) = objectify(2,@_);
671    }
672
673  return $upgrade->bacmp($x,$y) if defined $upgrade &&
674    ((!$x->isa($self)) || (!$y->isa($self)));
675
676  # handle +-inf and NaN's
677  if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/)
678    {
679    return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
680    return 0 if ($x->is_inf() && $y->is_inf());
681    return 1 if ($x->is_inf() && !$y->is_inf());
682    return -1;
683    }
684
685  # shortcut
686  my $xz = $x->is_zero();
687  my $yz = $y->is_zero();
688  return 0 if $xz && $yz;				# 0 <=> 0
689  return -1 if $xz && !$yz;				# 0 <=> +y
690  return 1 if $yz && !$xz;				# +x <=> 0
691
692  # adjust so that exponents are equal
693  my $lxm = $MBI->_len($x->{_m});
694  my $lym = $MBI->_len($y->{_m});
695  my ($xes,$yes) = (1,1);
696  $xes = -1 if $x->{_es} ne '+';
697  $yes = -1 if $y->{_es} ne '+';
698  # the numify somewhat limits our length, but makes it much faster
699  my $lx = $lxm + $xes * $MBI->_num($x->{_e});
700  my $ly = $lym + $yes * $MBI->_num($y->{_e});
701  my $l = $lx - $ly;
702  return $l <=> 0 if $l != 0;
703
704  # lengths (corrected by exponent) are equal
705  # so make mantissa equal-length by padding with zero (shift left)
706  my $diff = $lxm - $lym;
707  my $xm = $x->{_m};		# not yet copy it
708  my $ym = $y->{_m};
709  if ($diff > 0)
710    {
711    $ym = $MBI->_copy($y->{_m});
712    $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10);
713    }
714  elsif ($diff < 0)
715    {
716    $xm = $MBI->_copy($x->{_m});
717    $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10);
718    }
719  $MBI->_acmp($xm,$ym);
720  }
721
722sub badd
723  {
724  # add second arg (BFLOAT or string) to first (BFLOAT) (modifies first)
725  # return result as BFLOAT
726
727  # set up parameters
728  my ($self,$x,$y,@r) = (ref($_[0]),@_);
729  # objectify is costly, so avoid it
730  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
731    {
732    ($self,$x,$y,@r) = objectify(2,@_);
733    }
734
735  return $x if $x->modify('badd');
736
737  # inf and NaN handling
738  if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
739    {
740    # NaN first
741    return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
742    # inf handling
743    if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
744      {
745      # +inf++inf or -inf+-inf => same, rest is NaN
746      return $x if $x->{sign} eq $y->{sign};
747      return $x->bnan();
748      }
749    # +-inf + something => +inf; something +-inf => +-inf
750    $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
751    return $x;
752    }
753
754  return $upgrade->badd($x,$y,@r) if defined $upgrade &&
755   ((!$x->isa($self)) || (!$y->isa($self)));
756
757  $r[3] = $y;						# no push!
758
759  # speed: no add for 0+y or x+0
760  return $x->bround(@r) if $y->is_zero();		# x+0
761  if ($x->is_zero())					# 0+y
762    {
763    # make copy, clobbering up x (modify in place!)
764    $x->{_e} = $MBI->_copy($y->{_e});
765    $x->{_es} = $y->{_es};
766    $x->{_m} = $MBI->_copy($y->{_m});
767    $x->{sign} = $y->{sign} || $nan;
768    return $x->round(@r);
769    }
770
771  # take lower of the two e's and adapt m1 to it to match m2
772  my $e = $y->{_e};
773  $e = $MBI->_zero() if !defined $e;		# if no BFLOAT?
774  $e = $MBI->_copy($e);				# make copy (didn't do it yet)
775
776  my $es;
777
778  ($e,$es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es});
779
780  my $add = $MBI->_copy($y->{_m});
781
782  if ($es eq '-')				# < 0
783    {
784    $MBI->_lsft( $x->{_m}, $e, 10);
785    ($x->{_e},$x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
786    }
787  elsif (!$MBI->_is_zero($e))			# > 0
788    {
789    $MBI->_lsft($add, $e, 10);
790    }
791  # else: both e are the same, so just leave them
792
793  if ($x->{sign} eq $y->{sign})
794    {
795    # add
796    $x->{_m} = $MBI->_add($x->{_m}, $add);
797    }
798  else
799    {
800    ($x->{_m}, $x->{sign}) =
801     _e_add($x->{_m}, $add, $x->{sign}, $y->{sign});
802    }
803
804  # delete trailing zeros, then round
805  $x->bnorm()->round(@r);
806  }
807
808# sub bsub is inherited from Math::BigInt!
809
810sub binc
811  {
812  # increment arg by one
813  my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
814
815  return $x if $x->modify('binc');
816
817  if ($x->{_es} eq '-')
818    {
819    return $x->badd($self->bone(),@r);	#  digits after dot
820    }
821
822  if (!$MBI->_is_zero($x->{_e}))		# _e == 0 for NaN, inf, -inf
823    {
824    # 1e2 => 100, so after the shift below _m has a '0' as last digit
825    $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e},10);	# 1e2 => 100
826    $x->{_e} = $MBI->_zero();				# normalize
827    $x->{_es} = '+';
828    # we know that the last digit of $x will be '1' or '9', depending on the
829    # sign
830    }
831  # now $x->{_e} == 0
832  if ($x->{sign} eq '+')
833    {
834    $MBI->_inc($x->{_m});
835    return $x->bnorm()->bround(@r);
836    }
837  elsif ($x->{sign} eq '-')
838    {
839    $MBI->_dec($x->{_m});
840    $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0
841    return $x->bnorm()->bround(@r);
842    }
843  # inf, nan handling etc
844  $x->badd($self->bone(),@r);			# badd() does round
845  }
846
847sub bdec
848  {
849  # decrement arg by one
850  my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
851
852  return $x if $x->modify('bdec');
853
854  if ($x->{_es} eq '-')
855    {
856    return $x->badd($self->bone('-'),@r);	#  digits after dot
857    }
858
859  if (!$MBI->_is_zero($x->{_e}))
860    {
861    $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e},10);	# 1e2 => 100
862    $x->{_e} = $MBI->_zero();				# normalize
863    $x->{_es} = '+';
864    }
865  # now $x->{_e} == 0
866  my $zero = $x->is_zero();
867  # <= 0
868  if (($x->{sign} eq '-') || $zero)
869    {
870    $MBI->_inc($x->{_m});
871    $x->{sign} = '-' if $zero;				# 0 => 1 => -1
872    $x->{sign} = '+' if $MBI->_is_zero($x->{_m});	# -1 +1 => -0 => +0
873    return $x->bnorm()->round(@r);
874    }
875  # > 0
876  elsif ($x->{sign} eq '+')
877    {
878    $MBI->_dec($x->{_m});
879    return $x->bnorm()->round(@r);
880    }
881  # inf, nan handling etc
882  $x->badd($self->bone('-'),@r);		# does round
883  }
884
885sub DEBUG () { 0; }
886
887sub blog
888  {
889  my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
890
891  # If called as $x -> blog() or $x -> blog(undef), don't objectify the
892  # undefined base, since undef signals that the base is Euler's number.
893  #unless (ref($x) && !defined($base)) {
894  #    # objectify is costly, so avoid it
895  #    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
896  #        ($self,$x,$base,$a,$p,$r) = objectify(2,@_);
897  #    }
898  #}
899
900  return $x if $x->modify('blog');
901
902  return $x -> bnan() if $x -> is_nan();
903
904  # we need to limit the accuracy to protect against overflow
905  my $fallback = 0;
906  my ($scale,@params);
907  ($x,@params) = $x->_find_round_parameters($a,$p,$r);
908
909  # no rounding at all, so must use fallback
910  if (scalar @params == 0)
911    {
912    # simulate old behaviour
913    $params[0] = $self->div_scale();	# and round to it as accuracy
914    $params[1] = undef;			# P = undef
915    $scale = $params[0]+4; 		# at least four more for proper round
916    $params[2] = $r;			# round mode by caller or undef
917    $fallback = 1;			# to clear a/p afterwards
918    }
919  else
920    {
921    # the 4 below is empirical, and there might be cases where it is not
922    # enough...
923    $scale = abs($params[0] || $params[1]) + 4;	# take whatever is defined
924    }
925
926  my $done = 0;
927  if (defined $base) {
928      $base = $self -> new($base) unless ref $base;
929      if ($base -> is_nan() || $base -> is_one()) {
930          $x -> bnan();
931          $done = 1;
932      } elsif ($base -> is_inf() || $base -> is_zero()) {
933          if ($x -> is_inf() || $x -> is_zero()) {
934              $x -> bnan();
935          } else {
936              $x -> bzero(@params);
937          }
938          $done = 1;
939      } elsif ($base -> is_negative()) {        # -inf < base < 0
940          if ($x -> is_one()) {                 #     x = 1
941              $x -> bzero(@params);
942          } elsif ($x == $base) {
943              $x -> bone('+', @params);         #     x = base
944          } else {
945              $x -> bnan();                     #     otherwise
946          }
947          $done = 1;
948      } elsif ($x == $base) {
949          $x -> bone('+', @params);             # 0 < base && 0 < x < inf
950          $done = 1;
951      }
952  }
953
954  # We now know that the base is either undefined or positive and finite.
955
956  unless ($done) {
957      if ($x -> is_inf()) {             #   x = +/-inf
958          my $sign = defined $base && $base < 1 ? '-' : '+';
959          $x -> binf($sign);
960          $done = 1;
961      } elsif ($x -> is_neg()) {        #   -inf < x < 0
962          $x -> bnan();
963          $done = 1;
964      } elsif ($x -> is_one()) {        #   x = 1
965          $x -> bzero(@params);
966          $done = 1;
967      } elsif ($x -> is_zero()) {       #   x = 0
968          my $sign = defined $base && $base < 1 ? '+' : '-';
969          $x -> binf($sign);
970          $done = 1;
971      }
972  }
973
974  if ($done) {
975      if ($fallback) {
976        # clear a/p after round, since user did not request it
977          delete $x->{_a};
978          delete $x->{_p};
979        }
980      return $x;
981      }
982
983  # when user set globals, they would interfere with our calculation, so
984  # disable them and later re-enable them
985  no strict 'refs';
986  my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
987  my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
988  # we also need to disable any set A or P on $x (_find_round_parameters took
989  # them already into account), since these would interfere, too
990  delete $x->{_a}; delete $x->{_p};
991  # need to disable $upgrade in BigInt, to avoid deep recursion
992  local $Math::BigInt::upgrade = undef;
993  local $Math::BigFloat::downgrade = undef;
994
995  # upgrade $x if $x is not a BigFloat (handle BigInt input)
996  # XXX TODO: rebless!
997  if (!$x->isa('Math::BigFloat'))
998    {
999    $x = Math::BigFloat->new($x);
1000    $self = ref($x);
1001    }
1002
1003  $done = 0;
1004
1005  # If the base is defined and an integer, try to calculate integer result
1006  # first. This is very fast, and in case the real result was found, we can
1007  # stop right here.
1008  if (defined $base && $base->is_int() && $x->is_int())
1009    {
1010    my $i = $MBI->_copy( $x->{_m} );
1011    $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
1012    my $int = Math::BigInt->bzero();
1013    $int->{value} = $i;
1014    $int->blog($base->as_number());
1015    # if ($exact)
1016    if ($base->as_number()->bpow($int) == $x)
1017      {
1018      # found result, return it
1019      $x->{_m} = $int->{value};
1020      $x->{_e} = $MBI->_zero();
1021      $x->{_es} = '+';
1022      $x->bnorm();
1023      $done = 1;
1024      }
1025    }
1026
1027  if ($done == 0)
1028    {
1029    # base is undef, so base should be e (Euler's number), so first calculate the
1030    # log to base e (using reduction by 10 (and probably 2)):
1031    $self->_log_10($x,$scale);
1032
1033    # and if a different base was requested, convert it
1034    if (defined $base)
1035      {
1036      $base = Math::BigFloat->new($base) unless $base->isa('Math::BigFloat');
1037      # not ln, but some other base (don't modify $base)
1038      $x->bdiv( $base->copy()->blog(undef,$scale), $scale );
1039      }
1040    }
1041
1042  # shortcut to not run through _find_round_parameters again
1043  if (defined $params[0])
1044    {
1045    $x->bround($params[0],$params[2]);		# then round accordingly
1046    }
1047  else
1048    {
1049    $x->bfround($params[1],$params[2]);		# then round accordingly
1050    }
1051  if ($fallback)
1052    {
1053    # clear a/p after round, since user did not request it
1054    delete $x->{_a}; delete $x->{_p};
1055    }
1056  # restore globals
1057  $$abr = $ab; $$pbr = $pb;
1058
1059  $x;
1060  }
1061
1062sub _len_to_steps
1063  {
1064  # Given D (digits in decimal), compute N so that N! (N factorial) is
1065  # at least D digits long. D should be at least 50.
1066  my $d = shift;
1067
1068  # two constants for the Ramanujan estimate of ln(N!)
1069  my $lg2 = log(2 * 3.14159265) / 2;
1070  my $lg10 = log(10);
1071
1072  # D = 50 => N => 42, so L = 40 and R = 50
1073  my $l = 40; my $r = $d;
1074
1075  # Otherwise this does not work under -Mbignum and we do not yet have "no bignum;" :(
1076  $l = $l->numify if ref($l);
1077  $r = $r->numify if ref($r);
1078  $lg2 = $lg2->numify if ref($lg2);
1079  $lg10 = $lg10->numify if ref($lg10);
1080
1081  # binary search for the right value (could this be written as the reverse of lg(n!)?)
1082  while ($r - $l > 1)
1083    {
1084    my $n = int(($r - $l) / 2) + $l;
1085    my $ramanujan =
1086      int(($n * log($n) - $n + log( $n * (1 + 4*$n*(1+2*$n)) ) / 6 + $lg2) / $lg10);
1087    $ramanujan > $d ? $r = $n : $l = $n;
1088    }
1089  $l;
1090  }
1091
1092sub bnok
1093  {
1094  # Calculate n over k (binomial coefficient or "choose" function) as integer.
1095  # set up parameters
1096  my ($self,$x,$y,@r) = (ref($_[0]),@_);
1097
1098  # objectify is costly, so avoid it
1099  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1100    {
1101    ($self,$x,$y,@r) = objectify(2,@_);
1102    }
1103
1104  return $x if $x->modify('bnok');
1105
1106  return $x->bnan() if $x->is_nan() || $y->is_nan();
1107  return $x->binf() if $x->is_inf();
1108
1109  my $u = $x->as_int();
1110  $u->bnok($y->as_int());
1111
1112  $x->{_m} = $u->{value};
1113  $x->{_e} = $MBI->_zero();
1114  $x->{_es} = '+';
1115  $x->{sign} = '+';
1116  $x->bnorm(@r);
1117  }
1118
1119sub bexp
1120  {
1121  # Calculate e ** X (Euler's number to the power of X)
1122  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
1123
1124  return $x if $x->modify('bexp');
1125
1126  return $x->binf() if $x->{sign} eq '+inf';
1127  return $x->bzero() if $x->{sign} eq '-inf';
1128
1129  # we need to limit the accuracy to protect against overflow
1130  my $fallback = 0;
1131  my ($scale,@params);
1132  ($x,@params) = $x->_find_round_parameters($a,$p,$r);
1133
1134  # also takes care of the "error in _find_round_parameters?" case
1135  return $x if $x->{sign} eq 'NaN';
1136
1137  # no rounding at all, so must use fallback
1138  if (scalar @params == 0)
1139    {
1140    # simulate old behaviour
1141    $params[0] = $self->div_scale();	# and round to it as accuracy
1142    $params[1] = undef;			# P = undef
1143    $scale = $params[0]+4; 		# at least four more for proper round
1144    $params[2] = $r;			# round mode by caller or undef
1145    $fallback = 1;			# to clear a/p afterwards
1146    }
1147  else
1148    {
1149    # the 4 below is empirical, and there might be cases where it's not enough...
1150    $scale = abs($params[0] || $params[1]) + 4;	# take whatever is defined
1151    }
1152
1153  return $x->bone(@params) if $x->is_zero();
1154
1155  if (!$x->isa('Math::BigFloat'))
1156    {
1157    $x = Math::BigFloat->new($x);
1158    $self = ref($x);
1159    }
1160
1161  # when user set globals, they would interfere with our calculation, so
1162  # disable them and later re-enable them
1163  no strict 'refs';
1164  my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
1165  my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
1166  # we also need to disable any set A or P on $x (_find_round_parameters took
1167  # them already into account), since these would interfere, too
1168  delete $x->{_a}; delete $x->{_p};
1169  # need to disable $upgrade in BigInt, to avoid deep recursion
1170  local $Math::BigInt::upgrade = undef;
1171  local $Math::BigFloat::downgrade = undef;
1172
1173  my $x_org = $x->copy();
1174
1175  # We use the following Taylor series:
1176
1177  #           x    x^2   x^3   x^4
1178  #  e = 1 + --- + --- + --- + --- ...
1179  #           1!    2!    3!    4!
1180
1181  # The difference for each term is X and N, which would result in:
1182  # 2 copy, 2 mul, 2 add, 1 inc, 1 div operations per term
1183
1184  # But it is faster to compute exp(1) and then raising it to the
1185  # given power, esp. if $x is really big and an integer because:
1186
1187  #  * The numerator is always 1, making the computation faster
1188  #  * the series converges faster in the case of x == 1
1189  #  * We can also easily check when we have reached our limit: when the
1190  #    term to be added is smaller than "1E$scale", we can stop - f.i.
1191  #    scale == 5, and we have 1/40320, then we stop since 1/40320 < 1E-5.
1192  #  * we can compute the *exact* result by simulating bigrat math:
1193
1194  #  1   1    gcd(3,4) = 1    1*24 + 1*6    5
1195  #  - + -                  = ---------- =  --
1196  #  6   24                      6*24       24
1197
1198  # We do not compute the gcd() here, but simple do:
1199  #  1   1    1*24 + 1*6   30
1200  #  - + -  = --------- =  --
1201  #  6   24       6*24     144
1202
1203  # In general:
1204  #  a   c    a*d + c*b 	and note that c is always 1 and d = (b*f)
1205  #  - + -  = ---------
1206  #  b   d       b*d
1207
1208  # This leads to:         which can be reduced by b to:
1209  #  a   1     a*b*f + b    a*f + 1
1210  #  - + -   = --------- =  -------
1211  #  b   b*f     b*b*f        b*f
1212
1213  # The first terms in the series are:
1214
1215  # 1     1    1    1    1    1     1     1     13700
1216  # -- + -- + -- + -- + -- + --- + --- + ---- = -----
1217  # 1     1    2    6   24   120   720   5040   5040
1218
1219  # Note that we cannot simple reduce 13700/5040 to 685/252, but must keep A and B!
1220
1221  if ($scale <= 75)
1222    {
1223    # set $x directly from a cached string form
1224    $x->{_m} = $MBI->_new(
1225    "27182818284590452353602874713526624977572470936999595749669676277240766303535476");
1226    $x->{sign} = '+';
1227    $x->{_es} = '-';
1228    $x->{_e} = $MBI->_new(79);
1229    }
1230  else
1231    {
1232    # compute A and B so that e = A / B.
1233
1234    # After some terms we end up with this, so we use it as a starting point:
1235    my $A = $MBI->_new("90933395208605785401971970164779391644753259799242");
1236    my $F = $MBI->_new(42); my $step = 42;
1237
1238    # Compute how many steps we need to take to get $A and $B sufficiently big
1239    my $steps = _len_to_steps($scale - 4);
1240#    print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
1241    while ($step++ <= $steps)
1242      {
1243      # calculate $a * $f + 1
1244      $A = $MBI->_mul($A, $F);
1245      $A = $MBI->_inc($A);
1246      # increment f
1247      $F = $MBI->_inc($F);
1248      }
1249    # compute $B as factorial of $steps (this is faster than doing it manually)
1250    my $B = $MBI->_fac($MBI->_new($steps));
1251
1252#  print "A ", $MBI->_str($A), "\nB ", $MBI->_str($B), "\n";
1253
1254    # compute A/B with $scale digits in the result (truncate, not round)
1255    $A = $MBI->_lsft( $A, $MBI->_new($scale), 10);
1256    $A = $MBI->_div( $A, $B );
1257
1258    $x->{_m} = $A;
1259    $x->{sign} = '+';
1260    $x->{_es} = '-';
1261    $x->{_e} = $MBI->_new($scale);
1262    }
1263
1264  # $x contains now an estimate of e, with some surplus digits, so we can round
1265  if (!$x_org->is_one())
1266    {
1267    # Reduce size of fractional part, followup with integer power of two.
1268    my $lshift = 0;
1269    while ($lshift < 30 && $x_org->bacmp(2 << $lshift) > 0)
1270      {
1271        $lshift++;
1272      }
1273    # Raise $x to the wanted power and round it.
1274    if ($lshift == 0)
1275      {
1276        $x->bpow($x_org, @params);
1277      }
1278    else
1279      {
1280        my($mul, $rescale) = (1 << $lshift, $scale+1+$lshift);
1281        $x->bpow(scalar $x_org->bdiv($mul,$rescale),$rescale)->bpow($mul, @params);
1282      }
1283    }
1284  else
1285    {
1286    # else just round the already computed result
1287    delete $x->{_a}; delete $x->{_p};
1288    # shortcut to not run through _find_round_parameters again
1289    if (defined $params[0])
1290      {
1291      $x->bround($params[0],$params[2]);		# then round accordingly
1292      }
1293    else
1294      {
1295      $x->bfround($params[1],$params[2]);		# then round accordingly
1296      }
1297    }
1298  if ($fallback)
1299    {
1300    # clear a/p after round, since user did not request it
1301    delete $x->{_a}; delete $x->{_p};
1302    }
1303  # restore globals
1304  $$abr = $ab; $$pbr = $pb;
1305
1306  $x;						# return modified $x
1307  }
1308
1309sub _log
1310  {
1311  # internal log function to calculate ln() based on Taylor series.
1312  # Modifies $x in place.
1313  my ($self,$x,$scale) = @_;
1314
1315  # in case of $x == 1, result is 0
1316  return $x->bzero() if $x->is_one();
1317
1318  # XXX TODO: rewrite this in a similar manner to bexp()
1319
1320  # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log
1321
1322  # u = x-1, v = x+1
1323  #              _                               _
1324  # Taylor:     |    u    1   u^3   1   u^5       |
1325  # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 0
1326  #             |_   v    3   v^3   5   v^5      _|
1327
1328  # This takes much more steps to calculate the result and is thus not used
1329  # u = x-1
1330  #              _                               _
1331  # Taylor:     |    u    1   u^2   1   u^3       |
1332  # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 1/2
1333  #             |_   x    2   x^2   3   x^3      _|
1334
1335  my ($limit,$v,$u,$below,$factor,$two,$next,$over,$f);
1336
1337  $v = $x->copy(); $v->binc();		# v = x+1
1338  $x->bdec(); $u = $x->copy();		# u = x-1; x = x-1
1339  $x->bdiv($v,$scale);			# first term: u/v
1340  $below = $v->copy();
1341  $over = $u->copy();
1342  $u *= $u; $v *= $v;				# u^2, v^2
1343  $below->bmul($v);				# u^3, v^3
1344  $over->bmul($u);
1345  $factor = $self->new(3); $f = $self->new(2);
1346
1347  my $steps = 0;
1348  $limit = $self->new("1E-". ($scale-1));
1349  while (3 < 5)
1350    {
1351    # we calculate the next term, and add it to the last
1352    # when the next term is below our limit, it won't affect the outcome
1353    # anymore, so we stop
1354
1355    # calculating the next term simple from over/below will result in quite
1356    # a time hog if the input has many digits, since over and below will
1357    # accumulate more and more digits, and the result will also have many
1358    # digits, but in the end it is rounded to $scale digits anyway. So if we
1359    # round $over and $below first, we save a lot of time for the division
1360    # (not with log(1.2345), but try log (123**123) to see what I mean. This
1361    # can introduce a rounding error if the division result would be f.i.
1362    # 0.1234500000001 and we round it to 5 digits it would become 0.12346, but
1363    # if we truncated $over and $below we might get 0.12345. Does this matter
1364    # for the end result? So we give $over and $below 4 more digits to be
1365    # on the safe side (unscientific error handling as usual... :+D
1366
1367    $next = $over->copy->bround($scale+4)->bdiv(
1368      $below->copy->bmul($factor)->bround($scale+4),
1369      $scale);
1370
1371## old version:
1372##    $next = $over->copy()->bdiv($below->copy()->bmul($factor),$scale);
1373
1374    last if $next->bacmp($limit) <= 0;
1375
1376    delete $next->{_a}; delete $next->{_p};
1377    $x->badd($next);
1378    # calculate things for the next term
1379    $over *= $u; $below *= $v; $factor->badd($f);
1380    if (DEBUG)
1381      {
1382      $steps++; print "step $steps = $x\n" if $steps % 10 == 0;
1383      }
1384    }
1385  print "took $steps steps\n" if DEBUG;
1386  $x->bmul($f);					# $x *= 2
1387  }
1388
1389sub _log_10
1390  {
1391  # Internal log function based on reducing input to the range of 0.1 .. 9.99
1392  # and then "correcting" the result to the proper one. Modifies $x in place.
1393  my ($self,$x,$scale) = @_;
1394
1395  # Taking blog() from numbers greater than 10 takes a *very long* time, so we
1396  # break the computation down into parts based on the observation that:
1397  #  blog(X*Y) = blog(X) + blog(Y)
1398  # We set Y here to multiples of 10 so that $x becomes below 1 - the smaller
1399  # $x is the faster it gets. Since 2*$x takes about 10 times as
1400  # long, we make it faster by about a factor of 100 by dividing $x by 10.
1401
1402  # The same observation is valid for numbers smaller than 0.1, e.g. computing
1403  # log(1) is fastest, and the further away we get from 1, the longer it takes.
1404  # So we also 'break' this down by multiplying $x with 10 and subtract the
1405  # log(10) afterwards to get the correct result.
1406
1407  # To get $x even closer to 1, we also divide by 2 and then use log(2) to
1408  # correct for this. For instance if $x is 2.4, we use the formula:
1409  #  blog(2.4 * 2) == blog (1.2) + blog(2)
1410  # and thus calculate only blog(1.2) and blog(2), which is faster in total
1411  # than calculating blog(2.4).
1412
1413  # In addition, the values for blog(2) and blog(10) are cached.
1414
1415  # Calculate nr of digits before dot:
1416  my $dbd = $MBI->_num($x->{_e});
1417  $dbd = -$dbd if $x->{_es} eq '-';
1418  $dbd += $MBI->_len($x->{_m});
1419
1420  # more than one digit (e.g. at least 10), but *not* exactly 10 to avoid
1421  # infinite recursion
1422
1423  my $calc = 1;					# do some calculation?
1424
1425  # disable the shortcut for 10, since we need log(10) and this would recurse
1426  # infinitely deep
1427  if ($x->{_es} eq '+' && $MBI->_is_one($x->{_e}) && $MBI->_is_one($x->{_m}))
1428    {
1429    $dbd = 0;					# disable shortcut
1430    # we can use the cached value in these cases
1431    if ($scale <= $LOG_10_A)
1432      {
1433      $x->bzero(); $x->badd($LOG_10);		# modify $x in place
1434      $calc = 0; 				# no need to calc, but round
1435      }
1436    # if we can't use the shortcut, we continue normally
1437    }
1438  else
1439    {
1440    # disable the shortcut for 2, since we maybe have it cached
1441    if (($MBI->_is_zero($x->{_e}) && $MBI->_is_two($x->{_m})))
1442      {
1443      $dbd = 0;					# disable shortcut
1444      # we can use the cached value in these cases
1445      if ($scale <= $LOG_2_A)
1446        {
1447        $x->bzero(); $x->badd($LOG_2);		# modify $x in place
1448        $calc = 0; 				# no need to calc, but round
1449        }
1450      # if we can't use the shortcut, we continue normally
1451      }
1452    }
1453
1454  # if $x = 0.1, we know the result must be 0-log(10)
1455  if ($calc != 0 && $x->{_es} eq '-' && $MBI->_is_one($x->{_e}) &&
1456      $MBI->_is_one($x->{_m}))
1457    {
1458    $dbd = 0;					# disable shortcut
1459    # we can use the cached value in these cases
1460    if ($scale <= $LOG_10_A)
1461      {
1462      $x->bzero(); $x->bsub($LOG_10);
1463      $calc = 0; 				# no need to calc, but round
1464      }
1465    }
1466
1467  return if $calc == 0;				# already have the result
1468
1469  # default: these correction factors are undef and thus not used
1470  my $l_10;				# value of ln(10) to A of $scale
1471  my $l_2;				# value of ln(2) to A of $scale
1472
1473  my $two = $self->new(2);
1474
1475  # $x == 2 => 1, $x == 13 => 2, $x == 0.1 => 0, $x == 0.01 => -1
1476  # so don't do this shortcut for 1 or 0
1477  if (($dbd > 1) || ($dbd < 0))
1478    {
1479    # convert our cached value to an object if not already (avoid doing this
1480    # at import() time, since not everybody needs this)
1481    $LOG_10 = $self->new($LOG_10,undef,undef) unless ref $LOG_10;
1482
1483    #print "x = $x, dbd = $dbd, calc = $calc\n";
1484    # got more than one digit before the dot, or more than one zero after the
1485    # dot, so do:
1486    #  log(123)    == log(1.23) + log(10) * 2
1487    #  log(0.0123) == log(1.23) - log(10) * 2
1488
1489    if ($scale <= $LOG_10_A)
1490      {
1491      # use cached value
1492      $l_10 = $LOG_10->copy();		# copy for mul
1493      }
1494    else
1495      {
1496      # else: slower, compute and cache result
1497      # also disable downgrade for this code path
1498      local $Math::BigFloat::downgrade = undef;
1499
1500      # shorten the time to calculate log(10) based on the following:
1501      # log(1.25 * 8) = log(1.25) + log(8)
1502      #               = log(1.25) + log(2) + log(2) + log(2)
1503
1504      # first get $l_2 (and possible compute and cache log(2))
1505      $LOG_2 = $self->new($LOG_2,undef,undef) unless ref $LOG_2;
1506      if ($scale <= $LOG_2_A)
1507        {
1508        # use cached value
1509        $l_2 = $LOG_2->copy();			# copy() for the mul below
1510        }
1511      else
1512        {
1513        # else: slower, compute and cache result
1514        $l_2 = $two->copy(); $self->_log($l_2, $scale); # scale+4, actually
1515        $LOG_2 = $l_2->copy();			# cache the result for later
1516						# the copy() is for mul below
1517        $LOG_2_A = $scale;
1518        }
1519
1520      # now calculate log(1.25):
1521      $l_10 = $self->new('1.25'); $self->_log($l_10, $scale); # scale+4, actually
1522
1523      # log(1.25) + log(2) + log(2) + log(2):
1524      $l_10->badd($l_2);
1525      $l_10->badd($l_2);
1526      $l_10->badd($l_2);
1527      $LOG_10 = $l_10->copy();		# cache the result for later
1528					# the copy() is for mul below
1529      $LOG_10_A = $scale;
1530      }
1531    $dbd-- if ($dbd > 1); 		# 20 => dbd=2, so make it dbd=1
1532    $l_10->bmul( $self->new($dbd));	# log(10) * (digits_before_dot-1)
1533    my $dbd_sign = '+';
1534    if ($dbd < 0)
1535      {
1536      $dbd = -$dbd;
1537      $dbd_sign = '-';
1538      }
1539    ($x->{_e}, $x->{_es}) =
1540	_e_sub( $x->{_e}, $MBI->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23
1541
1542    }
1543
1544  # Now: 0.1 <= $x < 10 (and possible correction in l_10)
1545
1546  ### Since $x in the range 0.5 .. 1.5 is MUCH faster, we do a repeated div
1547  ### or mul by 2 (maximum times 3, since x < 10 and x > 0.1)
1548
1549  $HALF = $self->new($HALF) unless ref($HALF);
1550
1551  my $twos = 0;				# default: none (0 times)
1552  while ($x->bacmp($HALF) <= 0)		# X <= 0.5
1553    {
1554    $twos--; $x->bmul($two);
1555    }
1556  while ($x->bacmp($two) >= 0)		# X >= 2
1557    {
1558    $twos++; $x->bdiv($two,$scale+4);		# keep all digits
1559    }
1560  $x->bround($scale+4);
1561  # $twos > 0 => did mul 2, < 0 => did div 2 (but we never did both)
1562  # So calculate correction factor based on ln(2):
1563  if ($twos != 0)
1564    {
1565    $LOG_2 = $self->new($LOG_2,undef,undef) unless ref $LOG_2;
1566    if ($scale <= $LOG_2_A)
1567      {
1568      # use cached value
1569      $l_2 = $LOG_2->copy();			# copy() for the mul below
1570      }
1571    else
1572      {
1573      # else: slower, compute and cache result
1574      # also disable downgrade for this code path
1575      local $Math::BigFloat::downgrade = undef;
1576      $l_2 = $two->copy(); $self->_log($l_2, $scale); # scale+4, actually
1577      $LOG_2 = $l_2->copy();			# cache the result for later
1578						# the copy() is for mul below
1579      $LOG_2_A = $scale;
1580      }
1581    $l_2->bmul($twos);		# * -2 => subtract, * 2 => add
1582    }
1583  else
1584    {
1585      undef $l_2;
1586    }
1587
1588  $self->_log($x,$scale);			# need to do the "normal" way
1589  $x->badd($l_10) if defined $l_10; 		# correct it by ln(10)
1590  $x->badd($l_2) if defined $l_2;		# and maybe by ln(2)
1591
1592  # all done, $x contains now the result
1593  $x;
1594  }
1595
1596sub blcm
1597  {
1598  # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
1599  # does not modify arguments, but returns new object
1600  # Lowest Common Multiplicator
1601
1602  my ($self,@arg) = objectify(0,@_);
1603  my $x = $self->new(shift @arg);
1604  while (@arg) { $x = Math::BigInt::__lcm($x,shift @arg); }
1605  $x;
1606  }
1607
1608sub bgcd
1609  {
1610  # (BINT or num_str, BINT or num_str) return BINT
1611  # does not modify arguments, but returns new object
1612
1613  my $y = shift;
1614  $y = __PACKAGE__->new($y) if !ref($y);
1615  my $self = ref($y);
1616  my $x = $y->copy()->babs();			# keep arguments
1617
1618  return $x->bnan() if $x->{sign} !~ /^[+-]$/	# x NaN?
1619	|| !$x->is_int();			# only for integers now
1620
1621  while (@_)
1622    {
1623    my $t = shift; $t = $self->new($t) if !ref($t);
1624    $y = $t->copy()->babs();
1625
1626    return $x->bnan() if $y->{sign} !~ /^[+-]$/	# y NaN?
1627     	|| !$y->is_int();			# only for integers now
1628
1629    # greatest common divisor
1630    while (! $y->is_zero())
1631      {
1632      ($x,$y) = ($y->copy(), $x->copy()->bmod($y));
1633      }
1634
1635    last if $x->is_one();
1636    }
1637  $x;
1638  }
1639
1640##############################################################################
1641
1642sub _e_add {
1643    # Internal helper sub to take two positive integers and their signs and
1644    # then add them. Input ($CALC, $CALC, ('+'|'-'), ('+'|'-')), output
1645    # ($CALC, ('+'|'-')).
1646
1647    my ($x, $y, $xs, $ys) = @_;
1648
1649    # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
1650    if ($xs eq $ys) {
1651        $x = $MBI->_add($x, $y);                # +a + +b or -a + -b
1652    } else {
1653        my $a = $MBI->_acmp($x, $y);
1654        if ($a == 0) {
1655            # This does NOT modify $x in-place. TODO: Fix this?
1656            $x = $MBI->_zero();                 # result is 0
1657            $xs = '+';
1658            return ($x, $xs);
1659        }
1660        if ($a > 0) {
1661            $x = $MBI->_sub($x, $y);            # abs sub
1662        } else {                                # a < 0
1663            $x = $MBI->_sub ( $y, $x, 1 );      # abs sub
1664            $xs = $ys;
1665        }
1666    }
1667
1668    $xs = '+' if $xs eq '-' && $MBI->_is_zero($x);      # no "-0"
1669
1670    return ($x, $xs);
1671}
1672
1673sub _e_sub {
1674  # Internal helper sub to take two positive integers and their signs and
1675  # then subtract them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')),
1676  # output ($CALC,('+'|'-'))
1677  my ($x,$y,$xs,$ys) = @_;
1678
1679  # flip sign
1680    $ys = $ys eq '+' ? '-' : '+';       # swap sign of second operand ...
1681    _e_add($x, $y, $xs, $ys);           # ... and let _e_add() do the job
1682  }
1683
1684###############################################################################
1685# is_foo methods (is_negative, is_positive are inherited from BigInt)
1686
1687sub is_int
1688  {
1689  # return true if arg (BFLOAT or num_str) is an integer
1690  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1691
1692  (($x->{sign} =~ /^[+-]$/) &&			# NaN and +-inf aren't
1693   ($x->{_es} eq '+')) ? 1 : 0;			# 1e-1 => no integer
1694  }
1695
1696sub is_zero
1697  {
1698  # return true if arg (BFLOAT or num_str) is zero
1699  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1700
1701  ($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})) ? 1 : 0;
1702  }
1703
1704sub is_one
1705  {
1706  # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given
1707  my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
1708
1709  $sign = '+' if !defined $sign || $sign ne '-';
1710
1711  ($x->{sign} eq $sign &&
1712   $MBI->_is_zero($x->{_e}) &&
1713   $MBI->_is_one($x->{_m}) ) ? 1 : 0;
1714  }
1715
1716sub is_odd
1717  {
1718  # return true if arg (BFLOAT or num_str) is odd or false if even
1719  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1720
1721  (($x->{sign} =~ /^[+-]$/) &&		# NaN & +-inf aren't
1722   ($MBI->_is_zero($x->{_e})) &&
1723   ($MBI->_is_odd($x->{_m}))) ? 1 : 0;
1724  }
1725
1726sub is_even
1727  {
1728  # return true if arg (BINT or num_str) is even or false if odd
1729  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
1730
1731  (($x->{sign} =~ /^[+-]$/) &&			# NaN & +-inf aren't
1732   ($x->{_es} eq '+') &&	 		# 123.45 isn't
1733   ($MBI->_is_even($x->{_m}))) ? 1 : 0;		# but 1200 is
1734  }
1735
1736sub bmul
1737  {
1738  # multiply two numbers
1739
1740  # set up parameters
1741  my ($self,$x,$y,@r) = (ref($_[0]),@_);
1742  # objectify is costly, so avoid it
1743  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1744    {
1745    ($self,$x,$y,@r) = objectify(2,@_);
1746    }
1747
1748  return $x if $x->modify('bmul');
1749
1750  return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
1751
1752  # inf handling
1753  if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1754    {
1755    return $x->bnan() if $x->is_zero() || $y->is_zero();
1756    # result will always be +-inf:
1757    # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1758    # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1759    return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1760    return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1761    return $x->binf('-');
1762    }
1763
1764  return $upgrade->bmul($x,$y,@r) if defined $upgrade &&
1765   ((!$x->isa($self)) || (!$y->isa($self)));
1766
1767  # aEb * cEd = (a*c)E(b+d)
1768  $MBI->_mul($x->{_m},$y->{_m});
1769  ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
1770
1771  $r[3] = $y;				# no push!
1772
1773  # adjust sign:
1774  $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
1775  $x->bnorm->round(@r);
1776  }
1777
1778sub bmuladd
1779  {
1780  # multiply two numbers and add the third to the result
1781
1782  # set up parameters
1783  my ($self,$x,$y,$z,@r) = objectify(3,@_);
1784
1785  return $x if $x->modify('bmuladd');
1786
1787  return $x->bnan() if (($x->{sign} eq $nan) ||
1788			($y->{sign} eq $nan) ||
1789			($z->{sign} eq $nan));
1790
1791  # inf handling
1792  if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
1793    {
1794    return $x->bnan() if $x->is_zero() || $y->is_zero();
1795    # result will always be +-inf:
1796    # +inf * +/+inf => +inf, -inf * -/-inf => +inf
1797    # +inf * -/-inf => -inf, -inf * +/+inf => -inf
1798    return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
1799    return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
1800    return $x->binf('-');
1801    }
1802
1803  return $upgrade->bmul($x,$y,@r) if defined $upgrade &&
1804   ((!$x->isa($self)) || (!$y->isa($self)));
1805
1806  # aEb * cEd = (a*c)E(b+d)
1807  $MBI->_mul($x->{_m},$y->{_m});
1808  ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
1809
1810  $r[3] = $y;				# no push!
1811
1812  # adjust sign:
1813  $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
1814
1815  # z=inf handling (z=NaN handled above)
1816  $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/;
1817
1818  # take lower of the two e's and adapt m1 to it to match m2
1819  my $e = $z->{_e};
1820  $e = $MBI->_zero() if !defined $e;		# if no BFLOAT?
1821  $e = $MBI->_copy($e);				# make copy (didn't do it yet)
1822
1823  my $es;
1824
1825  ($e,$es) = _e_sub($e, $x->{_e}, $z->{_es} || '+', $x->{_es});
1826
1827  my $add = $MBI->_copy($z->{_m});
1828
1829  if ($es eq '-')				# < 0
1830    {
1831    $MBI->_lsft( $x->{_m}, $e, 10);
1832    ($x->{_e},$x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
1833    }
1834  elsif (!$MBI->_is_zero($e))			# > 0
1835    {
1836    $MBI->_lsft($add, $e, 10);
1837    }
1838  # else: both e are the same, so just leave them
1839
1840  if ($x->{sign} eq $z->{sign})
1841    {
1842    # add
1843    $x->{_m} = $MBI->_add($x->{_m}, $add);
1844    }
1845  else
1846    {
1847    ($x->{_m}, $x->{sign}) =
1848     _e_add($x->{_m}, $add, $x->{sign}, $z->{sign});
1849    }
1850
1851  # delete trailing zeros, then round
1852  $x->bnorm()->round(@r);
1853  }
1854
1855sub bdiv
1856  {
1857  # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return
1858    # (BFLOAT, BFLOAT) (quo, rem) or BFLOAT (only quo)
1859
1860  # set up parameters
1861  my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
1862  # objectify is costly, so avoid it
1863  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
1864    {
1865    ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1866    }
1867
1868  return $x if $x->modify('bdiv');
1869
1870    my $wantarray = wantarray;          # call only once
1871
1872    # At least one argument is NaN. This is handled the same way as in
1873    # Math::BigInt -> bdiv().
1874
1875    if ($x -> is_nan() || $y -> is_nan()) {
1876        return $wantarray ? ($x -> bnan(), $self -> bnan()) : $x -> bnan();
1877    }
1878
1879    # Divide by zero and modulo zero. This is handled the same way as in
1880    # Math::BigInt -> bdiv(). See the comment in the code for Math::BigInt ->
1881    # bdiv() for further details.
1882
1883    if ($y -> is_zero()) {
1884        my ($quo, $rem);
1885        if ($wantarray) {
1886            $rem = $x -> copy();
1887        }
1888        if ($x -> is_zero()) {
1889            $quo = $x -> bnan();
1890        } else {
1891            $quo = $x -> binf($x -> {sign});
1892        }
1893        return $wantarray ? ($quo, $rem) : $quo;
1894    }
1895
1896    # Numerator (dividend) is +/-inf. This is handled the same way as in
1897    # Math::BigInt -> bdiv(). See the comment in the code for Math::BigInt ->
1898    # bdiv() for further details.
1899
1900    if ($x -> is_inf()) {
1901        my ($quo, $rem);
1902        $rem = $self -> bnan() if $wantarray;
1903        if ($y -> is_inf()) {
1904            $quo = $x -> bnan();
1905        } else {
1906            my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
1907            $quo = $x -> binf($sign);
1908        }
1909        return $wantarray ? ($quo, $rem) : $quo;
1910    }
1911
1912  # Denominator (divisor) is +/-inf. This is handled the same way as in
1913  # Math::BigInt -> bdiv(), with one exception: In scalar context,
1914  # Math::BigFloat does true division (although rounded), not floored division
1915  # (F-division), so a finite number divided by +/-inf is always zero. See the
1916  # comment in the code for Math::BigInt -> bdiv() for further details.
1917
1918  if ($y -> is_inf()) {
1919      my ($quo, $rem);
1920      if ($wantarray) {
1921          if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
1922              $rem = $x -> copy();
1923              $quo = $x -> bzero();
1924          } else {
1925              $rem = $self -> binf($y -> {sign});
1926              $quo = $x -> bone('-');
1927          }
1928          return ($quo, $rem);
1929      } else {
1930        if ($y -> is_inf()) {
1931            if ($x -> is_nan() || $x -> is_inf()) {
1932                return $x -> bnan();
1933            } else {
1934                return $x -> bzero();
1935            }
1936        }
1937    }
1938    }
1939
1940  # At this point, both the numerator and denominator are finite numbers, and
1941  # the denominator (divisor) is non-zero.
1942
1943  # x == 0?
1944  return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
1945
1946  # upgrade ?
1947  return $upgrade->bdiv($upgrade->new($x),$y,$a,$p,$r) if defined $upgrade;
1948
1949  # we need to limit the accuracy to protect against overflow
1950  my $fallback = 0;
1951  my (@params,$scale);
1952  ($x,@params) = $x->_find_round_parameters($a,$p,$r,$y);
1953
1954  return $x if $x->is_nan();		# error in _find_round_parameters?
1955
1956  # no rounding at all, so must use fallback
1957    if (scalar @params == 0)
1958    {
1959    # simulate old behaviour
1960    $params[0] = $self->div_scale();	# and round to it as accuracy
1961    $scale = $params[0]+4; 		# at least four more for proper round
1962    $params[2] = $r;			# round mode by caller or undef
1963    $fallback = 1;			# to clear a/p afterwards
1964    } else {
1965    # the 4 below is empirical, and there might be cases where it is not
1966    # enough...
1967    $scale = abs($params[0] || $params[1]) + 4;	# take whatever is defined
1968    }
1969
1970    my $rem;
1971    $rem = $self -> bzero() if wantarray;
1972
1973  $y = $self->new($y) unless $y->isa('Math::BigFloat');
1974
1975  my $lx = $MBI -> _len($x->{_m}); my $ly = $MBI -> _len($y->{_m});
1976  $scale = $lx if $lx > $scale;
1977  $scale = $ly if $ly > $scale;
1978  my $diff = $ly - $lx;
1979  $scale += $diff if $diff > 0;		# if lx << ly, but not if ly << lx!
1980
1981  # check that $y is not 1 nor -1 and cache the result:
1982  my $y_not_one = !($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m}));
1983
1984  # flipping the sign of $y will also flip the sign of $x for the special
1985  # case of $x->bsub($x); so we can catch it below:
1986  my $xsign = $x->{sign};
1987  $y->{sign} =~ tr/+-/-+/;
1988
1989  if ($xsign ne $x->{sign})
1990    {
1991    # special case of $x /= $x results in 1
1992    $x->bone();			# "fixes" also sign of $y, since $x is $y
1993    }
1994  else
1995    {
1996    # correct $y's sign again
1997    $y->{sign} =~ tr/+-/-+/;
1998    # continue with normal div code:
1999
2000    # make copy of $x in case of list context for later remainder calculation
2001    if (wantarray && $y_not_one)
2002      {
2003      $rem = $x->copy();
2004      }
2005
2006    $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+';
2007
2008    # check for / +-1 ( +/- 1E0)
2009    if ($y_not_one)
2010      {
2011      # promote BigInts and it's subclasses (except when already a BigFloat)
2012      $y = $self->new($y) unless $y->isa('Math::BigFloat');
2013
2014      # calculate the result to $scale digits and then round it
2015      # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
2016      $MBI->_lsft($x->{_m},$MBI->_new($scale),10);
2017      $MBI->_div ($x->{_m},$y->{_m});	# a/c
2018
2019      # correct exponent of $x
2020      ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
2021      # correct for 10**scale
2022      ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+');
2023      $x->bnorm();		# remove trailing 0's
2024      }
2025    } # end else $x != $y
2026
2027  # shortcut to not run through _find_round_parameters again
2028  if (defined $params[0])
2029    {
2030    delete $x->{_a}; 				# clear before round
2031    $x->bround($params[0],$params[2]);		# then round accordingly
2032    }
2033  else
2034    {
2035    delete $x->{_p}; 				# clear before round
2036    $x->bfround($params[1],$params[2]);		# then round accordingly
2037    }
2038  if ($fallback)
2039    {
2040    # clear a/p after round, since user did not request it
2041    delete $x->{_a}; delete $x->{_p};
2042    }
2043
2044  if (wantarray)
2045    {
2046    if ($y_not_one)
2047      {
2048      $x -> bfloor();
2049      $rem->bmod($y,@params);			# copy already done
2050      }
2051    if ($fallback)
2052      {
2053      # clear a/p after round, since user did not request it
2054      delete $rem->{_a}; delete $rem->{_p};
2055      }
2056    return ($x,$rem);
2057    }
2058  $x;
2059  }
2060
2061sub bmod
2062  {
2063  # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return remainder
2064
2065  # set up parameters
2066  my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
2067  # objectify is costly, so avoid it
2068  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2069    {
2070    ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
2071    }
2072
2073  return $x if $x->modify('bmod');
2074
2075    # At least one argument is NaN. This is handled the same way as in
2076    # Math::BigInt -> bmod().
2077
2078    if ($x -> is_nan() || $y -> is_nan()) {
2079        return $x -> bnan();
2080    }
2081
2082    # Modulo zero. This is handled the same way as in Math::BigInt -> bmod().
2083
2084    if ($y -> is_zero()) {
2085    return $x;
2086    }
2087
2088    # Numerator (dividend) is +/-inf. This is handled the same way as in
2089    # Math::BigInt -> bmod().
2090
2091    if ($x -> is_inf()) {
2092        return $x -> bnan();
2093    }
2094
2095    # Denominator (divisor) is +/-inf. This is handled the same way as in
2096    # Math::BigInt -> bmod().
2097
2098    if ($y -> is_inf()) {
2099        if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
2100            return $x;
2101        } else {
2102            return $x -> binf($y -> sign());
2103        }
2104    }
2105
2106  return $x->bzero() if $x->is_zero()
2107 || ($x->is_int() &&
2108  # check that $y == +1 or $y == -1:
2109    ($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m})));
2110
2111  my $cmp = $x->bacmp($y);			# equal or $x < $y?
2112    if ($cmp == 0) {                            # $x == $y => result 0
2113        return $x -> bzero($a, $p);
2114    }
2115
2116  # only $y of the operands negative?
2117    my $neg = $x->{sign} ne $y->{sign} ? 1 : 0;
2118
2119  $x->{sign} = $y->{sign};				# calc sign first
2120    if ($cmp < 0 && $neg == 0) {                # $x < $y => result $x
2121        return $x -> round($a, $p, $r);
2122    }
2123
2124  my $ym = $MBI->_copy($y->{_m});
2125
2126  # 2e1 => 20
2127  $MBI->_lsft( $ym, $y->{_e}, 10)
2128   if $y->{_es} eq '+' && !$MBI->_is_zero($y->{_e});
2129
2130  # if $y has digits after dot
2131  my $shifty = 0;			# correct _e of $x by this
2132  if ($y->{_es} eq '-')			# has digits after dot
2133    {
2134    # 123 % 2.5 => 1230 % 25 => 5 => 0.5
2135    $shifty = $MBI->_num($y->{_e}); 	# no more digits after dot
2136    $MBI->_lsft($x->{_m}, $y->{_e}, 10);# 123 => 1230, $y->{_m} is already 25
2137    }
2138  # $ym is now mantissa of $y based on exponent 0
2139
2140  my $shiftx = 0;			# correct _e of $x by this
2141  if ($x->{_es} eq '-')			# has digits after dot
2142    {
2143    # 123.4 % 20 => 1234 % 200
2144    $shiftx = $MBI->_num($x->{_e});	# no more digits after dot
2145    $MBI->_lsft($ym, $x->{_e}, 10);	# 123 => 1230
2146    }
2147  # 123e1 % 20 => 1230 % 20
2148  if ($x->{_es} eq '+' && !$MBI->_is_zero($x->{_e}))
2149    {
2150    $MBI->_lsft( $x->{_m}, $x->{_e},10);	# es => '+' here
2151    }
2152
2153  $x->{_e} = $MBI->_new($shiftx);
2154  $x->{_es} = '+';
2155  $x->{_es} = '-' if $shiftx != 0 || $shifty != 0;
2156  $MBI->_add( $x->{_e}, $MBI->_new($shifty)) if $shifty != 0;
2157
2158  # now mantissas are equalized, exponent of $x is adjusted, so calc result
2159
2160  $x->{_m} = $MBI->_mod( $x->{_m}, $ym);
2161
2162  $x->{sign} = '+' if $MBI->_is_zero($x->{_m});		# fix sign for -0
2163  $x->bnorm();
2164
2165    if ($neg != 0 && ! $x -> is_zero())   # one of them negative => correct in place
2166    {
2167    my $r = $y - $x;
2168    $x->{_m} = $r->{_m};
2169    $x->{_e} = $r->{_e};
2170    $x->{_es} = $r->{_es};
2171    $x->{sign} = '+' if $MBI->_is_zero($x->{_m});	# fix sign for -0
2172    $x->bnorm();
2173    }
2174
2175  $x->round($a,$p,$r,$y);	# round and return
2176  }
2177
2178sub broot
2179  {
2180  # calculate $y'th root of $x
2181
2182  # set up parameters
2183  my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
2184  # objectify is costly, so avoid it
2185  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2186    {
2187    ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
2188    }
2189
2190  return $x if $x->modify('broot');
2191
2192  # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
2193  return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
2194         $y->{sign} !~ /^\+$/;
2195
2196  return $x if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
2197
2198  # we need to limit the accuracy to protect against overflow
2199  my $fallback = 0;
2200  my (@params,$scale);
2201  ($x,@params) = $x->_find_round_parameters($a,$p,$r);
2202
2203  return $x if $x->is_nan();		# error in _find_round_parameters?
2204
2205  # no rounding at all, so must use fallback
2206  if (scalar @params == 0)
2207    {
2208    # simulate old behaviour
2209    $params[0] = $self->div_scale();	# and round to it as accuracy
2210    $scale = $params[0]+4; 		# at least four more for proper round
2211    $params[2] = $r;			# round mode by caller or undef
2212    $fallback = 1;			# to clear a/p afterwards
2213    }
2214  else
2215    {
2216    # the 4 below is empirical, and there might be cases where it is not
2217    # enough...
2218    $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
2219    }
2220
2221  # when user set globals, they would interfere with our calculation, so
2222  # disable them and later re-enable them
2223  no strict 'refs';
2224  my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
2225  my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
2226  # we also need to disable any set A or P on $x (_find_round_parameters took
2227  # them already into account), since these would interfere, too
2228  delete $x->{_a}; delete $x->{_p};
2229  # need to disable $upgrade in BigInt, to avoid deep recursion
2230  local $Math::BigInt::upgrade = undef;	# should be really parent class vs MBI
2231
2232  # remember sign and make $x positive, since -4 ** (1/2) => -2
2233  my $sign = 0; $sign = 1 if $x->{sign} eq '-'; $x->{sign} = '+';
2234
2235  my $is_two = 0;
2236  if ($y->isa('Math::BigFloat'))
2237    {
2238    $is_two = ($y->{sign} eq '+' && $MBI->_is_two($y->{_m}) && $MBI->_is_zero($y->{_e}));
2239    }
2240  else
2241    {
2242    $is_two = ($y == 2);
2243    }
2244
2245  # normal square root if $y == 2:
2246  if ($is_two)
2247    {
2248    $x->bsqrt($scale+4);
2249    }
2250  elsif ($y->is_one('-'))
2251    {
2252    # $x ** -1 => 1/$x
2253    my $u = $self->bone()->bdiv($x,$scale);
2254    # copy private parts over
2255    $x->{_m} = $u->{_m};
2256    $x->{_e} = $u->{_e};
2257    $x->{_es} = $u->{_es};
2258    }
2259  else
2260    {
2261    # calculate the broot() as integer result first, and if it fits, return
2262    # it rightaway (but only if $x and $y are integer):
2263
2264    my $done = 0;				# not yet
2265    if ($y->is_int() && $x->is_int())
2266      {
2267      my $i = $MBI->_copy( $x->{_m} );
2268      $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
2269      my $int = Math::BigInt->bzero();
2270      $int->{value} = $i;
2271      $int->broot($y->as_number());
2272      # if ($exact)
2273      if ($int->copy()->bpow($y) == $x)
2274        {
2275        # found result, return it
2276        $x->{_m} = $int->{value};
2277        $x->{_e} = $MBI->_zero();
2278        $x->{_es} = '+';
2279        $x->bnorm();
2280        $done = 1;
2281        }
2282      }
2283    if ($done == 0)
2284      {
2285      my $u = $self->bone()->bdiv($y,$scale+4);
2286      delete $u->{_a}; delete $u->{_p};         # otherwise it conflicts
2287      $x->bpow($u,$scale+4);                    # el cheapo
2288      }
2289    }
2290  $x->bneg() if $sign == 1;
2291
2292  # shortcut to not run through _find_round_parameters again
2293  if (defined $params[0])
2294    {
2295    $x->bround($params[0],$params[2]);		# then round accordingly
2296    }
2297  else
2298    {
2299    $x->bfround($params[1],$params[2]);		# then round accordingly
2300    }
2301  if ($fallback)
2302    {
2303    # clear a/p after round, since user did not request it
2304    delete $x->{_a}; delete $x->{_p};
2305    }
2306  # restore globals
2307  $$abr = $ab; $$pbr = $pb;
2308  $x;
2309  }
2310
2311sub bsqrt
2312  {
2313  # calculate square root
2314  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
2315
2316  return $x if $x->modify('bsqrt');
2317
2318  return $x->bnan() if $x->{sign} !~ /^[+]/;	# NaN, -inf or < 0
2319  return $x if $x->{sign} eq '+inf';		# sqrt(inf) == inf
2320  return $x->round($a,$p,$r) if $x->is_zero() || $x->is_one();
2321
2322  # we need to limit the accuracy to protect against overflow
2323  my $fallback = 0;
2324  my (@params,$scale);
2325  ($x,@params) = $x->_find_round_parameters($a,$p,$r);
2326
2327  return $x if $x->is_nan();		# error in _find_round_parameters?
2328
2329  # no rounding at all, so must use fallback
2330  if (scalar @params == 0)
2331    {
2332    # simulate old behaviour
2333    $params[0] = $self->div_scale();	# and round to it as accuracy
2334    $scale = $params[0]+4; 		# at least four more for proper round
2335    $params[2] = $r;			# round mode by caller or undef
2336    $fallback = 1;			# to clear a/p afterwards
2337    }
2338  else
2339    {
2340    # the 4 below is empirical, and there might be cases where it is not
2341    # enough...
2342    $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
2343    }
2344
2345  # when user set globals, they would interfere with our calculation, so
2346  # disable them and later re-enable them
2347  no strict 'refs';
2348  my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
2349  my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
2350  # we also need to disable any set A or P on $x (_find_round_parameters took
2351  # them already into account), since these would interfere, too
2352  delete $x->{_a}; delete $x->{_p};
2353  # need to disable $upgrade in BigInt, to avoid deep recursion
2354  local $Math::BigInt::upgrade = undef;	# should be really parent class vs MBI
2355
2356  my $i = $MBI->_copy( $x->{_m} );
2357  $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
2358  my $xas = Math::BigInt->bzero();
2359  $xas->{value} = $i;
2360
2361  my $gs = $xas->copy()->bsqrt();	# some guess
2362
2363  if (($x->{_es} ne '-')		# guess can't be accurate if there are
2364					# digits after the dot
2365   && ($xas->bacmp($gs * $gs) == 0))	# guess hit the nail on the head?
2366    {
2367    # exact result, copy result over to keep $x
2368    $x->{_m} = $gs->{value}; $x->{_e} = $MBI->_zero(); $x->{_es} = '+';
2369    $x->bnorm();
2370    # shortcut to not run through _find_round_parameters again
2371    if (defined $params[0])
2372      {
2373      $x->bround($params[0],$params[2]);	# then round accordingly
2374      }
2375    else
2376      {
2377      $x->bfround($params[1],$params[2]);	# then round accordingly
2378      }
2379    if ($fallback)
2380      {
2381      # clear a/p after round, since user did not request it
2382      delete $x->{_a}; delete $x->{_p};
2383      }
2384    # re-enable A and P, upgrade is taken care of by "local"
2385    ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb;
2386    return $x;
2387    }
2388
2389  # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy
2390  # of the result by multiplying the input by 100 and then divide the integer
2391  # result of sqrt(input) by 10. Rounding afterwards returns the real result.
2392
2393  # The following steps will transform 123.456 (in $x) into 123456 (in $y1)
2394  my $y1 = $MBI->_copy($x->{_m});
2395
2396  my $length = $MBI->_len($y1);
2397
2398  # Now calculate how many digits the result of sqrt(y1) would have
2399  my $digits = int($length / 2);
2400
2401  # But we need at least $scale digits, so calculate how many are missing
2402  my $shift = $scale - $digits;
2403
2404  # This happens if the input had enough digits
2405  # (we take care of integer guesses above)
2406  $shift = 0 if $shift < 0;
2407
2408  # Multiply in steps of 100, by shifting left two times the "missing" digits
2409  my $s2 = $shift * 2;
2410
2411  # We now make sure that $y1 has the same odd or even number of digits than
2412  # $x had. So when _e of $x is odd, we must shift $y1 by one digit left,
2413  # because we always must multiply by steps of 100 (sqrt(100) is 10) and not
2414  # steps of 10. The length of $x does not count, since an even or odd number
2415  # of digits before the dot is not changed by adding an even number of digits
2416  # after the dot (the result is still odd or even digits long).
2417  $s2++ if $MBI->_is_odd($x->{_e});
2418
2419  $MBI->_lsft( $y1, $MBI->_new($s2), 10);
2420
2421  # now take the square root and truncate to integer
2422  $y1 = $MBI->_sqrt($y1);
2423
2424  # By "shifting" $y1 right (by creating a negative _e) we calculate the final
2425  # result, which is than later rounded to the desired scale.
2426
2427  # calculate how many zeros $x had after the '.' (or before it, depending
2428  # on sign of $dat, the result should have half as many:
2429  my $dat = $MBI->_num($x->{_e});
2430  $dat = -$dat if $x->{_es} eq '-';
2431  $dat += $length;
2432
2433  if ($dat > 0)
2434    {
2435    # no zeros after the dot (e.g. 1.23, 0.49 etc)
2436    # preserve half as many digits before the dot than the input had
2437    # (but round this "up")
2438    $dat = int(($dat+1)/2);
2439    }
2440  else
2441    {
2442    $dat = int(($dat)/2);
2443    }
2444  $dat -= $MBI->_len($y1);
2445  if ($dat < 0)
2446    {
2447    $dat = abs($dat);
2448    $x->{_e} = $MBI->_new( $dat );
2449    $x->{_es} = '-';
2450    }
2451  else
2452    {
2453    $x->{_e} = $MBI->_new( $dat );
2454    $x->{_es} = '+';
2455    }
2456  $x->{_m} = $y1;
2457  $x->bnorm();
2458
2459  # shortcut to not run through _find_round_parameters again
2460  if (defined $params[0])
2461    {
2462    $x->bround($params[0],$params[2]);		# then round accordingly
2463    }
2464  else
2465    {
2466    $x->bfround($params[1],$params[2]);		# then round accordingly
2467    }
2468  if ($fallback)
2469    {
2470    # clear a/p after round, since user did not request it
2471    delete $x->{_a}; delete $x->{_p};
2472    }
2473  # restore globals
2474  $$abr = $ab; $$pbr = $pb;
2475  $x;
2476  }
2477
2478sub bfac
2479  {
2480  # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
2481  # compute factorial number, modifies first argument
2482
2483  # set up parameters
2484  my ($self,$x,@r) = (ref($_[0]),@_);
2485  # objectify is costly, so avoid it
2486  ($self,$x,@r) = objectify(1,@_) if !ref($x);
2487
2488  # inf => inf
2489  return $x if $x->modify('bfac') || $x->{sign} eq '+inf';
2490
2491  return $x->bnan()
2492    if (($x->{sign} ne '+') ||		# inf, NaN, <0 etc => NaN
2493     ($x->{_es} ne '+'));		# digits after dot?
2494
2495  # use BigInt's bfac() for faster calc
2496  if (! $MBI->_is_zero($x->{_e}))
2497    {
2498    $MBI->_lsft($x->{_m}, $x->{_e},10);	# change 12e1 to 120e0
2499    $x->{_e} = $MBI->_zero();		# normalize
2500    $x->{_es} = '+';
2501    }
2502  $MBI->_fac($x->{_m});			# calculate factorial
2503  $x->bnorm()->round(@r); 		# norm again and round result
2504  }
2505
2506sub _pow
2507  {
2508  # Calculate a power where $y is a non-integer, like 2 ** 0.3
2509  my ($x,$y,@r) = @_;
2510  my $self = ref($x);
2511
2512  # if $y == 0.5, it is sqrt($x)
2513  $HALF = $self->new($HALF) unless ref($HALF);
2514  return $x->bsqrt(@r,$y) if $y->bcmp($HALF) == 0;
2515
2516  # Using:
2517  # a ** x == e ** (x * ln a)
2518
2519  # u = y * ln x
2520  #                _                         _
2521  # Taylor:       |   u    u^2    u^3         |
2522  # x ** y  = 1 + |  --- + --- + ----- + ...  |
2523  #               |_  1    1*2   1*2*3       _|
2524
2525  # we need to limit the accuracy to protect against overflow
2526  my $fallback = 0;
2527  my ($scale,@params);
2528  ($x,@params) = $x->_find_round_parameters(@r);
2529
2530  return $x if $x->is_nan();		# error in _find_round_parameters?
2531
2532  # no rounding at all, so must use fallback
2533  if (scalar @params == 0)
2534    {
2535    # simulate old behaviour
2536    $params[0] = $self->div_scale();	# and round to it as accuracy
2537    $params[1] = undef;			# disable P
2538    $scale = $params[0]+4; 		# at least four more for proper round
2539    $params[2] = $r[2];			# round mode by caller or undef
2540    $fallback = 1;			# to clear a/p afterwards
2541    }
2542  else
2543    {
2544    # the 4 below is empirical, and there might be cases where it is not
2545    # enough...
2546    $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
2547    }
2548
2549  # when user set globals, they would interfere with our calculation, so
2550  # disable them and later re-enable them
2551  no strict 'refs';
2552  my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
2553  my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
2554  # we also need to disable any set A or P on $x (_find_round_parameters took
2555  # them already into account), since these would interfere, too
2556  delete $x->{_a}; delete $x->{_p};
2557  # need to disable $upgrade in BigInt, to avoid deep recursion
2558  local $Math::BigInt::upgrade = undef;
2559
2560  my ($limit,$v,$u,$below,$factor,$next,$over);
2561
2562  $u = $x->copy()->blog(undef,$scale)->bmul($y);
2563  my $do_invert = ($u->{sign} eq '-');
2564  $u->bneg()  if $do_invert;
2565  $v = $self->bone();				# 1
2566  $factor = $self->new(2);			# 2
2567  $x->bone();					# first term: 1
2568
2569  $below = $v->copy();
2570  $over = $u->copy();
2571
2572  $limit = $self->new("1E-". ($scale-1));
2573  #my $steps = 0;
2574  while (3 < 5)
2575    {
2576    # we calculate the next term, and add it to the last
2577    # when the next term is below our limit, it won't affect the outcome
2578    # anymore, so we stop:
2579    $next = $over->copy()->bdiv($below,$scale);
2580    last if $next->bacmp($limit) <= 0;
2581    $x->badd($next);
2582    # calculate things for the next term
2583    $over *= $u; $below *= $factor; $factor->binc();
2584
2585    last if $x->{sign} !~ /^[-+]$/;
2586
2587    #$steps++;
2588    }
2589
2590  if ($do_invert)
2591    {
2592    my $x_copy = $x->copy;
2593    $x->bone->bdiv($x_copy, $scale);
2594    }
2595
2596  # shortcut to not run through _find_round_parameters again
2597  if (defined $params[0])
2598    {
2599    $x->bround($params[0],$params[2]);		# then round accordingly
2600    }
2601  else
2602    {
2603    $x->bfround($params[1],$params[2]);		# then round accordingly
2604    }
2605  if ($fallback)
2606    {
2607    # clear a/p after round, since user did not request it
2608    delete $x->{_a}; delete $x->{_p};
2609    }
2610  # restore globals
2611  $$abr = $ab; $$pbr = $pb;
2612  $x;
2613  }
2614
2615sub bpow
2616  {
2617  # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
2618  # compute power of two numbers, second arg is used as integer
2619  # modifies first argument
2620
2621  # set up parameters
2622  my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
2623  # objectify is costly, so avoid it
2624  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
2625    {
2626    ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
2627    }
2628
2629  return $x if $x->modify('bpow');
2630
2631  return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
2632  return $x if $x->{sign} =~ /^[+-]inf$/;
2633
2634  # cache the result of is_zero
2635  my $y_is_zero = $y->is_zero();
2636  return $x->bone() if $y_is_zero;
2637  return $x         if $x->is_one() || $y->is_one();
2638
2639  my $x_is_zero = $x->is_zero();
2640  return $x->_pow($y,$a,$p,$r) if !$x_is_zero && !$y->is_int();		# non-integer power
2641
2642  my $y1 = $y->as_number()->{value};			# make MBI part
2643
2644  # if ($x == -1)
2645  if ($x->{sign} eq '-' && $MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e}))
2646    {
2647    # if $x == -1 and odd/even y => +1/-1  because +-1 ^ (+-1) => +-1
2648    return $MBI->_is_odd($y1) ? $x : $x->babs(1);
2649    }
2650  if ($x_is_zero)
2651    {
2652    return $x if $y->{sign} eq '+'; 	# 0**y => 0 (if not y <= 0)
2653    # 0 ** -y => 1 / (0 ** y) => 1 / 0! (1 / 0 => +inf)
2654    return $x->binf();
2655    }
2656
2657  my $new_sign = '+';
2658  $new_sign = $MBI->_is_odd($y1) ? '-' : '+' if $x->{sign} ne '+';
2659
2660  # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
2661  $x->{_m} = $MBI->_pow( $x->{_m}, $y1);
2662  $x->{_e} = $MBI->_mul ($x->{_e}, $y1);
2663
2664  $x->{sign} = $new_sign;
2665  $x->bnorm();
2666  if ($y->{sign} eq '-')
2667    {
2668    # modify $x in place!
2669    my $z = $x->copy(); $x->bone();
2670    return scalar $x->bdiv($z,$a,$p,$r);	# round in one go (might ignore y's A!)
2671    }
2672  $x->round($a,$p,$r,$y);
2673  }
2674
2675sub bmodpow
2676  {
2677  # takes a very large number to a very large exponent in a given very
2678  # large modulus, quickly, thanks to binary exponentiation. Supports
2679  # negative exponents.
2680  my ($self,$num,$exp,$mod,@r) = objectify(3,@_);
2681
2682  return $num if $num->modify('bmodpow');
2683
2684  # check modulus for valid values
2685  return $num->bnan() if ($mod->{sign} ne '+'           # NaN, - , -inf, +inf
2686                       || $mod->is_zero());
2687
2688  # check exponent for valid values
2689  if ($exp->{sign} =~ /\w/)
2690    {
2691    # i.e., if it's NaN, +inf, or -inf...
2692    return $num->bnan();
2693    }
2694
2695  $num->bmodinv ($mod) if ($exp->{sign} eq '-');
2696
2697  # check num for valid values (also NaN if there was no inverse but $exp < 0)
2698  return $num->bnan() if $num->{sign} !~ /^[+-]$/;
2699
2700  # $mod is positive, sign on $exp is ignored, result also positive
2701
2702  # XXX TODO: speed it up when all three numbers are integers
2703  $num->bpow($exp)->bmod($mod);
2704  }
2705
2706###############################################################################
2707# trigonometric functions
2708
2709# helper function for bpi() and batan2(), calculates arcus tanges (1/x)
2710
2711sub _atan_inv
2712  {
2713  # return a/b so that a/b approximates atan(1/x) to at least limit digits
2714  my ($self, $x, $limit) = @_;
2715
2716  # Taylor:       x^3   x^5   x^7   x^9
2717  #    atan = x - --- + --- - --- + --- - ...
2718  #                3     5     7     9
2719
2720  #               1      1         1        1
2721  #    atan 1/x = - - ------- + ------- - ------- + ...
2722  #               x   x^3 * 3   x^5 * 5   x^7 * 7
2723
2724  #               1      1         1            1
2725  #    atan 1/x = - - --------- + ---------- - ----------- + ...
2726  #               5    3 * 125     5 * 3125     7 * 78125
2727
2728  # Subtraction/addition of a rational:
2729
2730  #  5    7    5*3 +- 7*4
2731  #  - +- -  = ----------
2732  #  4    3       4*3
2733
2734  # Term:  N        N+1
2735  #
2736  #        a             1                  a * d * c +- b
2737  #        ----- +- ------------------  =  ----------------
2738  #        b           d * c                b * d * c
2739
2740  #  since b1 = b0 * (d-2) * c
2741
2742  #        a             1                  a * d +- b / c
2743  #        ----- +- ------------------  =  ----------------
2744  #        b           d * c                b * d
2745
2746  # and  d = d + 2
2747  # and  c = c * x * x
2748
2749  #        u = d * c
2750  #        stop if length($u) > limit
2751  #        a = a * u +- b
2752  #        b = b * u
2753  #        d = d + 2
2754  #        c = c * x * x
2755  #        sign = 1 - sign
2756
2757  my $a = $MBI->_one();
2758  my $b = $MBI->_copy($x);
2759
2760  my $x2  = $MBI->_mul( $MBI->_copy($x), $b);		# x2 = x * x
2761  my $d   = $MBI->_new( 3 );				# d = 3
2762  my $c   = $MBI->_mul( $MBI->_copy($x), $x2);		# c = x ^ 3
2763  my $two = $MBI->_new( 2 );
2764
2765  # run the first step unconditionally
2766  my $u = $MBI->_mul( $MBI->_copy($d), $c);
2767  $a = $MBI->_mul($a, $u);
2768  $a = $MBI->_sub($a, $b);
2769  $b = $MBI->_mul($b, $u);
2770  $d = $MBI->_add($d, $two);
2771  $c = $MBI->_mul($c, $x2);
2772
2773  # a is now a * (d-3) * c
2774  # b is now b * (d-2) * c
2775
2776  # run the second step unconditionally
2777  $u = $MBI->_mul( $MBI->_copy($d), $c);
2778  $a = $MBI->_mul($a, $u);
2779  $a = $MBI->_add($a, $b);
2780  $b = $MBI->_mul($b, $u);
2781  $d = $MBI->_add($d, $two);
2782  $c = $MBI->_mul($c, $x2);
2783
2784  # a is now a * (d-3) * (d-5) * c * c
2785  # b is now b * (d-2) * (d-4) * c * c
2786
2787  # so we can remove c * c from both a and b to shorten the numbers involved:
2788  $a = $MBI->_div($a, $x2);
2789  $b = $MBI->_div($b, $x2);
2790  $a = $MBI->_div($a, $x2);
2791  $b = $MBI->_div($b, $x2);
2792
2793#  my $step = 0;
2794  my $sign = 0;						# 0 => -, 1 => +
2795  while (3 < 5)
2796    {
2797#    $step++;
2798#    if (($i++ % 100) == 0)
2799#      {
2800#    print "a=",$MBI->_str($a),"\n";
2801#    print "b=",$MBI->_str($b),"\n";
2802#      }
2803#    print "d=",$MBI->_str($d),"\n";
2804#    print "x2=",$MBI->_str($x2),"\n";
2805#    print "c=",$MBI->_str($c),"\n";
2806
2807    my $u = $MBI->_mul( $MBI->_copy($d), $c);
2808    # use _alen() for libs like GMP where _len() would be O(N^2)
2809    last if $MBI->_alen($u) > $limit;
2810    my ($bc,$r) = $MBI->_div( $MBI->_copy($b), $c);
2811    if ($MBI->_is_zero($r))
2812      {
2813      # b / c is an integer, so we can remove c from all terms
2814      # this happens almost every time:
2815      $a = $MBI->_mul($a, $d);
2816      $a = $MBI->_sub($a, $bc) if $sign == 0;
2817      $a = $MBI->_add($a, $bc) if $sign == 1;
2818      $b = $MBI->_mul($b, $d);
2819      }
2820    else
2821      {
2822      # b / c is not an integer, so we keep c in the terms
2823      # this happens very rarely, for instance for x = 5, this happens only
2824      # at the following steps:
2825      # 1, 5, 14, 32, 72, 157, 340, ...
2826      $a = $MBI->_mul($a, $u);
2827      $a = $MBI->_sub($a, $b) if $sign == 0;
2828      $a = $MBI->_add($a, $b) if $sign == 1;
2829      $b = $MBI->_mul($b, $u);
2830      }
2831    $d = $MBI->_add($d, $two);
2832    $c = $MBI->_mul($c, $x2);
2833    $sign = 1 - $sign;
2834
2835    }
2836
2837#  print "Took $step steps for ", $MBI->_str($x),"\n";
2838#  print "a=",$MBI->_str($a),"\n"; print "b=",$MBI->_str($b),"\n";
2839  # return a/b so that a/b approximates atan(1/x)
2840  ($a,$b);
2841  }
2842
2843sub bpi {
2844
2845    # Called as                 Argument list
2846    # ---------                 -------------
2847    # Math::BigFloat->bpi()     ("Math::BigFloat")
2848    # Math::BigFloat->bpi(10)   ("Math::BigFloat", 10)
2849    # $x->bpi()                 ($x)
2850    # $x->bpi(10)               ($x, 10)
2851    # Math::BigFloat::bpi()     ()
2852    # Math::BigFloat::bpi(10)   (10)
2853    #
2854    # In ambiguous cases, we favour the OO-style, so the following case
2855    #
2856    #   $n = Math::BigFloat->new("10");
2857    #   $x = Math::BigFloat->bpi($n);
2858    #
2859    # which gives an argument list with the single element $n, is resolved as
2860    #
2861    #   $n->bpi();
2862
2863    my $self    = shift;
2864    my $selfref = ref $self;
2865    my $class   = $selfref || $self;
2866
2867    my $accu;                      # accuracy (number of digits)
2868    my $prec;                      # precision
2869    my $rndm;                      # round mode
2870
2871    # If bpi() is called as a function ...
2872    #
2873    # This cludge is necessary because we still support bpi() as a function. If
2874    # bpi() is called with either no argument or one argument, and that one
2875    # argument is either undefined or a scalar that looks like a number, then
2876    # we assume bpi() is called as a function.
2877
2878    if (@_ == 0 &&
2879        (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/i)
2880          ||
2881        !defined($self))
2882    {
2883        $accu = $self;
2884        $class = __PACKAGE__;
2885        $self = $class -> bzero();      # initialize
2886    }
2887
2888    # ... or if bpi() is called as a method ...
2889
2890    else {
2891        if ($selfref) {                 # bpi() called as instance method
2892            return $self if $self -> modify('bpi');
2893        } else {                        # bpi() called as class method
2894            $self = $class -> bzero();  # initialize
2895        }
2896        $accu = shift;
2897        $prec = shift;
2898        $rndm = shift;
2899    }
2900
2901    my @r = ($accu, $prec, $rndm);
2902
2903    # We need to limit the accuracy to protect against overflow.
2904    my $fallback = 0;
2905    my ($scale, @params);
2906    ($self, @params) = $self -> _find_round_parameters(@r);
2907
2908    # Error in _find_round_parameters?
2909    #
2910    # We can't return here, because that will fail if $self was a NaN when
2911    # bpi() was invoked, and we want to assign pi to $x. It is probably not a
2912    # good idea that _find_round_parameters() signals invalid round parameters
2913    # by silently returning a NaN. Fixme!
2914    #return $self if $self && $self->is_nan();
2915
2916    # No rounding at all, so must use fallback.
2917    if (scalar @params == 0) {
2918        # Simulate old behaviour
2919        $params[0] = $self -> div_scale();  # and round to it as accuracy
2920        $params[1] = undef;                 # disable P
2921        $params[2] = $r[2];                 # round mode by caller or undef
2922        $fallback = 1;                      # to clear a/p afterwards
2923    }
2924
2925    # The accuracy, i.e., the number of digits. Pi has one digit before the
2926    # dot, so a precision of 4 digits is equivalent to an accuracy of 5 digits.
2927
2928    my $n = $params[0] || 1 - $params[1];
2929
2930    if ($n < 1000) {
2931
2932        # after 黃見利 (Hwang Chien-Lih) (1997)
2933        # pi/4 = 183 * atan(1/239) + 32 * atan(1/1023) – 68 * atan(1/5832)
2934        #        + 12 * atan(1/110443) - 12 * atan(1/4841182) - 100 * atan(1/6826318)
2935
2936        # Use a few more digits in the intermediate computations.
2937
2938        my $nextra = $n < 800 ? 4 : 5;
2939        $n += $nextra;
2940
2941        my ($a, $b) = $class->_atan_inv($MBI->_new(239), $n);
2942        my ($c, $d) = $class->_atan_inv($MBI->_new(1023), $n);
2943        my ($e, $f) = $class->_atan_inv($MBI->_new(5832), $n);
2944        my ($g, $h) = $class->_atan_inv($MBI->_new(110443), $n);
2945        my ($i, $j) = $class->_atan_inv($MBI->_new(4841182), $n);
2946        my ($k, $l) = $class->_atan_inv($MBI->_new(6826318), $n);
2947
2948        $MBI->_mul($a, $MBI->_new(732));
2949        $MBI->_mul($c, $MBI->_new(128));
2950        $MBI->_mul($e, $MBI->_new(272));
2951        $MBI->_mul($g, $MBI->_new(48));
2952        $MBI->_mul($i, $MBI->_new(48));
2953        $MBI->_mul($k, $MBI->_new(400));
2954
2955        my $x = $class->bone(); $x->{_m} = $a; my $x_d = $class->bone(); $x_d->{_m} = $b;
2956        my $y = $class->bone(); $y->{_m} = $c; my $y_d = $class->bone(); $y_d->{_m} = $d;
2957        my $z = $class->bone(); $z->{_m} = $e; my $z_d = $class->bone(); $z_d->{_m} = $f;
2958        my $u = $class->bone(); $u->{_m} = $g; my $u_d = $class->bone(); $u_d->{_m} = $h;
2959        my $v = $class->bone(); $v->{_m} = $i; my $v_d = $class->bone(); $v_d->{_m} = $j;
2960        my $w = $class->bone(); $w->{_m} = $k; my $w_d = $class->bone(); $w_d->{_m} = $l;
2961        $x->bdiv($x_d, $n);
2962        $y->bdiv($y_d, $n);
2963        $z->bdiv($z_d, $n);
2964        $u->bdiv($u_d, $n);
2965        $v->bdiv($v_d, $n);
2966        $w->bdiv($w_d, $n);
2967
2968        delete $x->{_a}; delete $y->{_a}; delete $z->{_a};
2969        delete $u->{_a}; delete $v->{_a}; delete $w->{_a};
2970        $x->badd($y)->bsub($z)->badd($u)->bsub($v)->bsub($w);
2971
2972        for my $key (qw/ sign _m _es _e _a _p /) {
2973            $self -> {$key} = $x -> {$key} if exists $x -> {$key};
2974        }
2975
2976    } else {
2977
2978        # For large accuracy, the arctan formulas become very inefficient with
2979        # Math::BigFloat. Switch to Brent-Salamin (aka AGM or Gauss-Legendre).
2980
2981        # Use a few more digits in the intermediate computations.
2982        my $nextra = 8;
2983
2984        $HALF = $class -> new($HALF) unless ref($HALF);
2985        my ($an, $bn, $tn, $pn) = ($class -> bone, $HALF -> copy -> bsqrt($n),
2986                                   $HALF -> copy -> bmul($HALF), $class -> bone);
2987        while ($pn < $n) {
2988            my $prev_an = $an -> copy;
2989            $an -> badd($bn) -> bmul($HALF, $n);
2990            $bn -> bmul($prev_an) -> bsqrt($n);
2991            $prev_an -> bsub($an);
2992            $tn -> bsub($pn * $prev_an * $prev_an);
2993            $pn -> badd($pn);
2994        }
2995        $an -> badd($bn);
2996        $an -> bmul($an, $n) -> bdiv(4 * $tn, $n);
2997
2998        for my $key (qw/ sign _m _es _e _a _p /) {
2999            $self -> {$key} = $an -> {$key} if exists $an -> {$key};;
3000        }
3001    }
3002
3003    $self -> round(@params);
3004
3005    if ($fallback) {
3006        delete $self->{_a};
3007        delete $self->{_p};
3008    }
3009
3010    return $self;
3011}
3012
3013sub bcos
3014  {
3015  # Calculate a cosinus of x.
3016  my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
3017
3018  # Taylor:      x^2   x^4   x^6   x^8
3019  #    cos = 1 - --- + --- - --- + --- ...
3020  #               2!    4!    6!    8!
3021
3022  # we need to limit the accuracy to protect against overflow
3023  my $fallback = 0;
3024  my ($scale,@params);
3025  ($x,@params) = $x->_find_round_parameters(@r);
3026
3027  #         constant object       or error in _find_round_parameters?
3028  return $x if $x->modify('bcos') || $x->is_nan();
3029
3030  return $x->bone(@r) if $x->is_zero();
3031
3032  # no rounding at all, so must use fallback
3033  if (scalar @params == 0)
3034    {
3035    # simulate old behaviour
3036    $params[0] = $self->div_scale();	# and round to it as accuracy
3037    $params[1] = undef;			# disable P
3038    $scale = $params[0]+4; 		# at least four more for proper round
3039    $params[2] = $r[2];			# round mode by caller or undef
3040    $fallback = 1;			# to clear a/p afterwards
3041    }
3042  else
3043    {
3044    # the 4 below is empirical, and there might be cases where it is not
3045    # enough...
3046    $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
3047    }
3048
3049  # when user set globals, they would interfere with our calculation, so
3050  # disable them and later re-enable them
3051  no strict 'refs';
3052  my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
3053  my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
3054  # we also need to disable any set A or P on $x (_find_round_parameters took
3055  # them already into account), since these would interfere, too
3056  delete $x->{_a}; delete $x->{_p};
3057  # need to disable $upgrade in BigInt, to avoid deep recursion
3058  local $Math::BigInt::upgrade = undef;
3059
3060  my $last = 0;
3061  my $over = $x * $x;                   # X ^ 2
3062  my $x2 = $over->copy();               # X ^ 2; difference between terms
3063  my $sign = 1;                         # start with -=
3064  my $below = $self->new(2); my $factorial = $self->new(3);
3065  $x->bone(); delete $x->{_a}; delete $x->{_p};
3066
3067  my $limit = $self->new("1E-". ($scale-1));
3068  #my $steps = 0;
3069  while (3 < 5)
3070    {
3071    # we calculate the next term, and add it to the last
3072    # when the next term is below our limit, it won't affect the outcome
3073    # anymore, so we stop:
3074    my $next = $over->copy()->bdiv($below,$scale);
3075    last if $next->bacmp($limit) <= 0;
3076
3077    if ($sign == 0)
3078      {
3079      $x->badd($next);
3080      }
3081    else
3082      {
3083      $x->bsub($next);
3084      }
3085    $sign = 1-$sign;					# alternate
3086    # calculate things for the next term
3087    $over->bmul($x2);					# $x*$x
3088    $below->bmul($factorial); $factorial->binc();	# n*(n+1)
3089    $below->bmul($factorial); $factorial->binc();	# n*(n+1)
3090    }
3091
3092  # shortcut to not run through _find_round_parameters again
3093  if (defined $params[0])
3094    {
3095    $x->bround($params[0],$params[2]);		# then round accordingly
3096    }
3097  else
3098    {
3099    $x->bfround($params[1],$params[2]);		# then round accordingly
3100    }
3101  if ($fallback)
3102    {
3103    # clear a/p after round, since user did not request it
3104    delete $x->{_a}; delete $x->{_p};
3105    }
3106  # restore globals
3107  $$abr = $ab; $$pbr = $pb;
3108  $x;
3109  }
3110
3111sub bsin
3112  {
3113  # Calculate a sinus of x.
3114  my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
3115
3116  # taylor:      x^3   x^5   x^7   x^9
3117  #    sin = x - --- + --- - --- + --- ...
3118  #               3!    5!    7!    9!
3119
3120  # we need to limit the accuracy to protect against overflow
3121  my $fallback = 0;
3122  my ($scale,@params);
3123  ($x,@params) = $x->_find_round_parameters(@r);
3124
3125  #         constant object       or error in _find_round_parameters?
3126  return $x if $x->modify('bsin') || $x->is_nan();
3127
3128  return $x->bzero(@r) if $x->is_zero();
3129
3130  # no rounding at all, so must use fallback
3131  if (scalar @params == 0)
3132    {
3133    # simulate old behaviour
3134    $params[0] = $self->div_scale();	# and round to it as accuracy
3135    $params[1] = undef;			# disable P
3136    $scale = $params[0]+4; 		# at least four more for proper round
3137    $params[2] = $r[2];			# round mode by caller or undef
3138    $fallback = 1;			# to clear a/p afterwards
3139    }
3140  else
3141    {
3142    # the 4 below is empirical, and there might be cases where it is not
3143    # enough...
3144    $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
3145    }
3146
3147  # when user set globals, they would interfere with our calculation, so
3148  # disable them and later re-enable them
3149  no strict 'refs';
3150  my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
3151  my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
3152  # we also need to disable any set A or P on $x (_find_round_parameters took
3153  # them already into account), since these would interfere, too
3154  delete $x->{_a}; delete $x->{_p};
3155  # need to disable $upgrade in BigInt, to avoid deep recursion
3156  local $Math::BigInt::upgrade = undef;
3157
3158  my $last = 0;
3159  my $over = $x * $x;			# X ^ 2
3160  my $x2 = $over->copy();		# X ^ 2; difference between terms
3161  $over->bmul($x);			# X ^ 3 as starting value
3162  my $sign = 1;				# start with -=
3163  my $below = $self->new(6); my $factorial = $self->new(4);
3164  delete $x->{_a}; delete $x->{_p};
3165
3166  my $limit = $self->new("1E-". ($scale-1));
3167  #my $steps = 0;
3168  while (3 < 5)
3169    {
3170    # we calculate the next term, and add it to the last
3171    # when the next term is below our limit, it won't affect the outcome
3172    # anymore, so we stop:
3173    my $next = $over->copy()->bdiv($below,$scale);
3174    last if $next->bacmp($limit) <= 0;
3175
3176    if ($sign == 0)
3177      {
3178      $x->badd($next);
3179      }
3180    else
3181      {
3182      $x->bsub($next);
3183      }
3184    $sign = 1-$sign;					# alternate
3185    # calculate things for the next term
3186    $over->bmul($x2);					# $x*$x
3187    $below->bmul($factorial); $factorial->binc();	# n*(n+1)
3188    $below->bmul($factorial); $factorial->binc();	# n*(n+1)
3189    }
3190
3191  # shortcut to not run through _find_round_parameters again
3192  if (defined $params[0])
3193    {
3194    $x->bround($params[0],$params[2]);		# then round accordingly
3195    }
3196  else
3197    {
3198    $x->bfround($params[1],$params[2]);		# then round accordingly
3199    }
3200  if ($fallback)
3201    {
3202    # clear a/p after round, since user did not request it
3203    delete $x->{_a}; delete $x->{_p};
3204    }
3205  # restore globals
3206  $$abr = $ab; $$pbr = $pb;
3207  $x;
3208  }
3209
3210sub batan2 {
3211    # $y -> batan2($x) returns the arcus tangens of $y / $x.
3212
3213    # Set up parameters.
3214    my ($self, $y, $x, @r) = (ref($_[0]), @_);
3215
3216    # Objectify is costly, so avoid it if we can.
3217    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
3218        ($self, $y, $x, @r) = objectify(2, @_);
3219    }
3220
3221    # Quick exit if $y is read-only.
3222    return $y if $y -> modify('batan2');
3223
3224    # Handle all NaN cases.
3225    return $y -> bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
3226
3227    # We need to limit the accuracy to protect against overflow.
3228    my $fallback = 0;
3229    my ($scale, @params);
3230    ($y, @params) = $y -> _find_round_parameters(@r);
3231
3232    # Error in _find_round_parameters?
3233    return $y if $y->is_nan();
3234
3235    # No rounding at all, so must use fallback.
3236    if (scalar @params == 0) {
3237        # Simulate old behaviour
3238        $params[0] = $self -> div_scale();  # and round to it as accuracy
3239        $params[1] = undef;                 # disable P
3240        $scale = $params[0] + 4;            # at least four more for proper round
3241        $params[2] = $r[2];                 # round mode by caller or undef
3242        $fallback = 1;                      # to clear a/p afterwards
3243    } else {
3244        # The 4 below is empirical, and there might be cases where it is not
3245        # enough ...
3246        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
3247    }
3248
3249    if ($x -> is_inf("+")) {                            # x = inf
3250        if ($y -> is_inf("+")) {                        #    y = inf
3251            $y -> bpi($scale) -> bmul("0.25");          #       pi/4
3252        } elsif ($y -> is_inf("-")) {                   #    y = -inf
3253            $y -> bpi($scale) -> bmul("-0.25");         #       -pi/4
3254        } else {                                        #    -inf < y < inf
3255            return $y -> bzero(@r);                     #       0
3256        }
3257    }
3258
3259    elsif ($x -> is_inf("-")) {                         # x = -inf
3260        if ($y -> is_inf("+")) {                        #    y = inf
3261            $y -> bpi($scale) -> bmul("0.75");          #       3/4 pi
3262        } elsif ($y -> is_inf("-")) {                   #    y = -inf
3263            $y -> bpi($scale) -> bmul("-0.75");         #       -3/4 pi
3264        } elsif ($y >= 0) {                             #    y >= 0
3265            $y -> bpi($scale);                          #       pi
3266        } else {                                        #    y < 0
3267            $y -> bpi($scale) -> bneg();                #       -pi
3268        }
3269    }
3270
3271    elsif ($x > 0) {                                    # 0 < x < inf
3272        if ($y -> is_inf("+")) {                        #    y = inf
3273            $y -> bpi($scale) -> bmul("0.5");           #       pi/2
3274        } elsif ($y -> is_inf("-")) {                   #    y = -inf
3275            $y -> bpi($scale) -> bmul("-0.5");          #       -pi/2
3276        } else {                                        #   -inf < y < inf
3277            $y -> bdiv($x, $scale) -> batan($scale);    #       atan(y/x)
3278        }
3279    }
3280
3281    elsif ($x < 0) {                                    # -inf < x < 0
3282        my $pi = $class -> bpi($scale);
3283        if ($y >= 0) {                                  #    y >= 0
3284            $y -> bdiv($x, $scale) -> batan()           #       atan(y/x) + pi
3285               -> badd($pi);
3286        } else {                                        #    y < 0
3287            $y -> bdiv($x, $scale) -> batan()           #       atan(y/x) - pi
3288               -> bsub($pi);
3289        }
3290    }
3291
3292    else {                                              # x = 0
3293        if ($y > 0) {                                   #    y > 0
3294            $y -> bpi($scale) -> bmul("0.5");           #       pi/2
3295        } elsif ($y < 0) {                              #    y < 0
3296            $y -> bpi($scale) -> bmul("-0.5");          #       -pi/2
3297        } else {                                        #    y = 0
3298            return $y -> bzero(@r);                     #       0
3299        }
3300    }
3301
3302    $y -> round(@r);
3303
3304    if ($fallback) {
3305        delete $y->{_a};
3306        delete $y->{_p};
3307    }
3308
3309    return $y;
3310}
3311
3312sub batan {
3313    # Calculate a arcus tangens of x.
3314
3315    my $self    = shift;
3316    my $selfref = ref $self;
3317    my $class   = $selfref || $self;
3318
3319    my (@r) = @_;
3320
3321    # taylor:       x^3   x^5   x^7   x^9
3322    #    atan = x - --- + --- - --- + --- ...
3323    #                3     5     7     9
3324
3325    # We need to limit the accuracy to protect against overflow.
3326
3327    my $fallback = 0;
3328    my ($scale, @params);
3329    ($self, @params) = $self->_find_round_parameters(@r);
3330
3331    # Constant object or error in _find_round_parameters?
3332
3333    return $self if $self->modify('batan') || $self->is_nan();
3334
3335    if ($self->{sign} =~ /^[+-]inf\z/) {
3336        # +inf result is PI/2
3337        # -inf result is -PI/2
3338        # calculate PI/2
3339        my $pi = $class->bpi(@r);
3340        # modify $self in place
3341        $self->{_m} = $pi->{_m};
3342        $self->{_e} = $pi->{_e};
3343        $self->{_es} = $pi->{_es};
3344        # -y => -PI/2, +y => PI/2
3345        $self->{sign} = substr($self->{sign}, 0, 1);  # "+inf" => "+"
3346        $MBI->_div($self->{_m}, $MBI->_new(2));
3347        return $self;
3348    }
3349
3350    return $self->bzero(@r) if $self->is_zero();
3351
3352    # no rounding at all, so must use fallback
3353    if (scalar @params == 0) {
3354        # simulate old behaviour
3355        $params[0] = $class->div_scale();  # and round to it as accuracy
3356        $params[1] = undef;               # disable P
3357        $scale = $params[0]+4;            # at least four more for proper round
3358        $params[2] = $r[2];               # round mode by caller or undef
3359        $fallback = 1;                    # to clear a/p afterwards
3360    } else {
3361        # the 4 below is empirical, and there might be cases where it is not
3362        # enough...
3363        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
3364    }
3365
3366    # 1 or -1 => PI/4
3367    # inlined is_one() && is_one('-')
3368    if ($MBI->_is_one($self->{_m}) && $MBI->_is_zero($self->{_e})) {
3369        my $pi = $class->bpi($scale - 3);
3370        # modify $self in place
3371        $self->{_m} = $pi->{_m};
3372        $self->{_e} = $pi->{_e};
3373        $self->{_es} = $pi->{_es};
3374        # leave the sign of $self alone (+1 => +PI/4, -1 => -PI/4)
3375        $MBI->_div($self->{_m}, $MBI->_new(4));
3376        return $self;
3377    }
3378
3379    # This series is only valid if -1 < x < 1, so for other x we need to
3380    # calculate PI/2 - atan(1/x):
3381    my $one = $MBI->_new(1);
3382    my $pi = undef;
3383    if ($self->bacmp($self->copy->bone) >= 0) {
3384        # calculate PI/2
3385        $pi = $class->bpi($scale - 3);
3386        $MBI->_div($pi->{_m}, $MBI->_new(2));
3387        # calculate 1/$self:
3388        my $self_copy = $self->copy();
3389        # modify $self in place
3390        $self->bone(); $self->bdiv($self_copy, $scale);
3391    }
3392
3393    my $fmul = 1;
3394    foreach my $k (0 .. int($scale / 20)) {
3395        $fmul *= 2;
3396        $self->bdiv($self->copy->bmul($self)->binc->bsqrt($scale + 4)->binc, $scale + 4);
3397    }
3398
3399    # When user set globals, they would interfere with our calculation, so
3400    # disable them and later re-enable them.
3401    no strict 'refs';
3402    my $abr = "$class\::accuracy";  my $ab = $$abr; $$abr = undef;
3403    my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
3404    # We also need to disable any set A or P on $self (_find_round_parameters
3405    # took them already into account), since these would interfere, too
3406    delete $self->{_a}; delete $self->{_p};
3407    # Need to disable $upgrade in BigInt, to avoid deep recursion.
3408    local $Math::BigInt::upgrade = undef;
3409
3410    my $last = 0;
3411    my $over = $self * $self;		# X ^ 2
3412    my $self2 = $over->copy();		# X ^ 2; difference between terms
3413    $over->bmul($self);			# X ^ 3 as starting value
3414    my $sign = 1;			# start with -=
3415    my $below = $class->new(3);
3416    my $two = $class->new(2);
3417    delete $self->{_a}; delete $self->{_p};
3418
3419    my $limit = $class->new("1E-". ($scale-1));
3420    #my $steps = 0;
3421    while (1) {
3422        # We calculate the next term, and add it to the last. When the next
3423        # term is below our limit, it won't affect the outcome anymore, so we
3424        # stop:
3425        my $next = $over->copy()->bdiv($below, $scale);
3426        last if $next->bacmp($limit) <= 0;
3427
3428        if ($sign == 0) {
3429            $self->badd($next);
3430        } else {
3431            $self->bsub($next);
3432        }
3433        $sign = 1-$sign;        # alternatex
3434        # calculate things for the next term
3435        $over->bmul($self2);    # $self*$self
3436        $below->badd($two);     # n += 2
3437    }
3438    $self->bmul($fmul);
3439
3440    if (defined $pi) {
3441        my $self_copy = $self->copy();
3442        # modify $self in place
3443        $self->{_m} = $pi->{_m};
3444        $self->{_e} = $pi->{_e};
3445        $self->{_es} = $pi->{_es};
3446        # PI/2 - $self
3447        $self->bsub($self_copy);
3448    }
3449
3450    # Shortcut to not run through _find_round_parameters again.
3451    if (defined $params[0]) {
3452        $self->bround($params[0], $params[2]); # then round accordingly
3453    } else {
3454        $self->bfround($params[1], $params[2]); # then round accordingly
3455    }
3456    if ($fallback) {
3457        # Clear a/p after round, since user did not request it.
3458        delete $self->{_a}; delete $self->{_p};
3459    }
3460
3461    # restore globals
3462    $$abr = $ab; $$pbr = $pb;
3463    $self;
3464}
3465
3466###############################################################################
3467# rounding functions
3468
3469sub bfround
3470  {
3471  # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
3472  # $n == 0 means round to integer
3473  # expects and returns normalized numbers!
3474  my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
3475
3476  my ($scale,$mode) = $x->_scale_p(@_);
3477  return $x if !defined $scale || $x->modify('bfround'); # no-op
3478
3479  # never round a 0, +-inf, NaN
3480  if ($x->is_zero())
3481    {
3482    $x->{_p} = $scale if !defined $x->{_p} || $x->{_p} < $scale; # -3 < -2
3483    return $x;
3484    }
3485  return $x if $x->{sign} !~ /^[+-]$/;
3486
3487  # don't round if x already has lower precision
3488  return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p});
3489
3490  $x->{_p} = $scale;			# remember round in any case
3491  delete $x->{_a};			# and clear A
3492  if ($scale < 0)
3493    {
3494    # round right from the '.'
3495
3496    return $x if $x->{_es} eq '+';		# e >= 0 => nothing to round
3497
3498    $scale = -$scale;				# positive for simplicity
3499    my $len = $MBI->_len($x->{_m});		# length of mantissa
3500
3501    # the following poses a restriction on _e, but if _e is bigger than a
3502    # scalar, you got other problems (memory etc) anyway
3503    my $dad = -(0+ ($x->{_es}.$MBI->_num($x->{_e})));	# digits after dot
3504    my $zad = 0;				# zeros after dot
3505    $zad = $dad - $len if (-$dad < -$len);	# for 0.00..00xxx style
3506
3507    # print "scale $scale dad $dad zad $zad len $len\n";
3508    # number  bsstr   len zad dad
3509    # 0.123   123e-3	3   0 3
3510    # 0.0123  123e-4	3   1 4
3511    # 0.001   1e-3      1   2 3
3512    # 1.23    123e-2	3   0 2
3513    # 1.2345  12345e-4	5   0 4
3514
3515    # do not round after/right of the $dad
3516    return $x if $scale > $dad;			# 0.123, scale >= 3 => exit
3517
3518    # round to zero if rounding inside the $zad, but not for last zero like:
3519    # 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
3520    return $x->bzero() if $scale < $zad;
3521    if ($scale == $zad)			# for 0.006, scale -3 and trunc
3522      {
3523      $scale = -$len;
3524      }
3525    else
3526      {
3527      # adjust round-point to be inside mantissa
3528      if ($zad != 0)
3529        {
3530	$scale = $scale-$zad;
3531        }
3532      else
3533        {
3534        my $dbd = $len - $dad; $dbd = 0 if $dbd < 0;	# digits before dot
3535	$scale = $dbd+$scale;
3536        }
3537      }
3538    }
3539  else
3540    {
3541    # round left from the '.'
3542
3543    # 123 => 100 means length(123) = 3 - $scale (2) => 1
3544
3545    my $dbt = $MBI->_len($x->{_m});
3546    # digits before dot
3547    my $dbd = $dbt + ($x->{_es} . $MBI->_num($x->{_e}));
3548    # should be the same, so treat it as this
3549    $scale = 1 if $scale == 0;
3550    # shortcut if already integer
3551    return $x if $scale == 1 && $dbt <= $dbd;
3552    # maximum digits before dot
3553    ++$dbd;
3554
3555    if ($scale > $dbd)
3556       {
3557       # not enough digits before dot, so round to zero
3558       return $x->bzero;
3559       }
3560    elsif ( $scale == $dbd )
3561       {
3562       # maximum
3563       $scale = -$dbt;
3564       }
3565    else
3566       {
3567       $scale = $dbd - $scale;
3568       }
3569    }
3570  # pass sign to bround for rounding modes '+inf' and '-inf'
3571  my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
3572  $m->bround($scale,$mode);
3573  $x->{_m} = $m->{value};			# get our mantissa back
3574  $x->bnorm();
3575  }
3576
3577sub bround
3578  {
3579  # accuracy: preserve $N digits, and overwrite the rest with 0's
3580  my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
3581
3582  if (($_[0] || 0) < 0)
3583    {
3584    require Carp; Carp::croak ('bround() needs positive accuracy');
3585    }
3586
3587  my ($scale,$mode) = $x->_scale_a(@_);
3588  return $x if !defined $scale || $x->modify('bround');	# no-op
3589
3590  # scale is now either $x->{_a}, $accuracy, or the user parameter
3591  # test whether $x already has lower accuracy, do nothing in this case
3592  # but do round if the accuracy is the same, since a math operation might
3593  # want to round a number with A=5 to 5 digits afterwards again
3594  return $x if defined $x->{_a} && $x->{_a} < $scale;
3595
3596  # scale < 0 makes no sense
3597  # scale == 0 => keep all digits
3598  # never round a +-inf, NaN
3599  return $x if ($scale <= 0) || $x->{sign} !~ /^[+-]$/;
3600
3601  # 1: never round a 0
3602  # 2: if we should keep more digits than the mantissa has, do nothing
3603  if ($x->is_zero() || $MBI->_len($x->{_m}) <= $scale)
3604    {
3605    $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale;
3606    return $x;
3607    }
3608
3609  # pass sign to bround for '+inf' and '-inf' rounding modes
3610  my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
3611
3612  $m->bround($scale,$mode);		# round mantissa
3613  $x->{_m} = $m->{value};		# get our mantissa back
3614  $x->{_a} = $scale;			# remember rounding
3615  delete $x->{_p};			# and clear P
3616  $x->bnorm();				# del trailing zeros gen. by bround()
3617  }
3618
3619sub bfloor
3620  {
3621  # round towards minus infinity
3622  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
3623
3624  return $x if $x->modify('bfloor');
3625
3626  return $x if $x->{sign} !~ /^[+-]$/;	# nan, +inf, -inf
3627
3628  # if $x has digits after dot
3629  if ($x->{_es} eq '-')
3630    {
3631    $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot
3632    $x->{_e} = $MBI->_zero();			# trunc/norm
3633    $x->{_es} = '+';				# abs e
3634    $MBI->_inc($x->{_m}) if $x->{sign} eq '-';	# increment if negative
3635    }
3636  $x->round($a,$p,$r);
3637  }
3638
3639sub bceil
3640  {
3641  # round towards plus infinity
3642  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
3643
3644  return $x if $x->modify('bceil');
3645  return $x if $x->{sign} !~ /^[+-]$/;	# nan, +inf, -inf
3646
3647  # if $x has digits after dot
3648  if ($x->{_es} eq '-')
3649    {
3650    $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot
3651    $x->{_e} = $MBI->_zero();			# trunc/norm
3652    $x->{_es} = '+';				# abs e
3653    if ($x->{sign} eq '+') {
3654        $MBI->_inc($x->{_m});                   # increment if positive
3655    } else {
3656        $x->{sign} = '+' if $MBI->_is_zero($x->{_m});   # avoid -0
3657    }
3658    }
3659  $x->round($a,$p,$r);
3660  }
3661
3662sub bint
3663  {
3664  # round towards zero
3665  my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
3666
3667  return $x if $x->modify('bint');
3668  return $x if $x->{sign} !~ /^[+-]$/;  # nan, +inf, -inf
3669
3670  # if $x has digits after the decimal point
3671  if ($x->{_es} eq '-')
3672    {
3673    $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot
3674    $x->{_e} = $MBI->_zero();                     # truncate/normalize
3675    $x->{_es} = '+';                              # abs e
3676    $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # avoid -0
3677    }
3678  $x->round($a,$p,$r);
3679  }
3680
3681sub brsft
3682  {
3683  # shift right by $y (divide by power of $n)
3684
3685  # set up parameters
3686  my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_);
3687  # objectify is costly, so avoid it
3688  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
3689    {
3690    ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
3691    }
3692
3693  return $x if $x->modify('brsft');
3694  return $x if $x->{sign} !~ /^[+-]$/;	# nan, +inf, -inf
3695
3696  $n = 2 if !defined $n; $n = $self->new($n);
3697
3698  # negative amount?
3699  return $x->blsft($y->copy()->babs(),$n) if $y->{sign} =~ /^-/;
3700
3701  # the following call to bdiv() will return either quo or (quo,remainder):
3702  $x->bdiv($n->bpow($y),$a,$p,$r,$y);
3703  }
3704
3705sub blsft
3706  {
3707  # shift left by $y (multiply by power of $n)
3708
3709  # set up parameters
3710  my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_);
3711  # objectify is costly, so avoid it
3712  if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
3713    {
3714    ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
3715    }
3716
3717  return $x if $x->modify('blsft');
3718  return $x if $x->{sign} !~ /^[+-]$/;	# nan, +inf, -inf
3719
3720  $n = 2 if !defined $n; $n = $self->new($n);
3721
3722  # negative amount?
3723  return $x->brsft($y->copy()->babs(),$n) if $y->{sign} =~ /^-/;
3724
3725  $x->bmul($n->bpow($y),$a,$p,$r,$y);
3726  }
3727
3728###############################################################################
3729
3730sub DESTROY
3731  {
3732  # going through AUTOLOAD for every DESTROY is costly, avoid it by empty sub
3733  }
3734
3735sub AUTOLOAD
3736  {
3737  # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx()
3738  # or falling back to MBI::bxxx()
3739  my $name = $AUTOLOAD;
3740
3741  $name =~ s/(.*):://;	# split package
3742  my $c = $1 || $class;
3743  no strict 'refs';
3744  $c->import() if $IMPORT == 0;
3745  if (!_method_alias($name))
3746    {
3747    if (!defined $name)
3748      {
3749      # delayed load of Carp and avoid recursion
3750      require Carp;
3751      Carp::croak ("$c: Can't call a method without name");
3752      }
3753    if (!_method_hand_up($name))
3754      {
3755      # delayed load of Carp and avoid recursion
3756      require Carp;
3757      Carp::croak ("Can't call $c\-\>$name, not a valid method");
3758      }
3759    # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
3760    $name =~ s/^f/b/;
3761    return &{"Math::BigInt"."::$name"}(@_);
3762    }
3763  my $bname = $name; $bname =~ s/^f/b/;
3764  $c .= "::$name";
3765  *{$c} = \&{$bname};
3766  &{$c};	# uses @_
3767  }
3768
3769sub exponent
3770  {
3771  # return a copy of the exponent
3772  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
3773
3774  if ($x->{sign} !~ /^[+-]$/)
3775    {
3776    my $s = $x->{sign}; $s =~ s/^[+-]//;
3777    return Math::BigInt->new($s); 		# -inf, +inf => +inf
3778    }
3779  Math::BigInt->new( $x->{_es} . $MBI->_str($x->{_e}));
3780  }
3781
3782sub mantissa
3783  {
3784  # return a copy of the mantissa
3785  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
3786
3787  if ($x->{sign} !~ /^[+-]$/)
3788    {
3789    my $s = $x->{sign}; $s =~ s/^[+]//;
3790    return Math::BigInt->new($s);		# -inf, +inf => +inf
3791    }
3792  my $m = Math::BigInt->new( $MBI->_str($x->{_m}));
3793  $m->bneg() if $x->{sign} eq '-';
3794
3795  $m;
3796  }
3797
3798sub parts
3799  {
3800  # return a copy of both the exponent and the mantissa
3801  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
3802
3803  if ($x->{sign} !~ /^[+-]$/)
3804    {
3805    my $s = $x->{sign}; $s =~ s/^[+]//; my $se = $s; $se =~ s/^[-]//;
3806    return ($self->new($s),$self->new($se)); # +inf => inf and -inf,+inf => inf
3807    }
3808  my $m = Math::BigInt->bzero();
3809  $m->{value} = $MBI->_copy($x->{_m});
3810  $m->bneg() if $x->{sign} eq '-';
3811  ($m, Math::BigInt->new( $x->{_es} . $MBI->_num($x->{_e}) ));
3812  }
3813
3814##############################################################################
3815# private stuff (internal use only)
3816
3817sub import
3818  {
3819  my $self = shift;
3820  my $l = scalar @_;
3821  my $lib = ''; my @a;
3822  my $lib_kind = 'try';
3823  $IMPORT=1;
3824  for ( my $i = 0; $i < $l ; $i++)
3825    {
3826    if ( $_[$i] eq ':constant' )
3827      {
3828      # This causes overlord er load to step in. 'binary' and 'integer'
3829      # are handled by BigInt.
3830      overload::constant float => sub { $self->new(shift); };
3831      }
3832    elsif ($_[$i] eq 'upgrade')
3833      {
3834      # this causes upgrading
3835      $upgrade = $_[$i+1];		# or undef to disable
3836      $i++;
3837      }
3838    elsif ($_[$i] eq 'downgrade')
3839      {
3840      # this causes downgrading
3841      $downgrade = $_[$i+1];		# or undef to disable
3842      $i++;
3843      }
3844    elsif ($_[$i] =~ /^(lib|try|only)\z/)
3845      {
3846      # alternative library
3847      $lib = $_[$i+1] || '';		# default Calc
3848      $lib_kind = $1;			# lib, try or only
3849      $i++;
3850      }
3851    elsif ($_[$i] eq 'with')
3852      {
3853      # alternative class for our private parts()
3854      # XXX: no longer supported
3855      # $MBI = $_[$i+1] || 'Math::BigInt';
3856      $i++;
3857      }
3858    else
3859      {
3860      push @a, $_[$i];
3861      }
3862    }
3863
3864  $lib =~ tr/a-zA-Z0-9,://cd;		# restrict to sane characters
3865  # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
3866  my $mbilib = eval { Math::BigInt->config()->{lib} };
3867  if ((defined $mbilib) && ($MBI eq 'Math::BigInt::Calc'))
3868    {
3869    # MBI already loaded
3870    Math::BigInt->import( $lib_kind, "$lib,$mbilib", 'objectify');
3871    }
3872  else
3873    {
3874    # MBI not loaded, or with ne "Math::BigInt::Calc"
3875    $lib .= ",$mbilib" if defined $mbilib;
3876    $lib =~ s/^,//;				# don't leave empty
3877
3878    # replacement library can handle lib statement, but also could ignore it
3879
3880    # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
3881    # used in the same script, or eval inside import(). So we require MBI:
3882    require Math::BigInt;
3883    Math::BigInt->import( $lib_kind => $lib, 'objectify' );
3884    }
3885  if ($@)
3886    {
3887    require Carp; Carp::croak ("Couldn't load $lib: $! $@");
3888    }
3889  # find out which one was actually loaded
3890  $MBI = Math::BigInt->config()->{lib};
3891
3892  # register us with MBI to get notified of future lib changes
3893  Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } );
3894
3895  $self->export_to_level(1,$self,@a);		# export wanted functions
3896  }
3897
3898sub bnorm
3899  {
3900  # adjust m and e so that m is smallest possible
3901  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
3902
3903  return $x if $x->{sign} !~ /^[+-]$/;		# inf, nan etc
3904
3905  my $zeros = $MBI->_zeros($x->{_m});		# correct for trailing zeros
3906  if ($zeros != 0)
3907    {
3908    my $z = $MBI->_new($zeros);
3909    $x->{_m} = $MBI->_rsft ($x->{_m}, $z, 10);
3910    if ($x->{_es} eq '-')
3911      {
3912      if ($MBI->_acmp($x->{_e},$z) >= 0)
3913        {
3914        $x->{_e} = $MBI->_sub ($x->{_e}, $z);
3915        $x->{_es} = '+' if $MBI->_is_zero($x->{_e});
3916        }
3917      else
3918        {
3919        $x->{_e} = $MBI->_sub ( $MBI->_copy($z), $x->{_e});
3920        $x->{_es} = '+';
3921        }
3922      }
3923    else
3924      {
3925      $x->{_e} = $MBI->_add ($x->{_e}, $z);
3926      }
3927    }
3928  else
3929    {
3930    # $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing
3931    # zeros). So, for something like 0Ey, set y to 1, and -0 => +0
3932    $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $MBI->_one()
3933     if $MBI->_is_zero($x->{_m});
3934    }
3935
3936  $x;					# MBI bnorm is no-op, so do not call it
3937  }
3938
3939##############################################################################
3940
3941sub as_hex
3942  {
3943  # return number as hexadecimal string (only for integers defined)
3944  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
3945
3946  return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
3947  return '0x0' if $x->is_zero();
3948
3949  return $nan if $x->{_es} ne '+';		# how to do 1e-1 in hex!?
3950
3951  my $z = $MBI->_copy($x->{_m});
3952  if (! $MBI->_is_zero($x->{_e}))		# > 0
3953    {
3954    $MBI->_lsft( $z, $x->{_e},10);
3955    }
3956  $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z));
3957  $z->as_hex();
3958  }
3959
3960sub as_bin
3961  {
3962  # return number as binary digit string (only for integers defined)
3963  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
3964
3965  return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
3966  return '0b0' if $x->is_zero();
3967
3968  return $nan if $x->{_es} ne '+';		# how to do 1e-1 in hex!?
3969
3970  my $z = $MBI->_copy($x->{_m});
3971  if (! $MBI->_is_zero($x->{_e}))		# > 0
3972    {
3973    $MBI->_lsft( $z, $x->{_e},10);
3974    }
3975  $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z));
3976  $z->as_bin();
3977  }
3978
3979sub as_oct
3980  {
3981  # return number as octal digit string (only for integers defined)
3982  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
3983
3984  return $x->bstr() if $x->{sign} !~ /^[+-]$/;  # inf, nan etc
3985  return '0' if $x->is_zero();
3986
3987  return $nan if $x->{_es} ne '+';		# how to do 1e-1 in hex!?
3988
3989  my $z = $MBI->_copy($x->{_m});
3990  if (! $MBI->_is_zero($x->{_e}))		# > 0
3991    {
3992    $MBI->_lsft( $z, $x->{_e},10);
3993    }
3994  $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z));
3995  $z->as_oct();
3996  }
3997
3998sub as_number
3999  {
4000  # return copy as a bigint representation of this BigFloat number
4001  my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
4002
4003  return $x if $x->modify('as_number');
4004
4005  if (!$x->isa('Math::BigFloat'))
4006    {
4007    # if the object can as_number(), use it
4008    return $x->as_number() if $x->can('as_number');
4009    # otherwise, get us a float and then a number
4010    $x = $x->can('as_float') ? $x->as_float() : $self->new(0+"$x");
4011    }
4012
4013  return Math::BigInt->binf($x->sign()) if $x->is_inf();
4014  return Math::BigInt->bnan()           if $x->is_nan();
4015
4016  my $z = $MBI->_copy($x->{_m});
4017  if ($x->{_es} eq '-')			# < 0
4018    {
4019    $MBI->_rsft( $z, $x->{_e},10);
4020    }
4021  elsif (! $MBI->_is_zero($x->{_e}))	# > 0
4022    {
4023    $MBI->_lsft( $z, $x->{_e},10);
4024    }
4025  $z = Math::BigInt->new( $x->{sign} . $MBI->_str($z));
4026  $z;
4027  }
4028
4029sub length
4030  {
4031  my $x = shift;
4032  my $class = ref($x) || $x;
4033  $x = $class->new(shift) unless ref($x);
4034
4035  return 1 if $MBI->_is_zero($x->{_m});
4036
4037  my $len = $MBI->_len($x->{_m});
4038  $len += $MBI->_num($x->{_e}) if $x->{_es} eq '+';
4039  if (wantarray())
4040    {
4041    my $t = 0;
4042    $t = $MBI->_num($x->{_e}) if $x->{_es} eq '-';
4043    return ($len, $t);
4044    }
4045  $len;
4046  }
4047
4048sub from_hex {
4049    my $self    = shift;
4050    my $selfref = ref $self;
4051    my $class   = $selfref || $self;
4052
4053    my $str = shift;
4054
4055    # If called as a class method, initialize a new object.
4056
4057    $self = $class -> bzero() unless $selfref;
4058
4059    if ($str =~ s/
4060                     ^
4061
4062                     # sign
4063                     ( [+-]? )
4064
4065                     # optional "hex marker"
4066                     (?: 0? x )?
4067
4068                     # significand using the hex digits 0..9 and a..f
4069                     (
4070                         [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )*
4071                         (?:
4072                             \.
4073                             (?: [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* )?
4074                         )?
4075                     |
4076                         \.
4077                         [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )*
4078                     )
4079
4080                     # exponent (power of 2) using decimal digits
4081                     (?:
4082                         [Pp]
4083                         ( [+-]? )
4084                         ( \d+ (?: _ \d+ )* )
4085                     )?
4086
4087                     $
4088                 //x)
4089    {
4090        my $s_sign  = $1 || '+';
4091        my $s_value = $2;
4092        my $e_sign  = $3 || '+';
4093        my $e_value = $4 || '0';
4094        $s_value =~ tr/_//d;
4095        $e_value =~ tr/_//d;
4096
4097        # The significand must be multiplied by 2 raised to this exponent.
4098
4099        my $two_expon = $class -> new($e_value);
4100        $two_expon -> bneg() if $e_sign eq '-';
4101
4102        # If there is a dot in the significand, remove it and adjust the
4103        # exponent according to the number of digits in the fraction part of
4104        # the significand. Since the digits in the significand are in base 16,
4105        # but the exponent is only in base 2, multiply the exponent adjustment
4106        # value by log(16) / log(2) = 4.
4107
4108        my $idx = index($s_value, '.');
4109        if ($idx >= 0) {
4110            substr($s_value, $idx, 1) = '';
4111            $two_expon -= $class -> new(CORE::length($s_value))
4112                                 -> bsub($idx)
4113                                 -> bmul("4");
4114        }
4115
4116        $self -> {sign} = $s_sign;
4117        $self -> {_m}   = $MBI -> _from_hex('0x' . $s_value);
4118
4119        if ($two_expon > 0) {
4120            my $factor = $class -> new("2") -> bpow($two_expon);
4121            $self -> bmul($factor);
4122        } elsif ($two_expon < 0) {
4123            my $factor = $class -> new("0.5") -> bpow(-$two_expon);
4124            $self -> bmul($factor);
4125        }
4126
4127        return $self;
4128    }
4129
4130    return $self->bnan();
4131}
4132
4133sub from_oct {
4134    my $self    = shift;
4135    my $selfref = ref $self;
4136    my $class   = $selfref || $self;
4137
4138    my $str = shift;
4139
4140    # If called as a class method, initialize a new object.
4141
4142    $self = $class -> bzero() unless $selfref;
4143
4144    if ($str =~ s/
4145                     ^
4146
4147                     # sign
4148                     ( [+-]? )
4149
4150                     # significand using the octal digits 0..7
4151                     (
4152                         [0-7]+ (?: _ [0-7]+ )*
4153                         (?:
4154                             \.
4155                             (?: [0-7]+ (?: _ [0-7]+ )* )?
4156                         )?
4157                     |
4158                         \.
4159                         [0-7]+ (?: _ [0-7]+ )*
4160                     )
4161
4162                     # exponent (power of 2) using decimal digits
4163                     (?:
4164                         [Pp]
4165                         ( [+-]? )
4166                         ( \d+ (?: _ \d+ )* )
4167                     )?
4168
4169                     $
4170                 //x)
4171    {
4172        my $s_sign  = $1 || '+';
4173        my $s_value = $2;
4174        my $e_sign  = $3 || '+';
4175        my $e_value = $4 || '0';
4176        $s_value =~ tr/_//d;
4177        $e_value =~ tr/_//d;
4178
4179        # The significand must be multiplied by 2 raised to this exponent.
4180
4181        my $two_expon = $class -> new($e_value);
4182        $two_expon -> bneg() if $e_sign eq '-';
4183
4184        # If there is a dot in the significand, remove it and adjust the
4185        # exponent according to the number of digits in the fraction part of
4186        # the significand. Since the digits in the significand are in base 8,
4187        # but the exponent is only in base 2, multiply the exponent adjustment
4188        # value by log(8) / log(2) = 3.
4189
4190        my $idx = index($s_value, '.');
4191        if ($idx >= 0) {
4192            substr($s_value, $idx, 1) = '';
4193            $two_expon -= $class -> new(CORE::length($s_value))
4194                                 -> bsub($idx)
4195                                 -> bmul("3");
4196        }
4197
4198        $self -> {sign} = $s_sign;
4199        $self -> {_m}   = $MBI -> _from_oct($s_value);
4200
4201        if ($two_expon > 0) {
4202            my $factor = $class -> new("2") -> bpow($two_expon);
4203            $self -> bmul($factor);
4204        } elsif ($two_expon < 0) {
4205            my $factor = $class -> new("0.5") -> bpow(-$two_expon);
4206            $self -> bmul($factor);
4207        }
4208
4209        return $self;
4210    }
4211
4212    return $self->bnan();
4213}
4214
4215sub from_bin {
4216    my $self    = shift;
4217    my $selfref = ref $self;
4218    my $class   = $selfref || $self;
4219
4220    my $str = shift;
4221
4222    # If called as a class method, initialize a new object.
4223
4224    $self = $class -> bzero() unless $selfref;
4225
4226    if ($str =~ s/
4227                     ^
4228
4229                     # sign
4230                     ( [+-]? )
4231
4232                     # optional "bin marker"
4233                     (?: 0? b )?
4234
4235                     # significand using the binary digits 0 and 1
4236                     (
4237                         [01]+ (?: _ [01]+ )*
4238                         (?:
4239                             \.
4240                             (?: [01]+ (?: _ [01]+ )* )?
4241                         )?
4242                     |
4243                         \.
4244                         [01]+ (?: _ [01]+ )*
4245                     )
4246
4247                     # exponent (power of 2) using decimal digits
4248                     (?:
4249                         [Pp]
4250                         ( [+-]? )
4251                         ( \d+ (?: _ \d+ )* )
4252                     )?
4253
4254                     $
4255                 //x)
4256    {
4257        my $s_sign  = $1 || '+';
4258        my $s_value = $2;
4259        my $e_sign  = $3 || '+';
4260        my $e_value = $4 || '0';
4261        $s_value =~ tr/_//d;
4262        $e_value =~ tr/_//d;
4263
4264        # The significand must be multiplied by 2 raised to this exponent.
4265
4266        my $two_expon = $class -> new($e_value);
4267        $two_expon -> bneg() if $e_sign eq '-';
4268
4269        # If there is a dot in the significand, remove it and adjust the
4270        # exponent according to the number of digits in the fraction part of
4271        # the significand.
4272
4273        my $idx = index($s_value, '.');
4274        if ($idx >= 0) {
4275            substr($s_value, $idx, 1) = '';
4276            $two_expon -= $class -> new(CORE::length($s_value))
4277                                 -> bsub($idx);
4278        }
4279
4280        $self -> {sign} = $s_sign;
4281        $self -> {_m}   = $MBI -> _from_bin('0b' . $s_value);
4282
4283        if ($two_expon > 0) {
4284            my $factor = $class -> new("2") -> bpow($two_expon);
4285            $self -> bmul($factor);
4286        } elsif ($two_expon < 0) {
4287            my $factor = $class -> new("0.5") -> bpow(-$two_expon);
4288            $self -> bmul($factor);
4289        }
4290
4291        return $self;
4292    }
4293
4294    return $self->bnan();
4295}
4296
42971;
4298
4299__END__
4300
4301=pod
4302
4303=head1 NAME
4304
4305Math::BigFloat - Arbitrary size floating point math package
4306
4307=head1 SYNOPSIS
4308
4309 use Math::BigFloat;
4310
4311 # Number creation
4312 my $x = Math::BigFloat->new($str);	# defaults to 0
4313 my $y = $x->copy();			# make a true copy
4314 my $nan  = Math::BigFloat->bnan();	# create a NotANumber
4315 my $zero = Math::BigFloat->bzero();	# create a +0
4316 my $inf = Math::BigFloat->binf();	# create a +inf
4317 my $inf = Math::BigFloat->binf('-');	# create a -inf
4318 my $one = Math::BigFloat->bone();	# create a +1
4319 my $mone = Math::BigFloat->bone('-');	# create a -1
4320 my $x = Math::BigFloat->bone('-');	#
4321
4322 my $x = Math::BigFloat->from_hex('0xc.afep+3');    # from hexadecimal
4323 my $x = Math::BigFloat->from_bin('0b1.1001p-4');   # from binary
4324 my $x = Math::BigFloat->from_oct('1.3267p-4');     # from octal
4325
4326 my $pi = Math::BigFloat->bpi(100);	# PI to 100 digits
4327
4328 # the following examples compute their result to 100 digits accuracy:
4329 my $cos  = Math::BigFloat->new(1)->bcos(100);	      # cosinus(1)
4330 my $sin  = Math::BigFloat->new(1)->bsin(100);	      # sinus(1)
4331 my $atan = Math::BigFloat->new(1)->batan(100);	      # arcus tangens(1)
4332
4333 my $atan2 = Math::BigFloat->new(  1 )->batan2( 1 ,100); # batan(1)
4334 my $atan2 = Math::BigFloat->new(  1 )->batan2( 8 ,100); # batan(1/8)
4335 my $atan2 = Math::BigFloat->new( -2 )->batan2( 1 ,100); # batan(-2)
4336
4337 # Testing
4338 $x->is_zero();		 # true if arg is +0
4339 $x->is_nan();		 # true if arg is NaN
4340 $x->is_one();		 # true if arg is +1
4341 $x->is_one('-');	 # true if arg is -1
4342 $x->is_odd();		 # true if odd, false for even
4343 $x->is_even();		 # true if even, false for odd
4344 $x->is_pos();		 # true if >= 0
4345 $x->is_neg();		 # true if <  0
4346 $x->is_inf(sign);	 # true if +inf, or -inf (default is '+')
4347
4348 $x->bcmp($y);		 # compare numbers (undef,<0,=0,>0)
4349 $x->bacmp($y);		 # compare absolutely (undef,<0,=0,>0)
4350 $x->sign();		 # return the sign, either +,- or NaN
4351 $x->digit($n);		 # return the nth digit, counting from right
4352 $x->digit(-$n);	 # return the nth digit, counting from left
4353
4354 # The following all modify their first argument. If you want to pre-
4355 # serve $x, use $z = $x->copy()->bXXX($y); See under L</CAVEATS> for
4356 # necessary when mixing $a = $b assignments with non-overloaded math.
4357
4358 # set
4359 $x->bzero();		 # set $i to 0
4360 $x->bnan();		 # set $i to NaN
4361 $x->bone();		 # set $x to +1
4362 $x->bone('-');		 # set $x to -1
4363 $x->binf();		 # set $x to inf
4364 $x->binf('-');		 # set $x to -inf
4365
4366 $x->bneg();		 # negation
4367 $x->babs();		 # absolute value
4368 $x->bnorm();		 # normalize (no-op)
4369 $x->bnot();		 # two's complement (bit wise not)
4370 $x->binc();		 # increment x by 1
4371 $x->bdec();		 # decrement x by 1
4372
4373 $x->badd($y);		 # addition (add $y to $x)
4374 $x->bsub($y);		 # subtraction (subtract $y from $x)
4375 $x->bmul($y);		 # multiplication (multiply $x by $y)
4376 $x->bdiv($y);		 # divide, set $x to quotient
4377			 # return (quo,rem) or quo if scalar
4378
4379 $x->bmod($y);		 # modulus ($x % $y)
4380 $x->bpow($y);		 # power of arguments ($x ** $y)
4381 $x->bmodpow($exp,$mod); # modular exponentiation (($num**$exp) % $mod))
4382 $x->blsft($y, $n);	 # left shift by $y places in base $n
4383 $x->brsft($y, $n);	 # right shift by $y places in base $n
4384			 # returns (quo,rem) or quo if in scalar context
4385
4386 $x->blog();		 # logarithm of $x to base e (Euler's number)
4387 $x->blog($base);	 # logarithm of $x to base $base (f.i. 2)
4388 $x->bexp();		 # calculate e ** $x where e is Euler's number
4389
4390 $x->band($y);		 # bit-wise and
4391 $x->bior($y);		 # bit-wise inclusive or
4392 $x->bxor($y);		 # bit-wise exclusive or
4393 $x->bnot();		 # bit-wise not (two's complement)
4394
4395 $x->bsqrt();		 # calculate square-root
4396 $x->broot($y);		 # $y'th root of $x (e.g. $y == 3 => cubic root)
4397 $x->bfac();		 # factorial of $x (1*2*3*4*..$x)
4398
4399 $x->bround($N); 	 # accuracy: preserve $N digits
4400 $x->bfround($N);	 # precision: round to the $Nth digit
4401
4402 $x->bfloor();		 # return integer less or equal than $x
4403 $x->bceil();		 # return integer greater or equal than $x
4404 $x->bint();             # round towards zero
4405
4406  # The following do not modify their arguments:
4407
4408 bgcd(@values);		 # greatest common divisor
4409 blcm(@values);		 # lowest common multiplicator
4410
4411 $x->bstr();		 # return string
4412 $x->bsstr();		 # return string in scientific notation
4413
4414 $x->as_int();		 # return $x as BigInt
4415 $x->exponent();	 # return exponent as BigInt
4416 $x->mantissa();	 # return mantissa as BigInt
4417 $x->parts();		 # return (mantissa,exponent) as BigInt
4418
4419 $x->length();		 # number of digits (w/o sign and '.')
4420 ($l,$f) = $x->length(); # number of digits, and length of fraction
4421
4422 $x->precision();	 # return P of $x (or global, if P of $x undef)
4423 $x->precision($n);	 # set P of $x to $n
4424 $x->accuracy();	 # return A of $x (or global, if A of $x undef)
4425 $x->accuracy($n);	 # set A $x to $n
4426
4427 # these get/set the appropriate global value for all BigFloat objects
4428 Math::BigFloat->precision();	# Precision
4429 Math::BigFloat->accuracy();	# Accuracy
4430 Math::BigFloat->round_mode();	# rounding mode
4431
4432=head1 DESCRIPTION
4433
4434All operators (including basic math operations) are overloaded if you
4435declare your big floating point numbers as
4436
4437  $i = Math::BigFloat -> new('12_3.456_789_123_456_789E-2');
4438
4439Operations with overloaded operators preserve the arguments, which is
4440exactly what you expect.
4441
4442=head2 Input
4443
4444Input to these routines are either BigFloat objects, or strings of the
4445following four forms:
4446
4447=over
4448
4449=item *
4450
4451C</^[+-]\d+$/>
4452
4453=item *
4454
4455C</^[+-]\d+\.\d*$/>
4456
4457=item *
4458
4459C</^[+-]\d+E[+-]?\d+$/>
4460
4461=item *
4462
4463C</^[+-]\d*\.\d+E[+-]?\d+$/>
4464
4465=back
4466
4467all with optional leading and trailing zeros and/or spaces. Additionally,
4468numbers are allowed to have an underscore between any two digits.
4469
4470Empty strings as well as other illegal numbers results in 'NaN'.
4471
4472bnorm() on a BigFloat object is now effectively a no-op, since the numbers
4473are always stored in normalized form. On a string, it creates a BigFloat
4474object.
4475
4476=head2 Output
4477
4478Output values are BigFloat objects (normalized), except for bstr() and bsstr().
4479
4480The string output will always have leading and trailing zeros stripped and drop
4481a plus sign. C<bstr()> will give you always the form with a decimal point,
4482while C<bsstr()> (s for scientific) gives you the scientific notation.
4483
4484	Input			bstr()		bsstr()
4485	'-0'			'0'		'0E1'
4486   	'  -123 123 123'	'-123123123'	'-123123123E0'
4487	'00.0123'		'0.0123'	'123E-4'
4488	'123.45E-2'		'1.2345'	'12345E-4'
4489	'10E+3'			'10000'		'1E4'
4490
4491Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
4492C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
4493return either undef, <0, 0 or >0 and are suited for sort.
4494
4495Actual math is done by using the class defined with C<< with => Class; >>
4496(which defaults to BigInts) to represent the mantissa and exponent.
4497
4498The sign C</^[+-]$/> is stored separately. The string 'NaN' is used to
4499represent the result when input arguments are not numbers, and 'inf' and
4500'-inf' are used to represent positive and negative infinity, respectively.
4501
4502=head2 mantissa(), exponent() and parts()
4503
4504mantissa() and exponent() return the said parts of the BigFloat
4505as BigInts such that:
4506
4507	$m = $x->mantissa();
4508	$e = $x->exponent();
4509	$y = $m * ( 10 ** $e );
4510	print "ok\n" if $x == $y;
4511
4512C<< ($m,$e) = $x->parts(); >> is just a shortcut giving you both of them.
4513
4514Currently the mantissa is reduced as much as possible, favouring higher
4515exponents over lower ones (e.g. returning 1e7 instead of 10e6 or 10000000e0).
4516This might change in the future, so do not depend on it.
4517
4518=head2 Accuracy vs. Precision
4519
4520See also: L<Rounding|/Rounding>.
4521
4522Math::BigFloat supports both precision (rounding to a certain place before or
4523after the dot) and accuracy (rounding to a certain number of digits). For a
4524full documentation, examples and tips on these topics please see the large
4525section about rounding in L<Math::BigInt>.
4526
4527Since things like C<sqrt(2)> or C<1 / 3> must presented with a limited
4528accuracy lest a operation consumes all resources, each operation produces
4529no more than the requested number of digits.
4530
4531If there is no global precision or accuracy set, B<and> the operation in
4532question was not called with a requested precision or accuracy, B<and> the
4533input $x has no accuracy or precision set, then a fallback parameter will
4534be used. For historical reasons, it is called C<div_scale> and can be accessed
4535via:
4536
4537	$d = Math::BigFloat->div_scale();	# query
4538	Math::BigFloat->div_scale($n);		# set to $n digits
4539
4540The default value for C<div_scale> is 40.
4541
4542In case the result of one operation has more digits than specified,
4543it is rounded. The rounding mode taken is either the default mode, or the one
4544supplied to the operation after the I<scale>:
4545
4546    $x = Math::BigFloat->new(2);
4547    Math::BigFloat->accuracy(5);	      # 5 digits max
4548    $y = $x->copy()->bdiv(3);		      # will give 0.66667
4549    $y = $x->copy()->bdiv(3,6);		      # will give 0.666667
4550    $y = $x->copy()->bdiv(3,6,undef,'odd');   # will give 0.666667
4551    Math::BigFloat->round_mode('zero');
4552    $y = $x->copy()->bdiv(3,6);		      # will also give 0.666667
4553
4554Note that C<< Math::BigFloat->accuracy() >> and C<< Math::BigFloat->precision() >>
4555set the global variables, and thus B<any> newly created number will be subject
4556to the global rounding B<immediately>. This means that in the examples above, the
4557C<3> as argument to C<bdiv()> will also get an accuracy of B<5>.
4558
4559It is less confusing to either calculate the result fully, and afterwards
4560round it explicitly, or use the additional parameters to the math
4561functions like so:
4562
4563	use Math::BigFloat;
4564	$x = Math::BigFloat->new(2);
4565	$y = $x->copy()->bdiv(3);
4566	print $y->bround(5),"\n";		# will give 0.66667
4567
4568	or
4569
4570	use Math::BigFloat;
4571	$x = Math::BigFloat->new(2);
4572	$y = $x->copy()->bdiv(3,5);		# will give 0.66667
4573	print "$y\n";
4574
4575=head2 Rounding
4576
4577=over
4578
4579=item bfround ( +$scale )
4580
4581Rounds to the $scale'th place left from the '.', counting from the dot.
4582The first digit is numbered 1.
4583
4584=item bfround ( -$scale )
4585
4586Rounds to the $scale'th place right from the '.', counting from the dot.
4587
4588=item bfround ( 0 )
4589
4590Rounds to an integer.
4591
4592=item bround  ( +$scale )
4593
4594Preserves accuracy to $scale digits from the left (aka significant digits)
4595and pads the rest with zeros. If the number is between 1 and -1, the
4596significant digits count from the first non-zero after the '.'
4597
4598=item bround  ( -$scale ) and bround ( 0 )
4599
4600These are effectively no-ops.
4601
4602=back
4603
4604All rounding functions take as a second parameter a rounding mode from one of
4605the following: 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'.
4606
4607The default rounding mode is 'even'. By using
4608C<< Math::BigFloat->round_mode($round_mode); >> you can get and set the default
4609mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is
4610no longer supported.
4611The second parameter to the round functions then overrides the default
4612temporarily.
4613
4614The C<as_number()> function returns a BigInt from a Math::BigFloat. It uses
4615'trunc' as rounding mode to make it equivalent to:
4616
4617	$x = 2.5;
4618	$y = int($x) + 2;
4619
4620You can override this by passing the desired rounding mode as parameter to
4621C<as_number()>:
4622
4623	$x = Math::BigFloat->new(2.5);
4624	$y = $x->as_number('odd');	# $y = 3
4625
4626=head1 METHODS
4627
4628Math::BigFloat supports all methods that Math::BigInt supports, except it
4629calculates non-integer results when possible. Please see L<Math::BigInt>
4630for a full description of each method. Below are just the most important
4631differences:
4632
4633=over
4634
4635=item accuracy()
4636
4637      $x->accuracy(5);           # local for $x
4638      CLASS->accuracy(5);        # global for all members of CLASS
4639                                 # Note: This also applies to new()!
4640
4641      $A = $x->accuracy();       # read out accuracy that affects $x
4642      $A = CLASS->accuracy();    # read out global accuracy
4643
4644Set or get the global or local accuracy, aka how many significant digits the
4645results have. If you set a global accuracy, then this also applies to new()!
4646
4647Warning! The accuracy I<sticks>, e.g. once you created a number under the
4648influence of C<< CLASS->accuracy($A) >>, all results from math operations with
4649that number will also be rounded.
4650
4651In most cases, you should probably round the results explicitly using one of
4652L<Math::BigInt/round()>, L<Math::BigInt/bround()> or L<Math::BigInt/bfround()> or by passing the desired accuracy
4653to the math operation as additional parameter:
4654
4655        my $x = Math::BigInt->new(30000);
4656        my $y = Math::BigInt->new(7);
4657        print scalar $x->copy()->bdiv($y, 2);           # print 4300
4658        print scalar $x->copy()->bdiv($y)->bround(2);   # print 4300
4659
4660=item precision()
4661
4662      $x->precision(-2);      # local for $x, round at the second
4663                              # digit right of the dot
4664      $x->precision(2);       # ditto, round at the second digit
4665                              # left of the dot
4666
4667      CLASS->precision(5);    # Global for all members of CLASS
4668                              # This also applies to new()!
4669      CLASS->precision(-5);   # ditto
4670
4671      $P = CLASS->precision();  # read out global precision
4672      $P = $x->precision();     # read out precision that affects $x
4673
4674Note: You probably want to use L</accuracy()> instead. With L</accuracy()> you
4675set the number of digits each result should have, with L</precision()> you
4676set the place where to round!
4677
4678=item bdiv()
4679
4680        $q = $x->bdiv($y);
4681        ($q, $r) = $x->bdiv($y);
4682
4683In scalar context, divides $x by $y and returns the result to the given or
4684default accuracy/precision. In list context, does floored division
4685(F-division), returning an integer $q and a remainder $r so that $x = $q * $y +
4686$r. The remainer (modulo) is equal to what is returned by C<$x->bmod($y)>.
4687
4688=item bmod()
4689
4690	$x->bmod($y);
4691
4692Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the
4693result is identical to the remainder after floored division (F-division). If,
4694in addition, both $x and $y are integers, the result is identical to the result
4695from Perl's % operator.
4696
4697=item bexp()
4698
4699	$x->bexp($accuracy);		# calculate e ** X
4700
4701Calculates the expression C<e ** $x> where C<e> is Euler's number.
4702
4703This method was added in v1.82 of Math::BigInt (April 2007).
4704
4705=item bnok()
4706
4707	$x->bnok($y);	# x over y (binomial coefficient n over k)
4708
4709Calculates the binomial coefficient n over k, also called the "choose"
4710function. The result is equivalent to:
4711
4712	( n )      n!
4713	| - |  = -------
4714	( k )    k!(n-k)!
4715
4716This method was added in v1.84 of Math::BigInt (April 2007).
4717
4718=item bpi()
4719
4720	print Math::BigFloat->bpi(100), "\n";
4721
4722Calculate PI to N digits (including the 3 before the dot). The result is
4723rounded according to the current rounding mode, which defaults to "even".
4724
4725This method was added in v1.87 of Math::BigInt (June 2007).
4726
4727=item bcos()
4728
4729	my $x = Math::BigFloat->new(1);
4730	print $x->bcos(100), "\n";
4731
4732Calculate the cosinus of $x, modifying $x in place.
4733
4734This method was added in v1.87 of Math::BigInt (June 2007).
4735
4736=item bsin()
4737
4738	my $x = Math::BigFloat->new(1);
4739	print $x->bsin(100), "\n";
4740
4741Calculate the sinus of $x, modifying $x in place.
4742
4743This method was added in v1.87 of Math::BigInt (June 2007).
4744
4745=item batan2()
4746
4747	my $y = Math::BigFloat->new(2);
4748	my $x = Math::BigFloat->new(3);
4749	print $y->batan2($x), "\n";
4750
4751Calculate the arcus tanges of C<$y> divided by C<$x>, modifying $y in place.
4752See also L</batan()>.
4753
4754This method was added in v1.87 of Math::BigInt (June 2007).
4755
4756=item batan()
4757
4758	my $x = Math::BigFloat->new(1);
4759	print $x->batan(100), "\n";
4760
4761Calculate the arcus tanges of $x, modifying $x in place. See also L</batan2()>.
4762
4763This method was added in v1.87 of Math::BigInt (June 2007).
4764
4765=item bmuladd()
4766
4767	$x->bmuladd($y,$z);
4768
4769Multiply $x by $y, and then add $z to the result.
4770
4771This method was added in v1.87 of Math::BigInt (June 2007).
4772
4773=item as_float()
4774
4775This method is called when Math::BigFloat encounters an object it doesn't know
4776how to handle. For instance, assume $x is a Math::BigFloat, or subclass
4777thereof, and $y is defined, but not a Math::BigFloat, or subclass thereof. If
4778you do
4779
4780    $x -> badd($y);
4781
4782$y needs to be converted into an object that $x can deal with. This is done by
4783first checking if $y is something that $x might be upgraded to. If that is the
4784case, no further attempts are made. The next is to see if $y supports the
4785method C<as_float()>. The method C<as_float()> is expected to return either an
4786object that has the same class as $x, a subclass thereof, or a string that
4787C<ref($x)-E<gt>new()> can parse to create an object.
4788
4789In Math::BigFloat, C<as_float()> has the same effect as C<copy()>.
4790
4791=item from_hex()
4792
4793    $x -> from_hex("0x1.921fb54442d18p+1");
4794    $x = Math::BigFloat -> from_hex("0x1.921fb54442d18p+1");
4795
4796Interpret input as a hexadecimal string.A prefix ("0x", "x", ignoring case) is
4797optional. A single underscore character ("_") may be placed between any two
4798digits. If the input is invalid, a NaN is returned. The exponent is in base 2
4799using decimal digits.
4800
4801If called as an instance method, the value is assigned to the invocand.
4802
4803=item from_bin()
4804
4805    $x -> from_bin("0b1.1001p-4");
4806    $x = Math::BigFloat -> from_bin("0b1.1001p-4");
4807
4808Interpret input as a hexadecimal string. A prefix ("0b" or "b", ignoring case)
4809is optional. A single underscore character ("_") may be placed between any two
4810digits. If the input is invalid, a NaN is returned. The exponent is in base 2
4811using decimal digits.
4812
4813If called as an instance method, the value is assigned to the invocand.
4814
4815=item from_oct()
4816
4817    $x -> from_oct("1.3267p-4");
4818    $x = Math::BigFloat -> from_oct("1.3267p-4");
4819
4820Interpret input as an octal string. A single underscore character ("_") may be
4821placed between any two digits. If the input is invalid, a NaN is returned. The
4822exponent is in base 2 using decimal digits.
4823
4824If called as an instance method, the value is assigned to the invocand.
4825
4826=back
4827
4828=head1 Autocreating constants
4829
4830After C<use Math::BigFloat ':constant'> all the floating point constants
4831in the given scope are converted to C<Math::BigFloat>. This conversion
4832happens at compile time.
4833
4834In particular
4835
4836  perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"'
4837
4838prints the value of C<2E-100>. Note that without conversion of
4839constants the expression 2E-100 will be calculated as normal floating point
4840number.
4841
4842Please note that ':constant' does not affect integer constants, nor binary
4843nor hexadecimal constants. Use L<bignum> or L<Math::BigInt> to get this to
4844work.
4845
4846=head2 Math library
4847
4848Math with the numbers is done (by default) by a module called
4849Math::BigInt::Calc. This is equivalent to saying:
4850
4851	use Math::BigFloat lib => 'Calc';
4852
4853You can change this by using:
4854
4855	use Math::BigFloat lib => 'GMP';
4856
4857B<Note>: General purpose packages should not be explicit about the library
4858to use; let the script author decide which is best.
4859
4860Note: The keyword 'lib' will warn when the requested library could not be
4861loaded. To suppress the warning use 'try' instead:
4862
4863	use Math::BigFloat try => 'GMP';
4864
4865If your script works with huge numbers and Calc is too slow for them,
4866you can also for the loading of one of these libraries and if none
4867of them can be used, the code will die:
4868
4869        use Math::BigFloat only => 'GMP,Pari';
4870
4871The following would first try to find Math::BigInt::Foo, then
4872Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
4873
4874	use Math::BigFloat lib => 'Foo,Math::BigInt::Bar';
4875
4876See the respective low-level library documentation for further details.
4877
4878Please note that Math::BigFloat does B<not> use the denoted library itself,
4879but it merely passes the lib argument to Math::BigInt. So, instead of the need
4880to do:
4881
4882	use Math::BigInt lib => 'GMP';
4883	use Math::BigFloat;
4884
4885you can roll it all into one line:
4886
4887	use Math::BigFloat lib => 'GMP';
4888
4889It is also possible to just require Math::BigFloat:
4890
4891	require Math::BigFloat;
4892
4893This will load the necessary things (like BigInt) when they are needed, and
4894automatically.
4895
4896See L<Math::BigInt> for more details than you ever wanted to know about using
4897a different low-level library.
4898
4899=head2 Using Math::BigInt::Lite
4900
4901For backwards compatibility reasons it is still possible to
4902request a different storage class for use with Math::BigFloat:
4903
4904        use Math::BigFloat with => 'Math::BigInt::Lite';
4905
4906However, this request is ignored, as the current code now uses the low-level
4907math library for directly storing the number parts.
4908
4909=head1 EXPORTS
4910
4911C<Math::BigFloat> exports nothing by default, but can export the C<bpi()> method:
4912
4913	use Math::BigFloat qw/bpi/;
4914
4915	print bpi(10), "\n";
4916
4917=head1 CAVEATS
4918
4919Do not try to be clever to insert some operations in between switching
4920libraries:
4921
4922    require Math::BigFloat;
4923    my $matter = Math::BigFloat->bone() + 4;	# load BigInt and Calc
4924    Math::BigFloat->import( lib => 'Pari' );	# load Pari, too
4925    my $anti_matter = Math::BigFloat->bone()+4;	# now use Pari
4926
4927This will create objects with numbers stored in two different backend libraries,
4928and B<VERY BAD THINGS> will happen when you use these together:
4929
4930	my $flash_and_bang = $matter + $anti_matter;	# Don't do this!
4931
4932=over
4933
4934=item stringify, bstr()
4935
4936Both stringify and bstr() now drop the leading '+'. The old code would return
4937'+1.23', the new returns '1.23'. See the documentation in L<Math::BigInt> for
4938reasoning and details.
4939
4940=item bdiv()
4941
4942The following will probably not print what you expect:
4943
4944	print $c->bdiv(123.456),"\n";
4945
4946It prints both quotient and remainder since print works in list context. Also,
4947bdiv() will modify $c, so be careful. You probably want to use
4948
4949    print $c / 123.456,"\n";
4950    # or if you want to modify $c:
4951    print scalar $c->bdiv(123.456),"\n";
4952
4953instead.
4954
4955=item brsft()
4956
4957The following will probably not print what you expect:
4958
4959	my $c = Math::BigFloat->new('3.14159');
4960        print $c->brsft(3,10),"\n";	# prints 0.00314153.1415
4961
4962It prints both quotient and remainder, since print calls C<brsft()> in list
4963context. Also, C<< $c->brsft() >> will modify $c, so be careful.
4964You probably want to use
4965
4966	print scalar $c->copy()->brsft(3,10),"\n";
4967	# or if you really want to modify $c
4968        print scalar $c->brsft(3,10),"\n";
4969
4970instead.
4971
4972=item Modifying and =
4973
4974Beware of:
4975
4976	$x = Math::BigFloat->new(5);
4977	$y = $x;
4978
4979It will not do what you think, e.g. making a copy of $x. Instead it just makes
4980a second reference to the B<same> object and stores it in $y. Thus anything
4981that modifies $x will modify $y (except overloaded math operators), and vice
4982versa. See L<Math::BigInt> for details and how to avoid that.
4983
4984=item bpow()
4985
4986C<bpow()> now modifies the first argument, unlike the old code which left
4987it alone and only returned the result. This is to be consistent with
4988C<badd()> etc. The first will modify $x, the second one won't:
4989
4990	print bpow($x,$i),"\n"; 	# modify $x
4991	print $x->bpow($i),"\n"; 	# ditto
4992	print $x ** $i,"\n";		# leave $x alone
4993
4994=item precision() vs. accuracy()
4995
4996A common pitfall is to use L</precision()> when you want to round a result to
4997a certain number of digits:
4998
4999    use Math::BigFloat;
5000
5001    Math::BigFloat->precision(4);	    # does not do what you
5002					    # think it does
5003    my $x = Math::BigFloat->new(12345);	    # rounds $x to "12000"!
5004    print "$x\n";			    # print "12000"
5005    my $y = Math::BigFloat->new(3);	    # rounds $y to "0"!
5006    print "$y\n";			    # print "0"
5007    $z = $x / $y;			    # 12000 / 0 => NaN!
5008    print "$z\n";
5009    print $z->precision(),"\n";		    # 4
5010
5011Replacing L</precision()> with L</accuracy()> is probably not what you want, either:
5012
5013    use Math::BigFloat;
5014
5015    Math::BigFloat->accuracy(4);	  # enables global rounding:
5016    my $x = Math::BigFloat->new(123456);  # rounded immediately
5017                                          #   to "12350"
5018    print "$x\n";			  # print "123500"
5019    my $y = Math::BigFloat->new(3);	  # rounded to "3
5020    print "$y\n";			  # print "3"
5021    print $z = $x->copy()->bdiv($y),"\n"; # 41170
5022    print $z->accuracy(),"\n";		  # 4
5023
5024What you want to use instead is:
5025
5026    use Math::BigFloat;
5027
5028    my $x = Math::BigFloat->new(123456);    # no rounding
5029    print "$x\n";			    # print "123456"
5030    my $y = Math::BigFloat->new(3);	    # no rounding
5031    print "$y\n";			    # print "3"
5032    print $z = $x->copy()->bdiv($y,4),"\n"; # 41150
5033    print $z->accuracy(),"\n";		    # undef
5034
5035In addition to computing what you expected, the last example also does B<not>
5036"taint" the result with an accuracy or precision setting, which would
5037influence any further operation.
5038
5039=back
5040
5041=head1 BUGS
5042
5043Please report any bugs or feature requests to
5044C<bug-math-bigint at rt.cpan.org>, or through the web interface at
5045L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt>
5046(requires login).
5047We will be notified, and then you'll automatically be notified of progress on
5048your bug as I make changes.
5049
5050=head1 SUPPORT
5051
5052You can find documentation for this module with the perldoc command.
5053
5054    perldoc Math::BigFloat
5055
5056You can also look for information at:
5057
5058=over 4
5059
5060=item * RT: CPAN's request tracker
5061
5062L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt>
5063
5064=item * AnnoCPAN: Annotated CPAN documentation
5065
5066L<http://annocpan.org/dist/Math-BigInt>
5067
5068=item * CPAN Ratings
5069
5070L<http://cpanratings.perl.org/dist/Math-BigInt>
5071
5072=item * Search CPAN
5073
5074L<http://search.cpan.org/dist/Math-BigInt/>
5075
5076=item * CPAN Testers Matrix
5077
5078L<http://matrix.cpantesters.org/?dist=Math-BigInt>
5079
5080=item * The Bignum mailing list
5081
5082=over 4
5083
5084=item * Post to mailing list
5085
5086C<bignum at lists.scsys.co.uk>
5087
5088=item * View mailing list
5089
5090L<http://lists.scsys.co.uk/pipermail/bignum/>
5091
5092=item * Subscribe/Unsubscribe
5093
5094L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum>
5095
5096=back
5097
5098=back
5099
5100=head1 LICENSE
5101
5102This program is free software; you may redistribute it and/or modify it under
5103the same terms as Perl itself.
5104
5105=head1 SEE ALSO
5106
5107L<Math::BigFloat> and L<Math::BigInt> as well as the backends
5108L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>.
5109
5110The pragmas L<bignum>, L<bigint> and L<bigrat> also might be of interest
5111because they solve the autoupgrading/downgrading issue, at least partly.
5112
5113=head1 AUTHORS
5114
5115=over 4
5116
5117=item *
5118
5119Mark Biggar, overloaded interface by Ilya Zakharevich, 1996-2001.
5120
5121=item *
5122
5123Completely rewritten by Tels L<http://bloodgate.com> in 2001-2008.
5124
5125=item *
5126
5127Florian Ragwitz L<flora@cpan.org>, 2010.
5128
5129=item *
5130
5131Peter John Acklam, L<pjacklam@online.no>, 2011-.
5132
5133=back
5134
5135=cut
5136