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