projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
assorted VMS test fix-ups, $Config{prefixexp} revisited
[p5sagit/p5-mst-13.2.git] / lib / Math / BigFloat.pm
CommitLineData
13a12e00 1package Math::BigFloat;
2
3#
4# Mike grinned. 'Two down, infinity to go' - Mike Nostrus in Before and After
5#
6
58cde26e 7# The following hash values are internally used:
8# _e: exponent (BigInt)
9# _m: mantissa (absolute BigInt)
10# sign: +,-,"NaN" if not a number
11# _a: accuracy
12# _p: precision
0716bf9b 13# _f: flags, used to signal MBI not to touch our private parts
58cde26e 14
13a12e00 15$VERSION = '1.29';
58cde26e 16require 5.005;
17use Exporter;
0716bf9b 18use Math::BigInt qw/objectify/;
58cde26e 19@ISA = qw( Exporter Math::BigInt);
394e6ffb 20
58cde26e 21use strict;
027dc388 22use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/;
b3abae2a 23use vars qw/$upgrade $downgrade/;
58cde26e 24my $class = "Math::BigFloat";
a0d0e21e 25
a5f75d66 26use overload
bd05a461 27'<=>' => sub { $_[2] ?
28 ref($_[0])->bcmp($_[1],$_[0]) :
29 ref($_[0])->bcmp($_[0],$_[1])},
0716bf9b 30'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint
a5f75d66 31;
a0d0e21e 32
0716bf9b 33##############################################################################
34# global constants, flags and accessory
35
36use constant MB_NEVER_ROUND => 0x0001;
37
58cde26e 38# are NaNs ok?
39my $NaNOK=1;
58cde26e 40# constant for easier life
41my $nan = 'NaN';
58cde26e 42
ee15d750 43# class constants, use Class->constant_name() to access
44$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
45$accuracy = undef;
46$precision = undef;
47$div_scale = 40;
58cde26e 48
b3abae2a 49$upgrade = undef;
50$downgrade = undef;
51
027dc388 52##############################################################################
53# the old code had $rnd_mode, so we need to support it, too
54
55$rnd_mode = 'even';
56sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; }
57sub FETCH { return $round_mode; }
58sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); }
59
60BEGIN { tie $rnd_mode, 'Math::BigFloat'; }
61
62##############################################################################
63
574bacfe 64# in case we call SUPER::->foo() and this wants to call modify()
65# sub modify () { 0; }
66
58cde26e 67{
ee15d750 68 # valid method aliases for AUTOLOAD
58cde26e 69 my %methods = map { $_ => 1 }
70 qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
b3abae2a 71 fint facmp fcmp fzero fnan finf finc fdec flog ffac
61f5c3f5 72 fceil ffloor frsft flsft fone flog
ee15d750 73 /;
61f5c3f5 74 # valid method's that can be hand-ed up (for AUTOLOAD)
ee15d750 75 my %hand_ups = map { $_ => 1 }
76 qw / is_nan is_inf is_negative is_positive
394e6ffb 77 accuracy precision div_scale round_mode fneg fabs babs fnot
13a12e00 78 objectify
79 bone binf bnan bzero
58cde26e 80 /;
81
ee15d750 82 sub method_alias { return exists $methods{$_[0]||''}; }
83 sub method_hand_up { return exists $hand_ups{$_[0]||''}; }
a0d0e21e 84}
0e8b9368 85
58cde26e 86##############################################################################
87# constructors
a0d0e21e 88
58cde26e 89sub new
90 {
91 # create a new BigFloat object from a string or another bigfloat object.
92 # _e: exponent
93 # _m: mantissa
94 # sign => sign (+/-), or "NaN"
a0d0e21e 95
61f5c3f5 96 my ($class,$wanted,@r) = @_;
b3abae2a 97
61f5c3f5 98 # avoid numify-calls by not using || on $wanted!
99 return $class->bzero() if !defined $wanted; # default to 0
100 return $wanted->copy() if UNIVERSAL::isa($wanted,'Math::BigFloat');
a0d0e21e 101
58cde26e 102 my $self = {}; bless $self, $class;
b22b3e31 103 # shortcut for bigints and its subclasses
0716bf9b 104 if ((ref($wanted)) && (ref($wanted) ne $class))
58cde26e 105 {
0716bf9b 106 $self->{_m} = $wanted->as_number(); # get us a bigint copy
027dc388 107 $self->{_e} = Math::BigInt->bzero();
58cde26e 108 $self->{_m}->babs();
109 $self->{sign} = $wanted->sign();
0716bf9b 110 return $self->bnorm();
58cde26e 111 }
112 # got string
113 # handle '+inf', '-inf' first
ee15d750 114 if ($wanted =~ /^[+-]?inf$/)
58cde26e 115 {
027dc388 116 $self->{_e} = Math::BigInt->bzero();
117 $self->{_m} = Math::BigInt->bzero();
58cde26e 118 $self->{sign} = $wanted;
ee15d750 119 $self->{sign} = '+inf' if $self->{sign} eq 'inf';
0716bf9b 120 return $self->bnorm();
58cde26e 121 }
122 #print "new string '$wanted'\n";
123 my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split(\$wanted);
124 if (!ref $mis)
125 {
126 die "$wanted is not a number initialized to $class" if !$NaNOK;
027dc388 127 $self->{_e} = Math::BigInt->bzero();
128 $self->{_m} = Math::BigInt->bzero();
58cde26e 129 $self->{sign} = $nan;
130 }
131 else
132 {
133 # make integer from mantissa by adjusting exp, then convert to bigint
61f5c3f5 134 # undef,undef to signal MBI that we don't need no bloody rounding
135 $self->{_e} = Math::BigInt->new("$$es$$ev",undef,undef); # exponent
136 $self->{_m} = Math::BigInt->new("$$miv$$mfv",undef,undef); # create mant.
58cde26e 137 # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5
027dc388 138 $self->{_e} -= CORE::length($$mfv) if CORE::length($$mfv) != 0;
139 $self->{sign} = $$mis;
58cde26e 140 }
b3abae2a 141 # print "mbf new $self->{sign} $self->{_m} e $self->{_e}\n";
61f5c3f5 142 $self->bnorm()->round(@r); # first normalize, then round
58cde26e 143 }
a0d0e21e 144
13a12e00 145sub _bnan
58cde26e 146 {
13a12e00 147 # used by parent class bone() to initialize number to 1
58cde26e 148 my $self = shift;
574bacfe 149 $self->{_m} = Math::BigInt->bzero();
150 $self->{_e} = Math::BigInt->bzero();
58cde26e 151 }
a0d0e21e 152
13a12e00 153sub _binf
58cde26e 154 {
13a12e00 155 # used by parent class bone() to initialize number to 1
58cde26e 156 my $self = shift;
574bacfe 157 $self->{_m} = Math::BigInt->bzero();
158 $self->{_e} = Math::BigInt->bzero();
58cde26e 159 }
a0d0e21e 160
13a12e00 161sub _bone
574bacfe 162 {
13a12e00 163 # used by parent class bone() to initialize number to 1
574bacfe 164 my $self = shift;
574bacfe 165 $self->{_m} = Math::BigInt->bone();
166 $self->{_e} = Math::BigInt->bzero();
574bacfe 167 }
168
13a12e00 169sub _bzero
58cde26e 170 {
13a12e00 171 # used by parent class bone() to initialize number to 1
58cde26e 172 my $self = shift;
574bacfe 173 $self->{_m} = Math::BigInt->bzero();
174 $self->{_e} = Math::BigInt->bone();
58cde26e 175 }
176
177##############################################################################
178# string conversation
179
180sub bstr
181 {
182 # (ref to BFLOAT or num_str ) return num_str
183 # Convert number from internal format to (non-scientific) string format.
184 # internal format is always normalized (no leading zeros, "-0" => "+0")
ee15d750 185 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
186 #my $x = shift; my $class = ref($x) || $x;
187 #$x = $class->new(shift) unless ref($x);
58cde26e 188
574bacfe 189 #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
190 #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
191 if ($x->{sign} !~ /^[+-]$/)
58cde26e 192 {
574bacfe 193 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
194 return 'inf'; # +inf
58cde26e 195 }
196
574bacfe 197 my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.';
198
199 my $not_zero = !$x->is_zero();
200 if ($not_zero)
58cde26e 201 {
574bacfe 202 $es = $x->{_m}->bstr();
203 $len = CORE::length($es);
204 if (!$x->{_e}->is_zero())
58cde26e 205 {
574bacfe 206 if ($x->{_e}->sign() eq '-')
207 {
208 $dot = '';
209 if ($x->{_e} <= -$len)
210 {
211 # print "style: 0.xxxx\n";
212 my $r = $x->{_e}->copy(); $r->babs()->bsub( CORE::length($es) );
213 $es = '0.'. ('0' x $r) . $es; $cad = -($len+$r);
214 }
215 else
216 {
217 # print "insert '.' at $x->{_e} in '$es'\n";
218 substr($es,$x->{_e},0) = '.'; $cad = $x->{_e};
219 }
220 }
221 else
222 {
223 # expand with zeros
224 $es .= '0' x $x->{_e}; $len += $x->{_e}; $cad = 0;
225 }
82cf049f 226 }
574bacfe 227 } # if not zero
228 $es = $x->{sign}.$es if $x->{sign} eq '-';
229 # if set accuracy or precision, pad with zeros
230 if ((defined $x->{_a}) && ($not_zero))
231 {
232 # 123400 => 6, 0.1234 => 4, 0.001234 => 4
233 my $zeros = $x->{_a} - $cad; # cad == 0 => 12340
234 $zeros = $x->{_a} - $len if $cad != $len;
574bacfe 235 $es .= $dot.'0' x $zeros if $zeros > 0;
82cf049f 236 }
574bacfe 237 elsif ($x->{_p} || 0 < 0)
58cde26e 238 {
574bacfe 239 # 123400 => 6, 0.1234 => 4, 0.001234 => 6
240 my $zeros = -$x->{_p} + $cad;
574bacfe 241 $es .= $dot.'0' x $zeros if $zeros > 0;
58cde26e 242 }
58cde26e 243 return $es;
82cf049f 244 }
f216259d 245
58cde26e 246sub bsstr
247 {
248 # (ref to BFLOAT or num_str ) return num_str
249 # Convert number from internal format to scientific string format.
250 # internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
ee15d750 251 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
252 #my $x = shift; my $class = ref($x) || $x;
253 #$x = $class->new(shift) unless ref($x);
a0d0e21e 254
574bacfe 255 #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
256 #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
257 if ($x->{sign} !~ /^[+-]$/)
258 {
259 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
260 return 'inf'; # +inf
261 }
58cde26e 262 my $sign = $x->{_e}->{sign}; $sign = '' if $sign eq '-';
263 my $sep = 'e'.$sign;
264 return $x->{_m}->bstr().$sep.$x->{_e}->bstr();
265 }
266
267sub numify
268 {
269 # Make a number from a BigFloat object
574bacfe 270 # simple return string and let Perl's atoi()/atof() handle the rest
ee15d750 271 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 272 return $x->bsstr();
273 }
a0d0e21e 274
58cde26e 275##############################################################################
276# public stuff (usually prefixed with "b")
277
574bacfe 278# tels 2001-08-04
279# todo: this must be overwritten and return NaN for non-integer values
280# band(), bior(), bxor(), too
58cde26e 281#sub bnot
282# {
283# $class->SUPER::bnot($class,@_);
284# }
285
286sub bcmp
287 {
288 # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
289 # (BFLOAT or num_str, BFLOAT or num_str) return cond_code
290 my ($self,$x,$y) = objectify(2,@_);
58cde26e 291
0716bf9b 292 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
293 {
294 # handle +-inf and NaN
295 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
296 return 0 if ($x->{sign} eq $y->{sign}) && ($x->{sign} =~ /^[+-]inf$/);
297 return +1 if $x->{sign} eq '+inf';
298 return -1 if $x->{sign} eq '-inf';
299 return -1 if $y->{sign} eq '+inf';
b3abae2a 300 return +1;
0716bf9b 301 }
302
303 # check sign for speed first
574bacfe 304 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
58cde26e 305 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
306
574bacfe 307 # shortcut
308 my $xz = $x->is_zero();
309 my $yz = $y->is_zero();
310 return 0 if $xz && $yz; # 0 <=> 0
311 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
312 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
58cde26e 313
314 # adjust so that exponents are equal
bd05a461 315 my $lxm = $x->{_m}->length();
316 my $lym = $y->{_m}->length();
317 my $lx = $lxm + $x->{_e};
318 my $ly = $lym + $y->{_e};
b3abae2a 319 my $l = $lx - $ly; $l->bneg() if $x->{sign} eq '-';
bd05a461 320 return $l <=> 0 if $l != 0;
58cde26e 321
bd05a461 322 # lengths (corrected by exponent) are equal
323 # so make mantissa euqal length by padding with zero (shift left)
324 my $diff = $lxm - $lym;
325 my $xm = $x->{_m}; # not yet copy it
326 my $ym = $y->{_m};
327 if ($diff > 0)
328 {
329 $ym = $y->{_m}->copy()->blsft($diff,10);
330 }
331 elsif ($diff < 0)
332 {
333 $xm = $x->{_m}->copy()->blsft(-$diff,10);
334 }
335 my $rc = $xm->bcmp($ym);
58cde26e 336 $rc = -$rc if $x->{sign} eq '-'; # -124 < -123
b3abae2a 337 $rc <=> 0;
58cde26e 338 }
339
340sub bacmp
341 {
342 # Compares 2 values, ignoring their signs.
343 # Returns one of undef, <0, =0, >0. (suitable for sort)
344 # (BFLOAT or num_str, BFLOAT or num_str) return cond_code
345 my ($self,$x,$y) = objectify(2,@_);
ee15d750 346
347 # handle +-inf and NaN's
abcfbf51 348 if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/)
ee15d750 349 {
350 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
351 return 0 if ($x->is_inf() && $y->is_inf());
352 return 1 if ($x->is_inf() && !$y->is_inf());
b3abae2a 353 return -1;
ee15d750 354 }
355
356 # shortcut
357 my $xz = $x->is_zero();
358 my $yz = $y->is_zero();
359 return 0 if $xz && $yz; # 0 <=> 0
360 return -1 if $xz && !$yz; # 0 <=> +y
361 return 1 if $yz && !$xz; # +x <=> 0
362
363 # adjust so that exponents are equal
364 my $lxm = $x->{_m}->length();
365 my $lym = $y->{_m}->length();
366 my $lx = $lxm + $x->{_e};
367 my $ly = $lym + $y->{_e};
394e6ffb 368 my $l = $lx - $ly;
ee15d750 369 return $l <=> 0 if $l != 0;
58cde26e 370
ee15d750 371 # lengths (corrected by exponent) are equal
394e6ffb 372 # so make mantissa equal-length by padding with zero (shift left)
ee15d750 373 my $diff = $lxm - $lym;
374 my $xm = $x->{_m}; # not yet copy it
375 my $ym = $y->{_m};
376 if ($diff > 0)
377 {
378 $ym = $y->{_m}->copy()->blsft($diff,10);
379 }
380 elsif ($diff < 0)
381 {
382 $xm = $x->{_m}->copy()->blsft(-$diff,10);
383 }
b3abae2a 384 $xm->bcmp($ym) <=> 0;
58cde26e 385 }
a0d0e21e 386
58cde26e 387sub badd
388 {
389 # add second arg (BFLOAT or string) to first (BFLOAT) (modifies first)
390 # return result as BFLOAT
58cde26e 391 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
392
b3abae2a 393 #print "mbf badd $x $y\n";
574bacfe 394 # inf and NaN handling
395 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
396 {
397 # NaN first
398 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
13a12e00 399 # inf handling
574bacfe 400 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
401 {
13a12e00 402 # +inf++inf or -inf+-inf => same, rest is NaN
403 return $x if $x->{sign} eq $y->{sign};
404 return $x->bnan();
574bacfe 405 }
406 # +-inf + something => +inf
407 # something +-inf => +-inf
408 $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
409 return $x;
410 }
411
58cde26e 412 # speed: no add for 0+y or x+0
413 return $x if $y->is_zero(); # x+0
414 if ($x->is_zero()) # 0+y
415 {
416 # make copy, clobbering up x (modify in place!)
417 $x->{_e} = $y->{_e}->copy();
418 $x->{_m} = $y->{_m}->copy();
419 $x->{sign} = $y->{sign} || $nan;
420 return $x->round($a,$p,$r,$y);
a0d0e21e 421 }
58cde26e 422
423 # take lower of the two e's and adapt m1 to it to match m2
424 my $e = $y->{_e}; $e = Math::BigInt::bzero() if !defined $e; # if no BFLOAT
425 $e = $e - $x->{_e};
426 my $add = $y->{_m}->copy();
427 if ($e < 0)
428 {
58cde26e 429 my $e1 = $e->copy()->babs();
430 $x->{_m} *= (10 ** $e1);
431 $x->{_e} += $e; # need the sign of e
58cde26e 432 }
433 elsif ($e > 0)
434 {
58cde26e 435 $add *= (10 ** $e);
58cde26e 436 }
61f5c3f5 437 # else: both e are the same, so just leave them
438 $x->{_m}->{sign} = $x->{sign}; # fiddle with signs
58cde26e 439 $add->{sign} = $y->{sign};
61f5c3f5 440 $x->{_m} += $add; # finally do add/sub
441 $x->{sign} = $x->{_m}->{sign}; # re-adjust signs
442 $x->{_m}->{sign} = '+'; # mantissa always positiv
443 # delete trailing zeros, then round
444 return $x->bnorm()->round($a,$p,$r,$y);
58cde26e 445 }
446
447sub bsub
448 {
0716bf9b 449 # (BigFloat or num_str, BigFloat or num_str) return BigFloat
58cde26e 450 # subtract second arg from first, modify first
e745a66c 451 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
a0d0e21e 452
e745a66c 453 if (!$y->is_zero()) # don't need to do anything if $y is 0
454 {
455 $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
456 $x->badd($y,$a,$p,$r); # badd does not leave internal zeros
457 $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
458 }
459 $x; # already rounded by badd()
58cde26e 460 }
461
462sub binc
463 {
464 # increment arg by one
ee15d750 465 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
e745a66c 466
467 if ($x->{_e}->sign() eq '-')
468 {
469 return $x->badd($self->bone(),$a,$p,$r); # digits after dot
470 }
471
472 if (!$x->{_e}->is_zero())
473 {
474 $x->{_m}->blsft($x->{_e},10); # 1e2 => 100
475 $x->{_e}->bzero();
476 }
477 # now $x->{_e} == 0
478 if ($x->{sign} eq '+')
479 {
480 $x->{_m}->binc();
481 return $x->bnorm()->bround($a,$p,$r);
482 }
483 elsif ($x->{sign} eq '-')
484 {
485 $x->{_m}->bdec();
486 $x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0
487 return $x->bnorm()->bround($a,$p,$r);
488 }
489 # inf, nan handling etc
490 $x->badd($self->__one(),$a,$p,$r); # does round
58cde26e 491 }
492
493sub bdec
494 {
495 # decrement arg by one
ee15d750 496 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
e745a66c 497
498 if ($x->{_e}->sign() eq '-')
499 {
500 return $x->badd($self->bone('-'),$a,$p,$r); # digits after dot
501 }
502
503 if (!$x->{_e}->is_zero())
504 {
505 $x->{_m}->blsft($x->{_e},10); # 1e2 => 100
506 $x->{_e}->bzero();
507 }
508 # now $x->{_e} == 0
509 my $zero = $x->is_zero();
510 # <= 0
511 if (($x->{sign} eq '-') || $zero)
512 {
513 $x->{_m}->binc();
514 $x->{sign} = '-' if $zero; # 0 => 1 => -1
515 $x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0
516 return $x->bnorm()->round($a,$p,$r);
517 }
518 # > 0
519 elsif ($x->{sign} eq '+')
520 {
521 $x->{_m}->bdec();
522 return $x->bnorm()->round($a,$p,$r);
523 }
524 # inf, nan handling etc
525 $x->badd($self->bone('-'),$a,$p,$r); # does round
58cde26e 526 }
527
61f5c3f5 528sub blog
529 {
b3abae2a 530 my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(2,@_);
61f5c3f5 531
532 # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log
533
534 # u = x-1, v = x +1
535 # _ _
536 # taylor: | u 1 u^3 1 u^5 |
537 # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 0
b3abae2a 538 # |_ v 3 v^3 5 v^5 _|
61f5c3f5 539
b3abae2a 540 # we need to limit the accuracy to protect against overflow
541 my $fallback = 0;
542 my $scale = 0;
543 my @params = $x->_find_round_parameters($a,$p,$r);
61f5c3f5 544
b3abae2a 545 # no rounding at all, so must use fallback
546 if (scalar @params == 1)
547 {
548 # simulate old behaviour
549 $params[1] = $self->div_scale(); # and round to it as accuracy
550 $scale = $params[1]+4; # at least four more for proper round
551 $params[3] = $r; # round mode by caller or undef
552 $fallback = 1; # to clear a/p afterwards
553 }
554 else
555 {
556 # the 4 below is empirical, and there might be cases where it is not
557 # enough...
558 $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined
559 }
61f5c3f5 560
b3abae2a 561 return $x->bzero(@params) if $x->is_one();
562 return $x->bnan() if $x->{sign} ne '+' || $x->is_zero();
563 #return $x->bone('+',@params) if $x->bcmp($base) == 0;
61f5c3f5 564
b3abae2a 565 # when user set globals, they would interfere with our calculation, so
566 # disable then and later re-enable them
567 no strict 'refs';
568 my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
569 my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
570 # we also need to disable any set A or P on $x (_find_round_parameters took
571 # them already into account), since these would interfere, too
572 delete $x->{_a}; delete $x->{_p};
573 # need to disable $upgrade in BigInt, to aoid deep recursion
574 local $Math::BigInt::upgrade = undef;
575
576 my $v = $x->copy(); $v->binc(); # v = x+1
577 $x->bdec(); my $u = $x->copy(); # u = x-1; x = x-1
578
579 $x->bdiv($v,$scale); # first term: u/v
580
581 my $below = $v->copy();
582 my $over = $u->copy();
583 $u *= $u; $v *= $v; # u^2, v^2
584 $below->bmul($v); # u^3, v^3
585 $over->bmul($u);
61f5c3f5 586 my $factor = $self->new(3); my $two = $self->new(2);
587
588 my $diff = $self->bone();
b3abae2a 589 my $limit = $self->new("1E-". ($scale-1)); my $last;
61f5c3f5 590 # print "diff $diff limit $limit\n";
b3abae2a 591 while ($diff->bcmp($limit) > 0)
61f5c3f5 592 {
b3abae2a 593 #print "$x $over $below $factor\n";
61f5c3f5 594 $diff = $x->copy()->bsub($last)->babs();
b3abae2a 595 #print "diff $diff $limit\n";
61f5c3f5 596 $last = $x->copy();
b3abae2a 597 $x += $over->copy()->bdiv($below->copy()->bmul($factor),$scale);
61f5c3f5 598 $over *= $u; $below *= $v; $factor->badd($two);
599 }
600 $x->bmul($two);
b3abae2a 601
602 # shortcut to not run trough _find_round_parameters again
603 if (defined $params[1])
604 {
605 $x->bround($params[1],$params[3]); # then round accordingly
606 }
607 else
608 {
609 $x->bfround($params[2],$params[3]); # then round accordingly
610 }
611 if ($fallback)
612 {
613 # clear a/p after round, since user did not request it
614 $x->{_a} = undef; $x->{_p} = undef;
615 }
616 # restore globals
617 $$abr = $ab; $$pbr = $pb;
618
619 $x;
61f5c3f5 620 }
621
58cde26e 622sub blcm
623 {
ee15d750 624 # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
58cde26e 625 # does not modify arguments, but returns new object
626 # Lowest Common Multiplicator
58cde26e 627
628 my ($self,@arg) = objectify(0,@_);
629 my $x = $self->new(shift @arg);
630 while (@arg) { $x = _lcm($x,shift @arg); }
631 $x;
632 }
633
634sub bgcd
635 {
ee15d750 636 # (BFLOAT or num_str, BFLOAT or num_str) return BINT
58cde26e 637 # does not modify arguments, but returns new object
638 # GCD -- Euclids algorithm Knuth Vol 2 pg 296
58cde26e 639
640 my ($self,@arg) = objectify(0,@_);
641 my $x = $self->new(shift @arg);
642 while (@arg) { $x = _gcd($x,shift @arg); }
643 $x;
644 }
645
b3abae2a 646###############################################################################
647# is_foo methods (is_negative, is_positive are inherited from BigInt)
648
649sub is_int
650 {
651 # return true if arg (BFLOAT or num_str) is an integer
652 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
653
654 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
655 $x->{_e}->{sign} eq '+'; # 1e-1 => no integer
656 0;
657 }
658
58cde26e 659sub is_zero
660 {
b3abae2a 661 # return true if arg (BFLOAT or num_str) is zero
ee15d750 662 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
574bacfe 663
664 return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero();
b3abae2a 665 0;
58cde26e 666 }
667
668sub is_one
669 {
b3abae2a 670 # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given
ee15d750 671 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
672
673 my $sign = shift || ''; $sign = '+' if $sign ne '-';
674 return 1
675 if ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one());
b3abae2a 676 0;
58cde26e 677 }
678
679sub is_odd
680 {
ee15d750 681 # return true if arg (BFLOAT or num_str) is odd or false if even
682 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
0716bf9b 683
b3abae2a 684 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
685 ($x->{_e}->is_zero() && $x->{_m}->is_odd());
686 0;
58cde26e 687 }
688
689sub is_even
690 {
b22b3e31 691 # return true if arg (BINT or num_str) is even or false if odd
ee15d750 692 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
0716bf9b 693
694 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
b3abae2a 695 return 1 if ($x->{_e}->{sign} eq '+' # 123.45 is never
696 && $x->{_m}->is_even()); # but 1200 is
697 0;
58cde26e 698 }
699
700sub bmul
701 {
702 # multiply two numbers -- stolen from Knuth Vol 2 pg 233
703 # (BINT or num_str, BINT or num_str) return BINT
704 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
58cde26e 705
58cde26e 706 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
707
574bacfe 708 # inf handling
709 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
710 {
13a12e00 711 return $x->bnan() if $x->is_zero() || $y->is_zero();
574bacfe 712 # result will always be +-inf:
713 # +inf * +/+inf => +inf, -inf * -/-inf => +inf
714 # +inf * -/-inf => -inf, -inf * +/+inf => -inf
715 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
716 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
717 return $x->binf('-');
718 }
13a12e00 719 # handle result = 0
720 return $x->bzero() if $x->is_zero() || $y->is_zero();
574bacfe 721
58cde26e 722 # aEb * cEd = (a*c)E(b+d)
394e6ffb 723 $x->{_m}->bmul($y->{_m});
724 $x->{_e}->badd($y->{_e});
58cde26e 725 # adjust sign:
726 $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
394e6ffb 727 return $x->bnorm()->round($a,$p,$r,$y);
58cde26e 728 }
729
730sub bdiv
731 {
732 # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return
733 # (BFLOAT,BFLOAT) (quo,rem) or BINT (only rem)
734 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
735
13a12e00 736 return $self->_div_inf($x,$y)
737 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
574bacfe 738
13a12e00 739 # x== 0 # also: or y == 1 or y == -1
394e6ffb 740 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
0716bf9b 741
13a12e00 742 # upgrade
743 return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade;
744
58cde26e 745 # we need to limit the accuracy to protect against overflow
574bacfe 746 my $fallback = 0;
ee15d750 747 my $scale = 0;
ee15d750 748 my @params = $x->_find_round_parameters($a,$p,$r,$y);
749
750 # no rounding at all, so must use fallback
751 if (scalar @params == 1)
58cde26e 752 {
0716bf9b 753 # simulate old behaviour
ee15d750 754 $params[1] = $self->div_scale(); # and round to it as accuracy
61f5c3f5 755 $scale = $params[1]+4; # at least four more for proper round
ee15d750 756 $params[3] = $r; # round mode by caller or undef
757 $fallback = 1; # to clear a/p afterwards
758 }
759 else
760 {
761 # the 4 below is empirical, and there might be cases where it is not
762 # enough...
763 $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined
a0d0e21e 764 }
0716bf9b 765 my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length();
58cde26e 766 $scale = $lx if $lx > $scale;
58cde26e 767 $scale = $ly if $ly > $scale;
0716bf9b 768 my $diff = $ly - $lx;
769 $scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx!
b3abae2a 770
771 # make copy of $x in case of list context for later reminder calculation
772 my $rem;
773 if (wantarray && !$y->is_one())
774 {
775 $rem = $x->copy();
776 }
a0d0e21e 777
58cde26e 778 $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+';
a0d0e21e 779
58cde26e 780 # check for / +-1 ( +/- 1E0)
394e6ffb 781 if (!$y->is_one())
58cde26e 782 {
394e6ffb 783 # promote BigInts and it's subclasses (except when already a BigFloat)
784 $y = $self->new($y) unless $y->isa('Math::BigFloat');
785
786 # calculate the result to $scale digits and then round it
787 # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
788 $x->{_m}->blsft($scale,10);
789 $x->{_m}->bdiv( $y->{_m} ); # a/c
790 $x->{_e}->bsub( $y->{_e} ); # b-d
791 $x->{_e}->bsub($scale); # correct for 10**scale
792 $x->bnorm(); # remove trailing 0's
a0d0e21e 793 }
a5f75d66 794
ee15d750 795 # shortcut to not run trough _find_round_parameters again
796 if (defined $params[1])
797 {
61f5c3f5 798 $x->bround($params[1],$params[3]); # then round accordingly
ee15d750 799 }
800 else
801 {
802 $x->bfround($params[2],$params[3]); # then round accordingly
803 }
574bacfe 804 if ($fallback)
805 {
806 # clear a/p after round, since user did not request it
ee15d750 807 $x->{_a} = undef; $x->{_p} = undef;
574bacfe 808 }
0716bf9b 809
58cde26e 810 if (wantarray)
811 {
394e6ffb 812 if (!$y->is_one())
813 {
b3abae2a 814 $rem->bmod($y,$params[1],$params[2],$params[3]); # copy already done
394e6ffb 815 }
816 else
817 {
818 $rem = $self->bzero();
819 }
574bacfe 820 if ($fallback)
821 {
822 # clear a/p after round, since user did not request it
ee15d750 823 $rem->{_a} = undef; $rem->{_p} = undef;
574bacfe 824 }
0716bf9b 825 return ($x,$rem);
58cde26e 826 }
827 return $x;
828 }
a0d0e21e 829
58cde26e 830sub bmod
831 {
832 # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return reminder
833 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
a0d0e21e 834
61f5c3f5 835 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
836 {
837 my ($d,$re) = $self->SUPER::_div_inf($x,$y);
838 return $re->round($a,$p,$r,$y);
839 }
840 return $x->bnan() if $x->is_zero() && $y->is_zero();
841 return $x if $y->is_zero();
842 return $x->bnan() if $x->is_nan() || $y->is_nan();
843 return $x->bzero() if $y->is_one() || $x->is_zero();
58cde26e 844
61f5c3f5 845 # inf handling is missing here
846
847 my $cmp = $x->bacmp($y); # equal or $x < $y?
848 return $x->bzero($a,$p) if $cmp == 0; # $x == $y => result 0
849
850 # only $y of the operands negative?
851 my $neg = 0; $neg = 1 if $x->{sign} ne $y->{sign};
852
853 $x->{sign} = $y->{sign}; # calc sign first
854 return $x->round($a,$p,$r) if $cmp < 0 && $neg == 0; # $x < $y => result $x
855
856 my $ym = $y->{_m}->copy();
857
858 # 2e1 => 20
859 $ym->blsft($y->{_e},10) if $y->{_e}->{sign} eq '+' && !$y->{_e}->is_zero();
860
861 # if $y has digits after dot
862 my $shifty = 0; # correct _e of $x by this
863 if ($y->{_e}->{sign} eq '-') # has digits after dot
864 {
865 # 123 % 2.5 => 1230 % 25 => 5 => 0.5
866 $shifty = $y->{_e}->copy()->babs(); # no more digits after dot
867 $x->blsft($shifty,10); # 123 => 1230, $y->{_m} is already 25
868 }
869 # $ym is now mantissa of $y based on exponent 0
b3abae2a 870
61f5c3f5 871 my $shiftx = 0; # correct _e of $x by this
872 if ($x->{_e}->{sign} eq '-') # has digits after dot
873 {
874 # 123.4 % 20 => 1234 % 200
875 $shiftx = $x->{_e}->copy()->babs(); # no more digits after dot
876 $ym->blsft($shiftx,10);
877 }
878 # 123e1 % 20 => 1230 % 20
879 if ($x->{_e}->{sign} eq '+' && !$x->{_e}->is_zero())
880 {
881 $x->{_m}->blsft($x->{_e},10);
882 }
883 $x->{_e} = Math::BigInt->bzero() unless $x->{_e}->is_zero();
884
885 $x->{_e}->bsub($shiftx) if $shiftx != 0;
886 $x->{_e}->bsub($shifty) if $shifty != 0;
887
888 # now mantissas are equalized, exponent of $x is adjusted, so calc result
b3abae2a 889# $ym->{sign} = '-' if $neg; # bmod() will make the correction for us
890
61f5c3f5 891 $x->{_m}->bmod($ym);
892
893 $x->{sign} = '+' if $x->{_m}->is_zero(); # fix sign for -0
894 $x->bnorm();
895
896 if ($neg != 0) # one of them negative => correct in place
897 {
898 my $r = $y - $x;
899 $x->{_m} = $r->{_m};
900 $x->{_e} = $r->{_e};
901 $x->{sign} = '+' if $x->{_m}->is_zero(); # fix sign for -0
902 $x->bnorm();
903 }
904
905 $x->round($a,$p,$r,$y); # round and return
58cde26e 906 }
907
908sub bsqrt
909 {
0716bf9b 910 # calculate square root; this should probably
911 # use a different test to see whether the accuracy we want is...
ee15d750 912 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 913
0716bf9b 914 return $x->bnan() if $x->{sign} eq 'NaN' || $x->{sign} =~ /^-/; # <0, NaN
915 return $x if $x->{sign} eq '+inf'; # +inf
394e6ffb 916 return $x if $x->is_zero() || $x->is_one();
58cde26e 917
61f5c3f5 918 # we need to limit the accuracy to protect against overflow
574bacfe 919 my $fallback = 0;
61f5c3f5 920 my $scale = 0;
921 my @params = $x->_find_round_parameters($a,$p,$r);
922
923 # no rounding at all, so must use fallback
924 if (scalar @params == 1)
0716bf9b 925 {
926 # simulate old behaviour
61f5c3f5 927 $params[1] = $self->div_scale(); # and round to it as accuracy
928 $scale = $params[1]+4; # at least four more for proper round
929 $params[3] = $r; # round mode by caller or undef
ee15d750 930 $fallback = 1; # to clear a/p afterwards
0716bf9b 931 }
61f5c3f5 932 else
933 {
934 # the 4 below is empirical, and there might be cases where it is not
935 # enough...
936 $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined
937 }
938
939 # when user set globals, they would interfere with our calculation, so
940 # disable then and later re-enable them
941 no strict 'refs';
942 my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
b3abae2a 943 my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
61f5c3f5 944 # we also need to disable any set A or P on $x (_find_round_parameters took
945 # them already into account), since these would interfere, too
946 delete $x->{_a}; delete $x->{_p};
b3abae2a 947 # need to disable $upgrade in BigInt, to aoid deep recursion
948 local $Math::BigInt::upgrade = undef;
61f5c3f5 949
394e6ffb 950 my $xas = $x->as_number();
951 my $gs = $xas->copy()->bsqrt(); # some guess
b3abae2a 952
394e6ffb 953 if (($x->{_e}->{sign} ne '-') # guess can't be accurate if there are
954 # digits after the dot
b3abae2a 955 && ($xas->bacmp($gs * $gs) == 0)) # guess hit the nail on the head?
394e6ffb 956 {
957 # exact result
61f5c3f5 958 $x->{_m} = $gs; $x->{_e} = Math::BigInt->bzero(); $x->bnorm();
959 # shortcut to not run trough _find_round_parameters again
960 if (defined $params[1])
961 {
962 $x->bround($params[1],$params[3]); # then round accordingly
963 }
964 else
965 {
966 $x->bfround($params[2],$params[3]); # then round accordingly
967 }
968 if ($fallback)
969 {
970 # clear a/p after round, since user did not request it
971 $x->{_a} = undef; $x->{_p} = undef;
972 }
b3abae2a 973 ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb;
61f5c3f5 974 return $x;
394e6ffb 975 }
61f5c3f5 976 $gs = $self->new( $gs ); # BigInt to BigFloat
394e6ffb 977
0716bf9b 978 my $lx = $x->{_m}->length();
979 $scale = $lx if $scale < $lx;
394e6ffb 980 my $e = $self->new("1E-$scale"); # make test variable
b3abae2a 981# return $x->bnan() if $e->sign() eq 'NaN';
58cde26e 982
58cde26e 983 my $y = $x->copy();
394e6ffb 984 my $two = $self->new(2);
61f5c3f5 985 my $diff = $e;
ee15d750 986 # promote BigInts and it's subclasses (except when already a BigFloat)
987 $y = $self->new($y) unless $y->isa('Math::BigFloat');
61f5c3f5 988
ee15d750 989 my $rem;
58cde26e 990 while ($diff >= $e)
991 {
61f5c3f5 992 $rem = $y->copy()->bdiv($gs,$scale)->badd($gs)->bdiv($two,$scale);
993 $diff = $rem->copy()->bsub($gs)->babs();
994 $gs = $rem->copy();
a0d0e21e 995 }
61f5c3f5 996 # copy over to modify $x
997 $x->{_m} = $rem->{_m}; $x->{_e} = $rem->{_e};
998
999 # shortcut to not run trough _find_round_parameters again
1000 if (defined $params[1])
1001 {
1002 $x->bround($params[1],$params[3]); # then round accordingly
1003 }
1004 else
1005 {
1006 $x->bfround($params[2],$params[3]); # then round accordingly
1007 }
574bacfe 1008 if ($fallback)
1009 {
1010 # clear a/p after round, since user did not request it
ee15d750 1011 $x->{_a} = undef; $x->{_p} = undef;
574bacfe 1012 }
61f5c3f5 1013 # restore globals
b3abae2a 1014 $$abr = $ab; $$pbr = $pb;
574bacfe 1015 $x;
58cde26e 1016 }
1017
b3abae2a 1018sub bfac
1019 {
1020 # (BINT or num_str, BINT or num_str) return BINT
1021 # compute factorial numbers
1022 # modifies first argument
1023 my ($self,$x,@r) = objectify(1,@_);
1024
1025 return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
1026 return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
1027
1028 return $x->bnan() if $x->{_e}->{sign} ne '+'; # digits after dot?
1029
1030 # use BigInt's bfac() for faster calc
1031 $x->{_m}->blsft($x->{_e},10); # un-norm m
1032 $x->{_e}->bzero(); # norm $x again
1033 $x->{_m}->bfac(); # factorial
1034 $x->bnorm();
1035
1036 #my $n = $x->copy();
1037 #$x->bone();
1038 #my $f = $self->new(2);
1039 #while ($f->bacmp($n) < 0)
1040 # {
1041 # $x->bmul($f); $f->binc();
1042 # }
1043 #$x->bmul($f); # last step
1044 $x->round(@r); # round
1045 }
1046
58cde26e 1047sub bpow
1048 {
1049 # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
1050 # compute power of two numbers, second arg is used as integer
1051 # modifies first argument
1052
1053 my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
1054
0716bf9b 1055 return $x if $x->{sign} =~ /^[+-]inf$/;
58cde26e 1056 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
574bacfe 1057 return $x->bone() if $y->is_zero();
58cde26e 1058 return $x if $x->is_one() || $y->is_one();
ee15d750 1059 my $y1 = $y->as_number(); # make bigint (trunc)
394e6ffb 1060 # if ($x == -1)
1061 if ($x->{sign} eq '-' && $x->{_m}->is_one() && $x->{_e}->is_zero())
58cde26e 1062 {
1063 # if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1
0716bf9b 1064 return $y1->is_odd() ? $x : $x->babs(1);
288d023a 1065 }
58cde26e 1066 return $x if $x->is_zero() && $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0)
574bacfe 1067 # 0 ** -y => 1 / (0 ** y) => / 0! (1 / 0 => +inf)
1068 return $x->binf() if $x->is_zero() && $y->{sign} eq '-';
58cde26e 1069
1070 # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
1071 $y1->babs();
1072 $x->{_m}->bpow($y1);
1073 $x->{_e}->bmul($y1);
1074 $x->{sign} = $nan if $x->{_m}->{sign} eq $nan || $x->{_e}->{sign} eq $nan;
1075 $x->bnorm();
1076 if ($y->{sign} eq '-')
1077 {
1078 # modify $x in place!
0716bf9b 1079 my $z = $x->copy(); $x->bzero()->binc();
58cde26e 1080 return $x->bdiv($z,$a,$p,$r); # round in one go (might ignore y's A!)
a0d0e21e 1081 }
58cde26e 1082 return $x->round($a,$p,$r,$y);
1083 }
1084
1085###############################################################################
1086# rounding functions
1087
1088sub bfround
1089 {
1090 # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
1091 # $n == 0 means round to integer
1092 # expects and returns normalized numbers!
ee15d750 1093 my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
a0d0e21e 1094
58cde26e 1095 return $x if $x->modify('bfround');
1096
ee15d750 1097 my ($scale,$mode) = $x->_scale_p($self->precision(),$self->round_mode(),@_);
58cde26e 1098 return $x if !defined $scale; # no-op
1099
574bacfe 1100 # never round a 0, +-inf, NaN
61f5c3f5 1101 if ($x->is_zero())
1102 {
1103 $x->{_p} = $scale if !defined $x->{_p} || $x->{_p} < $scale; # -3 < -2
1104 return $x;
1105 }
1106 return $x if $x->{sign} !~ /^[+-]$/;
58cde26e 1107 # print "MBF bfround $x to scale $scale mode $mode\n";
58cde26e 1108
ee15d750 1109 # don't round if x already has lower precision
1110 return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p});
1111
1112 $x->{_p} = $scale; # remember round in any case
1113 $x->{_a} = undef; # and clear A
58cde26e 1114 if ($scale < 0)
1115 {
1116 # print "bfround scale $scale e $x->{_e}\n";
1117 # round right from the '.'
1118 return $x if $x->{_e} >= 0; # nothing to round
1119 $scale = -$scale; # positive for simplicity
1120 my $len = $x->{_m}->length(); # length of mantissa
1121 my $dad = -$x->{_e}; # digits after dot
1122 my $zad = 0; # zeros after dot
1123 $zad = -$len-$x->{_e} if ($x->{_e} < -$len);# for 0.00..00xxx style
ee15d750 1124 #print "scale $scale dad $dad zad $zad len $len\n";
58cde26e 1125
1126 # number bsstr len zad dad
1127 # 0.123 123e-3 3 0 3
1128 # 0.0123 123e-4 3 1 4
1129 # 0.001 1e-3 1 2 3
1130 # 1.23 123e-2 3 0 2
1131 # 1.2345 12345e-4 5 0 4
1132
1133 # do not round after/right of the $dad
1134 return $x if $scale > $dad; # 0.123, scale >= 3 => exit
1135
ee15d750 1136 # round to zero if rounding inside the $zad, but not for last zero like:
1137 # 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
1138 return $x->bzero() if $scale < $zad;
1139 if ($scale == $zad) # for 0.006, scale -3 and trunc
58cde26e 1140 {
b3abae2a 1141 $scale = -$len;
58cde26e 1142 }
1143 else
1144 {
1145 # adjust round-point to be inside mantissa
1146 if ($zad != 0)
1147 {
1148 $scale = $scale-$zad;
1149 }
1150 else
1151 {
1152 my $dbd = $len - $dad; $dbd = 0 if $dbd < 0; # digits before dot
1153 $scale = $dbd+$scale;
1154 }
1155 }
1156 # print "round to $x->{_m} to $scale\n";
a0d0e21e 1157 }
58cde26e 1158 else
1159 {
1160 # 123 => 100 means length(123) = 3 - $scale (2) => 1
a5f75d66 1161
b3abae2a 1162 my $dbt = $x->{_m}->length();
1163 # digits before dot
1164 my $dbd = $dbt + $x->{_e};
1165 # should be the same, so treat it as this
1166 $scale = 1 if $scale == 0;
1167 # shortcut if already integer
1168 return $x if $scale == 1 && $dbt <= $dbd;
1169 # maximum digits before dot
1170 ++$dbd;
1171
1172 if ($scale > $dbd)
1173 {
1174 # not enough digits before dot, so round to zero
1175 return $x->bzero;
1176 }
1177 elsif ( $scale == $dbd )
1178 {
1179 # maximum
1180 $scale = -$dbt;
1181 }
58cde26e 1182 else
b3abae2a 1183 {
1184 $scale = $dbd - $scale;
1185 }
1186
a0d0e21e 1187 }
574bacfe 1188 # print "using $scale for $x->{_m} with '$mode'\n";
1189 # pass sign to bround for rounding modes '+inf' and '-inf'
58cde26e 1190 $x->{_m}->{sign} = $x->{sign};
1191 $x->{_m}->bround($scale,$mode);
1192 $x->{_m}->{sign} = '+'; # fix sign back
1193 $x->bnorm();
1194 }
1195
1196sub bround
1197 {
1198 # accuracy: preserve $N digits, and overwrite the rest with 0's
ee15d750 1199 my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
1200
1201 die ('bround() needs positive accuracy') if ($_[0] || 0) < 0;
58cde26e 1202
ee15d750 1203 my ($scale,$mode) = $x->_scale_a($self->accuracy(),$self->round_mode(),@_);
1204 return $x if !defined $scale; # no-op
61f5c3f5 1205
58cde26e 1206 return $x if $x->modify('bround');
61f5c3f5 1207
ee15d750 1208 # scale is now either $x->{_a}, $accuracy, or the user parameter
1209 # test whether $x already has lower accuracy, do nothing in this case
1210 # but do round if the accuracy is the same, since a math operation might
1211 # want to round a number with A=5 to 5 digits afterwards again
1212 return $x if defined $_[0] && defined $x->{_a} && $x->{_a} < $_[0];
58cde26e 1213
61f5c3f5 1214 # scale < 0 makes no sense
1215 # never round a +-inf, NaN
1216 return $x if ($scale < 0) || $x->{sign} !~ /^[+-]$/;
58cde26e 1217
61f5c3f5 1218 # 1: $scale == 0 => keep all digits
1219 # 2: never round a 0
1220 # 3: if we should keep more digits than the mantissa has, do nothing
1221 if ($scale == 0 || $x->is_zero() || $x->{_m}->length() <= $scale)
1222 {
1223 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale;
1224 return $x;
1225 }
f216259d 1226
58cde26e 1227 # pass sign to bround for '+inf' and '-inf' rounding modes
1228 $x->{_m}->{sign} = $x->{sign};
1229 $x->{_m}->bround($scale,$mode); # round mantissa
1230 $x->{_m}->{sign} = '+'; # fix sign back
61f5c3f5 1231 # $x->{_m}->{_a} = undef; $x->{_m}->{_p} = undef;
ee15d750 1232 $x->{_a} = $scale; # remember rounding
1233 $x->{_p} = undef; # and clear P
574bacfe 1234 $x->bnorm(); # del trailing zeros gen. by bround()
58cde26e 1235 }
1236
1237sub bfloor
1238 {
1239 # return integer less or equal then $x
ee15d750 1240 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 1241
1242 return $x if $x->modify('bfloor');
1243
1244 return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
1245
1246 # if $x has digits after dot
1247 if ($x->{_e}->{sign} eq '-')
1248 {
1249 $x->{_m}->brsft(-$x->{_e},10);
1250 $x->{_e}->bzero();
1251 $x-- if $x->{sign} eq '-';
f216259d 1252 }
61f5c3f5 1253 $x->round($a,$p,$r);
58cde26e 1254 }
288d023a 1255
58cde26e 1256sub bceil
1257 {
1258 # return integer greater or equal then $x
ee15d750 1259 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
58cde26e 1260
1261 return $x if $x->modify('bceil');
1262 return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
1263
1264 # if $x has digits after dot
1265 if ($x->{_e}->{sign} eq '-')
1266 {
1267 $x->{_m}->brsft(-$x->{_e},10);
1268 $x->{_e}->bzero();
1269 $x++ if $x->{sign} eq '+';
a0d0e21e 1270 }
61f5c3f5 1271 $x->round($a,$p,$r);
58cde26e 1272 }
1273
394e6ffb 1274sub brsft
1275 {
1276 # shift right by $y (divide by power of 2)
1277 my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
1278
1279 return $x if $x->modify('brsft');
1280 return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
1281
1282 $n = 2 if !defined $n; $n = Math::BigFloat->new($n);
1283 $x->bdiv($n ** $y,$a,$p,$r,$y);
1284 }
1285
1286sub blsft
1287 {
1288 # shift right by $y (divide by power of 2)
1289 my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
1290
1291 return $x if $x->modify('brsft');
1292 return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
1293
1294 $n = 2 if !defined $n; $n = Math::BigFloat->new($n);
1295 $x->bmul($n ** $y,$a,$p,$r,$y);
1296 }
1297
58cde26e 1298###############################################################################
a5f75d66 1299
58cde26e 1300sub DESTROY
1301 {
ee15d750 1302 # going through AUTOLOAD for every DESTROY is costly, so avoid it by empty sub
58cde26e 1303 }
1304
1305sub AUTOLOAD
1306 {
b3abae2a 1307 # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx()
1308 # or falling back to MBI::bxxx()
58cde26e 1309 my $name = $AUTOLOAD;
1310
1311 $name =~ s/.*:://; # split package
ee15d750 1312 no strict 'refs';
1313 if (!method_alias($name))
58cde26e 1314 {
ee15d750 1315 if (!defined $name)
1316 {
1317 # delayed load of Carp and avoid recursion
1318 require Carp;
1319 Carp::croak ("Can't call a method without name");
1320 }
ee15d750 1321 if (!method_hand_up($name))
1322 {
1323 # delayed load of Carp and avoid recursion
1324 require Carp;
1325 Carp::croak ("Can't call $class\-\>$name, not a valid method");
1326 }
1327 # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
1328 $name =~ s/^f/b/;
1329 return &{'Math::BigInt'."::$name"}(@_);
a0d0e21e 1330 }
58cde26e 1331 my $bname = $name; $bname =~ s/^f/b/;
b3abae2a 1332 *{$class."::$name"} = \&$bname;
58cde26e 1333 &$bname; # uses @_
1334 }
1335
1336sub exponent
1337 {
1338 # return a copy of the exponent
ee15d750 1339 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1340
ee15d750 1341 if ($x->{sign} !~ /^[+-]$/)
1342 {
1343 my $s = $x->{sign}; $s =~ s/^[+-]//;
1344 return $self->new($s); # -inf, +inf => +inf
1345 }
1346 return $x->{_e}->copy();
58cde26e 1347 }
1348
1349sub mantissa
1350 {
1351 # return a copy of the mantissa
ee15d750 1352 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1353
ee15d750 1354 if ($x->{sign} !~ /^[+-]$/)
1355 {
1356 my $s = $x->{sign}; $s =~ s/^[+]//;
1357 return $self->new($s); # -inf, +inf => +inf
1358 }
1359 my $m = $x->{_m}->copy(); # faster than going via bstr()
1360 $m->bneg() if $x->{sign} eq '-';
58cde26e 1361
61f5c3f5 1362 $m;
58cde26e 1363 }
1364
1365sub parts
1366 {
1367 # return a copy of both the exponent and the mantissa
ee15d750 1368 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1369
ee15d750 1370 if ($x->{sign} !~ /^[+-]$/)
1371 {
1372 my $s = $x->{sign}; $s =~ s/^[+]//; my $se = $s; $se =~ s/^[-]//;
1373 return ($self->new($s),$self->new($se)); # +inf => inf and -inf,+inf => inf
1374 }
1375 my $m = $x->{_m}->copy(); # faster than going via bstr()
1376 $m->bneg() if $x->{sign} eq '-';
1377 return ($m,$x->{_e}->copy());
58cde26e 1378 }
1379
1380##############################################################################
1381# private stuff (internal use only)
1382
58cde26e 1383sub import
1384 {
1385 my $self = shift;
b3abae2a 1386 my $l = scalar @_; my $j = 0; my @a = @_;
1387 for ( my $i = 0; $i < $l ; $i++, $j++)
58cde26e 1388 {
1389 if ( $_[$i] eq ':constant' )
1390 {
1391 # this rest causes overlord er load to step in
1392 # print "overload @_\n";
1393 overload::constant float => sub { $self->new(shift); };
b3abae2a 1394 splice @a, $j, 1; $j--;
1395 }
1396 elsif ($_[$i] eq 'upgrade')
1397 {
1398 # this causes upgrading
1399 $upgrade = $_[$i+1]; # or undef to disable
1400 my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
1401 splice @a, $j, $s; $j -= $s;
58cde26e 1402 }
1403 }
1404 # any non :constant stuff is handled by our parent, Exporter
1405 # even if @_ is empty, to give it a chance
b3abae2a 1406 $self->SUPER::import(@a); # for subclasses
1407 $self->export_to_level(1,$self,@a); # need this, too
58cde26e 1408 }
1409
1410sub bnorm
1411 {
1412 # adjust m and e so that m is smallest possible
1413 # round number according to accuracy and precision settings
ee15d750 1414 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1415
0716bf9b 1416 return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc
58cde26e 1417
1418 my $zeros = $x->{_m}->_trailing_zeros(); # correct for trailing zeros
1419 if ($zeros != 0)
1420 {
1421 $x->{_m}->brsft($zeros,10); $x->{_e} += $zeros;
1422 }
ee15d750 1423 # for something like 0Ey, set y to 1, and -0 => +0
1424 $x->{sign} = '+', $x->{_e}->bone() if $x->{_m}->is_zero();
1425 # this is to prevent automatically rounding when MBI's globals are set
0716bf9b 1426 $x->{_m}->{_f} = MB_NEVER_ROUND;
1427 $x->{_e}->{_f} = MB_NEVER_ROUND;
ee15d750 1428 # 'forget' that mantissa was rounded via MBI::bround() in MBF's bfround()
1429 $x->{_m}->{_a} = undef; $x->{_e}->{_a} = undef;
1430 $x->{_m}->{_p} = undef; $x->{_e}->{_p} = undef;
61f5c3f5 1431 $x; # MBI bnorm is no-op, so dont call it
1432 }
58cde26e 1433
1434##############################################################################
1435# internal calculation routines
1436
1437sub as_number
1438 {
394e6ffb 1439 # return copy as a bigint representation of this BigFloat number
1440 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
58cde26e 1441
1442 my $z;
1443 if ($x->{_e}->is_zero())
1444 {
1445 $z = $x->{_m}->copy();
1446 $z->{sign} = $x->{sign};
1447 return $z;
1448 }
0716bf9b 1449 $z = $x->{_m}->copy();
58cde26e 1450 if ($x->{_e} < 0)
1451 {
0716bf9b 1452 $z->brsft(-$x->{_e},10);
1453 }
1454 else
1455 {
1456 $z->blsft($x->{_e},10);
58cde26e 1457 }
58cde26e 1458 $z->{sign} = $x->{sign};
61f5c3f5 1459 $z;
58cde26e 1460 }
1461
1462sub length
1463 {
ee15d750 1464 my $x = shift;
1465 my $class = ref($x) || $x;
1466 $x = $class->new(shift) unless ref($x);
58cde26e 1467
ee15d750 1468 return 1 if $x->{_m}->is_zero();
58cde26e 1469 my $len = $x->{_m}->length();
1470 $len += $x->{_e} if $x->{_e}->sign() eq '+';
1471 if (wantarray())
1472 {
1473 my $t = Math::BigInt::bzero();
1474 $t = $x->{_e}->copy()->babs() if $x->{_e}->sign() eq '-';
1475 return ($len,$t);
1476 }
61f5c3f5 1477 $len;
58cde26e 1478 }
a0d0e21e 1479
14801;
a5f75d66 1481__END__
1482
1483=head1 NAME
1484
58cde26e 1485Math::BigFloat - Arbitrary size floating point math package
a5f75d66 1486
1487=head1 SYNOPSIS
1488
a2008d6d 1489 use Math::BigFloat;
58cde26e 1490
b3abae2a 1491 # Number creation
1492 $x = Math::BigFloat->new($str); # defaults to 0
1493 $nan = Math::BigFloat->bnan(); # create a NotANumber
1494 $zero = Math::BigFloat->bzero(); # create a +0
1495 $inf = Math::BigFloat->binf(); # create a +inf
1496 $inf = Math::BigFloat->binf('-'); # create a -inf
1497 $one = Math::BigFloat->bone(); # create a +1
1498 $one = Math::BigFloat->bone('-'); # create a -1
58cde26e 1499
1500 # Testing
b3abae2a 1501 $x->is_zero(); # true if arg is +0
1502 $x->is_nan(); # true if arg is NaN
0716bf9b 1503 $x->is_one(); # true if arg is +1
1504 $x->is_one('-'); # true if arg is -1
1505 $x->is_odd(); # true if odd, false for even
1506 $x->is_even(); # true if even, false for odd
1507 $x->is_positive(); # true if >= 0
1508 $x->is_negative(); # true if < 0
b3abae2a 1509 $x->is_inf(sign); # true if +inf, or -inf (default is '+')
1510
58cde26e 1511 $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
1512 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
1513 $x->sign(); # return the sign, either +,- or NaN
b3abae2a 1514 $x->digit($n); # return the nth digit, counting from right
1515 $x->digit(-$n); # return the nth digit, counting from left
58cde26e 1516
1517 # The following all modify their first argument:
b3abae2a 1518
58cde26e 1519 # set
1520 $x->bzero(); # set $i to 0
1521 $x->bnan(); # set $i to NaN
b3abae2a 1522 $x->bone(); # set $x to +1
1523 $x->bone('-'); # set $x to -1
1524 $x->binf(); # set $x to inf
1525 $x->binf('-'); # set $x to -inf
58cde26e 1526
1527 $x->bneg(); # negation
1528 $x->babs(); # absolute value
1529 $x->bnorm(); # normalize (no-op)
1530 $x->bnot(); # two's complement (bit wise not)
1531 $x->binc(); # increment x by 1
1532 $x->bdec(); # decrement x by 1
1533
1534 $x->badd($y); # addition (add $y to $x)
1535 $x->bsub($y); # subtraction (subtract $y from $x)
1536 $x->bmul($y); # multiplication (multiply $x by $y)
1537 $x->bdiv($y); # divide, set $i to quotient
1538 # return (quo,rem) or quo if scalar
1539
1540 $x->bmod($y); # modulus
1541 $x->bpow($y); # power of arguments (a**b)
1542 $x->blsft($y); # left shift
1543 $x->brsft($y); # right shift
1544 # return (quo,rem) or quo if scalar
1545
61f5c3f5 1546 $x->blog($base); # logarithm of $x, base defaults to e
1547 # (other bases than e not supported yet)
1548
58cde26e 1549 $x->band($y); # bit-wise and
1550 $x->bior($y); # bit-wise inclusive or
1551 $x->bxor($y); # bit-wise exclusive or
1552 $x->bnot(); # bit-wise not (two's complement)
b3abae2a 1553
1554 $x->bsqrt(); # calculate square-root
1555 $x->bfac(); # factorial of $x (1*2*3*4*..$x)
1556
58cde26e 1557 $x->bround($N); # accuracy: preserver $N digits
1558 $x->bfround($N); # precision: round to the $Nth digit
1559
1560 # The following do not modify their arguments:
58cde26e 1561 bgcd(@values); # greatest common divisor
1562 blcm(@values); # lowest common multiplicator
1563
1564 $x->bstr(); # return string
1565 $x->bsstr(); # return string in scientific notation
b3abae2a 1566
1567 $x->bfloor(); # return integer less or equal than $x
1568 $x->bceil(); # return integer greater or equal than $x
1569
58cde26e 1570 $x->exponent(); # return exponent as BigInt
1571 $x->mantissa(); # return mantissa as BigInt
1572 $x->parts(); # return (mantissa,exponent) as BigInt
1573
1574 $x->length(); # number of digits (w/o sign and '.')
1575 ($l,$f) = $x->length(); # number of digits, and length of fraction
a5f75d66 1576
1577=head1 DESCRIPTION
1578
58cde26e 1579All operators (inlcuding basic math operations) are overloaded if you
1580declare your big floating point numbers as
a5f75d66 1581
58cde26e 1582 $i = new Math::BigFloat '12_3.456_789_123_456_789E-2';
1583
1584Operations with overloaded operators preserve the arguments, which is
1585exactly what you expect.
1586
1587=head2 Canonical notation
1588
1589Input to these routines are either BigFloat objects, or strings of the
1590following four forms:
a5f75d66 1591
1592=over 2
1593
58cde26e 1594=item *
1595
1596C</^[+-]\d+$/>
a5f75d66 1597
58cde26e 1598=item *
a5f75d66 1599
58cde26e 1600C</^[+-]\d+\.\d*$/>
a5f75d66 1601
58cde26e 1602=item *
a5f75d66 1603
58cde26e 1604C</^[+-]\d+E[+-]?\d+$/>
a5f75d66 1605
58cde26e 1606=item *
a5f75d66 1607
58cde26e 1608C</^[+-]\d*\.\d+E[+-]?\d+$/>
5d7098d5 1609
58cde26e 1610=back
1611
1612all with optional leading and trailing zeros and/or spaces. Additonally,
1613numbers are allowed to have an underscore between any two digits.
1614
1615Empty strings as well as other illegal numbers results in 'NaN'.
1616
1617bnorm() on a BigFloat object is now effectively a no-op, since the numbers
1618are always stored in normalized form. On a string, it creates a BigFloat
1619object.
1620
1621=head2 Output
1622
1623Output values are BigFloat objects (normalized), except for bstr() and bsstr().
1624
1625The string output will always have leading and trailing zeros stripped and drop
1626a plus sign. C<bstr()> will give you always the form with a decimal point,
1627while C<bsstr()> (for scientific) gives you the scientific notation.
1628
1629 Input bstr() bsstr()
1630 '-0' '0' '0E1'
1631 ' -123 123 123' '-123123123' '-123123123E0'
1632 '00.0123' '0.0123' '123E-4'
1633 '123.45E-2' '1.2345' '12345E-4'
1634 '10E+3' '10000' '1E4'
1635
1636Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
1637C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
1638return either undef, <0, 0 or >0 and are suited for sort.
1639
1640Actual math is done by using BigInts to represent the mantissa and exponent.
1641The sign C</^[+-]$/> is stored separately. The string 'NaN' is used to
1642represent the result when input arguments are not numbers, as well as
1643the result of dividing by zero.
1644
1645=head2 C<mantissa()>, C<exponent()> and C<parts()>
1646
1647C<mantissa()> and C<exponent()> return the said parts of the BigFloat
1648as BigInts such that:
1649
1650 $m = $x->mantissa();
1651 $e = $x->exponent();
1652 $y = $m * ( 10 ** $e );
1653 print "ok\n" if $x == $y;
1654
1655C<< ($m,$e) = $x->parts(); >> is just a shortcut giving you both of them.
1656
1657A zero is represented and returned as C<0E1>, B<not> C<0E0> (after Knuth).
1658
1659Currently the mantissa is reduced as much as possible, favouring higher
1660exponents over lower ones (e.g. returning 1e7 instead of 10e6 or 10000000e0).
1661This might change in the future, so do not depend on it.
1662
1663=head2 Accuracy vs. Precision
1664
1665See also: L<Rounding|Rounding>.
1666
027dc388 1667Math::BigFloat supports both precision and accuracy. For a full documentation,
1668examples and tips on these topics please see the large section in
1669L<Math::BigInt>.
5d7098d5 1670
58cde26e 1671Since things like sqrt(2) or 1/3 must presented with a limited precision lest
1672a operation consumes all resources, each operation produces no more than
1673C<Math::BigFloat::precision()> digits.
1674
1675In case the result of one operation has more precision than specified,
1676it is rounded. The rounding mode taken is either the default mode, or the one
1677supplied to the operation after the I<scale>:
1678
1679 $x = Math::BigFloat->new(2);
1680 Math::BigFloat::precision(5); # 5 digits max
1681 $y = $x->copy()->bdiv(3); # will give 0.66666
1682 $y = $x->copy()->bdiv(3,6); # will give 0.666666
1683 $y = $x->copy()->bdiv(3,6,'odd'); # will give 0.666667
1684 Math::BigFloat::round_mode('zero');
1685 $y = $x->copy()->bdiv(3,6); # will give 0.666666
1686
1687=head2 Rounding
1688
1689=over 2
1690
5dc6f178 1691=item ffround ( +$scale )
58cde26e 1692
0716bf9b 1693Rounds to the $scale'th place left from the '.', counting from the dot.
1694The first digit is numbered 1.
58cde26e 1695
5dc6f178 1696=item ffround ( -$scale )
58cde26e 1697
0716bf9b 1698Rounds to the $scale'th place right from the '.', counting from the dot.
58cde26e 1699
5dc6f178 1700=item ffround ( 0 )
1701
0716bf9b 1702Rounds to an integer.
5dc6f178 1703
1704=item fround ( +$scale )
1705
0716bf9b 1706Preserves accuracy to $scale digits from the left (aka significant digits)
1707and pads the rest with zeros. If the number is between 1 and -1, the
1708significant digits count from the first non-zero after the '.'
5dc6f178 1709
1710=item fround ( -$scale ) and fround ( 0 )
1711
0716bf9b 1712These are effetively no-ops.
5d7098d5 1713
a5f75d66 1714=back
1715
0716bf9b 1716All rounding functions take as a second parameter a rounding mode from one of
1717the following: 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
58cde26e 1718
1719The default rounding mode is 'even'. By using
ee15d750 1720C<< Math::BigFloat::round_mode($round_mode); >> you can get and set the default
1721mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is
0716bf9b 1722no longer supported.
b22b3e31 1723The second parameter to the round functions then overrides the default
0716bf9b 1724temporarily.
58cde26e 1725
1726The C<< as_number() >> function returns a BigInt from a Math::BigFloat. It uses
1727'trunc' as rounding mode to make it equivalent to:
1728
1729 $x = 2.5;
1730 $y = int($x) + 2;
1731
1732You can override this by passing the desired rounding mode as parameter to
1733C<as_number()>:
1734
1735 $x = Math::BigFloat->new(2.5);
1736 $y = $x->as_number('odd'); # $y = 3
1737
1738=head1 EXAMPLES
1739
58cde26e 1740 # not ready yet
58cde26e 1741
1742=head1 Autocreating constants
1743
1744After C<use Math::BigFloat ':constant'> all the floating point constants
1745in the given scope are converted to C<Math::BigFloat>. This conversion
1746happens at compile time.
1747
1748In particular
1749
1750 perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"'
1751
1752prints the value of C<2E-100>. Note that without conversion of
1753constants the expression 2E-100 will be calculated as normal floating point
1754number.
1755
a5f75d66 1756=head1 BUGS
1757
58cde26e 1758=over 2
1759
1760=item *
1761
1762The following does not work yet:
1763
1764 $m = $x->mantissa();
1765 $e = $x->exponent();
1766 $y = $m * ( 10 ** $e );
1767 print "ok\n" if $x == $y;
1768
1769=item *
1770
1771There is no fmod() function yet.
1772
1773=back
1774
1775=head1 CAVEAT
1776
1777=over 1
1778
1779=item stringify, bstr()
1780
1781Both stringify and bstr() now drop the leading '+'. The old code would return
1782'+1.23', the new returns '1.23'. See the documentation in L<Math::BigInt> for
1783reasoning and details.
1784
1785=item bdiv
1786
1787The following will probably not do what you expect:
1788
1789 print $c->bdiv(123.456),"\n";
1790
1791It prints both quotient and reminder since print works in list context. Also,
1792bdiv() will modify $c, so be carefull. You probably want to use
1793
1794 print $c / 123.456,"\n";
1795 print scalar $c->bdiv(123.456),"\n"; # or if you want to modify $c
1796
1797instead.
1798
1799=item Modifying and =
1800
1801Beware of:
1802
1803 $x = Math::BigFloat->new(5);
1804 $y = $x;
1805
1806It will not do what you think, e.g. making a copy of $x. Instead it just makes
1807a second reference to the B<same> object and stores it in $y. Thus anything
1808that modifies $x will modify $y, and vice versa.
1809
1810 $x->bmul(2);
1811 print "$x, $y\n"; # prints '10, 10'
1812
1813If you want a true copy of $x, use:
1814
1815 $y = $x->copy();
1816
1817See also the documentation in L<overload> regarding C<=>.
1818
1819=item bpow
1820
1821C<bpow()> now modifies the first argument, unlike the old code which left
1822it alone and only returned the result. This is to be consistent with
1823C<badd()> etc. The first will modify $x, the second one won't:
1824
1825 print bpow($x,$i),"\n"; # modify $x
1826 print $x->bpow($i),"\n"; # ditto
1827 print $x ** $i,"\n"; # leave $x alone
1828
1829=back
1830
1831=head1 LICENSE
a5f75d66 1832
58cde26e 1833This program is free software; you may redistribute it and/or modify it under
1834the same terms as Perl itself.
5d7098d5 1835
58cde26e 1836=head1 AUTHORS
5d7098d5 1837
58cde26e 1838Mark Biggar, overloaded interface by Ilya Zakharevich.
1839Completely rewritten by Tels http://bloodgate.com in 2001.
a5f75d66 1840
a5f75d66 1841=cut
Unnamed repository; edit this file to name it for gitweb.