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