1package Math::BigInt; 2 3# 4# "Mike had an infinite amount to do and a negative amount of time in which 5# to do it." - Before and After 6# 7 8# The following hash values are used: 9# value: unsigned int with actual value (as a Math::BigInt::Calc or similar) 10# sign : +,-,NaN,+inf,-inf 11# _a : accuracy 12# _p : precision 13# _f : flags, used by MBF to flag parts of a float as untouchable 14 15# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since 16# underlying lib might change the reference! 17 18use 5.006001; 19use strict; 20use warnings; 21 22our $VERSION = '1.999715'; 23$VERSION = eval $VERSION; 24 25our @ISA = qw(Exporter); 26our @EXPORT_OK = qw(objectify bgcd blcm); 27 28# _trap_inf and _trap_nan are internal and should never be accessed from the 29# outside 30our ($round_mode, $accuracy, $precision, $div_scale, $rnd_mode, 31 $upgrade, $downgrade, $_trap_nan, $_trap_inf); 32 33my $class = "Math::BigInt"; 34 35# Inside overload, the first arg is always an object. If the original code had 36# it reversed (like $x = 2 * $y), then the third parameter is true. 37# In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes 38# no difference, but in some cases it does. 39 40# For overloaded ops with only one argument we simple use $_[0]->copy() to 41# preserve the argument. 42 43# Thus inheritance of overload operators becomes possible and transparent for 44# our subclasses without the need to repeat the entire overload section there. 45 46# We register ops that are not registerable yet, so suppress warnings 47{ no warnings; 48use overload 49'=' => sub { $_[0]->copy(); }, 50 51# some shortcuts for speed (assumes that reversed order of arguments is routed 52# to normal '+' and we thus can always modify first arg. If this is changed, 53# this breaks and must be adjusted.) 54'+=' => sub { $_[0]->badd($_[1]); }, 55'-=' => sub { $_[0]->bsub($_[1]); }, 56'*=' => sub { $_[0]->bmul($_[1]); }, 57'/=' => sub { scalar $_[0]->bdiv($_[1]); }, 58'%=' => sub { $_[0]->bmod($_[1]); }, 59'^=' => sub { $_[0]->bxor($_[1]); }, 60'&=' => sub { $_[0]->band($_[1]); }, 61'|=' => sub { $_[0]->bior($_[1]); }, 62 63'**=' => sub { $_[0]->bpow($_[1]); }, 64'<<=' => sub { $_[0]->blsft($_[1]); }, 65'>>=' => sub { $_[0]->brsft($_[1]); }, 66 67# not supported by Perl yet 68'..' => \&_pointpoint, 69 70'<=>' => sub { my $rc = $_[2] ? 71 ref($_[0])->bcmp($_[1],$_[0]) : 72 $_[0]->bcmp($_[1]); 73 $rc = 1 unless defined $rc; 74 $rc <=> 0; 75 }, 76# we need '>=' to get things like "1 >= NaN" right: 77'>=' => sub { my $rc = $_[2] ? 78 ref($_[0])->bcmp($_[1],$_[0]) : 79 $_[0]->bcmp($_[1]); 80 # if there was a NaN involved, return false 81 return '' unless defined $rc; 82 $rc >= 0; 83 }, 84'cmp' => sub { 85 $_[2] ? 86 "$_[1]" cmp $_[0]->bstr() : 87 $_[0]->bstr() cmp "$_[1]" }, 88 89'cos' => sub { $_[0]->copy->bcos(); }, 90'sin' => sub { $_[0]->copy->bsin(); }, 91'atan2' => sub { $_[2] ? 92 ref($_[0])->new($_[1])->batan2($_[0]) : 93 $_[0]->copy()->batan2($_[1]) }, 94 95# are not yet overloadable 96#'hex' => sub { print "hex"; $_[0]; }, 97#'oct' => sub { print "oct"; $_[0]; }, 98 99# log(N) is log(N, e), where e is Euler's number 100'log' => sub { $_[0]->copy()->blog(); }, 101'exp' => sub { $_[0]->copy()->bexp($_[1]); }, 102'int' => sub { $_[0]->copy(); }, 103'neg' => sub { $_[0]->copy()->bneg(); }, 104'abs' => sub { $_[0]->copy()->babs(); }, 105'sqrt' => sub { $_[0]->copy()->bsqrt(); }, 106'~' => sub { $_[0]->copy()->bnot(); }, 107 108# for subtract it's a bit tricky to not modify b: b-a => -a+b 109'-' => sub { my $c = $_[0]->copy; $_[2] ? 110 $c->bneg()->badd( $_[1]) : 111 $c->bsub( $_[1]) }, 112'+' => sub { $_[0]->copy()->badd($_[1]); }, 113'*' => sub { $_[0]->copy()->bmul($_[1]); }, 114 115'/' => sub { 116 $_[2] ? ref($_[0])->new($_[1])->bdiv($_[0]) : $_[0]->copy->bdiv($_[1]); 117 }, 118'%' => sub { 119 $_[2] ? ref($_[0])->new($_[1])->bmod($_[0]) : $_[0]->copy->bmod($_[1]); 120 }, 121'**' => sub { 122 $_[2] ? ref($_[0])->new($_[1])->bpow($_[0]) : $_[0]->copy->bpow($_[1]); 123 }, 124'<<' => sub { 125 $_[2] ? ref($_[0])->new($_[1])->blsft($_[0]) : $_[0]->copy->blsft($_[1]); 126 }, 127'>>' => sub { 128 $_[2] ? ref($_[0])->new($_[1])->brsft($_[0]) : $_[0]->copy->brsft($_[1]); 129 }, 130'&' => sub { 131 $_[2] ? ref($_[0])->new($_[1])->band($_[0]) : $_[0]->copy->band($_[1]); 132 }, 133'|' => sub { 134 $_[2] ? ref($_[0])->new($_[1])->bior($_[0]) : $_[0]->copy->bior($_[1]); 135 }, 136'^' => sub { 137 $_[2] ? ref($_[0])->new($_[1])->bxor($_[0]) : $_[0]->copy->bxor($_[1]); 138 }, 139 140# can modify arg of ++ and --, so avoid a copy() for speed, but don't 141# use $_[0]->bone(), it would modify $_[0] to be 1! 142'++' => sub { $_[0]->binc() }, 143'--' => sub { $_[0]->bdec() }, 144 145# if overloaded, O(1) instead of O(N) and twice as fast for small numbers 146'bool' => sub { 147 # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/ 148 # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-( 149 my $t = undef; 150 $t = 1 if !$_[0]->is_zero(); 151 $t; 152 }, 153 154# the original qw() does not work with the TIESCALAR below, why? 155# Order of arguments insignificant 156'""' => sub { $_[0]->bstr(); }, 157'0+' => sub { $_[0]->numify(); } 158; 159} # no warnings scope 160 161############################################################################## 162# global constants, flags and accessory 163 164# These vars are public, but their direct usage is not recommended, use the 165# accessor methods instead 166 167$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common' 168$accuracy = undef; 169$precision = undef; 170$div_scale = 40; 171 172$upgrade = undef; # default is no upgrade 173$downgrade = undef; # default is no downgrade 174 175# These are internally, and not to be used from the outside at all 176 177$_trap_nan = 0; # are NaNs ok? set w/ config() 178$_trap_inf = 0; # are infs ok? set w/ config() 179my $nan = 'NaN'; # constants for easier life 180 181my $CALC = 'Math::BigInt::Calc'; # module to do the low level math 182 # default is Calc.pm 183my $IMPORT = 0; # was import() called yet? 184 # used to make require work 185my %WARN; # warn only once for low-level libs 186my %CAN; # cache for $CALC->can(...) 187my %CALLBACKS; # callbacks to notify on lib loads 188my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math 189 190############################################################################## 191# the old code had $rnd_mode, so we need to support it, too 192 193$rnd_mode = 'even'; 194sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; } 195sub FETCH { return $round_mode; } 196sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); } 197 198BEGIN 199 { 200 # tie to enable $rnd_mode to work transparently 201 tie $rnd_mode, 'Math::BigInt'; 202 203 # set up some handy alias names 204 *as_int = \&as_number; 205 *is_pos = \&is_positive; 206 *is_neg = \&is_negative; 207 } 208 209############################################################################## 210 211sub round_mode 212 { 213 no strict 'refs'; 214 # make Class->round_mode() work 215 my $self = shift; 216 my $class = ref($self) || $self || __PACKAGE__; 217 if (defined $_[0]) 218 { 219 my $m = shift; 220 if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/) 221 { 222 require Carp; Carp::croak ("Unknown round mode '$m'"); 223 } 224 return ${"${class}::round_mode"} = $m; 225 } 226 ${"${class}::round_mode"}; 227 } 228 229sub upgrade 230 { 231 no strict 'refs'; 232 # make Class->upgrade() work 233 my $self = shift; 234 my $class = ref($self) || $self || __PACKAGE__; 235 # need to set new value? 236 if (@_ > 0) 237 { 238 return ${"${class}::upgrade"} = $_[0]; 239 } 240 ${"${class}::upgrade"}; 241 } 242 243sub downgrade 244 { 245 no strict 'refs'; 246 # make Class->downgrade() work 247 my $self = shift; 248 my $class = ref($self) || $self || __PACKAGE__; 249 # need to set new value? 250 if (@_ > 0) 251 { 252 return ${"${class}::downgrade"} = $_[0]; 253 } 254 ${"${class}::downgrade"}; 255 } 256 257sub div_scale 258 { 259 no strict 'refs'; 260 # make Class->div_scale() work 261 my $self = shift; 262 my $class = ref($self) || $self || __PACKAGE__; 263 if (defined $_[0]) 264 { 265 if ($_[0] < 0) 266 { 267 require Carp; Carp::croak ('div_scale must be greater than zero'); 268 } 269 ${"${class}::div_scale"} = $_[0]; 270 } 271 ${"${class}::div_scale"}; 272 } 273 274sub accuracy 275 { 276 # $x->accuracy($a); ref($x) $a 277 # $x->accuracy(); ref($x) 278 # Class->accuracy(); class 279 # Class->accuracy($a); class $a 280 281 my $x = shift; 282 my $class = ref($x) || $x || __PACKAGE__; 283 284 no strict 'refs'; 285 # need to set new value? 286 if (@_ > 0) 287 { 288 my $a = shift; 289 # convert objects to scalars to avoid deep recursion. If object doesn't 290 # have numify(), then hopefully it will have overloading for int() and 291 # boolean test without wandering into a deep recursion path... 292 $a = $a->numify() if ref($a) && $a->can('numify'); 293 294 if (defined $a) 295 { 296 # also croak on non-numerical 297 if (!$a || $a <= 0) 298 { 299 require Carp; 300 Carp::croak ('Argument to accuracy must be greater than zero'); 301 } 302 if (int($a) != $a) 303 { 304 require Carp; 305 Carp::croak ('Argument to accuracy must be an integer'); 306 } 307 } 308 if (ref($x)) 309 { 310 # $object->accuracy() or fallback to global 311 $x->bround($a) if $a; # not for undef, 0 312 $x->{_a} = $a; # set/overwrite, even if not rounded 313 delete $x->{_p}; # clear P 314 $a = ${"${class}::accuracy"} unless defined $a; # proper return value 315 } 316 else 317 { 318 ${"${class}::accuracy"} = $a; # set global A 319 ${"${class}::precision"} = undef; # clear global P 320 } 321 return $a; # shortcut 322 } 323 324 my $a; 325 # $object->accuracy() or fallback to global 326 $a = $x->{_a} if ref($x); 327 # but don't return global undef, when $x's accuracy is 0! 328 $a = ${"${class}::accuracy"} if !defined $a; 329 $a; 330 } 331 332sub precision 333 { 334 # $x->precision($p); ref($x) $p 335 # $x->precision(); ref($x) 336 # Class->precision(); class 337 # Class->precision($p); class $p 338 339 my $x = shift; 340 my $class = ref($x) || $x || __PACKAGE__; 341 342 no strict 'refs'; 343 if (@_ > 0) 344 { 345 my $p = shift; 346 # convert objects to scalars to avoid deep recursion. If object doesn't 347 # have numify(), then hopefully it will have overloading for int() and 348 # boolean test without wandering into a deep recursion path... 349 $p = $p->numify() if ref($p) && $p->can('numify'); 350 if ((defined $p) && (int($p) != $p)) 351 { 352 require Carp; Carp::croak ('Argument to precision must be an integer'); 353 } 354 if (ref($x)) 355 { 356 # $object->precision() or fallback to global 357 $x->bfround($p) if $p; # not for undef, 0 358 $x->{_p} = $p; # set/overwrite, even if not rounded 359 delete $x->{_a}; # clear A 360 $p = ${"${class}::precision"} unless defined $p; # proper return value 361 } 362 else 363 { 364 ${"${class}::precision"} = $p; # set global P 365 ${"${class}::accuracy"} = undef; # clear global A 366 } 367 return $p; # shortcut 368 } 369 370 my $p; 371 # $object->precision() or fallback to global 372 $p = $x->{_p} if ref($x); 373 # but don't return global undef, when $x's precision is 0! 374 $p = ${"${class}::precision"} if !defined $p; 375 $p; 376 } 377 378sub config 379 { 380 # return (or set) configuration data as hash ref 381 my $class = shift || 'Math::BigInt'; 382 383 no strict 'refs'; 384 if (@_ > 1 || (@_ == 1 && (ref($_[0]) eq 'HASH'))) 385 { 386 # try to set given options as arguments from hash 387 388 my $args = $_[0]; 389 if (ref($args) ne 'HASH') 390 { 391 $args = { @_ }; 392 } 393 # these values can be "set" 394 my $set_args = {}; 395 foreach my $key ( 396 qw/trap_inf trap_nan 397 upgrade downgrade precision accuracy round_mode div_scale/ 398 ) 399 { 400 $set_args->{$key} = $args->{$key} if exists $args->{$key}; 401 delete $args->{$key}; 402 } 403 if (keys %$args > 0) 404 { 405 require Carp; 406 Carp::croak ("Illegal key(s) '", 407 join("','",keys %$args),"' passed to $class\->config()"); 408 } 409 foreach my $key (keys %$set_args) 410 { 411 if ($key =~ /^trap_(inf|nan)\z/) 412 { 413 ${"${class}::_trap_$1"} = ($set_args->{"trap_$1"} ? 1 : 0); 414 next; 415 } 416 # use a call instead of just setting the $variable to check argument 417 $class->$key($set_args->{$key}); 418 } 419 } 420 421 # now return actual configuration 422 423 my $cfg = { 424 lib => $CALC, 425 lib_version => ${"${CALC}::VERSION"}, 426 class => $class, 427 trap_nan => ${"${class}::_trap_nan"}, 428 trap_inf => ${"${class}::_trap_inf"}, 429 version => ${"${class}::VERSION"}, 430 }; 431 foreach my $key (qw/ 432 upgrade downgrade precision accuracy round_mode div_scale 433 /) 434 { 435 $cfg->{$key} = ${"${class}::$key"}; 436 }; 437 if (@_ == 1 && (ref($_[0]) ne 'HASH')) 438 { 439 # calls of the style config('lib') return just this value 440 return $cfg->{$_[0]}; 441 } 442 $cfg; 443 } 444 445sub _scale_a 446 { 447 # select accuracy parameter based on precedence, 448 # used by bround() and bfround(), may return undef for scale (means no op) 449 my ($x,$scale,$mode) = @_; 450 451 $scale = $x->{_a} unless defined $scale; 452 453 no strict 'refs'; 454 my $class = ref($x); 455 456 $scale = ${ $class . '::accuracy' } unless defined $scale; 457 $mode = ${ $class . '::round_mode' } unless defined $mode; 458 459 if (defined $scale) 460 { 461 $scale = $scale->can('numify') ? $scale->numify() 462 : "$scale" if ref($scale); 463 $scale = int($scale); 464 } 465 466 ($scale,$mode); 467 } 468 469sub _scale_p 470 { 471 # select precision parameter based on precedence, 472 # used by bround() and bfround(), may return undef for scale (means no op) 473 my ($x,$scale,$mode) = @_; 474 475 $scale = $x->{_p} unless defined $scale; 476 477 no strict 'refs'; 478 my $class = ref($x); 479 480 $scale = ${ $class . '::precision' } unless defined $scale; 481 $mode = ${ $class . '::round_mode' } unless defined $mode; 482 483 if (defined $scale) 484 { 485 $scale = $scale->can('numify') ? $scale->numify() 486 : "$scale" if ref($scale); 487 $scale = int($scale); 488 } 489 490 ($scale,$mode); 491 } 492 493############################################################################## 494# constructors 495 496sub copy { 497 my $self = shift; 498 my $selfref = ref $self; 499 my $class = $selfref || $self; 500 501 # If called as a class method, the object to copy is the next argument. 502 503 $self = shift() unless $selfref; 504 505 my $copy = bless {}, $class; 506 507 $copy->{sign} = $self->{sign}; 508 $copy->{value} = $CALC->_copy($self->{value}); 509 $copy->{_a} = $self->{_a} if exists $self->{_a}; 510 $copy->{_p} = $self->{_p} if exists $self->{_p}; 511 512 return $copy; 513} 514 515sub new { 516 # Create a new Math::BigInt object from a string or another Math::BigInt 517 # object. See hash keys documented at top. 518 519 # The argument could be an object, so avoid ||, && etc. on it. This would 520 # cause costly overloaded code to be called. The only allowed ops are ref() 521 # and defined. 522 523 my $self = shift; 524 my $selfref = ref $self; 525 my $class = $selfref || $self; 526 527 my ($wanted, $a, $p, $r) = @_; 528 529 # If called as a class method, initialize a new object. 530 531 $self = bless {}, $class unless $selfref; 532 533 unless (defined $wanted) { 534 require Carp; 535 Carp::carp("Use of uninitialized value in new"); 536 return $self->bzero($a, $p, $r); 537 } 538 539 if (ref($wanted) && $wanted->isa($class)) { # MBI or subclass 540 # Using "$copy = $wanted -> copy()" here fails some tests. Fixme! 541 my $copy = $class -> copy($wanted); 542 if ($selfref) { 543 %$self = %$copy; 544 } else { 545 $self = $copy; 546 } 547 return $self; 548 } 549 550 $class->import() if $IMPORT == 0; # make require work 551 552 # Shortcut for non-zero scalar integers with no non-zero exponent. 553 554 if (!ref($wanted) && 555 $wanted =~ / ^ 556 ([+-]?) # optional sign 557 ([1-9][0-9]*) # non-zero significand 558 (\.0*)? # ... with optional zero fraction 559 ([Ee][+-]?0+)? # optional zero exponent 560 \z 561 /x) 562 { 563 my $sgn = $1; 564 my $abs = $2; 565 $self->{sign} = $sgn || '+'; 566 $self->{value} = $CALC->_new($abs); 567 568 no strict 'refs'; 569 if (defined($a) || defined($p) 570 || defined(${"${class}::precision"}) 571 || defined(${"${class}::accuracy"})) 572 { 573 $self->round($a, $p, $r) 574 unless @_ == 4 && !defined $a && !defined $p; 575 } 576 577 return $self; 578 } 579 580 # Handle Infs. 581 582 if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { 583 my $sgn = $1 || '+'; 584 $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() 585 return $self->binf($sgn); 586 } 587 588 # Handle explicit NaNs (not the ones returned due to invalid input). 589 590 if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) { 591 return $self->bnan(); 592 } 593 594 if ($wanted =~ /^\s*[+-]?0[Xx]/) { 595 return $class -> from_hex($wanted); 596 } 597 598 if ($wanted =~ /^\s*[+-]?0[Bb]/) { 599 return $class -> from_bin($wanted); 600 } 601 602 # Split string into mantissa, exponent, integer, fraction, value, and sign. 603 my ($mis, $miv, $mfv, $es, $ev) = _split($wanted); 604 if (!ref $mis) { 605 if ($_trap_nan) { 606 require Carp; Carp::croak("$wanted is not a number in $class"); 607 } 608 $self->{value} = $CALC->_zero(); 609 $self->{sign} = $nan; 610 return $self; 611 } 612 613 if (!ref $miv) { 614 # _from_hex or _from_bin 615 $self->{value} = $mis->{value}; 616 $self->{sign} = $mis->{sign}; 617 return $self; # throw away $mis 618 } 619 620 # Make integer from mantissa by adjusting exponent, then convert to a 621 # Math::BigInt. 622 $self->{sign} = $$mis; # store sign 623 $self->{value} = $CALC->_zero(); # for all the NaN cases 624 my $e = int("$$es$$ev"); # exponent (avoid recursion) 625 if ($e > 0) { 626 my $diff = $e - CORE::length($$mfv); 627 if ($diff < 0) { # Not integer 628 if ($_trap_nan) { 629 require Carp; Carp::croak("$wanted not an integer in $class"); 630 } 631 #print "NOI 1\n"; 632 return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; 633 $self->{sign} = $nan; 634 } else { # diff >= 0 635 # adjust fraction and add it to value 636 #print "diff > 0 $$miv\n"; 637 $$miv = $$miv . ($$mfv . '0' x $diff); 638 } 639 } 640 641 else { 642 if ($$mfv ne '') { # e <= 0 643 # fraction and negative/zero E => NOI 644 if ($_trap_nan) { 645 require Carp; Carp::croak("$wanted not an integer in $class"); 646 } 647 #print "NOI 2 \$\$mfv '$$mfv'\n"; 648 return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; 649 $self->{sign} = $nan; 650 } elsif ($e < 0) { 651 # xE-y, and empty mfv 652 # Split the mantissa at the decimal point. E.g., if 653 # $$miv = 12345 and $e = -2, then $frac = 45 and $$miv = 123. 654 655 my $frac = substr($$miv, $e); # $frac is fraction part 656 substr($$miv, $e) = ""; # $$miv is now integer part 657 658 if ($frac =~ /[^0]/) { 659 if ($_trap_nan) { 660 require Carp; Carp::croak("$wanted not an integer in $class"); 661 } 662 #print "NOI 3\n"; 663 return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; 664 $self->{sign} = $nan; 665 } 666 } 667 } 668 669 unless ($self->{sign} eq $nan) { 670 $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0 671 $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/; 672 } 673 674 # If any of the globals are set, use them to round, and store them inside 675 # $self. Do not round for new($x, undef, undef) since that is used by MBF 676 # to signal no rounding. 677 678 $self->round($a, $p, $r) unless @_ == 4 && !defined $a && !defined $p; 679 $self; 680} 681 682sub bnan 683 { 684 # create a bigint 'NaN', if given a BigInt, set it to 'NaN' 685 my $self = shift; 686 $self = $class if !defined $self; 687 if (!ref($self)) 688 { 689 my $c = $self; $self = {}; bless $self, $c; 690 } 691 no strict 'refs'; 692 if (${"${class}::_trap_nan"}) 693 { 694 require Carp; 695 Carp::croak ("Tried to set $self to NaN in $class\::bnan()"); 696 } 697 $self->import() if $IMPORT == 0; # make require work 698 return if $self->modify('bnan'); 699 if ($self->can('_bnan')) 700 { 701 # use subclass to initialize 702 $self->_bnan(); 703 } 704 else 705 { 706 # otherwise do our own thing 707 $self->{value} = $CALC->_zero(); 708 } 709 $self->{sign} = $nan; 710 delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly 711 $self; 712 } 713 714sub binf 715 { 716 # create a bigint '+-inf', if given a BigInt, set it to '+-inf' 717 # the sign is either '+', or if given, used from there 718 my $self = shift; 719 my $sign = shift; $sign = '+' if !defined $sign || $sign !~ /^-(inf)?$/; 720 $self = $class if !defined $self; 721 if (!ref($self)) 722 { 723 my $c = $self; $self = {}; bless $self, $c; 724 } 725 no strict 'refs'; 726 if (${"${class}::_trap_inf"}) 727 { 728 require Carp; 729 Carp::croak ("Tried to set $self to +-inf in $class\::binf()"); 730 } 731 $self->import() if $IMPORT == 0; # make require work 732 return if $self->modify('binf'); 733 if ($self->can('_binf')) 734 { 735 # use subclass to initialize 736 $self->_binf(); 737 } 738 else 739 { 740 # otherwise do our own thing 741 $self->{value} = $CALC->_zero(); 742 } 743 $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf 744 $self->{sign} = $sign; 745 ($self->{_a},$self->{_p}) = @_; # take over requested rounding 746 $self; 747 } 748 749sub bzero 750 { 751 # create a bigint '+0', if given a BigInt, set it to 0 752 my $self = shift; 753 $self = __PACKAGE__ if !defined $self; 754 755 if (!ref($self)) 756 { 757 my $c = $self; $self = {}; bless $self, $c; 758 } 759 $self->import() if $IMPORT == 0; # make require work 760 return if $self->modify('bzero'); 761 762 if ($self->can('_bzero')) 763 { 764 # use subclass to initialize 765 $self->_bzero(); 766 } 767 else 768 { 769 # otherwise do our own thing 770 $self->{value} = $CALC->_zero(); 771 } 772 $self->{sign} = '+'; 773 if (@_ > 0) 774 { 775 if (@_ > 3) 776 { 777 # call like: $x->bzero($a,$p,$r,$y); 778 ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_); 779 } 780 else 781 { 782 $self->{_a} = $_[0] 783 if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a})); 784 $self->{_p} = $_[1] 785 if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p})); 786 } 787 } 788 $self; 789 } 790 791sub bone 792 { 793 # create a bigint '+1' (or -1 if given sign '-'), 794 # if given a BigInt, set it to +1 or -1, respectively 795 my $self = shift; 796 my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-'; 797 $self = $class if !defined $self; 798 799 if (!ref($self)) 800 { 801 my $c = $self; $self = {}; bless $self, $c; 802 } 803 $self->import() if $IMPORT == 0; # make require work 804 return if $self->modify('bone'); 805 806 if ($self->can('_bone')) 807 { 808 # use subclass to initialize 809 $self->_bone(); 810 } 811 else 812 { 813 # otherwise do our own thing 814 $self->{value} = $CALC->_one(); 815 } 816 $self->{sign} = $sign; 817 if (@_ > 0) 818 { 819 if (@_ > 3) 820 { 821 # call like: $x->bone($sign,$a,$p,$r,$y); 822 ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_); 823 } 824 else 825 { 826 # call like: $x->bone($sign,$a,$p,$r); 827 $self->{_a} = $_[0] 828 if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a})); 829 $self->{_p} = $_[1] 830 if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p})); 831 } 832 } 833 $self; 834 } 835 836############################################################################## 837# string conversion 838 839sub bsstr 840 { 841 # (ref to BFLOAT or num_str ) return num_str 842 # Convert number from internal format to scientific string format. 843 # internal format is always normalized (no leading zeros, "-0E0" => "+0E0") 844 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 845 846 if ($x->{sign} !~ /^[+-]$/) 847 { 848 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 849 return 'inf'; # +inf 850 } 851 my ($m,$e) = $x->parts(); 852 #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt 853 # 'e+' because E can only be positive in BigInt 854 $m->bstr() . 'e+' . $CALC->_str($e->{value}); 855 } 856 857sub bstr 858 { 859 # make a string from bigint object 860 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 861 862 if ($x->{sign} !~ /^[+-]$/) 863 { 864 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 865 return 'inf'; # +inf 866 } 867 my $es = ''; $es = $x->{sign} if $x->{sign} eq '-'; 868 $es.$CALC->_str($x->{value}); 869 } 870 871sub numify 872 { 873 # Make a Perl scalar number from a Math::BigInt object. 874 my $x = shift; $x = $class->new($x) unless ref $x; 875 876 if ($x -> is_nan()) { 877 require Math::Complex; 878 my $inf = Math::Complex::Inf(); 879 return $inf - $inf; 880 } 881 882 if ($x -> is_inf()) { 883 require Math::Complex; 884 my $inf = Math::Complex::Inf(); 885 return $x -> is_negative() ? -$inf : $inf; 886 } 887 888 my $num = 0 + $CALC->_num($x->{value}); 889 return $x->{sign} eq '-' ? -$num : $num; 890 } 891 892############################################################################## 893# public stuff (usually prefixed with "b") 894 895sub sign 896 { 897 # return the sign of the number: +/-/-inf/+inf/NaN 898 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 899 900 $x->{sign}; 901 } 902 903sub _find_round_parameters { 904 # After any operation or when calling round(), the result is rounded by 905 # regarding the A & P from arguments, local parameters, or globals. 906 907 # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!! 908 909 # This procedure finds the round parameters, but it is for speed reasons 910 # duplicated in round. Otherwise, it is tested by the testsuite and used 911 # by bdiv(). 912 913 # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P 914 # were requested/defined (locally or globally or both) 915 916 my ($self, $a, $p, $r, @args) = @_; 917 # $a accuracy, if given by caller 918 # $p precision, if given by caller 919 # $r round_mode, if given by caller 920 # @args all 'other' arguments (0 for unary, 1 for binary ops) 921 922 my $class = ref($self); # find out class of argument(s) 923 no strict 'refs'; 924 925 # convert to normal scalar for speed and correctness in inner parts 926 $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a); 927 $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p); 928 929 # now pick $a or $p, but only if we have got "arguments" 930 if (!defined $a) { 931 foreach ($self, @args) { 932 # take the defined one, or if both defined, the one that is smaller 933 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a); 934 } 935 } 936 if (!defined $p) { 937 # even if $a is defined, take $p, to signal error for both defined 938 foreach ($self, @args) { 939 # take the defined one, or if both defined, the one that is bigger 940 # -2 > -3, and 3 > 2 941 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); 942 } 943 } 944 945 # if still none defined, use globals (#2) 946 $a = ${"$class\::accuracy"} unless defined $a; 947 $p = ${"$class\::precision"} unless defined $p; 948 949 # A == 0 is useless, so undef it to signal no rounding 950 $a = undef if defined $a && $a == 0; 951 952 # no rounding today? 953 return ($self) unless defined $a || defined $p; # early out 954 955 # set A and set P is an fatal error 956 return ($self->bnan()) if defined $a && defined $p; # error 957 958 $r = ${"$class\::round_mode"} unless defined $r; 959 if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) { 960 require Carp; Carp::croak ("Unknown round mode '$r'"); 961 } 962 963 $a = int($a) if defined $a; 964 $p = int($p) if defined $p; 965 966 ($self, $a, $p, $r); 967} 968 969sub round { 970 # Round $self according to given parameters, or given second argument's 971 # parameters or global defaults 972 973 # for speed reasons, _find_round_parameters is embedded here: 974 975 my ($self, $a, $p, $r, @args) = @_; 976 # $a accuracy, if given by caller 977 # $p precision, if given by caller 978 # $r round_mode, if given by caller 979 # @args all 'other' arguments (0 for unary, 1 for binary ops) 980 981 my $class = ref($self); # find out class of argument(s) 982 no strict 'refs'; 983 984 # now pick $a or $p, but only if we have got "arguments" 985 if (!defined $a) { 986 foreach ($self, @args) { 987 # take the defined one, or if both defined, the one that is smaller 988 $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a); 989 } 990 } 991 if (!defined $p) { 992 # even if $a is defined, take $p, to signal error for both defined 993 foreach ($self, @args) { 994 # take the defined one, or if both defined, the one that is bigger 995 # -2 > -3, and 3 > 2 996 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); 997 } 998 } 999 1000 # if still none defined, use globals (#2) 1001 $a = ${"$class\::accuracy"} unless defined $a; 1002 $p = ${"$class\::precision"} unless defined $p; 1003 1004 # A == 0 is useless, so undef it to signal no rounding 1005 $a = undef if defined $a && $a == 0; 1006 1007 # no rounding today? 1008 return $self unless defined $a || defined $p; # early out 1009 1010 # set A and set P is an fatal error 1011 return $self->bnan() if defined $a && defined $p; 1012 1013 $r = ${"$class\::round_mode"} unless defined $r; 1014 if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) { 1015 require Carp; Carp::croak ("Unknown round mode '$r'"); 1016 } 1017 1018 # now round, by calling either bround or bfround: 1019 if (defined $a) { 1020 $self->bround(int($a), $r) if !defined $self->{_a} || $self->{_a} >= $a; 1021 } else { # both can't be undefined due to early out 1022 $self->bfround(int($p), $r) if !defined $self->{_p} || $self->{_p} <= $p; 1023 } 1024 1025 # bround() or bfround() already called bnorm() if nec. 1026 $self; 1027} 1028 1029sub bnorm 1030 { 1031 # (numstr or BINT) return BINT 1032 # Normalize number -- no-op here 1033 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1034 $x; 1035 } 1036 1037sub babs 1038 { 1039 # (BINT or num_str) return BINT 1040 # make number absolute, or return absolute BINT from string 1041 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1042 1043 return $x if $x->modify('babs'); 1044 # post-normalized abs for internal use (does nothing for NaN) 1045 $x->{sign} =~ s/^-/+/; 1046 $x; 1047 } 1048 1049sub bsgn { 1050 # Signum function. 1051 1052 my $self = shift; 1053 1054 return $self if $self->modify('bsgn'); 1055 1056 return $self -> bone("+") if $self -> is_pos(); 1057 return $self -> bone("-") if $self -> is_neg(); 1058 return $self; # zero or NaN 1059} 1060 1061sub bneg 1062 { 1063 # (BINT or num_str) return BINT 1064 # negate number or make a negated number from string 1065 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1066 1067 return $x if $x->modify('bneg'); 1068 1069 # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN' 1070 $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $CALC->_is_zero($x->{value})); 1071 $x; 1072 } 1073 1074sub bcmp 1075 { 1076 # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort) 1077 # (BINT or num_str, BINT or num_str) return cond_code 1078 1079 # set up parameters 1080 my ($self,$x,$y) = (ref($_[0]),@_); 1081 1082 # objectify is costly, so avoid it 1083 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1084 { 1085 ($self,$x,$y) = objectify(2,@_); 1086 } 1087 1088 return $upgrade->bcmp($x,$y) if defined $upgrade && 1089 ((!$x->isa($self)) || (!$y->isa($self))); 1090 1091 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) 1092 { 1093 # handle +-inf and NaN 1094 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 1095 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; 1096 return +1 if $x->{sign} eq '+inf'; 1097 return -1 if $x->{sign} eq '-inf'; 1098 return -1 if $y->{sign} eq '+inf'; 1099 return +1; 1100 } 1101 # check sign for speed first 1102 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y 1103 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0 1104 1105 # have same sign, so compare absolute values. Don't make tests for zero 1106 # here because it's actually slower than testing in Calc (especially w/ Pari 1107 # et al) 1108 1109 # post-normalized compare for internal use (honors signs) 1110 if ($x->{sign} eq '+') 1111 { 1112 # $x and $y both > 0 1113 return $CALC->_acmp($x->{value},$y->{value}); 1114 } 1115 1116 # $x && $y both < 0 1117 $CALC->_acmp($y->{value},$x->{value}); # swapped acmp (lib returns 0,1,-1) 1118 } 1119 1120sub bacmp 1121 { 1122 # Compares 2 values, ignoring their signs. 1123 # Returns one of undef, <0, =0, >0. (suitable for sort) 1124 # (BINT, BINT) return cond_code 1125 1126 # set up parameters 1127 my ($self,$x,$y) = (ref($_[0]),@_); 1128 # objectify is costly, so avoid it 1129 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1130 { 1131 ($self,$x,$y) = objectify(2,@_); 1132 } 1133 1134 return $upgrade->bacmp($x,$y) if defined $upgrade && 1135 ((!$x->isa($self)) || (!$y->isa($self))); 1136 1137 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) 1138 { 1139 # handle +-inf and NaN 1140 return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 1141 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; 1142 return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; 1143 return -1; 1144 } 1145 $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1 1146 } 1147 1148sub badd 1149 { 1150 # add second arg (BINT or string) to first (BINT) (modifies first) 1151 # return result as BINT 1152 1153 # set up parameters 1154 my ($self,$x,$y,@r) = (ref($_[0]),@_); 1155 # objectify is costly, so avoid it 1156 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1157 { 1158 ($self,$x,$y,@r) = objectify(2,@_); 1159 } 1160 1161 return $x if $x->modify('badd'); 1162 return $upgrade->badd($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade && 1163 ((!$x->isa($self)) || (!$y->isa($self))); 1164 1165 $r[3] = $y; # no push! 1166 # inf and NaN handling 1167 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) 1168 { 1169 # NaN first 1170 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 1171 # inf handling 1172 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) 1173 { 1174 # +inf++inf or -inf+-inf => same, rest is NaN 1175 return $x if $x->{sign} eq $y->{sign}; 1176 return $x->bnan(); 1177 } 1178 # +-inf + something => +inf 1179 # something +-inf => +-inf 1180 $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/; 1181 return $x; 1182 } 1183 1184 my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs 1185 1186 if ($sx eq $sy) 1187 { 1188 $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add 1189 } 1190 else 1191 { 1192 my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare 1193 if ($a > 0) 1194 { 1195 $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap 1196 $x->{sign} = $sy; 1197 } 1198 elsif ($a == 0) 1199 { 1200 # speedup, if equal, set result to 0 1201 $x->{value} = $CALC->_zero(); 1202 $x->{sign} = '+'; 1203 } 1204 else # a < 0 1205 { 1206 $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub 1207 } 1208 } 1209 $x->round(@r); 1210 } 1211 1212sub bsub 1213 { 1214 # (BINT or num_str, BINT or num_str) return BINT 1215 # subtract second arg from first, modify first 1216 1217 # set up parameters 1218 my ($self,$x,$y,@r) = (ref($_[0]),@_); 1219 1220 # objectify is costly, so avoid it 1221 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1222 { 1223 ($self,$x,$y,@r) = objectify(2,@_); 1224 } 1225 1226 return $x if $x->modify('bsub'); 1227 1228 return $upgrade->new($x)->bsub($upgrade->new($y),@r) if defined $upgrade && 1229 ((!$x->isa($self)) || (!$y->isa($self))); 1230 1231 return $x->round(@r) if $y->is_zero(); 1232 1233 # To correctly handle the lone special case $x->bsub($x), we note the sign 1234 # of $x, then flip the sign from $y, and if the sign of $x did change, too, 1235 # then we caught the special case: 1236 my $xsign = $x->{sign}; 1237 $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN 1238 if ($xsign ne $x->{sign}) 1239 { 1240 # special case of $x->bsub($x) results in 0 1241 return $x->bzero(@r) if $xsign =~ /^[+-]$/; 1242 return $x->bnan(); # NaN, -inf, +inf 1243 } 1244 $x->badd($y,@r); # badd does not leave internal zeros 1245 $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN) 1246 $x; # already rounded by badd() or no round nec. 1247 } 1248 1249sub binc 1250 { 1251 # increment arg by one 1252 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); 1253 return $x if $x->modify('binc'); 1254 1255 if ($x->{sign} eq '+') 1256 { 1257 $x->{value} = $CALC->_inc($x->{value}); 1258 return $x->round($a,$p,$r); 1259 } 1260 elsif ($x->{sign} eq '-') 1261 { 1262 $x->{value} = $CALC->_dec($x->{value}); 1263 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0 1264 return $x->round($a,$p,$r); 1265 } 1266 # inf, nan handling etc 1267 $x->badd($self->bone(),$a,$p,$r); # badd does round 1268 } 1269 1270sub bdec 1271 { 1272 # decrement arg by one 1273 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); 1274 return $x if $x->modify('bdec'); 1275 1276 if ($x->{sign} eq '-') 1277 { 1278 # x already < 0 1279 $x->{value} = $CALC->_inc($x->{value}); 1280 } 1281 else 1282 { 1283 return $x->badd($self->bone('-'),@r) 1284 unless $x->{sign} eq '+'; # inf or NaN 1285 # >= 0 1286 if ($CALC->_is_zero($x->{value})) 1287 { 1288 # == 0 1289 $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1 1290 } 1291 else 1292 { 1293 # > 0 1294 $x->{value} = $CALC->_dec($x->{value}); 1295 } 1296 } 1297 $x->round(@r); 1298 } 1299 1300sub blog 1301 { 1302 # Return the logarithm of the operand. If a second operand is defined, that 1303 # value is used as the base, otherwise the base is assumed to be Euler's 1304 # constant. 1305 1306 # Don't objectify the base, since an undefined base, as in $x->blog() or 1307 # $x->blog(undef) signals that the base is Euler's number. 1308 1309 # set up parameters 1310 my ($self,$x,$base,@r) = (undef,@_); 1311 # objectify is costly, so avoid it 1312 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 1313 ($self,$x,$base,@r) = objectify(1,@_); 1314 } 1315 1316 return $x if $x->modify('blog'); 1317 1318 # Handle all exception cases and all trivial cases. I have used Wolfram Alpha 1319 # (http://www.wolframalpha.com) as the reference for these cases. 1320 1321 return $x -> bnan() if $x -> is_nan(); 1322 1323 if (defined $base) { 1324 $base = $self -> new($base) unless ref $base; 1325 if ($base -> is_nan() || $base -> is_one()) { 1326 return $x -> bnan(); 1327 } elsif ($base -> is_inf() || $base -> is_zero()) { 1328 return $x -> bnan() if $x -> is_inf() || $x -> is_zero(); 1329 return $x -> bzero(); 1330 } elsif ($base -> is_negative()) { # -inf < base < 0 1331 return $x -> bzero() if $x -> is_one(); # x = 1 1332 return $x -> bone() if $x == $base; # x = base 1333 return $x -> bnan(); # otherwise 1334 } 1335 return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf 1336 } 1337 1338 # We now know that the base is either undefined or >= 2 and finite. 1339 1340 return $x -> binf('+') if $x -> is_inf(); # x = +/-inf 1341 return $x -> bnan() if $x -> is_neg(); # -inf < x < 0 1342 return $x -> bzero() if $x -> is_one(); # x = 1 1343 return $x -> binf('-') if $x -> is_zero(); # x = 0 1344 1345 # At this point we are done handling all exception cases and trivial cases. 1346 1347 return $upgrade -> blog($upgrade -> new($x), $base, @r) if defined $upgrade; 1348 1349 # fix for bug #24969: 1350 # the default base is e (Euler's number) which is not an integer 1351 if (!defined $base) 1352 { 1353 require Math::BigFloat; 1354 my $u = Math::BigFloat->blog(Math::BigFloat->new($x))->as_int(); 1355 # modify $x in place 1356 $x->{value} = $u->{value}; 1357 $x->{sign} = $u->{sign}; 1358 return $x; 1359 } 1360 1361 my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value}); 1362 return $x->bnan() unless defined $rc; # not possible to take log? 1363 $x->{value} = $rc; 1364 $x->round(@r); 1365 } 1366 1367sub bnok 1368 { 1369 # Calculate n over k (binomial coefficient or "choose" function) as integer. 1370 # set up parameters 1371 my ($self,$x,$y,@r) = (ref($_[0]),@_); 1372 1373 # objectify is costly, so avoid it 1374 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1375 { 1376 ($self,$x,$y,@r) = objectify(2,@_); 1377 } 1378 1379 return $x if $x->modify('bnok'); 1380 return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'; 1381 return $x->binf() if $x->{sign} eq '+inf'; 1382 1383 # k > n or k < 0 => 0 1384 my $cmp = $x->bacmp($y); 1385 return $x->bzero() if $cmp < 0 || $y->{sign} =~ /^-/; 1386 # k == n => 1 1387 return $x->bone(@r) if $cmp == 0; 1388 1389 if ($CALC->can('_nok')) 1390 { 1391 $x->{value} = $CALC->_nok($x->{value},$y->{value}); 1392 } 1393 else 1394 { 1395 # ( 7 ) 7! 1*2*3*4 * 5*6*7 5 * 6 * 7 6 7 1396 # ( - ) = --------- = --------------- = --------- = 5 * - * - 1397 # ( 3 ) (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3 1398 1399 if (!$y->is_zero()) 1400 { 1401 my $z = $x - $y; 1402 $z->binc(); 1403 my $r = $z->copy(); $z->binc(); 1404 my $d = $self->new(2); 1405 while ($z->bacmp($x) <= 0) # f <= x ? 1406 { 1407 $r->bmul($z); $r->bdiv($d); 1408 $z->binc(); $d->binc(); 1409 } 1410 $x->{value} = $r->{value}; $x->{sign} = '+'; 1411 } 1412 else { $x->bone(); } 1413 } 1414 $x->round(@r); 1415 } 1416 1417sub bexp 1418 { 1419 # Calculate e ** $x (Euler's number to the power of X), truncated to 1420 # an integer value. 1421 my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); 1422 return $x if $x->modify('bexp'); 1423 1424 # inf, -inf, NaN, <0 => NaN 1425 return $x->bnan() if $x->{sign} eq 'NaN'; 1426 return $x->bone() if $x->is_zero(); 1427 return $x if $x->{sign} eq '+inf'; 1428 return $x->bzero() if $x->{sign} eq '-inf'; 1429 1430 my $u; 1431 { 1432 # run through Math::BigFloat unless told otherwise 1433 require Math::BigFloat unless defined $upgrade; 1434 local $upgrade = 'Math::BigFloat' unless defined $upgrade; 1435 # calculate result, truncate it to integer 1436 $u = $upgrade->bexp($upgrade->new($x),@r); 1437 } 1438 1439 if (!defined $upgrade) 1440 { 1441 $u = $u->as_int(); 1442 # modify $x in place 1443 $x->{value} = $u->{value}; 1444 $x->round(@r); 1445 } 1446 else { $x = $u; } 1447 } 1448 1449sub blcm 1450 { 1451 # (BINT or num_str, BINT or num_str) return BINT 1452 # does not modify arguments, but returns new object 1453 # Lowest Common Multiple 1454 1455 my $y = shift; my ($x); 1456 if (ref($y)) 1457 { 1458 $x = $y->copy(); 1459 } 1460 else 1461 { 1462 $x = $class->new($y); 1463 } 1464 my $self = ref($x); 1465 while (@_) 1466 { 1467 my $y = shift; $y = $self->new($y) if !ref ($y); 1468 $x = __lcm($x,$y); 1469 } 1470 $x; 1471 } 1472 1473sub bgcd 1474 { 1475 # (BINT or num_str, BINT or num_str) return BINT 1476 # does not modify arguments, but returns new object 1477 # GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff) 1478 1479 my $y = shift; 1480 $y = $class->new($y) if !ref($y); 1481 my $self = ref($y); 1482 my $x = $y->copy()->babs(); # keep arguments 1483 return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? 1484 1485 while (@_) 1486 { 1487 $y = shift; $y = $self->new($y) if !ref($y); 1488 return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN? 1489 $x->{value} = $CALC->_gcd($x->{value},$y->{value}); 1490 last if $CALC->_is_one($x->{value}); 1491 } 1492 $x; 1493 } 1494 1495sub bnot 1496 { 1497 # (num_str or BINT) return BINT 1498 # represent ~x as twos-complement number 1499 # we don't need $self, so undef instead of ref($_[0]) make it slightly faster 1500 my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 1501 1502 return $x if $x->modify('bnot'); 1503 $x->binc()->bneg(); # binc already does round 1504 } 1505 1506############################################################################## 1507# is_foo test routines 1508# we don't need $self, so undef instead of ref($_[0]) make it slightly faster 1509 1510sub is_zero 1511 { 1512 # return true if arg (BINT or num_str) is zero (array '+', '0') 1513 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1514 1515 return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't 1516 $CALC->_is_zero($x->{value}); 1517 } 1518 1519sub is_nan 1520 { 1521 # return true if arg (BINT or num_str) is NaN 1522 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1523 1524 $x->{sign} eq $nan ? 1 : 0; 1525 } 1526 1527sub is_inf 1528 { 1529 # return true if arg (BINT or num_str) is +-inf 1530 my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 1531 1532 if (defined $sign) 1533 { 1534 $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf 1535 $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-' 1536 return $x->{sign} =~ /^$sign$/ ? 1 : 0; 1537 } 1538 $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity 1539 } 1540 1541sub is_one 1542 { 1543 # return true if arg (BINT or num_str) is +1, or -1 if sign is given 1544 my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 1545 1546 $sign = '+' if !defined $sign || $sign ne '-'; 1547 1548 return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either 1549 $CALC->_is_one($x->{value}); 1550 } 1551 1552sub is_odd 1553 { 1554 # return true when arg (BINT or num_str) is odd, false for even 1555 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1556 1557 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't 1558 $CALC->_is_odd($x->{value}); 1559 } 1560 1561sub is_even 1562 { 1563 # return true when arg (BINT or num_str) is even, false for odd 1564 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1565 1566 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't 1567 $CALC->_is_even($x->{value}); 1568 } 1569 1570sub is_positive 1571 { 1572 # return true when arg (BINT or num_str) is positive (> 0) 1573 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1574 1575 return 1 if $x->{sign} eq '+inf'; # +inf is positive 1576 1577 # 0+ is neither positive nor negative 1578 ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0; 1579 } 1580 1581sub is_negative 1582 { 1583 # return true when arg (BINT or num_str) is negative (< 0) 1584 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1585 1586 $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not 1587 } 1588 1589sub is_int 1590 { 1591 # return true when arg (BINT or num_str) is an integer 1592 # always true for BigInt, but different for BigFloats 1593 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 1594 1595 $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't 1596 } 1597 1598############################################################################### 1599 1600sub bmul 1601 { 1602 # multiply the first number by the second number 1603 # (BINT or num_str, BINT or num_str) return BINT 1604 1605 # set up parameters 1606 my ($self,$x,$y,@r) = (ref($_[0]),@_); 1607 # objectify is costly, so avoid it 1608 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1609 { 1610 ($self,$x,$y,@r) = objectify(2,@_); 1611 } 1612 1613 return $x if $x->modify('bmul'); 1614 1615 return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 1616 1617 # inf handling 1618 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) 1619 { 1620 return $x->bnan() if $x->is_zero() || $y->is_zero(); 1621 # result will always be +-inf: 1622 # +inf * +/+inf => +inf, -inf * -/-inf => +inf 1623 # +inf * -/-inf => -inf, -inf * +/+inf => -inf 1624 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); 1625 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); 1626 return $x->binf('-'); 1627 } 1628 1629 return $upgrade->bmul($x,$upgrade->new($y),@r) 1630 if defined $upgrade && !$y->isa($self); 1631 1632 $r[3] = $y; # no push here 1633 1634 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + 1635 1636 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math 1637 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0 1638 1639 $x->round(@r); 1640 } 1641 1642sub bmuladd 1643 { 1644 # multiply two numbers and then add the third to the result 1645 # (BINT or num_str, BINT or num_str, BINT or num_str) return BINT 1646 1647 # set up parameters 1648 my ($self,$x,$y,$z,@r) = objectify(3,@_); 1649 1650 return $x if $x->modify('bmuladd'); 1651 1652 return $x->bnan() if ($x->{sign} eq $nan) || 1653 ($y->{sign} eq $nan) || 1654 ($z->{sign} eq $nan); 1655 1656 # inf handling of x and y 1657 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) 1658 { 1659 return $x->bnan() if $x->is_zero() || $y->is_zero(); 1660 # result will always be +-inf: 1661 # +inf * +/+inf => +inf, -inf * -/-inf => +inf 1662 # +inf * -/-inf => -inf, -inf * +/+inf => -inf 1663 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); 1664 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); 1665 return $x->binf('-'); 1666 } 1667 # inf handling x*y and z 1668 if (($z->{sign} =~ /^[+-]inf$/)) 1669 { 1670 # something +-inf => +-inf 1671 $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/; 1672 } 1673 1674 return $upgrade->bmuladd($x,$upgrade->new($y),$upgrade->new($z),@r) 1675 if defined $upgrade && (!$y->isa($self) || !$z->isa($self) || !$x->isa($self)); 1676 1677 # TODO: what if $y and $z have A or P set? 1678 $r[3] = $z; # no push here 1679 1680 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + 1681 1682 $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math 1683 $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0 1684 1685 my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs 1686 1687 if ($sx eq $sz) 1688 { 1689 $x->{value} = $CALC->_add($x->{value},$z->{value}); # same sign, abs add 1690 } 1691 else 1692 { 1693 my $a = $CALC->_acmp ($z->{value},$x->{value}); # absolute compare 1694 if ($a > 0) 1695 { 1696 $x->{value} = $CALC->_sub($z->{value},$x->{value},1); # abs sub w/ swap 1697 $x->{sign} = $sz; 1698 } 1699 elsif ($a == 0) 1700 { 1701 # speedup, if equal, set result to 0 1702 $x->{value} = $CALC->_zero(); 1703 $x->{sign} = '+'; 1704 } 1705 else # a < 0 1706 { 1707 $x->{value} = $CALC->_sub($x->{value}, $z->{value}); # abs sub 1708 } 1709 } 1710 $x->round(@r); 1711 } 1712 1713sub bdiv 1714 { 1715 1716 # This does floored division, where the quotient is floored toward negative 1717 # infinity and the remainder has the same sign as the divisor. 1718 1719 # Set up parameters. 1720 my ($self,$x,$y,@r) = (ref($_[0]),@_); 1721 1722 # objectify() is costly, so avoid it if we can. 1723 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 1724 ($self,$x,$y,@r) = objectify(2,@_); 1725 } 1726 1727 return $x if $x->modify('bdiv'); 1728 1729 my $wantarray = wantarray; # call only once 1730 1731 # At least one argument is NaN. Return NaN for both quotient and the 1732 # modulo/remainder. 1733 1734 if ($x -> is_nan() || $y -> is_nan()) { 1735 return $wantarray ? ($x -> bnan(), $self -> bnan()) : $x -> bnan(); 1736 } 1737 1738 # Divide by zero and modulo zero. 1739 # 1740 # Division: Use the common convention that x / 0 is inf with the same sign 1741 # as x, except when x = 0, where we return NaN. This is also what earlier 1742 # versions did. 1743 # 1744 # Modulo: In modular arithmetic, the congruence relation z = x (mod y) 1745 # means that there is some integer k such that z - x = k y. If y = 0, we 1746 # get z - x = 0 or z = x. This is also what earlier versions did, except 1747 # that 0 % 0 returned NaN. 1748 # 1749 # inf / 0 = inf inf % 0 = inf 1750 # 5 / 0 = inf 5 % 0 = 5 1751 # 0 / 0 = NaN 0 % 0 = 0 (before: NaN) 1752 # -5 / 0 = -inf -5 % 0 = -5 1753 # -inf / 0 = -inf -inf % 0 = -inf 1754 1755 if ($y -> is_zero()) { 1756 my ($quo, $rem); 1757 if ($wantarray) { 1758 $rem = $x -> copy(); 1759 } 1760 if ($x -> is_zero()) { 1761 $quo = $x -> bnan(); 1762 } else { 1763 $quo = $x -> binf($x -> {sign}); 1764 } 1765 return $wantarray ? ($quo, $rem) : $quo; 1766 } 1767 1768 # Numerator (dividend) is +/-inf, and denominator is finite and non-zero. 1769 # The divide by zero cases are covered above. In all of the cases listed 1770 # below we return the same as core Perl. 1771 # 1772 # inf / -inf = NaN inf % -inf = NaN 1773 # inf / -5 = -inf inf % -5 = NaN (before: 0) 1774 # inf / 5 = inf inf % 5 = NaN (before: 0) 1775 # inf / inf = NaN inf % inf = NaN 1776 # 1777 # -inf / -inf = NaN -inf % -inf = NaN 1778 # -inf / -5 = inf -inf % -5 = NaN (before: 0) 1779 # -inf / 5 = -inf -inf % 5 = NaN (before: 0) 1780 # -inf / inf = NaN -inf % inf = NaN 1781 1782 if ($x -> is_inf()) { 1783 my ($quo, $rem); 1784 $rem = $self -> bnan() if $wantarray; 1785 if ($y -> is_inf()) { 1786 $quo = $x -> bnan(); 1787 } else { 1788 my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-'; 1789 $quo = $x -> binf($sign); 1790 } 1791 return $wantarray ? ($quo, $rem) : $quo; 1792 } 1793 1794 # Denominator (divisor) is +/-inf. The cases when the numerator is +/-inf 1795 # are covered above. In the modulo cases (in the right column) we return 1796 # the same as core Perl, which does floored division, so for consistency we 1797 # also do floored division in the division cases (in the left column). 1798 # 1799 # -5 / inf = -1 (before: 0) -5 % inf = inf (before: -5) 1800 # 0 / inf = 0 0 % inf = 0 1801 # 5 / inf = 0 5 % inf = 5 1802 # 1803 # -5 / -inf = 0 -5 % -inf = -5 1804 # 0 / -inf = 0 0 % -inf = 0 1805 # 5 / -inf = -1 (before: 0) 5 % -inf = -inf (before: 5) 1806 1807 if ($y -> is_inf()) { 1808 my ($quo, $rem); 1809 if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { 1810 $rem = $x -> copy() if $wantarray; 1811 $quo = $x -> bzero(); 1812 } else { 1813 $rem = $self -> binf($y -> {sign}) if $wantarray; 1814 $quo = $x -> bone('-'); 1815 } 1816 return $wantarray ? ($quo, $rem) : $quo; 1817 } 1818 1819 # At this point, both the numerator and denominator are finite numbers, and 1820 # the denominator (divisor) is non-zero. 1821 1822 return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r) 1823 if defined $upgrade; 1824 1825 $r[3] = $y; # no push! 1826 1827 # Inialize remainder. 1828 1829 my $rem = $self->bzero(); 1830 1831 # Are both operands the same object, i.e., like $x -> bdiv($x)? 1832 # If so, flipping the sign of $y also flips the sign of $x. 1833 1834 my $xsign = $x->{sign}; 1835 my $ysign = $y->{sign}; 1836 1837 $y->{sign} =~ tr/+-/-+/; # Flip the sign of $y, and see ... 1838 my $same = $xsign ne $x->{sign}; # ... if that changed the sign of $x. 1839 $y->{sign} = $ysign; # Re-insert the original sign. 1840 1841 if ($same) { 1842 $x -> bone(); 1843 } else { 1844 ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value}); 1845 1846 if ($CALC -> _is_zero($rem->{value})) { 1847 if ($xsign eq $ysign || $CALC -> _is_zero($x->{value})) { 1848 $x->{sign} = '+'; 1849 } else { 1850 $x->{sign} = '-'; 1851 } 1852 } else { 1853 if ($xsign eq $ysign) { 1854 $x->{sign} = '+'; 1855 } else { 1856 if ($xsign eq '+') { 1857 $x -> badd(1); 1858 } else { 1859 $x -> bsub(1); 1860 } 1861 $x->{sign} = '-'; 1862 } 1863 } 1864 } 1865 1866 $x->round(@r); 1867 1868 if ($wantarray) { 1869 unless ($CALC -> _is_zero($rem->{value})) { 1870 if ($xsign ne $ysign) { 1871 $rem = $y -> copy() -> babs() -> bsub($rem); 1872 } 1873 $rem->{sign} = $ysign; 1874 } 1875 $rem->{_a} = $x->{_a}; 1876 $rem->{_p} = $x->{_p}; 1877 $rem->round(@r); 1878 return ($x,$rem); 1879 } 1880 1881 return $x; 1882 } 1883 1884############################################################################### 1885# modulus functions 1886 1887sub bmod 1888 { 1889 1890 # This is the remainder after floored division, where the quotient is 1891 # floored toward negative infinity and the remainder has the same sign as 1892 # the divisor. 1893 1894 # Set up parameters. 1895 my ($self,$x,$y,@r) = (ref($_[0]),@_); 1896 1897 # objectify is costly, so avoid it 1898 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1899 { 1900 ($self,$x,$y,@r) = objectify(2,@_); 1901 } 1902 1903 return $x if $x->modify('bmod'); 1904 $r[3] = $y; # no push! 1905 1906 # At least one argument is NaN. 1907 1908 if ($x -> is_nan() || $y -> is_nan()) { 1909 return $x -> bnan(); 1910 } 1911 1912 # Modulo zero. See documentation for bdiv(). 1913 1914 if ($y -> is_zero()) { 1915 return $x; 1916 } 1917 1918 # Numerator (dividend) is +/-inf. 1919 1920 if ($x -> is_inf()) { 1921 return $x -> bnan(); 1922 } 1923 1924 # Denominator (divisor) is +/-inf. 1925 1926 if ($y -> is_inf()) { 1927 if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { 1928 return $x; 1929 } else { 1930 return $x -> binf($y -> sign()); 1931 } 1932 } 1933 1934 # Calc new sign and in case $y == +/- 1, return $x. 1935 1936 $x->{value} = $CALC->_mod($x->{value},$y->{value}); 1937 if ($CALC -> _is_zero($x->{value})) 1938 { 1939 $x->{sign} = '+'; # do not leave -0 1940 } 1941 else 1942 { 1943 $x->{value} = $CALC->_sub($y->{value},$x->{value},1) # $y-$x 1944 if ($x->{sign} ne $y->{sign}); 1945 $x->{sign} = $y->{sign}; 1946 } 1947 1948 $x->round(@r); 1949 } 1950 1951sub bmodinv 1952 { 1953 # Return modular multiplicative inverse: 1954 # 1955 # z is the modular inverse of x (mod y) if and only if 1956 # 1957 # x*z ≡ 1 (mod y) 1958 # 1959 # If the modulus y is larger than one, x and z are relative primes (i.e., 1960 # their greatest common divisor is one). 1961 # 1962 # If no modular multiplicative inverse exists, NaN is returned. 1963 1964 # set up parameters 1965 my ($self,$x,$y,@r) = (undef,@_); 1966 # objectify is costly, so avoid it 1967 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 1968 { 1969 ($self,$x,$y,@r) = objectify(2,@_); 1970 } 1971 1972 return $x if $x->modify('bmodinv'); 1973 1974 # Return NaN if one or both arguments is +inf, -inf, or nan. 1975 1976 return $x->bnan() if ($y->{sign} !~ /^[+-]$/ || 1977 $x->{sign} !~ /^[+-]$/); 1978 1979 # Return NaN if $y is zero; 1 % 0 makes no sense. 1980 1981 return $x->bnan() if $y->is_zero(); 1982 1983 # Return 0 in the trivial case. $x % 1 or $x % -1 is zero for all finite 1984 # integers $x. 1985 1986 return $x->bzero() if ($y->is_one() || 1987 $y->is_one('-')); 1988 1989 # Return NaN if $x = 0, or $x modulo $y is zero. The only valid case when 1990 # $x = 0 is when $y = 1 or $y = -1, but that was covered above. 1991 # 1992 # Note that computing $x modulo $y here affects the value we'll feed to 1993 # $CALC->_modinv() below when $x and $y have opposite signs. E.g., if $x = 1994 # 5 and $y = 7, those two values are fed to _modinv(), but if $x = -5 and 1995 # $y = 7, the values fed to _modinv() are $x = 2 (= -5 % 7) and $y = 7. 1996 # The value if $x is affected only when $x and $y have opposite signs. 1997 1998 $x->bmod($y); 1999 return $x->bnan() if $x->is_zero(); 2000 2001 # Compute the modular multiplicative inverse of the absolute values. We'll 2002 # correct for the signs of $x and $y later. Return NaN if no GCD is found. 2003 2004 ($x->{value}, $x->{sign}) = $CALC->_modinv($x->{value}, $y->{value}); 2005 return $x->bnan() if !defined $x->{value}; 2006 2007 # Library inconsistency workaround: _modinv() in Math::BigInt::GMP versions 2008 # <= 1.32 return undef rather than a "+" for the sign. 2009 2010 $x->{sign} = '+' unless defined $x->{sign}; 2011 2012 # When one or both arguments are negative, we have the following 2013 # relations. If x and y are positive: 2014 # 2015 # modinv(-x, -y) = -modinv(x, y) 2016 # modinv(-x, y) = y - modinv(x, y) = -modinv(x, y) (mod y) 2017 # modinv( x, -y) = modinv(x, y) - y = modinv(x, y) (mod -y) 2018 2019 # We must swap the sign of the result if the original $x is negative. 2020 # However, we must compensate for ignoring the signs when computing the 2021 # inverse modulo. The net effect is that we must swap the sign of the 2022 # result if $y is negative. 2023 2024 $x -> bneg() if $y->{sign} eq '-'; 2025 2026 # Compute $x modulo $y again after correcting the sign. 2027 2028 $x -> bmod($y) if $x->{sign} ne $y->{sign}; 2029 2030 return $x; 2031 } 2032 2033sub bmodpow 2034 { 2035 # Modular exponentiation. Raises a very large number to a very large exponent 2036 # in a given very large modulus quickly, thanks to binary exponentiation. 2037 # Supports negative exponents. 2038 my ($self,$num,$exp,$mod,@r) = objectify(3,@_); 2039 2040 return $num if $num->modify('bmodpow'); 2041 2042 # When the exponent 'e' is negative, use the following relation, which is 2043 # based on finding the multiplicative inverse 'd' of 'b' modulo 'm': 2044 # 2045 # b^(-e) (mod m) = d^e (mod m) where b*d = 1 (mod m) 2046 2047 $num->bmodinv($mod) if ($exp->{sign} eq '-'); 2048 2049 # Check for valid input. All operands must be finite, and the modulus must be 2050 # non-zero. 2051 2052 return $num->bnan() if ($num->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf 2053 $exp->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf 2054 $mod->{sign} =~ /NaN|inf/); # NaN, -inf, +inf 2055 2056 # Modulo zero. See documentation for Math::BigInt's bmod() method. 2057 2058 if ($mod -> is_zero()) { 2059 if ($num -> is_zero()) { 2060 return $self -> bnan(); 2061 } else { 2062 return $num -> copy(); 2063 } 2064 } 2065 2066 # Compute 'a (mod m)', ignoring the signs on 'a' and 'm'. If the resulting 2067 # value is zero, the output is also zero, regardless of the signs on 'a' and 2068 # 'm'. 2069 2070 my $value = $CALC->_modpow($num->{value}, $exp->{value}, $mod->{value}); 2071 my $sign = '+'; 2072 2073 # If the resulting value is non-zero, we have four special cases, depending 2074 # on the signs on 'a' and 'm'. 2075 2076 unless ($CALC->_is_zero($value)) { 2077 2078 # There is a negative sign on 'a' (= $num**$exp) only if the number we 2079 # are exponentiating ($num) is negative and the exponent ($exp) is odd. 2080 2081 if ($num->{sign} eq '-' && $exp->is_odd()) { 2082 2083 # When both the number 'a' and the modulus 'm' have a negative sign, 2084 # use this relation: 2085 # 2086 # -a (mod -m) = -(a (mod m)) 2087 2088 if ($mod->{sign} eq '-') { 2089 $sign = '-'; 2090 } 2091 2092 # When only the number 'a' has a negative sign, use this relation: 2093 # 2094 # -a (mod m) = m - (a (mod m)) 2095 2096 else { 2097 # Use copy of $mod since _sub() modifies the first argument. 2098 my $mod = $CALC->_copy($mod->{value}); 2099 $value = $CALC->_sub($mod, $value); 2100 $sign = '+'; 2101 } 2102 2103 } else { 2104 2105 # When only the modulus 'm' has a negative sign, use this relation: 2106 # 2107 # a (mod -m) = (a (mod m)) - m 2108 # = -(m - (a (mod m))) 2109 2110 if ($mod->{sign} eq '-') { 2111 # Use copy of $mod since _sub() modifies the first argument. 2112 my $mod = $CALC->_copy($mod->{value}); 2113 $value = $CALC->_sub($mod, $value); 2114 $sign = '-'; 2115 } 2116 2117 # When neither the number 'a' nor the modulus 'm' have a negative 2118 # sign, directly return the already computed value. 2119 # 2120 # (a (mod m)) 2121 2122 } 2123 2124 } 2125 2126 $num->{value} = $value; 2127 $num->{sign} = $sign; 2128 2129 return $num; 2130 } 2131 2132############################################################################### 2133 2134sub bfac 2135 { 2136 # (BINT or num_str, BINT or num_str) return BINT 2137 # compute factorial number from $x, modify $x in place 2138 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 2139 2140 return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf 2141 return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN 2142 2143 $x->{value} = $CALC->_fac($x->{value}); 2144 $x->round(@r); 2145 } 2146 2147sub bpow 2148 { 2149 # (BINT or num_str, BINT or num_str) return BINT 2150 # compute power of two numbers -- stolen from Knuth Vol 2 pg 233 2151 # modifies first argument 2152 2153 # set up parameters 2154 my ($self,$x,$y,@r) = (ref($_[0]),@_); 2155 # objectify is costly, so avoid it 2156 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 2157 { 2158 ($self,$x,$y,@r) = objectify(2,@_); 2159 } 2160 2161 return $x if $x->modify('bpow'); 2162 2163 return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; 2164 2165 # inf handling 2166 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) 2167 { 2168 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) 2169 { 2170 # +-inf ** +-inf 2171 return $x->bnan(); 2172 } 2173 # +-inf ** Y 2174 if ($x->{sign} =~ /^[+-]inf/) 2175 { 2176 # +inf ** 0 => NaN 2177 return $x->bnan() if $y->is_zero(); 2178 # -inf ** -1 => 1/inf => 0 2179 return $x->bzero() if $y->is_one('-') && $x->is_negative(); 2180 2181 # +inf ** Y => inf 2182 return $x if $x->{sign} eq '+inf'; 2183 2184 # -inf ** Y => -inf if Y is odd 2185 return $x if $y->is_odd(); 2186 return $x->babs(); 2187 } 2188 # X ** +-inf 2189 2190 # 1 ** +inf => 1 2191 return $x if $x->is_one(); 2192 2193 # 0 ** inf => 0 2194 return $x if $x->is_zero() && $y->{sign} =~ /^[+]/; 2195 2196 # 0 ** -inf => inf 2197 return $x->binf() if $x->is_zero(); 2198 2199 # -1 ** -inf => NaN 2200 return $x->bnan() if $x->is_one('-') && $y->{sign} =~ /^[-]/; 2201 2202 # -X ** -inf => 0 2203 return $x->bzero() if $x->{sign} eq '-' && $y->{sign} =~ /^[-]/; 2204 2205 # -1 ** inf => NaN 2206 return $x->bnan() if $x->{sign} eq '-'; 2207 2208 # X ** inf => inf 2209 return $x->binf() if $y->{sign} =~ /^[+]/; 2210 # X ** -inf => 0 2211 return $x->bzero(); 2212 } 2213 2214 return $upgrade->bpow($upgrade->new($x),$y,@r) 2215 if defined $upgrade && (!$y->isa($self) || $y->{sign} eq '-'); 2216 2217 $r[3] = $y; # no push! 2218 2219 # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu 2220 2221 my $new_sign = '+'; 2222 $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+'); 2223 2224 # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf 2225 return $x->binf() 2226 if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value}); 2227 # 1 ** -y => 1 / (1 ** |y|) 2228 # so do test for negative $y after above's clause 2229 return $x->bnan() if $y->{sign} eq '-' && !$CALC->_is_one($x->{value}); 2230 2231 $x->{value} = $CALC->_pow($x->{value},$y->{value}); 2232 $x->{sign} = $new_sign; 2233 $x->{sign} = '+' if $CALC->_is_zero($y->{value}); 2234 $x->round(@r); 2235 } 2236 2237sub blsft 2238 { 2239 # (BINT or num_str, BINT or num_str) return BINT 2240 # compute x << y, base n, y >= 0 2241 2242 # set up parameters 2243 my ($self,$x,$y,$n,@r) = (ref($_[0]),@_); 2244 # objectify is costly, so avoid it 2245 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 2246 { 2247 ($self,$x,$y,$n,@r) = objectify(2,@_); 2248 } 2249 2250 return $x if $x->modify('blsft'); 2251 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); 2252 return $x->round(@r) if $y->is_zero(); 2253 2254 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; 2255 2256 $x->{value} = $CALC->_lsft($x->{value},$y->{value},$n); 2257 $x->round(@r); 2258 } 2259 2260sub brsft 2261 { 2262 # (BINT or num_str, BINT or num_str) return BINT 2263 # compute x >> y, base n, y >= 0 2264 2265 # set up parameters 2266 my ($self,$x,$y,$n,@r) = (ref($_[0]),@_); 2267 # objectify is costly, so avoid it 2268 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 2269 { 2270 ($self,$x,$y,$n,@r) = objectify(2,@_); 2271 } 2272 2273 return $x if $x->modify('brsft'); 2274 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); 2275 return $x->round(@r) if $y->is_zero(); 2276 return $x->bzero(@r) if $x->is_zero(); # 0 => 0 2277 2278 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; 2279 2280 # this only works for negative numbers when shifting in base 2 2281 if (($x->{sign} eq '-') && ($n == 2)) 2282 { 2283 return $x->round(@r) if $x->is_one('-'); # -1 => -1 2284 if (!$y->is_one()) 2285 { 2286 # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al 2287 # but perhaps there is a better emulation for two's complement shift... 2288 # if $y != 1, we must simulate it by doing: 2289 # convert to bin, flip all bits, shift, and be done 2290 $x->binc(); # -3 => -2 2291 my $bin = $x->as_bin(); 2292 $bin =~ s/^-0b//; # strip '-0b' prefix 2293 $bin =~ tr/10/01/; # flip bits 2294 # now shift 2295 if ($y >= CORE::length($bin)) 2296 { 2297 $bin = '0'; # shifting to far right creates -1 2298 # 0, because later increment makes 2299 # that 1, attached '-' makes it '-1' 2300 # because -1 >> x == -1 ! 2301 } 2302 else 2303 { 2304 $bin =~ s/.{$y}$//; # cut off at the right side 2305 $bin = '1' . $bin; # extend left side by one dummy '1' 2306 $bin =~ tr/10/01/; # flip bits back 2307 } 2308 my $res = $self->new('0b'.$bin); # add prefix and convert back 2309 $res->binc(); # remember to increment 2310 $x->{value} = $res->{value}; # take over value 2311 return $x->round(@r); # we are done now, magic, isn't? 2312 } 2313 # x < 0, n == 2, y == 1 2314 $x->bdec(); # n == 2, but $y == 1: this fixes it 2315 } 2316 2317 $x->{value} = $CALC->_rsft($x->{value},$y->{value},$n); 2318 $x->round(@r); 2319 } 2320 2321sub band 2322 { 2323 #(BINT or num_str, BINT or num_str) return BINT 2324 # compute x & y 2325 2326 # set up parameters 2327 my ($self,$x,$y,@r) = (ref($_[0]),@_); 2328 # objectify is costly, so avoid it 2329 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 2330 { 2331 ($self,$x,$y,@r) = objectify(2,@_); 2332 } 2333 2334 return $x if $x->modify('band'); 2335 2336 $r[3] = $y; # no push! 2337 2338 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); 2339 2340 my $sx = $x->{sign} eq '+' ? 1 : -1; 2341 my $sy = $y->{sign} eq '+' ? 1 : -1; 2342 2343 if ($sx == 1 && $sy == 1) 2344 { 2345 $x->{value} = $CALC->_and($x->{value},$y->{value}); 2346 return $x->round(@r); 2347 } 2348 2349 if ($CAN{signed_and}) 2350 { 2351 $x->{value} = $CALC->_signed_and($x->{value},$y->{value},$sx,$sy); 2352 return $x->round(@r); 2353 } 2354 2355 require $EMU_LIB; 2356 __emu_band($self,$x,$y,$sx,$sy,@r); 2357 } 2358 2359sub bior 2360 { 2361 #(BINT or num_str, BINT or num_str) return BINT 2362 # compute x | y 2363 2364 # set up parameters 2365 my ($self,$x,$y,@r) = (ref($_[0]),@_); 2366 # objectify is costly, so avoid it 2367 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 2368 { 2369 ($self,$x,$y,@r) = objectify(2,@_); 2370 } 2371 2372 return $x if $x->modify('bior'); 2373 $r[3] = $y; # no push! 2374 2375 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); 2376 2377 my $sx = $x->{sign} eq '+' ? 1 : -1; 2378 my $sy = $y->{sign} eq '+' ? 1 : -1; 2379 2380 # the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior() 2381 2382 # don't use lib for negative values 2383 if ($sx == 1 && $sy == 1) 2384 { 2385 $x->{value} = $CALC->_or($x->{value},$y->{value}); 2386 return $x->round(@r); 2387 } 2388 2389 # if lib can do negative values, let it handle this 2390 if ($CAN{signed_or}) 2391 { 2392 $x->{value} = $CALC->_signed_or($x->{value},$y->{value},$sx,$sy); 2393 return $x->round(@r); 2394 } 2395 2396 require $EMU_LIB; 2397 __emu_bior($self,$x,$y,$sx,$sy,@r); 2398 } 2399 2400sub bxor 2401 { 2402 #(BINT or num_str, BINT or num_str) return BINT 2403 # compute x ^ y 2404 2405 # set up parameters 2406 my ($self,$x,$y,@r) = (ref($_[0]),@_); 2407 # objectify is costly, so avoid it 2408 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 2409 { 2410 ($self,$x,$y,@r) = objectify(2,@_); 2411 } 2412 2413 return $x if $x->modify('bxor'); 2414 $r[3] = $y; # no push! 2415 2416 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); 2417 2418 my $sx = $x->{sign} eq '+' ? 1 : -1; 2419 my $sy = $y->{sign} eq '+' ? 1 : -1; 2420 2421 # don't use lib for negative values 2422 if ($sx == 1 && $sy == 1) 2423 { 2424 $x->{value} = $CALC->_xor($x->{value},$y->{value}); 2425 return $x->round(@r); 2426 } 2427 2428 # if lib can do negative values, let it handle this 2429 if ($CAN{signed_xor}) 2430 { 2431 $x->{value} = $CALC->_signed_xor($x->{value},$y->{value},$sx,$sy); 2432 return $x->round(@r); 2433 } 2434 2435 require $EMU_LIB; 2436 __emu_bxor($self,$x,$y,$sx,$sy,@r); 2437 } 2438 2439sub length 2440 { 2441 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 2442 2443 my $e = $CALC->_len($x->{value}); 2444 wantarray ? ($e,0) : $e; 2445 } 2446 2447sub digit 2448 { 2449 # return the nth decimal digit, negative values count backward, 0 is right 2450 my ($self,$x,$n) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 2451 2452 $n = $n->numify() if ref($n); 2453 $CALC->_digit($x->{value},$n||0); 2454 } 2455 2456sub _trailing_zeros 2457 { 2458 # return the amount of trailing zeros in $x (as scalar) 2459 my $x = shift; 2460 $x = $class->new($x) unless ref $x; 2461 2462 return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc 2463 2464 $CALC->_zeros($x->{value}); # must handle odd values, 0 etc 2465 } 2466 2467sub bsqrt 2468 { 2469 # calculate square root of $x 2470 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 2471 2472 return $x if $x->modify('bsqrt'); 2473 2474 return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN 2475 return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf 2476 2477 return $upgrade->bsqrt($x,@r) if defined $upgrade; 2478 2479 $x->{value} = $CALC->_sqrt($x->{value}); 2480 $x->round(@r); 2481 } 2482 2483sub broot 2484 { 2485 # calculate $y'th root of $x 2486 2487 # set up parameters 2488 my ($self,$x,$y,@r) = (ref($_[0]),@_); 2489 2490 $y = $self->new(2) unless defined $y; 2491 2492 # objectify is costly, so avoid it 2493 if ((!ref($x)) || (ref($x) ne ref($y))) 2494 { 2495 ($self,$x,$y,@r) = objectify(2,$self || $class,@_); 2496 } 2497 2498 return $x if $x->modify('broot'); 2499 2500 # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0 2501 return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() || 2502 $y->{sign} !~ /^\+$/; 2503 2504 return $x->round(@r) 2505 if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one(); 2506 2507 return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade; 2508 2509 $x->{value} = $CALC->_root($x->{value},$y->{value}); 2510 $x->round(@r); 2511 } 2512 2513sub exponent 2514 { 2515 # return a copy of the exponent (here always 0, NaN or 1 for $m == 0) 2516 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 2517 2518 if ($x->{sign} !~ /^[+-]$/) 2519 { 2520 my $s = $x->{sign}; $s =~ s/^[+-]//; # NaN, -inf,+inf => NaN or inf 2521 return $self->new($s); 2522 } 2523 return $self->bzero() if $x->is_zero(); 2524 2525 # 12300 => 2 trailing zeros => exponent is 2 2526 $self->new( $CALC->_zeros($x->{value}) ); 2527 } 2528 2529sub mantissa 2530 { 2531 # return the mantissa (compatible to Math::BigFloat, e.g. reduced) 2532 my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); 2533 2534 if ($x->{sign} !~ /^[+-]$/) 2535 { 2536 # for NaN, +inf, -inf: keep the sign 2537 return $self->new($x->{sign}); 2538 } 2539 my $m = $x->copy(); delete $m->{_p}; delete $m->{_a}; 2540 2541 # that's a bit inefficient: 2542 my $zeros = $CALC->_zeros($m->{value}); 2543 $m->brsft($zeros,10) if $zeros != 0; 2544 $m; 2545 } 2546 2547sub parts 2548 { 2549 # return a copy of both the exponent and the mantissa 2550 my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); 2551 2552 ($x->mantissa(),$x->exponent()); 2553 } 2554 2555############################################################################## 2556# rounding functions 2557 2558sub bfround 2559 { 2560 # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' 2561 # $n == 0 || $n == 1 => round to integer 2562 my $x = shift; my $self = ref($x) || $x; $x = $self->new($x) unless ref $x; 2563 2564 my ($scale,$mode) = $x->_scale_p(@_); 2565 2566 return $x if !defined $scale || $x->modify('bfround'); # no-op 2567 2568 # no-op for BigInts if $n <= 0 2569 $x->bround( $x->length()-$scale, $mode) if $scale > 0; 2570 2571 delete $x->{_a}; # delete to save memory 2572 $x->{_p} = $scale; # store new _p 2573 $x; 2574 } 2575 2576sub _scan_for_nonzero 2577 { 2578 # internal, used by bround() to scan for non-zeros after a '5' 2579 my ($x,$pad,$xs,$len) = @_; 2580 2581 return 0 if $len == 1; # "5" is trailed by invisible zeros 2582 my $follow = $pad - 1; 2583 return 0 if $follow > $len || $follow < 1; 2584 2585 # use the string form to check whether only '0's follow or not 2586 substr ($xs,-$follow) =~ /[^0]/ ? 1 : 0; 2587 } 2588 2589sub fround 2590 { 2591 # Exists to make life easier for switch between MBF and MBI (should we 2592 # autoload fxxx() like MBF does for bxxx()?) 2593 my $x = shift; $x = $class->new($x) unless ref $x; 2594 $x->bround(@_); 2595 } 2596 2597sub bround 2598 { 2599 # accuracy: +$n preserve $n digits from left, 2600 # -$n preserve $n digits from right (f.i. for 0.1234 style in MBF) 2601 # no-op for $n == 0 2602 # and overwrite the rest with 0's, return normalized number 2603 # do not return $x->bnorm(), but $x 2604 2605 my $x = shift; $x = $class->new($x) unless ref $x; 2606 my ($scale,$mode) = $x->_scale_a(@_); 2607 return $x if !defined $scale || $x->modify('bround'); # no-op 2608 2609 if ($x->is_zero() || $scale == 0) 2610 { 2611 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2 2612 return $x; 2613 } 2614 return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN 2615 2616 # we have fewer digits than we want to scale to 2617 my $len = $x->length(); 2618 # convert $scale to a scalar in case it is an object (put's a limit on the 2619 # number length, but this would already limited by memory constraints), makes 2620 # it faster 2621 $scale = $scale->numify() if ref ($scale); 2622 2623 # scale < 0, but > -len (not >=!) 2624 if (($scale < 0 && $scale < -$len-1) || ($scale >= $len)) 2625 { 2626 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2 2627 return $x; 2628 } 2629 2630 # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6 2631 my ($pad,$digit_round,$digit_after); 2632 $pad = $len - $scale; 2633 $pad = abs($scale-1) if $scale < 0; 2634 2635 # do not use digit(), it is very costly for binary => decimal 2636 # getting the entire string is also costly, but we need to do it only once 2637 my $xs = $CALC->_str($x->{value}); 2638 my $pl = -$pad-1; 2639 2640 # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4 2641 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3 2642 $digit_round = '0'; $digit_round = substr($xs,$pl,1) if $pad <= $len; 2643 $pl++; $pl ++ if $pad >= $len; 2644 $digit_after = '0'; $digit_after = substr($xs,$pl,1) if $pad > 0; 2645 2646 # in case of 01234 we round down, for 6789 up, and only in case 5 we look 2647 # closer at the remaining digits of the original $x, remember decision 2648 my $round_up = 1; # default round up 2649 $round_up -- if 2650 ($mode eq 'trunc') || # trunc by round down 2651 ($digit_after =~ /[01234]/) || # round down anyway, 2652 # 6789 => round up 2653 ($digit_after eq '5') && # not 5000...0000 2654 ($x->_scan_for_nonzero($pad,$xs,$len) == 0) && 2655 ( 2656 ($mode eq 'even') && ($digit_round =~ /[24680]/) || 2657 ($mode eq 'odd') && ($digit_round =~ /[13579]/) || 2658 ($mode eq '+inf') && ($x->{sign} eq '-') || 2659 ($mode eq '-inf') && ($x->{sign} eq '+') || 2660 ($mode eq 'zero') # round down if zero, sign adjusted below 2661 ); 2662 my $put_back = 0; # not yet modified 2663 2664 if (($pad > 0) && ($pad <= $len)) 2665 { 2666 substr($xs,-$pad,$pad) = '0' x $pad; # replace with '00...' 2667 $put_back = 1; # need to put back 2668 } 2669 elsif ($pad > $len) 2670 { 2671 $x->bzero(); # round to '0' 2672 } 2673 2674 if ($round_up) # what gave test above? 2675 { 2676 $put_back = 1; # need to put back 2677 $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0 2678 2679 # we modify directly the string variant instead of creating a number and 2680 # adding it, since that is faster (we already have the string) 2681 my $c = 0; $pad ++; # for $pad == $len case 2682 while ($pad <= $len) 2683 { 2684 $c = substr($xs,-$pad,1) + 1; $c = '0' if $c eq '10'; 2685 substr($xs,-$pad,1) = $c; $pad++; 2686 last if $c != 0; # no overflow => early out 2687 } 2688 $xs = '1'.$xs if $c == 0; 2689 2690 } 2691 $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed 2692 2693 $x->{_a} = $scale if $scale >= 0; 2694 if ($scale < 0) 2695 { 2696 $x->{_a} = $len+$scale; 2697 $x->{_a} = 0 if $scale < -$len; 2698 } 2699 $x; 2700 } 2701 2702sub bfloor 2703 { 2704 # round towards minus infinity; no-op since it's already integer 2705 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 2706 2707 $x->round(@r); 2708 } 2709 2710sub bceil 2711 { 2712 # round towards plus infinity; no-op since it's already int 2713 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 2714 2715 $x->round(@r); 2716 } 2717 2718sub bint { 2719 # round towards zero; no-op since it's already integer 2720 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 2721 2722 $x->round(@r); 2723} 2724 2725sub as_number 2726 { 2727 # An object might be asked to return itself as bigint on certain overloaded 2728 # operations. This does exactly this, so that sub classes can simple inherit 2729 # it or override with their own integer conversion routine. 2730 $_[0]->copy(); 2731 } 2732 2733sub as_hex 2734 { 2735 # return as hex string, with prefixed 0x 2736 my $x = shift; $x = $class->new($x) if !ref($x); 2737 2738 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc 2739 2740 my $s = ''; 2741 $s = $x->{sign} if $x->{sign} eq '-'; 2742 $s . $CALC->_as_hex($x->{value}); 2743 } 2744 2745sub as_bin 2746 { 2747 # return as binary string, with prefixed 0b 2748 my $x = shift; $x = $class->new($x) if !ref($x); 2749 2750 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc 2751 2752 my $s = ''; $s = $x->{sign} if $x->{sign} eq '-'; 2753 return $s . $CALC->_as_bin($x->{value}); 2754 } 2755 2756sub as_oct 2757 { 2758 # return as octal string, with prefixed 0 2759 my $x = shift; $x = $class->new($x) if !ref($x); 2760 2761 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc 2762 2763 my $oct = $CALC->_as_oct($x->{value}); 2764 return $x->{sign} eq '-' ? "-$oct" : $oct; 2765 } 2766 2767############################################################################## 2768# private stuff (internal use only) 2769 2770sub objectify { 2771 # Convert strings and "foreign objects" to the objects we want. 2772 2773 # The first argument, $count, is the number of following arguments that 2774 # objectify() looks at and converts to objects. The first is a classname. 2775 # If the given count is 0, all arguments will be used. 2776 2777 # After the count is read, objectify obtains the name of the class to which 2778 # the following arguments are converted. If the second argument is a 2779 # reference, use the reference type as the class name. Otherwise, if it is 2780 # a string that looks like a class name, use that. Otherwise, use $class. 2781 2782 # Caller: Gives us: 2783 # 2784 # $x->badd(1); => ref x, scalar y 2785 # Class->badd(1,2); => classname x (scalar), scalar x, scalar y 2786 # Class->badd(Class->(1),2); => classname x (scalar), ref x, scalar y 2787 # Math::BigInt::badd(1,2); => scalar x, scalar y 2788 2789 # A shortcut for the common case $x->unary_op(): 2790 2791 return (ref($_[1]), $_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]); 2792 2793 # Check the context. 2794 2795 unless (wantarray) { 2796 require Carp; 2797 Carp::croak ("${class}::objectify() needs list context"); 2798 } 2799 2800 # Get the number of arguments to objectify. 2801 2802 my $count = shift; 2803 $count ||= @_; 2804 2805 # Initialize the output array. 2806 2807 my @a = @_; 2808 2809 # If the first argument is a reference, use that reference type as our 2810 # class name. Otherwise, if the first argument looks like a class name, 2811 # then use that as our class name. Otherwise, use the default class name. 2812 2813 { 2814 if (ref($a[0])) { # reference? 2815 unshift @a, ref($a[0]); 2816 last; 2817 } 2818 if ($a[0] =~ /^[A-Z].*::/) { # string with class name? 2819 last; 2820 } 2821 unshift @a, $class; # default class name 2822 } 2823 2824 no strict 'refs'; 2825 2826 # What we upgrade to, if anything. 2827 2828 my $up = ${"$a[0]::upgrade"}; 2829 2830 # Disable downgrading, because Math::BigFloat -> foo('1.0','2.0') needs 2831 # floats. 2832 2833 my $down; 2834 if (defined ${"$a[0]::downgrade"}) { 2835 $down = ${"$a[0]::downgrade"}; 2836 ${"$a[0]::downgrade"} = undef; 2837 } 2838 2839 for my $i (1 .. $count) { 2840 my $ref = ref $a[$i]; 2841 2842 # Perl scalars are fed to the appropriate constructor. 2843 2844 unless ($ref) { 2845 $a[$i] = $a[0] -> new($a[$i]); 2846 next; 2847 } 2848 2849 # If it is an object of the right class, all is fine. 2850 2851 next if $ref -> isa($a[0]); 2852 2853 # Upgrading is OK, so skip further tests if the argument is upgraded. 2854 2855 if (defined $up && $ref -> isa($up)) { 2856 next; 2857 } 2858 2859 # See if we can call one of the as_xxx() methods. We don't know whether 2860 # the as_xxx() method returns an object or a scalar, so re-check 2861 # afterwards. 2862 2863 my $recheck = 0; 2864 2865 if ($a[0] -> isa('Math::BigInt')) { 2866 if ($a[$i] -> can('as_int')) { 2867 $a[$i] = $a[$i] -> as_int(); 2868 $recheck = 1; 2869 } elsif ($a[$i] -> can('as_number')) { 2870 $a[$i] = $a[$i] -> as_number(); 2871 $recheck = 1; 2872 } 2873 } 2874 2875 elsif ($a[0] -> isa('Math::BigFloat')) { 2876 if ($a[$i] -> can('as_float')) { 2877 $a[$i] = $a[$i] -> as_float(); 2878 $recheck = $1; 2879 } 2880 } 2881 2882 # If we called one of the as_xxx() methods, recheck. 2883 2884 if ($recheck) { 2885 $ref = ref($a[$i]); 2886 2887 # Perl scalars are fed to the appropriate constructor. 2888 2889 unless ($ref) { 2890 $a[$i] = $a[0] -> new($a[$i]); 2891 next; 2892 } 2893 2894 # If it is an object of the right class, all is fine. 2895 2896 next if $ref -> isa($a[0]); 2897 } 2898 2899 # Last resort. 2900 2901 $a[$i] = $a[0] -> new($a[$i]); 2902 } 2903 2904 # Reset the downgrading. 2905 2906 ${"$a[0]::downgrade"} = $down; 2907 2908 return @a; 2909} 2910 2911sub _register_callback 2912 { 2913 my ($class,$callback) = @_; 2914 2915 if (ref($callback) ne 'CODE') 2916 { 2917 require Carp; 2918 Carp::croak ("$callback is not a coderef"); 2919 } 2920 $CALLBACKS{$class} = $callback; 2921 } 2922 2923sub import 2924 { 2925 my $self = shift; 2926 2927 $IMPORT++; # remember we did import() 2928 my @a; my $l = scalar @_; 2929 my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die 2930 for ( my $i = 0; $i < $l ; $i++ ) 2931 { 2932 if ($_[$i] eq ':constant') 2933 { 2934 # this causes overlord er load to step in 2935 overload::constant 2936 integer => sub { $self->new(shift) }, 2937 binary => sub { $self->new(shift) }; 2938 } 2939 elsif ($_[$i] eq 'upgrade') 2940 { 2941 # this causes upgrading 2942 $upgrade = $_[$i+1]; # or undef to disable 2943 $i++; 2944 } 2945 elsif ($_[$i] =~ /^(lib|try|only)\z/) 2946 { 2947 # this causes a different low lib to take care... 2948 $CALC = $_[$i+1] || ''; 2949 # lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback) 2950 $warn_or_die = 1 if $_[$i] eq 'lib'; 2951 $warn_or_die = 2 if $_[$i] eq 'only'; 2952 $i++; 2953 } 2954 else 2955 { 2956 push @a, $_[$i]; 2957 } 2958 } 2959 # any non :constant stuff is handled by our parent, Exporter 2960 if (@a > 0) 2961 { 2962 require Exporter; 2963 2964 $self->SUPER::import(@a); # need it for subclasses 2965 $self->export_to_level(1,$self,@a); # need it for MBF 2966 } 2967 2968 # try to load core math lib 2969 my @c = split /\s*,\s*/,$CALC; 2970 foreach (@c) 2971 { 2972 $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters 2973 } 2974 push @c, \'Calc' # if all fail, try these 2975 if $warn_or_die < 2; # but not for "only" 2976 $CALC = ''; # signal error 2977 foreach my $l (@c) 2978 { 2979 # fallback libraries are "marked" as \'string', extract string if nec. 2980 my $lib = $l; $lib = $$l if ref($l); 2981 2982 next if ($lib || '') eq ''; 2983 $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i; 2984 $lib =~ s/\.pm$//; 2985 if ($] < 5.006) 2986 { 2987 # Perl < 5.6.0 dies with "out of memory!" when eval("") and ':constant' is 2988 # used in the same script, or eval("") inside import(). 2989 my @parts = split /::/, $lib; # Math::BigInt => Math BigInt 2990 my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm 2991 require File::Spec; 2992 $file = File::Spec->catfile (@parts, $file); 2993 eval { require "$file"; $lib->import( @c ); } 2994 } 2995 else 2996 { 2997 eval "use $lib qw/@c/;"; 2998 } 2999 if ($@ eq '') 3000 { 3001 my $ok = 1; 3002 # loaded it ok, see if the api_version() is high enough 3003 if ($lib->can('api_version') && $lib->api_version() >= 1.0) 3004 { 3005 $ok = 0; 3006 # api_version matches, check if it really provides anything we need 3007 for my $method (qw/ 3008 one two ten 3009 str num 3010 add mul div sub dec inc 3011 acmp len digit is_one is_zero is_even is_odd 3012 is_two is_ten 3013 zeros new copy check 3014 from_hex from_oct from_bin as_hex as_bin as_oct 3015 rsft lsft xor and or 3016 mod sqrt root fac pow modinv modpow log_int gcd 3017 /) 3018 { 3019 if (!$lib->can("_$method")) 3020 { 3021 if (($WARN{$lib}||0) < 2) 3022 { 3023 require Carp; 3024 Carp::carp ("$lib is missing method '_$method'"); 3025 $WARN{$lib} = 1; # still warn about the lib 3026 } 3027 $ok++; last; 3028 } 3029 } 3030 } 3031 if ($ok == 0) 3032 { 3033 $CALC = $lib; 3034 if ($warn_or_die > 0 && ref($l)) 3035 { 3036 require Carp; 3037 my $msg = 3038 "Math::BigInt: couldn't load specified math lib(s), fallback to $lib"; 3039 Carp::carp ($msg) if $warn_or_die == 1; 3040 Carp::croak ($msg) if $warn_or_die == 2; 3041 } 3042 last; # found a usable one, break 3043 } 3044 else 3045 { 3046 if (($WARN{$lib}||0) < 2) 3047 { 3048 my $ver = eval "\$$lib\::VERSION" || 'unknown'; 3049 require Carp; 3050 Carp::carp ("Cannot load outdated $lib v$ver, please upgrade"); 3051 $WARN{$lib} = 2; # never warn again 3052 } 3053 } 3054 } 3055 } 3056 if ($CALC eq '') 3057 { 3058 require Carp; 3059 if ($warn_or_die == 2) 3060 { 3061 Carp::croak( 3062 "Couldn't load specified math lib(s) and fallback disallowed"); 3063 } 3064 else 3065 { 3066 Carp::croak( 3067 "Couldn't load any math lib(s), not even fallback to Calc.pm"); 3068 } 3069 } 3070 3071 # notify callbacks 3072 foreach my $class (keys %CALLBACKS) 3073 { 3074 &{$CALLBACKS{$class}}($CALC); 3075 } 3076 3077 # Fill $CAN with the results of $CALC->can(...) for emulating lower math lib 3078 # functions 3079 3080 %CAN = (); 3081 for my $method (qw/ signed_and signed_or signed_xor /) 3082 { 3083 $CAN{$method} = $CALC->can("_$method") ? 1 : 0; 3084 } 3085 3086 # import done 3087 } 3088 3089# Create a Math::BigInt from a hexadecimal string. 3090 3091sub from_hex { 3092 my $self = shift; 3093 my $selfref = ref $self; 3094 my $class = $selfref || $self; 3095 3096 my $str = shift; 3097 3098 # If called as a class method, initialize a new object. 3099 3100 $self = $class -> bzero() unless $selfref; 3101 3102 if ($str =~ s/ 3103 ^ 3104 ( [+-]? ) 3105 (0?x)? 3106 ( 3107 [0-9a-fA-F]* 3108 ( _ [0-9a-fA-F]+ )* 3109 ) 3110 $ 3111 //x) 3112 { 3113 # Get a "clean" version of the string, i.e., non-emtpy and with no 3114 # underscores or invalid characters. 3115 3116 my $sign = $1; 3117 my $chrs = $3; 3118 $chrs =~ tr/_//d; 3119 $chrs = '0' unless CORE::length $chrs; 3120 3121 # The library method requires a prefix. 3122 3123 $self->{value} = $CALC->_from_hex('0x' . $chrs); 3124 3125 # Place the sign. 3126 3127 if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) { 3128 $self->{sign} = '-'; 3129 } 3130 3131 return $self; 3132 } 3133 3134 # CORE::hex() parses as much as it can, and ignores any trailing garbage. 3135 # For backwards compatibility, we return NaN. 3136 3137 return $self->bnan(); 3138} 3139 3140# Create a Math::BigInt from an octal string. 3141 3142sub from_oct { 3143 my $self = shift; 3144 my $selfref = ref $self; 3145 my $class = $selfref || $self; 3146 3147 my $str = shift; 3148 3149 # If called as a class method, initialize a new object. 3150 3151 $self = $class -> bzero() unless $selfref; 3152 3153 if ($str =~ s/ 3154 ^ 3155 ( [+-]? ) 3156 ( 3157 [0-7]* 3158 ( _ [0-7]+ )* 3159 ) 3160 $ 3161 //x) 3162 { 3163 # Get a "clean" version of the string, i.e., non-emtpy and with no 3164 # underscores or invalid characters. 3165 3166 my $sign = $1; 3167 my $chrs = $2; 3168 $chrs =~ tr/_//d; 3169 $chrs = '0' unless CORE::length $chrs; 3170 3171 # The library method requires a prefix. 3172 3173 $self->{value} = $CALC->_from_oct('0' . $chrs); 3174 3175 # Place the sign. 3176 3177 if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) { 3178 $self->{sign} = '-'; 3179 } 3180 3181 return $self; 3182 } 3183 3184 # CORE::oct() parses as much as it can, and ignores any trailing garbage. 3185 # For backwards compatibility, we return NaN. 3186 3187 return $self->bnan(); 3188} 3189 3190# Create a Math::BigInt from a binary string. 3191 3192sub from_bin { 3193 my $self = shift; 3194 my $selfref = ref $self; 3195 my $class = $selfref || $self; 3196 3197 my $str = shift; 3198 3199 # If called as a class method, initialize a new object. 3200 3201 $self = $class -> bzero() unless $selfref; 3202 3203 if ($str =~ s/ 3204 ^ 3205 ( [+-]? ) 3206 (0?b)? 3207 ( 3208 [01]* 3209 ( _ [01]+ )* 3210 ) 3211 $ 3212 //x) 3213 { 3214 # Get a "clean" version of the string, i.e., non-emtpy and with no 3215 # underscores or invalid characters. 3216 3217 my $sign = $1; 3218 my $chrs = $3; 3219 $chrs =~ tr/_//d; 3220 $chrs = '0' unless CORE::length $chrs; 3221 3222 # The library method requires a prefix. 3223 3224 $self->{value} = $CALC->_from_bin('0b' . $chrs); 3225 3226 # Place the sign. 3227 3228 if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) { 3229 $self->{sign} = '-'; 3230 } 3231 3232 return $self; 3233 } 3234 3235 # For consistency with from_hex() and from_oct(), we return NaN when the 3236 # input is invalid. 3237 3238 return $self->bnan(); 3239} 3240 3241sub _split_dec_string { 3242 my $str = shift; 3243 3244 if ($str =~ s/ 3245 ^ 3246 3247 # leading whitespace 3248 ( \s* ) 3249 3250 # optional sign 3251 ( [+-]? ) 3252 3253 # significand 3254 ( 3255 \d+ (?: _ \d+ )* 3256 (?: 3257 \. 3258 (?: \d+ (?: _ \d+ )* )? 3259 )? 3260 | 3261 \. 3262 \d+ (?: _ \d+ )* 3263 ) 3264 3265 # optional exponent 3266 (?: 3267 [Ee] 3268 ( [+-]? ) 3269 ( \d+ (?: _ \d+ )* ) 3270 )? 3271 3272 # trailing stuff 3273 ( \D .*? )? 3274 3275 \z 3276 //x) 3277 { 3278 my $leading = $1; 3279 my $significand_sgn = $2 || '+'; 3280 my $significand_abs = $3; 3281 my $exponent_sgn = $4 || '+'; 3282 my $exponent_abs = $5 || '0'; 3283 my $trailing = $6; 3284 3285 # Remove underscores and leading zeros. 3286 3287 $significand_abs =~ tr/_//d; 3288 $exponent_abs =~ tr/_//d; 3289 3290 $significand_abs =~ s/^0+(.)/$1/; 3291 $exponent_abs =~ s/^0+(.)/$1/; 3292 3293 # If the significand contains a dot, remove it and adjust the exponent 3294 # accordingly. E.g., "1234.56789e+3" -> "123456789e-2" 3295 3296 my $idx = index $significand_abs, '.'; 3297 if ($idx > -1) { 3298 $significand_abs =~ s/0+\z//; 3299 substr($significand_abs, $idx, 1) = ''; 3300 my $exponent = $exponent_sgn . $exponent_abs; 3301 $exponent .= $idx - CORE::length($significand_abs); 3302 $exponent_abs = abs $exponent; 3303 $exponent_sgn = $exponent < 0 ? '-' : '+'; 3304 } 3305 3306 return($leading, 3307 $significand_sgn, $significand_abs, 3308 $exponent_sgn, $exponent_abs, 3309 $trailing); 3310 } 3311 3312 return undef; 3313} 3314 3315sub _split 3316 { 3317 # input: num_str; output: undef for invalid or 3318 # (\$mantissa_sign,\$mantissa_value,\$mantissa_fraction, 3319 # \$exp_sign,\$exp_value) 3320 # Internal, take apart a string and return the pieces. 3321 # Strip leading/trailing whitespace, leading zeros, underscore and reject 3322 # invalid input. 3323 my $x = shift; 3324 3325 # strip white space at front, also extraneous leading zeros 3326 $x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2' 3327 $x =~ s/^\s+//; # but this will 3328 $x =~ s/\s+$//g; # strip white space at end 3329 3330 # shortcut, if nothing to split, return early 3331 if ($x =~ /^[+-]?[0-9]+\z/) 3332 { 3333 $x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+'; 3334 return (\$sign, \$x, \'', \'', \0); 3335 } 3336 3337 # invalid starting char? 3338 return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/; 3339 3340 return Math::BigInt->from_hex($x) if $x =~ /^[+-]?0x/; # hex string 3341 return Math::BigInt->from_bin($x) if $x =~ /^[+-]?0b/; # binary string 3342 3343 # strip underscores between digits 3344 $x =~ s/([0-9])_([0-9])/$1$2/g; 3345 $x =~ s/([0-9])_([0-9])/$1$2/g; # do twice for 1_2_3 3346 3347 # some possible inputs: 3348 # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2 3349 # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2 # 0e999 3350 3351 my ($m,$e,$last) = split /[Ee]/,$x; 3352 return if defined $last; # last defined => 1e2E3 or others 3353 $e = '0' if !defined $e || $e eq ""; 3354 3355 # sign,value for exponent,mantint,mantfrac 3356 my ($es,$ev,$mis,$miv,$mfv); 3357 # valid exponent? 3358 if ($e =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros 3359 { 3360 $es = $1; $ev = $2; 3361 # valid mantissa? 3362 return if $m eq '.' || $m eq ''; 3363 my ($mi,$mf,$lastf) = split /\./,$m; 3364 return if defined $lastf; # lastf defined => 1.2.3 or others 3365 $mi = '0' if !defined $mi; 3366 $mi .= '0' if $mi =~ /^[\-\+]?$/; 3367 $mf = '0' if !defined $mf || $mf eq ''; 3368 if ($mi =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros 3369 { 3370 $mis = $1||'+'; $miv = $2; 3371 return unless ($mf =~ /^([0-9]*?)0*$/); # strip trailing zeros 3372 $mfv = $1; 3373 # handle the 0e999 case here 3374 $ev = 0 if $miv eq '0' && $mfv eq ''; 3375 return (\$mis,\$miv,\$mfv,\$es,\$ev); 3376 } 3377 } 3378 return; # NaN, not a number 3379 } 3380 3381############################################################################## 3382# internal calculation routines (others are in Math::BigInt::Calc etc) 3383 3384sub __lcm 3385 { 3386 # (BINT or num_str, BINT or num_str) return BINT 3387 # does modify first argument 3388 # LCM 3389 3390 my ($x,$ty) = @_; 3391 return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan); 3392 my $method = ref($x) . '::bgcd'; 3393 no strict 'refs'; 3394 $x * $ty / &$method($x,$ty); 3395 } 3396 3397############################################################################### 3398# trigonometric functions 3399 3400sub bpi 3401 { 3402 # Calculate PI to N digits. Unless upgrading is in effect, returns the 3403 # result truncated to an integer, that is, always returns '3'. 3404 my ($self,$n) = @_; 3405 if (@_ == 1) 3406 { 3407 # called like Math::BigInt::bpi(10); 3408 $n = $self; $self = $class; 3409 } 3410 $self = ref($self) if ref($self); 3411 3412 return $upgrade->new($n) if defined $upgrade; 3413 3414 # hard-wired to "3" 3415 $self->new(3); 3416 } 3417 3418sub bcos 3419 { 3420 # Calculate cosinus(x) to N digits. Unless upgrading is in effect, returns the 3421 # result truncated to an integer. 3422 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 3423 3424 return $x if $x->modify('bcos'); 3425 3426 return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN 3427 3428 return $upgrade->new($x)->bcos(@r) if defined $upgrade; 3429 3430 require Math::BigFloat; 3431 # calculate the result and truncate it to integer 3432 my $t = Math::BigFloat->new($x)->bcos(@r)->as_int(); 3433 3434 $x->bone() if $t->is_one(); 3435 $x->bzero() if $t->is_zero(); 3436 $x->round(@r); 3437 } 3438 3439sub bsin 3440 { 3441 # Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the 3442 # result truncated to an integer. 3443 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 3444 3445 return $x if $x->modify('bsin'); 3446 3447 return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN 3448 3449 return $upgrade->new($x)->bsin(@r) if defined $upgrade; 3450 3451 require Math::BigFloat; 3452 # calculate the result and truncate it to integer 3453 my $t = Math::BigFloat->new($x)->bsin(@r)->as_int(); 3454 3455 $x->bone() if $t->is_one(); 3456 $x->bzero() if $t->is_zero(); 3457 $x->round(@r); 3458 } 3459 3460sub batan2 3461 { 3462 # calculate arcus tangens of ($y/$x) 3463 3464 # set up parameters 3465 my ($self,$y,$x,@r) = (ref($_[0]),@_); 3466 # objectify is costly, so avoid it 3467 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) 3468 { 3469 ($self,$y,$x,@r) = objectify(2,@_); 3470 } 3471 3472 return $y if $y->modify('batan2'); 3473 3474 return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan); 3475 3476 # Y X 3477 # != 0 -inf result is +- pi 3478 if ($x->is_inf() || $y->is_inf()) 3479 { 3480 # upgrade to BigFloat etc. 3481 return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade; 3482 if ($y->is_inf()) 3483 { 3484 if ($x->{sign} eq '-inf') 3485 { 3486 # calculate 3 pi/4 => 2.3.. => 2 3487 $y->bone( substr($y->{sign},0,1) ); 3488 $y->bmul($self->new(2)); 3489 } 3490 elsif ($x->{sign} eq '+inf') 3491 { 3492 # calculate pi/4 => 0.7 => 0 3493 $y->bzero(); 3494 } 3495 else 3496 { 3497 # calculate pi/2 => 1.5 => 1 3498 $y->bone( substr($y->{sign},0,1) ); 3499 } 3500 } 3501 else 3502 { 3503 if ($x->{sign} eq '+inf') 3504 { 3505 # calculate pi/4 => 0.7 => 0 3506 $y->bzero(); 3507 } 3508 else 3509 { 3510 # PI => 3.1415.. => 3 3511 $y->bone( substr($y->{sign},0,1) ); 3512 $y->bmul($self->new(3)); 3513 } 3514 } 3515 return $y; 3516 } 3517 3518 return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade; 3519 3520 require Math::BigFloat; 3521 my $r = Math::BigFloat->new($y) 3522 ->batan2(Math::BigFloat->new($x),@r) 3523 ->as_int(); 3524 3525 $x->{value} = $r->{value}; 3526 $x->{sign} = $r->{sign}; 3527 3528 $x; 3529 } 3530 3531sub batan 3532 { 3533 # Calculate arcus tangens of x to N digits. Unless upgrading is in effect, returns the 3534 # result truncated to an integer. 3535 my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); 3536 3537 return $x if $x->modify('batan'); 3538 3539 return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN 3540 3541 return $upgrade->new($x)->batan(@r) if defined $upgrade; 3542 3543 # calculate the result and truncate it to integer 3544 my $t = Math::BigFloat->new($x)->batan(@r); 3545 3546 $x->{value} = $CALC->_new( $x->as_int()->bstr() ); 3547 $x->round(@r); 3548 } 3549 3550############################################################################### 3551# this method returns 0 if the object can be modified, or 1 if not. 3552# We use a fast constant sub() here, to avoid costly calls. Subclasses 3553# may override it with special code (f.i. Math::BigInt::Constant does so) 3554 3555sub modify () { 0; } 3556 35571; 3558__END__ 3559 3560=pod 3561 3562=head1 NAME 3563 3564Math::BigInt - Arbitrary size integer/float math package 3565 3566=head1 SYNOPSIS 3567 3568 use Math::BigInt; 3569 3570 # or make it faster with huge numbers: install (optional) 3571 # Math::BigInt::GMP and always use (it will fall back to 3572 # pure Perl if the GMP library is not installed): 3573 # (See also the L<MATH LIBRARY> section!) 3574 3575 # will warn if Math::BigInt::GMP cannot be found 3576 use Math::BigInt lib => 'GMP'; 3577 3578 # to suppress the warning use this: 3579 # use Math::BigInt try => 'GMP'; 3580 3581 # dies if GMP cannot be loaded: 3582 # use Math::BigInt only => 'GMP'; 3583 3584 my $str = '1234567890'; 3585 my @values = (64,74,18); 3586 my $n = 1; my $sign = '-'; 3587 3588 # Number creation 3589 my $x = Math::BigInt->new($str); # defaults to 0 3590 my $y = $x->copy(); # make a true copy 3591 my $nan = Math::BigInt->bnan(); # create a NotANumber 3592 my $zero = Math::BigInt->bzero(); # create a +0 3593 my $inf = Math::BigInt->binf(); # create a +inf 3594 my $inf = Math::BigInt->binf('-'); # create a -inf 3595 my $one = Math::BigInt->bone(); # create a +1 3596 my $mone = Math::BigInt->bone('-'); # create a -1 3597 3598 my $pi = Math::BigInt->bpi(); # returns '3' 3599 # see Math::BigFloat::bpi() 3600 3601 $h = Math::BigInt->new('0x123'); # from hexadecimal 3602 $b = Math::BigInt->new('0b101'); # from binary 3603 $o = Math::BigInt->from_oct('0101'); # from octal 3604 $h = Math::BigInt->from_hex('cafe'); # from hexadecimal 3605 $b = Math::BigInt->from_bin('0101'); # from binary 3606 3607 # Testing (don't modify their arguments) 3608 # (return true if the condition is met, otherwise false) 3609 3610 $x->is_zero(); # if $x is +0 3611 $x->is_nan(); # if $x is NaN 3612 $x->is_one(); # if $x is +1 3613 $x->is_one('-'); # if $x is -1 3614 $x->is_odd(); # if $x is odd 3615 $x->is_even(); # if $x is even 3616 $x->is_pos(); # if $x > 0 3617 $x->is_neg(); # if $x < 0 3618 $x->is_inf($sign); # if $x is +inf, or -inf (sign is default '+') 3619 $x->is_int(); # if $x is an integer (not a float) 3620 3621 # comparing and digit/sign extraction 3622 $x->bcmp($y); # compare numbers (undef,<0,=0,>0) 3623 $x->bacmp($y); # compare absolutely (undef,<0,=0,>0) 3624 $x->sign(); # return the sign, either +,- or NaN 3625 $x->digit($n); # return the nth digit, counting from right 3626 $x->digit(-$n); # return the nth digit, counting from left 3627 3628 # The following all modify their first argument. If you want to pre- 3629 # serve $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for 3630 # why this is necessary when mixing $a = $b assignments with non-over- 3631 # loaded math. 3632 3633 $x->bzero(); # set $x to 0 3634 $x->bnan(); # set $x to NaN 3635 $x->bone(); # set $x to +1 3636 $x->bone('-'); # set $x to -1 3637 $x->binf(); # set $x to inf 3638 $x->binf('-'); # set $x to -inf 3639 3640 $x->bneg(); # negation 3641 $x->babs(); # absolute value 3642 $x->bsgn(); # sign function (-1, 0, 1, or NaN) 3643 $x->bnorm(); # normalize (no-op in BigInt) 3644 $x->bnot(); # two's complement (bit wise not) 3645 $x->binc(); # increment $x by 1 3646 $x->bdec(); # decrement $x by 1 3647 3648 $x->badd($y); # addition (add $y to $x) 3649 $x->bsub($y); # subtraction (subtract $y from $x) 3650 $x->bmul($y); # multiplication (multiply $x by $y) 3651 $x->bdiv($y); # divide, set $x to quotient 3652 # return (quo,rem) or quo if scalar 3653 3654 $x->bmuladd($y,$z); # $x = $x * $y + $z 3655 3656 $x->bmod($y); # modulus (x % y) 3657 $x->bmodpow($y,$mod); # modular exponentiation (($x ** $y) % $mod) 3658 $x->bmodinv($mod); # modular multiplicative inverse 3659 $x->bpow($y); # power of arguments (x ** y) 3660 $x->blsft($y); # left shift in base 2 3661 $x->brsft($y); # right shift in base 2 3662 # returns (quo,rem) or quo if in sca- 3663 # lar context 3664 $x->blsft($y,$n); # left shift by $y places in base $n 3665 $x->brsft($y,$n); # right shift by $y places in base $n 3666 # returns (quo,rem) or quo if in sca- 3667 # lar context 3668 3669 $x->band($y); # bitwise and 3670 $x->bior($y); # bitwise inclusive or 3671 $x->bxor($y); # bitwise exclusive or 3672 $x->bnot(); # bitwise not (two's complement) 3673 3674 $x->bsqrt(); # calculate square-root 3675 $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root) 3676 $x->bfac(); # factorial of $x (1*2*3*4*..$x) 3677 3678 $x->bnok($y); # x over y (binomial coefficient n over k) 3679 3680 $x->blog(); # logarithm of $x to base e (Euler's number) 3681 $x->blog($base); # logarithm of $x to base $base (f.i. 2) 3682 $x->bexp(); # calculate e ** $x where e is Euler's number 3683 3684 $x->round($A,$P,$mode); # round to accuracy or precision using 3685 # mode $mode 3686 $x->bround($n); # accuracy: preserve $n digits 3687 $x->bfround($n); # $n > 0: round $nth digits, 3688 # $n < 0: round to the $nth digit after the 3689 # dot, no-op for BigInts 3690 3691 # The following do not modify their arguments in BigInt (are no-ops), 3692 # but do so in BigFloat: 3693 3694 $x->bfloor(); # round towards minus infinity 3695 $x->bceil(); # round towards plus infinity 3696 $x->bint(); # round towards zero 3697 3698 # The following do not modify their arguments: 3699 3700 # greatest common divisor (no OO style) 3701 my $gcd = Math::BigInt::bgcd(@values); 3702 # lowest common multiple (no OO style) 3703 my $lcm = Math::BigInt::blcm(@values); 3704 3705 $x->length(); # return number of digits in number 3706 ($xl,$f) = $x->length(); # length of number and length of fraction 3707 # part, latter is always 0 digits long 3708 # for BigInts 3709 3710 $x->exponent(); # return exponent as BigInt 3711 $x->mantissa(); # return (signed) mantissa as BigInt 3712 $x->parts(); # return (mantissa,exponent) as BigInt 3713 $x->copy(); # make a true copy of $x (unlike $y = $x;) 3714 $x->as_int(); # return as BigInt (in BigInt: same as copy()) 3715 $x->numify(); # return as scalar (might overflow!) 3716 3717 # conversion to string (do not modify their argument) 3718 $x->bstr(); # normalized string (e.g. '3') 3719 $x->bsstr(); # norm. string in scientific notation (e.g. '3E0') 3720 $x->as_hex(); # as signed hexadecimal string with prefixed 0x 3721 $x->as_bin(); # as signed binary string with prefixed 0b 3722 $x->as_oct(); # as signed octal string with prefixed 0 3723 3724 3725 # precision and accuracy (see section about rounding for more) 3726 $x->precision(); # return P of $x (or global, if P of $x undef) 3727 $x->precision($n); # set P of $x to $n 3728 $x->accuracy(); # return A of $x (or global, if A of $x undef) 3729 $x->accuracy($n); # set A $x to $n 3730 3731 # Global methods 3732 Math::BigInt->precision(); # get/set global P for all BigInt objects 3733 Math::BigInt->accuracy(); # get/set global A for all BigInt objects 3734 Math::BigInt->round_mode(); # get/set global round mode, one of 3735 # 'even', 'odd', '+inf', '-inf', 'zero', 3736 # 'trunc' or 'common' 3737 Math::BigInt->config(); # return hash containing configuration 3738 3739=head1 DESCRIPTION 3740 3741All operators (including basic math operations) are overloaded if you 3742declare your big integers as 3743 3744 $i = Math::BigInt -> new('123_456_789_123_456_789'); 3745 3746Operations with overloaded operators preserve the arguments which is 3747exactly what you expect. 3748 3749=head2 Input 3750 3751Input values to these routines may be any string, that looks like a number 3752and results in an integer, including hexadecimal and binary numbers. 3753 3754Scalars holding numbers may also be passed, but note that non-integer numbers 3755may already have lost precision due to the conversion to float. Quote 3756your input if you want BigInt to see all the digits: 3757 3758 $x = Math::BigInt->new(12345678890123456789); # bad 3759 $x = Math::BigInt->new('12345678901234567890'); # good 3760 3761You can include one underscore between any two digits. 3762 3763This means integer values like 1.01E2 or even 1000E-2 are also accepted. 3764Non-integer values result in NaN. 3765 3766Hexadecimal (prefixed with "0x") and binary numbers (prefixed with "0b") 3767are accepted, too. Please note that octal numbers are not recognized 3768by new(), so the following will print "123": 3769 3770 perl -MMath::BigInt -le 'print Math::BigInt->new("0123")' 3771 3772To convert an octal number, use from_oct(); 3773 3774 perl -MMath::BigInt -le 'print Math::BigInt->from_oct("0123")' 3775 3776Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('') 3777results in 'NaN'. This might change in the future, so use always the following 3778explicit forms to get a zero or NaN: 3779 3780 $zero = Math::BigInt->bzero(); 3781 $nan = Math::BigInt->bnan(); 3782 3783C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers 3784are always stored in normalized form. If passed a string, creates a BigInt 3785object from the input. 3786 3787=head2 Output 3788 3789Output values are BigInt objects (normalized), except for the methods which 3790return a string (see L</SYNOPSIS>). 3791 3792Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>, 3793C<is_nan()>, etc.) return true or false, while others (C<bcmp()>, C<bacmp()>) 3794return either undef (if NaN is involved), <0, 0 or >0 and are suited for sort. 3795 3796=head1 METHODS 3797 3798Each of the methods below (except config(), accuracy() and precision()) 3799accepts three additional parameters. These arguments C<$A>, C<$P> and C<$R> 3800are C<accuracy>, C<precision> and C<round_mode>. Please see the section about 3801L</ACCURACY and PRECISION> for more information. 3802 3803=over 3804 3805=item config() 3806 3807 use Data::Dumper; 3808 3809 print Dumper ( Math::BigInt->config() ); 3810 print Math::BigInt->config()->{lib},"\n"; 3811 3812Returns a hash containing the configuration, e.g. the version number, lib 3813loaded etc. The following hash keys are currently filled in with the 3814appropriate information. 3815 3816 key Description 3817 Example 3818 ============================================================ 3819 lib Name of the low-level math library 3820 Math::BigInt::Calc 3821 lib_version Version of low-level math library (see 'lib') 3822 0.30 3823 class The class name of config() you just called 3824 Math::BigInt 3825 upgrade To which class math operations might be 3826 upgraded Math::BigFloat 3827 downgrade To which class math operations might be 3828 downgraded undef 3829 precision Global precision 3830 undef 3831 accuracy Global accuracy 3832 undef 3833 round_mode Global round mode 3834 even 3835 version version number of the class you used 3836 1.61 3837 div_scale Fallback accuracy for div 3838 40 3839 trap_nan If true, traps creation of NaN via croak() 3840 1 3841 trap_inf If true, traps creation of +inf/-inf via croak() 3842 1 3843 3844The following values can be set by passing C<config()> a reference to a hash: 3845 3846 trap_inf trap_nan 3847 upgrade downgrade precision accuracy round_mode div_scale 3848 3849Example: 3850 3851 $new_cfg = Math::BigInt->config( 3852 { trap_inf => 1, precision => 5 } 3853 ); 3854 3855=item accuracy() 3856 3857 $x->accuracy(5); # local for $x 3858 CLASS->accuracy(5); # global for all members of CLASS 3859 # Note: This also applies to new()! 3860 3861 $A = $x->accuracy(); # read out accuracy that affects $x 3862 $A = CLASS->accuracy(); # read out global accuracy 3863 3864Set or get the global or local accuracy, aka how many significant digits the 3865results have. If you set a global accuracy, then this also applies to new()! 3866 3867Warning! The accuracy I<sticks>, e.g. once you created a number under the 3868influence of C<< CLASS->accuracy($A) >>, all results from math operations with 3869that number will also be rounded. 3870 3871In most cases, you should probably round the results explicitly using one of 3872L</round()>, L</bround()> or L</bfround()> or by passing the desired accuracy 3873to the math operation as additional parameter: 3874 3875 my $x = Math::BigInt->new(30000); 3876 my $y = Math::BigInt->new(7); 3877 print scalar $x->copy()->bdiv($y, 2); # print 4300 3878 print scalar $x->copy()->bdiv($y)->bround(2); # print 4300 3879 3880Please see the section about L</ACCURACY and PRECISION> for further details. 3881 3882Value must be greater than zero. Pass an undef value to disable it: 3883 3884 $x->accuracy(undef); 3885 Math::BigInt->accuracy(undef); 3886 3887Returns the current accuracy. For C<< $x->accuracy() >> it will return either 3888the local accuracy, or if not defined, the global. This means the return value 3889represents the accuracy that will be in effect for $x: 3890 3891 $y = Math::BigInt->new(1234567); # unrounded 3892 print Math::BigInt->accuracy(4),"\n"; # set 4, print 4 3893 $x = Math::BigInt->new(123456); # $x will be automatic- 3894 # ally rounded! 3895 print "$x $y\n"; # '123500 1234567' 3896 print $x->accuracy(),"\n"; # will be 4 3897 print $y->accuracy(),"\n"; # also 4, since 3898 # global is 4 3899 print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5 3900 print $x->accuracy(),"\n"; # still 4 3901 print $y->accuracy(),"\n"; # 5, since global is 5 3902 3903Note: Works also for subclasses like Math::BigFloat. Each class has it's own 3904globals separated from Math::BigInt, but it is possible to subclass 3905Math::BigInt and make the globals of the subclass aliases to the ones from 3906Math::BigInt. 3907 3908=item precision() 3909 3910 $x->precision(-2); # local for $x, round at the second 3911 # digit right of the dot 3912 $x->precision(2); # ditto, round at the second digit 3913 # left of the dot 3914 3915 CLASS->precision(5); # Global for all members of CLASS 3916 # This also applies to new()! 3917 CLASS->precision(-5); # ditto 3918 3919 $P = CLASS->precision(); # read out global precision 3920 $P = $x->precision(); # read out precision that affects $x 3921 3922Note: You probably want to use L</accuracy()> instead. With L</accuracy()> you 3923set the number of digits each result should have, with L</precision()> you 3924set the place where to round! 3925 3926C<precision()> sets or gets the global or local precision, aka at which digit 3927before or after the dot to round all results. A set global precision also 3928applies to all newly created numbers! 3929 3930In Math::BigInt, passing a negative number precision has no effect since no 3931numbers have digits after the dot. In L<Math::BigFloat>, it will round all 3932results to P digits after the dot. 3933 3934Please see the section about L</ACCURACY and PRECISION> for further details. 3935 3936Pass an undef value to disable it: 3937 3938 $x->precision(undef); 3939 Math::BigInt->precision(undef); 3940 3941Returns the current precision. For C<< $x->precision() >> it will return either 3942the local precision of $x, or if not defined, the global. This means the return 3943value represents the prevision that will be in effect for $x: 3944 3945 $y = Math::BigInt->new(1234567); # unrounded 3946 print Math::BigInt->precision(4),"\n"; # set 4, print 4 3947 $x = Math::BigInt->new(123456); # will be automatically rounded 3948 print $x; # print "120000"! 3949 3950Note: Works also for subclasses like L<Math::BigFloat>. Each class has its 3951own globals separated from Math::BigInt, but it is possible to subclass 3952Math::BigInt and make the globals of the subclass aliases to the ones from 3953Math::BigInt. 3954 3955=item brsft() 3956 3957 $x->brsft($y,$n); 3958 3959Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and 39602, but others work, too. 3961 3962Right shifting usually amounts to dividing $x by $n ** $y and truncating the 3963result: 3964 3965 3966 $x = Math::BigInt->new(10); 3967 $x->brsft(1); # same as $x >> 1: 5 3968 $x = Math::BigInt->new(1234); 3969 $x->brsft(2,10); # result 12 3970 3971There is one exception, and that is base 2 with negative $x: 3972 3973 3974 $x = Math::BigInt->new(-5); 3975 print $x->brsft(1); 3976 3977This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the 3978result). 3979 3980=item new() 3981 3982 $x = Math::BigInt->new($str,$A,$P,$R); 3983 3984Creates a new BigInt object from a scalar or another BigInt object. The 3985input is accepted as decimal, hex (with leading '0x') or binary (with leading 3986'0b'). 3987 3988See L</Input> for more info on accepted input formats. 3989 3990=item from_oct() 3991 3992 $x = Math::BigInt->from_oct("0775"); # input is octal 3993 3994Interpret the input as an octal string and return the corresponding value. A 3995"0" (zero) prefix is optional. A single underscore character may be placed 3996right after the prefix, if present, or between any two digits. If the input is 3997invalid, a NaN is returned. 3998 3999=item from_hex() 4000 4001 $x = Math::BigInt->from_hex("0xcafe"); # input is hexadecimal 4002 4003Interpret input as a hexadecimal string. A "0x" or "x" prefix is optional. A 4004single underscore character may be placed right after the prefix, if present, 4005or between any two digits. If the input is invalid, a NaN is returned. 4006 4007=item from_bin() 4008 4009 $x = Math::BigInt->from_bin("0b10011"); # input is binary 4010 4011Interpret the input as a binary string. A "0b" or "b" prefix is optional. A 4012single underscore character may be placed right after the prefix, if present, 4013or between any two digits. If the input is invalid, a NaN is returned. 4014 4015=item bnan() 4016 4017 $x = Math::BigInt->bnan(); 4018 4019Creates a new BigInt object representing NaN (Not A Number). 4020If used on an object, it will set it to NaN: 4021 4022 $x->bnan(); 4023 4024=item bzero() 4025 4026 $x = Math::BigInt->bzero(); 4027 4028Creates a new BigInt object representing zero. 4029If used on an object, it will set it to zero: 4030 4031 $x->bzero(); 4032 4033=item binf() 4034 4035 $x = Math::BigInt->binf($sign); 4036 4037Creates a new BigInt object representing infinity. The optional argument is 4038either '-' or '+', indicating whether you want infinity or minus infinity. 4039If used on an object, it will set it to infinity: 4040 4041 $x->binf(); 4042 $x->binf('-'); 4043 4044=item bone() 4045 4046 $x = Math::BigInt->binf($sign); 4047 4048Creates a new BigInt object representing one. The optional argument is 4049either '-' or '+', indicating whether you want one or minus one. 4050If used on an object, it will set it to one: 4051 4052 $x->bone(); # +1 4053 $x->bone('-'); # -1 4054 4055=item is_one()/is_zero()/is_nan()/is_inf() 4056 4057 $x->is_zero(); # true if arg is +0 4058 $x->is_nan(); # true if arg is NaN 4059 $x->is_one(); # true if arg is +1 4060 $x->is_one('-'); # true if arg is -1 4061 $x->is_inf(); # true if +inf 4062 $x->is_inf('-'); # true if -inf (sign is default '+') 4063 4064These methods all test the BigInt for being one specific value and return 4065true or false depending on the input. These are faster than doing something 4066like: 4067 4068 if ($x == 0) 4069 4070=item is_pos()/is_neg()/is_positive()/is_negative() 4071 4072 $x->is_pos(); # true if > 0 4073 $x->is_neg(); # true if < 0 4074 4075The methods return true if the argument is positive or negative, respectively. 4076C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and 4077C<-inf> is negative. A C<zero> is neither positive nor negative. 4078 4079These methods are only testing the sign, and not the value. 4080 4081C<is_positive()> and C<is_negative()> are aliases to C<is_pos()> and 4082C<is_neg()>, respectively. C<is_positive()> and C<is_negative()> were 4083introduced in v1.36, while C<is_pos()> and C<is_neg()> were only introduced 4084in v1.68. 4085 4086=item is_odd()/is_even()/is_int() 4087 4088 $x->is_odd(); # true if odd, false for even 4089 $x->is_even(); # true if even, false for odd 4090 $x->is_int(); # true if $x is an integer 4091 4092The return true when the argument satisfies the condition. C<NaN>, C<+inf>, 4093C<-inf> are not integers and are neither odd nor even. 4094 4095In BigInt, all numbers except C<NaN>, C<+inf> and C<-inf> are integers. 4096 4097=item bcmp() 4098 4099 $x->bcmp($y); 4100 4101Compares $x with $y and takes the sign into account. 4102Returns -1, 0, 1 or undef. 4103 4104=item bacmp() 4105 4106 $x->bacmp($y); 4107 4108Compares $x with $y while ignoring their sign. Returns -1, 0, 1 or undef. 4109 4110=item sign() 4111 4112 $x->sign(); 4113 4114Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN. 4115 4116If you want $x to have a certain sign, use one of the following methods: 4117 4118 $x->babs(); # '+' 4119 $x->babs()->bneg(); # '-' 4120 $x->bnan(); # 'NaN' 4121 $x->binf(); # '+inf' 4122 $x->binf('-'); # '-inf' 4123 4124=item digit() 4125 4126 $x->digit($n); # return the nth digit, counting from right 4127 4128If C<$n> is negative, returns the digit counting from left. 4129 4130=item bneg() 4131 4132 $x->bneg(); 4133 4134Negate the number, e.g. change the sign between '+' and '-', or between '+inf' 4135and '-inf', respectively. Does nothing for NaN or zero. 4136 4137=item babs() 4138 4139 $x->babs(); 4140 4141Set the number to its absolute value, e.g. change the sign from '-' to '+' 4142and from '-inf' to '+inf', respectively. Does nothing for NaN or positive 4143numbers. 4144 4145=item bsgn() 4146 4147 $x->bsgn(); 4148 4149Signum function. Set the number to -1, 0, or 1, depending on whether the 4150number is negative, zero, or positive, respectively. Does not modify NaNs. 4151 4152=item bnorm() 4153 4154 $x->bnorm(); # normalize (no-op) 4155 4156=item bnot() 4157 4158 $x->bnot(); 4159 4160Two's complement (bitwise not). This is equivalent to 4161 4162 $x->binc()->bneg(); 4163 4164but faster. 4165 4166=item binc() 4167 4168 $x->binc(); # increment x by 1 4169 4170=item bdec() 4171 4172 $x->bdec(); # decrement x by 1 4173 4174=item badd() 4175 4176 $x->badd($y); # addition (add $y to $x) 4177 4178=item bsub() 4179 4180 $x->bsub($y); # subtraction (subtract $y from $x) 4181 4182=item bmul() 4183 4184 $x->bmul($y); # multiplication (multiply $x by $y) 4185 4186=item bmuladd() 4187 4188 $x->bmuladd($y,$z); 4189 4190Multiply $x by $y, and then add $z to the result, 4191 4192This method was added in v1.87 of Math::BigInt (June 2007). 4193 4194=item bdiv() 4195 4196 $x->bdiv($y); # divide, set $x to quotient 4197 4198Returns $x divided by $y. In list context, does floored division (F-division), 4199where the quotient is the greatest integer less than or equal to the quotient 4200of the two operands. Consequently, the remainder is either zero or has the same 4201sign as the second operand. In scalar context, only the quotient is returned. 4202 4203=item bmod() 4204 4205 $x->bmod($y); # modulus (x % y) 4206 4207Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the 4208result is identical to the remainder after floored division (F-division), i.e., 4209identical to the result from Perl's % operator. 4210 4211=item bmodinv() 4212 4213 $x->bmodinv($mod); # modular multiplicative inverse 4214 4215Returns the multiplicative inverse of C<$x> modulo C<$mod>. If 4216 4217 $y = $x -> copy() -> bmodinv($mod) 4218 4219then C<$y> is the number closest to zero, and with the same sign as C<$mod>, 4220satisfying 4221 4222 ($x * $y) % $mod = 1 % $mod 4223 4224If C<$x> and C<$y> are non-zero, they must be relative primes, i.e., 4225C<bgcd($y, $mod)==1>. 'C<NaN>' is returned when no modular multiplicative 4226inverse exists. 4227 4228=item bmodpow() 4229 4230 $num->bmodpow($exp,$mod); # modular exponentiation 4231 # ($num**$exp % $mod) 4232 4233Returns the value of C<$num> taken to the power C<$exp> in the modulus 4234C<$mod> using binary exponentiation. C<bmodpow> is far superior to 4235writing 4236 4237 $num ** $exp % $mod 4238 4239because it is much faster - it reduces internal variables into 4240the modulus whenever possible, so it operates on smaller numbers. 4241 4242C<bmodpow> also supports negative exponents. 4243 4244 bmodpow($num, -1, $mod) 4245 4246is exactly equivalent to 4247 4248 bmodinv($num, $mod) 4249 4250=item bpow() 4251 4252 $x->bpow($y); # power of arguments (x ** y) 4253 4254=item blog() 4255 4256 $x->blog($base, $accuracy); # logarithm of x to the base $base 4257 4258If C<$base> is not defined, Euler's number (e) is used: 4259 4260 print $x->blog(undef, 100); # log(x) to 100 digits 4261 4262=item bexp() 4263 4264 $x->bexp($accuracy); # calculate e ** X 4265 4266Calculates the expression C<e ** $x> where C<e> is Euler's number. 4267 4268This method was added in v1.82 of Math::BigInt (April 2007). 4269 4270See also L</blog()>. 4271 4272=item bnok() 4273 4274 $x->bnok($y); # x over y (binomial coefficient n over k) 4275 4276Calculates the binomial coefficient n over k, also called the "choose" 4277function. The result is equivalent to: 4278 4279 ( n ) n! 4280 | - | = ------- 4281 ( k ) k!(n-k)! 4282 4283This method was added in v1.84 of Math::BigInt (April 2007). 4284 4285=item bpi() 4286 4287 print Math::BigInt->bpi(100), "\n"; # 3 4288 4289Returns PI truncated to an integer, with the argument being ignored. This means 4290under BigInt this always returns C<3>. 4291 4292If upgrading is in effect, returns PI, rounded to N digits with the 4293current rounding mode: 4294 4295 use Math::BigFloat; 4296 use Math::BigInt upgrade => Math::BigFloat; 4297 print Math::BigInt->bpi(3), "\n"; # 3.14 4298 print Math::BigInt->bpi(100), "\n"; # 3.1415.... 4299 4300This method was added in v1.87 of Math::BigInt (June 2007). 4301 4302=item bcos() 4303 4304 my $x = Math::BigInt->new(1); 4305 print $x->bcos(100), "\n"; 4306 4307Calculate the cosinus of $x, modifying $x in place. 4308 4309In BigInt, unless upgrading is in effect, the result is truncated to an 4310integer. 4311 4312This method was added in v1.87 of Math::BigInt (June 2007). 4313 4314=item bsin() 4315 4316 my $x = Math::BigInt->new(1); 4317 print $x->bsin(100), "\n"; 4318 4319Calculate the sinus of $x, modifying $x in place. 4320 4321In BigInt, unless upgrading is in effect, the result is truncated to an 4322integer. 4323 4324This method was added in v1.87 of Math::BigInt (June 2007). 4325 4326=item batan2() 4327 4328 my $x = Math::BigInt->new(1); 4329 my $y = Math::BigInt->new(1); 4330 print $y->batan2($x), "\n"; 4331 4332Calculate the arcus tangens of C<$y> divided by C<$x>, modifying $y in place. 4333 4334In BigInt, unless upgrading is in effect, the result is truncated to an 4335integer. 4336 4337This method was added in v1.87 of Math::BigInt (June 2007). 4338 4339=item batan() 4340 4341 my $x = Math::BigFloat->new(0.5); 4342 print $x->batan(100), "\n"; 4343 4344Calculate the arcus tangens of $x, modifying $x in place. 4345 4346In BigInt, unless upgrading is in effect, the result is truncated to an 4347integer. 4348 4349This method was added in v1.87 of Math::BigInt (June 2007). 4350 4351=item blsft() 4352 4353 $x->blsft($y); # left shift in base 2 4354 $x->blsft($y,$n); # left shift, in base $n (like 10) 4355 4356=item brsft() 4357 4358 $x->brsft($y); # right shift in base 2 4359 $x->brsft($y,$n); # right shift, in base $n (like 10) 4360 4361=item band() 4362 4363 $x->band($y); # bitwise and 4364 4365=item bior() 4366 4367 $x->bior($y); # bitwise inclusive or 4368 4369=item bxor() 4370 4371 $x->bxor($y); # bitwise exclusive or 4372 4373=item bnot() 4374 4375 $x->bnot(); # bitwise not (two's complement) 4376 4377=item bsqrt() 4378 4379 $x->bsqrt(); # calculate square-root 4380 4381=item broot() 4382 4383 $x->broot($N); 4384 4385Calculates the N'th root of C<$x>. 4386 4387=item bfac() 4388 4389 $x->bfac(); # factorial of $x (1*2*3*4*..$x) 4390 4391=item round() 4392 4393 $x->round($A,$P,$round_mode); 4394 4395Round $x to accuracy C<$A> or precision C<$P> using the round mode 4396C<$round_mode>. 4397 4398=item bround() 4399 4400 $x->bround($N); # accuracy: preserve $N digits 4401 4402=item bfround() 4403 4404 $x->bfround($N); 4405 4406If N is > 0, rounds to the Nth digit from the left. If N < 0, rounds to 4407the Nth digit after the dot. Since BigInts are integers, the case N < 0 4408is a no-op for them. 4409 4410Examples: 4411 4412 Input N Result 4413 =================================================== 4414 123456.123456 3 123500 4415 123456.123456 2 123450 4416 123456.123456 -2 123456.12 4417 123456.123456 -3 123456.123 4418 4419=item bfloor() 4420 4421 $x->bfloor(); 4422 4423Round $x towards minus infinity (i.e., set $x to the largest integer less than 4424or equal to $x). This is a no-op in BigInt, but changes $x in BigFloat, if $x 4425is not an integer. 4426 4427=item bceil() 4428 4429 $x->bceil(); 4430 4431Round $x towards plus infinity (i.e., set $x to the smallest integer greater 4432than or equal to $x). This is a no-op in BigInt, but changes $x in BigFloat, if 4433$x is not an integer. 4434 4435=item bint() 4436 4437 $x->bint(); 4438 4439Round $x towards zero. This is a no-op in BigInt, but changes $x in BigFloat, 4440if $x is not an integer. 4441 4442=item bgcd() 4443 4444 bgcd(@values); # greatest common divisor (no OO style) 4445 4446=item blcm() 4447 4448 blcm(@values); # lowest common multiple (no OO style) 4449 4450=item length() 4451 4452 $x->length(); 4453 ($xl,$fl) = $x->length(); 4454 4455Returns the number of digits in the decimal representation of the number. 4456In list context, returns the length of the integer and fraction part. For 4457BigInt's, the length of the fraction part will always be 0. 4458 4459=item exponent() 4460 4461 $x->exponent(); 4462 4463Return the exponent of $x as BigInt. 4464 4465=item mantissa() 4466 4467 $x->mantissa(); 4468 4469Return the signed mantissa of $x as BigInt. 4470 4471=item parts() 4472 4473 $x->parts(); # return (mantissa,exponent) as BigInt 4474 4475=item copy() 4476 4477 $x->copy(); # make a true copy of $x (unlike $y = $x;) 4478 4479=item as_int() 4480 4481=item as_number() 4482 4483These methods are called when Math::BigInt encounters an object it doesn't know 4484how to handle. For instance, assume $x is a Math::BigInt, or subclass thereof, 4485and $y is defined, but not a Math::BigInt, or subclass thereof. If you do 4486 4487 $x -> badd($y); 4488 4489$y needs to be converted into an object that $x can deal with. This is done by 4490first checking if $y is something that $x might be upgraded to. If that is the 4491case, no further attempts are made. The next is to see if $y supports the 4492method C<as_int()>. If it does, C<as_int()> is called, but if it doesn't, the 4493next thing is to see if $y supports the method C<as_number()>. If it does, 4494C<as_number()> is called. The method C<as_int()> (and C<as_number()>) is 4495expected to return either an object that has the same class as $x, a subclass 4496thereof, or a string that C<ref($x)-E<gt>new()> can parse to create an object. 4497 4498C<as_number()> is an alias to C<as_int()>. C<as_number> was introduced in 4499v1.22, while C<as_int()> was introduced in v1.68. 4500 4501In Math::BigInt, C<as_int()> has the same effect as C<copy()>. 4502 4503=item bstr() 4504 4505 $x->bstr(); 4506 4507Returns a normalized string representation of C<$x>. 4508 4509=item bsstr() 4510 4511 $x->bsstr(); # normalized string in scientific notation 4512 4513=item as_hex() 4514 4515 $x->as_hex(); # as signed hexadecimal string with prefixed 0x 4516 4517=item as_bin() 4518 4519 $x->as_bin(); # as signed binary string with prefixed 0b 4520 4521=item as_oct() 4522 4523 $x->as_oct(); # as signed octal string with prefixed 0 4524 4525=item numify() 4526 4527 print $x->numify(); 4528 4529This returns a normal Perl scalar from $x. It is used automatically 4530whenever a scalar is needed, for instance in array index operations. 4531 4532This loses precision, to avoid this use L</as_int()> instead. 4533 4534=item modify() 4535 4536 $x->modify('bpowd'); 4537 4538This method returns 0 if the object can be modified with the given 4539operation, or 1 if not. 4540 4541This is used for instance by L<Math::BigInt::Constant>. 4542 4543=item upgrade()/downgrade() 4544 4545Set/get the class for downgrade/upgrade operations. Thuis is used 4546for instance by L<bignum>. The defaults are '', thus the following 4547operation will create a BigInt, not a BigFloat: 4548 4549 my $i = Math::BigInt->new(123); 4550 my $f = Math::BigFloat->new('123.1'); 4551 4552 print $i + $f,"\n"; # print 246 4553 4554=item div_scale() 4555 4556Set/get the number of digits for the default precision in divide 4557operations. 4558 4559=item round_mode() 4560 4561Set/get the current round mode. 4562 4563=back 4564 4565=head1 ACCURACY and PRECISION 4566 4567Since version v1.33, Math::BigInt and Math::BigFloat have full support for 4568accuracy and precision based rounding, both automatically after every 4569operation, as well as manually. 4570 4571This section describes the accuracy/precision handling in Math::Big* as it 4572used to be and as it is now, complete with an explanation of all terms and 4573abbreviations. 4574 4575Not yet implemented things (but with correct description) are marked with '!', 4576things that need to be answered are marked with '?'. 4577 4578In the next paragraph follows a short description of terms used here (because 4579these may differ from terms used by others people or documentation). 4580 4581During the rest of this document, the shortcuts A (for accuracy), P (for 4582precision), F (fallback) and R (rounding mode) will be used. 4583 4584=head2 Precision P 4585 4586A fixed number of digits before (positive) or after (negative) 4587the decimal point. For example, 123.45 has a precision of -2. 0 means an 4588integer like 123 (or 120). A precision of 2 means two digits to the left 4589of the decimal point are zero, so 123 with P = 1 becomes 120. Note that 4590numbers with zeros before the decimal point may have different precisions, 4591because 1200 can have p = 0, 1 or 2 (depending on what the initial value 4592was). It could also have p < 0, when the digits after the decimal point 4593are zero. 4594 4595The string output (of floating point numbers) will be padded with zeros: 4596 4597 Initial value P A Result String 4598 ------------------------------------------------------------ 4599 1234.01 -3 1000 1000 4600 1234 -2 1200 1200 4601 1234.5 -1 1230 1230 4602 1234.001 1 1234 1234.0 4603 1234.01 0 1234 1234 4604 1234.01 2 1234.01 1234.01 4605 1234.01 5 1234.01 1234.01000 4606 4607For BigInts, no padding occurs. 4608 4609=head2 Accuracy A 4610 4611Number of significant digits. Leading zeros are not counted. A 4612number may have an accuracy greater than the non-zero digits 4613when there are zeros in it or trailing zeros. For example, 123.456 has 4614A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3. 4615 4616The string output (of floating point numbers) will be padded with zeros: 4617 4618 Initial value P A Result String 4619 ------------------------------------------------------------ 4620 1234.01 3 1230 1230 4621 1234.01 6 1234.01 1234.01 4622 1234.1 8 1234.1 1234.1000 4623 4624For BigInts, no padding occurs. 4625 4626=head2 Fallback F 4627 4628When both A and P are undefined, this is used as a fallback accuracy when 4629dividing numbers. 4630 4631=head2 Rounding mode R 4632 4633When rounding a number, different 'styles' or 'kinds' 4634of rounding are possible. (Note that random rounding, as in 4635Math::Round, is not implemented.) 4636 4637=over 4638 4639=item 'trunc' 4640 4641truncation invariably removes all digits following the 4642rounding place, replacing them with zeros. Thus, 987.65 rounded 4643to tens (P=1) becomes 980, and rounded to the fourth sigdig 4644becomes 987.6 (A=4). 123.456 rounded to the second place after the 4645decimal point (P=-2) becomes 123.46. 4646 4647All other implemented styles of rounding attempt to round to the 4648"nearest digit." If the digit D immediately to the right of the 4649rounding place (skipping the decimal point) is greater than 5, the 4650number is incremented at the rounding place (possibly causing a 4651cascade of incrementation): e.g. when rounding to units, 0.9 rounds 4652to 1, and -19.9 rounds to -20. If D < 5, the number is similarly 4653truncated at the rounding place: e.g. when rounding to units, 0.4 4654rounds to 0, and -19.4 rounds to -19. 4655 4656However the results of other styles of rounding differ if the 4657digit immediately to the right of the rounding place (skipping the 4658decimal point) is 5 and if there are no digits, or no digits other 4659than 0, after that 5. In such cases: 4660 4661=item 'even' 4662 4663rounds the digit at the rounding place to 0, 2, 4, 6, or 8 4664if it is not already. E.g., when rounding to the first sigdig, 0.45 4665becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5. 4666 4667=item 'odd' 4668 4669rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if 4670it is not already. E.g., when rounding to the first sigdig, 0.45 4671becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6. 4672 4673=item '+inf' 4674 4675round to plus infinity, i.e. always round up. E.g., when 4676rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5, 4677and 0.4501 also becomes 0.5. 4678 4679=item '-inf' 4680 4681round to minus infinity, i.e. always round down. E.g., when 4682rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6, 4683but 0.4501 becomes 0.5. 4684 4685=item 'zero' 4686 4687round to zero, i.e. positive numbers down, negative ones up. 4688E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55 4689becomes -0.5, but 0.4501 becomes 0.5. 4690 4691=item 'common' 4692 4693round up if the digit immediately to the right of the rounding place 4694is 5 or greater, otherwise round down. E.g., 0.15 becomes 0.2 and 46950.149 becomes 0.1. 4696 4697=back 4698 4699The handling of A & P in MBI/MBF (the old core code shipped with Perl 4700versions <= 5.7.2) is like this: 4701 4702=over 4703 4704=item Precision 4705 4706 * bfround($p) is able to round to $p number of digits after the decimal 4707 point 4708 * otherwise P is unused 4709 4710=item Accuracy (significant digits) 4711 4712 * bround($a) rounds to $a significant digits 4713 * only bdiv() and bsqrt() take A as (optional) parameter 4714 + other operations simply create the same number (bneg etc), or 4715 more (bmul) of digits 4716 + rounding/truncating is only done when explicitly calling one 4717 of bround or bfround, and never for BigInt (not implemented) 4718 * bsqrt() simply hands its accuracy argument over to bdiv. 4719 * the documentation and the comment in the code indicate two 4720 different ways on how bdiv() determines the maximum number 4721 of digits it should calculate, and the actual code does yet 4722 another thing 4723 POD: 4724 max($Math::BigFloat::div_scale,length(dividend)+length(divisor)) 4725 Comment: 4726 result has at most max(scale, length(dividend), length(divisor)) digits 4727 Actual code: 4728 scale = max(scale, length(dividend)-1,length(divisor)-1); 4729 scale += length(divisor) - length(dividend); 4730 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10 4731 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 4732 (10+9-3). Actually, the 'difference' added to the scale is cal- 4733 culated from the number of "significant digits" in dividend and 4734 divisor, which is derived by looking at the length of the man- 4735 tissa. Which is wrong, since it includes the + sign (oops) and 4736 actually gets 2 for '+100' and 4 for '+101'. Oops again. Thus 4737 124/3 with div_scale=1 will get you '41.3' based on the strange 4738 assumption that 124 has 3 significant digits, while 120/7 will 4739 get you '17', not '17.1' since 120 is thought to have 2 signif- 4740 icant digits. The rounding after the division then uses the 4741 remainder and $y to determine whether it must round up or down. 4742 ? I have no idea which is the right way. That's why I used a slightly more 4743 ? simple scheme and tweaked the few failing testcases to match it. 4744 4745=back 4746 4747This is how it works now: 4748 4749=over 4750 4751=item Setting/Accessing 4752 4753 * You can set the A global via Math::BigInt->accuracy() or 4754 Math::BigFloat->accuracy() or whatever class you are using. 4755 * You can also set P globally by using Math::SomeClass->precision() 4756 likewise. 4757 * Globals are classwide, and not inherited by subclasses. 4758 * to undefine A, use Math::SomeCLass->accuracy(undef); 4759 * to undefine P, use Math::SomeClass->precision(undef); 4760 * Setting Math::SomeClass->accuracy() clears automatically 4761 Math::SomeClass->precision(), and vice versa. 4762 * To be valid, A must be > 0, P can have any value. 4763 * If P is negative, this means round to the P'th place to the right of the 4764 decimal point; positive values mean to the left of the decimal point. 4765 P of 0 means round to integer. 4766 * to find out the current global A, use Math::SomeClass->accuracy() 4767 * to find out the current global P, use Math::SomeClass->precision() 4768 * use $x->accuracy() respective $x->precision() for the local 4769 setting of $x. 4770 * Please note that $x->accuracy() respective $x->precision() 4771 return eventually defined global A or P, when $x's A or P is not 4772 set. 4773 4774=item Creating numbers 4775 4776 * When you create a number, you can give the desired A or P via: 4777 $x = Math::BigInt->new($number,$A,$P); 4778 * Only one of A or P can be defined, otherwise the result is NaN 4779 * If no A or P is give ($x = Math::BigInt->new($number) form), then the 4780 globals (if set) will be used. Thus changing the global defaults later on 4781 will not change the A or P of previously created numbers (i.e., A and P of 4782 $x will be what was in effect when $x was created) 4783 * If given undef for A and P, NO rounding will occur, and the globals will 4784 NOT be used. This is used by subclasses to create numbers without 4785 suffering rounding in the parent. Thus a subclass is able to have its own 4786 globals enforced upon creation of a number by using 4787 $x = Math::BigInt->new($number,undef,undef): 4788 4789 use Math::BigInt::SomeSubclass; 4790 use Math::BigInt; 4791 4792 Math::BigInt->accuracy(2); 4793 Math::BigInt::SomeSubClass->accuracy(3); 4794 $x = Math::BigInt::SomeSubClass->new(1234); 4795 4796 $x is now 1230, and not 1200. A subclass might choose to implement 4797 this otherwise, e.g. falling back to the parent's A and P. 4798 4799=item Usage 4800 4801 * If A or P are enabled/defined, they are used to round the result of each 4802 operation according to the rules below 4803 * Negative P is ignored in Math::BigInt, since BigInts never have digits 4804 after the decimal point 4805 * Math::BigFloat uses Math::BigInt internally, but setting A or P inside 4806 Math::BigInt as globals does not tamper with the parts of a BigFloat. 4807 A flag is used to mark all Math::BigFloat numbers as 'never round'. 4808 4809=item Precedence 4810 4811 * It only makes sense that a number has only one of A or P at a time. 4812 If you set either A or P on one object, or globally, the other one will 4813 be automatically cleared. 4814 * If two objects are involved in an operation, and one of them has A in 4815 effect, and the other P, this results in an error (NaN). 4816 * A takes precedence over P (Hint: A comes before P). 4817 If neither of them is defined, nothing is used, i.e. the result will have 4818 as many digits as it can (with an exception for bdiv/bsqrt) and will not 4819 be rounded. 4820 * There is another setting for bdiv() (and thus for bsqrt()). If neither of 4821 A or P is defined, bdiv() will use a fallback (F) of $div_scale digits. 4822 If either the dividend's or the divisor's mantissa has more digits than 4823 the value of F, the higher value will be used instead of F. 4824 This is to limit the digits (A) of the result (just consider what would 4825 happen with unlimited A and P in the case of 1/3 :-) 4826 * bdiv will calculate (at least) 4 more digits than required (determined by 4827 A, P or F), and, if F is not used, round the result 4828 (this will still fail in the case of a result like 0.12345000000001 with A 4829 or P of 5, but this can not be helped - or can it?) 4830 * Thus you can have the math done by on Math::Big* class in two modi: 4831 + never round (this is the default): 4832 This is done by setting A and P to undef. No math operation 4833 will round the result, with bdiv() and bsqrt() as exceptions to guard 4834 against overflows. You must explicitly call bround(), bfround() or 4835 round() (the latter with parameters). 4836 Note: Once you have rounded a number, the settings will 'stick' on it 4837 and 'infect' all other numbers engaged in math operations with it, since 4838 local settings have the highest precedence. So, to get SaferRound[tm], 4839 use a copy() before rounding like this: 4840 4841 $x = Math::BigFloat->new(12.34); 4842 $y = Math::BigFloat->new(98.76); 4843 $z = $x * $y; # 1218.6984 4844 print $x->copy()->bround(3); # 12.3 (but A is now 3!) 4845 $z = $x * $y; # still 1218.6984, without 4846 # copy would have been 1210! 4847 4848 + round after each op: 4849 After each single operation (except for testing like is_zero()), the 4850 method round() is called and the result is rounded appropriately. By 4851 setting proper values for A and P, you can have all-the-same-A or 4852 all-the-same-P modes. For example, Math::Currency might set A to undef, 4853 and P to -2, globally. 4854 4855 ?Maybe an extra option that forbids local A & P settings would be in order, 4856 ?so that intermediate rounding does not 'poison' further math? 4857 4858=item Overriding globals 4859 4860 * you will be able to give A, P and R as an argument to all the calculation 4861 routines; the second parameter is A, the third one is P, and the fourth is 4862 R (shift right by one for binary operations like badd). P is used only if 4863 the first parameter (A) is undefined. These three parameters override the 4864 globals in the order detailed as follows, i.e. the first defined value 4865 wins: 4866 (local: per object, global: global default, parameter: argument to sub) 4867 + parameter A 4868 + parameter P 4869 + local A (if defined on both of the operands: smaller one is taken) 4870 + local P (if defined on both of the operands: bigger one is taken) 4871 + global A 4872 + global P 4873 + global F 4874 * bsqrt() will hand its arguments to bdiv(), as it used to, only now for two 4875 arguments (A and P) instead of one 4876 4877=item Local settings 4878 4879 * You can set A or P locally by using $x->accuracy() or 4880 $x->precision() 4881 and thus force different A and P for different objects/numbers. 4882 * Setting A or P this way immediately rounds $x to the new value. 4883 * $x->accuracy() clears $x->precision(), and vice versa. 4884 4885=item Rounding 4886 4887 * the rounding routines will use the respective global or local settings. 4888 bround() is for accuracy rounding, while bfround() is for precision 4889 * the two rounding functions take as the second parameter one of the 4890 following rounding modes (R): 4891 'even', 'odd', '+inf', '-inf', 'zero', 'trunc', 'common' 4892 * you can set/get the global R by using Math::SomeClass->round_mode() 4893 or by setting $Math::SomeClass::round_mode 4894 * after each operation, $result->round() is called, and the result may 4895 eventually be rounded (that is, if A or P were set either locally, 4896 globally or as parameter to the operation) 4897 * to manually round a number, call $x->round($A,$P,$round_mode); 4898 this will round the number by using the appropriate rounding function 4899 and then normalize it. 4900 * rounding modifies the local settings of the number: 4901 4902 $x = Math::BigFloat->new(123.456); 4903 $x->accuracy(5); 4904 $x->bround(4); 4905 4906 Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy() 4907 will be 4 from now on. 4908 4909=item Default values 4910 4911 * R: 'even' 4912 * F: 40 4913 * A: undef 4914 * P: undef 4915 4916=item Remarks 4917 4918 * The defaults are set up so that the new code gives the same results as 4919 the old code (except in a few cases on bdiv): 4920 + Both A and P are undefined and thus will not be used for rounding 4921 after each operation. 4922 + round() is thus a no-op, unless given extra parameters A and P 4923 4924=back 4925 4926=head1 Infinity and Not a Number 4927 4928While BigInt has extensive handling of inf and NaN, certain quirks remain. 4929 4930=over 4931 4932=item oct()/hex() 4933 4934These perl routines currently (as of Perl v.5.8.6) cannot handle passed 4935inf. 4936 4937 te@linux:~> perl -wle 'print 2 ** 3333' 4938 Inf 4939 te@linux:~> perl -wle 'print 2 ** 3333 == 2 ** 3333' 4940 1 4941 te@linux:~> perl -wle 'print oct(2 ** 3333)' 4942 0 4943 te@linux:~> perl -wle 'print hex(2 ** 3333)' 4944 Illegal hexadecimal digit 'I' ignored at -e line 1. 4945 0 4946 4947The same problems occur if you pass them Math::BigInt->binf() objects. Since 4948overloading these routines is not possible, this cannot be fixed from BigInt. 4949 4950=item ==, !=, <, >, <=, >= with NaNs 4951 4952BigInt's bcmp() routine currently returns undef to signal that a NaN was 4953involved in a comparison. However, the overload code turns that into 4954either 1 or '' and thus operations like C<< NaN != NaN >> might return 4955wrong values. 4956 4957=item log(-inf) 4958 4959C<< log(-inf) >> is highly weird. Since log(-x)=pi*i+log(x), then 4960log(-inf)=pi*i+inf. However, since the imaginary part is finite, the real 4961infinity "overshadows" it, so the number might as well just be infinity. 4962However, the result is a complex number, and since BigInt/BigFloat can only 4963have real numbers as results, the result is NaN. 4964 4965=item exp(), cos(), sin(), atan2() 4966 4967These all might have problems handling infinity right. 4968 4969=back 4970 4971=head1 INTERNALS 4972 4973The actual numbers are stored as unsigned big integers (with separate sign). 4974 4975You should neither care about nor depend on the internal representation; it 4976might change without notice. Use B<ONLY> method calls like C<< $x->sign(); >> 4977instead relying on the internal representation. 4978 4979=head2 MATH LIBRARY 4980 4981Math with the numbers is done (by default) by a module called 4982C<Math::BigInt::Calc>. This is equivalent to saying: 4983 4984 use Math::BigInt try => 'Calc'; 4985 4986You can change this backend library by using: 4987 4988 use Math::BigInt try => 'GMP'; 4989 4990B<Note>: General purpose packages should not be explicit about the library 4991to use; let the script author decide which is best. 4992 4993If your script works with huge numbers and Calc is too slow for them, 4994you can also for the loading of one of these libraries and if none 4995of them can be used, the code will die: 4996 4997 use Math::BigInt only => 'GMP,Pari'; 4998 4999The following would first try to find Math::BigInt::Foo, then 5000Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: 5001 5002 use Math::BigInt try => 'Foo,Math::BigInt::Bar'; 5003 5004The library that is loaded last will be used. Note that this can be 5005overwritten at any time by loading a different library, and numbers 5006constructed with different libraries cannot be used in math operations 5007together. 5008 5009=head3 What library to use? 5010 5011B<Note>: General purpose packages should not be explicit about the library 5012to use; let the script author decide which is best. 5013 5014L<Math::BigInt::GMP> and L<Math::BigInt::Pari> are in cases involving big 5015numbers much faster than Calc, however it is slower when dealing with very 5016small numbers (less than about 20 digits) and when converting very large 5017numbers to decimal (for instance for printing, rounding, calculating their 5018length in decimal etc). 5019 5020So please select carefully what library you want to use. 5021 5022Different low-level libraries use different formats to store the numbers. 5023However, you should B<NOT> depend on the number having a specific format 5024internally. 5025 5026See the respective math library module documentation for further details. 5027 5028=head2 SIGN 5029 5030The sign is either '+', '-', 'NaN', '+inf' or '-inf'. 5031 5032A sign of 'NaN' is used to represent the result when input arguments are not 5033numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively 5034minus infinity. You will get '+inf' when dividing a positive number by 0, and 5035'-inf' when dividing any negative number by 0. 5036 5037=head2 mantissa(), exponent() and parts() 5038 5039C<mantissa()> and C<exponent()> return the said parts of the BigInt such 5040that: 5041 5042 $m = $x->mantissa(); 5043 $e = $x->exponent(); 5044 $y = $m * ( 10 ** $e ); 5045 print "ok\n" if $x == $y; 5046 5047C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them 5048in one go. Both the returned mantissa and exponent have a sign. 5049 5050Currently, for BigInts C<$e> is always 0, except +inf and -inf, where it is 5051C<+inf>; and for NaN, where it is C<NaN>; and for C<$x == 0>, where it is C<1> 5052(to be compatible with Math::BigFloat's internal representation of a zero as 5053C<0E1>). 5054 5055C<$m> is currently just a copy of the original number. The relation between 5056C<$e> and C<$m> will stay always the same, though their real values might 5057change. 5058 5059=head1 EXAMPLES 5060 5061 use Math::BigInt; 5062 5063 sub bigint { Math::BigInt->new(shift); } 5064 5065 $x = Math::BigInt->bstr("1234") # string "1234" 5066 $x = "$x"; # same as bstr() 5067 $x = Math::BigInt->bneg("1234"); # BigInt "-1234" 5068 $x = Math::BigInt->babs("-12345"); # BigInt "12345" 5069 $x = Math::BigInt->bnorm("-0.00"); # BigInt "0" 5070 $x = bigint(1) + bigint(2); # BigInt "3" 5071 $x = bigint(1) + "2"; # ditto (auto-BigIntify of "2") 5072 $x = bigint(1); # BigInt "1" 5073 $x = $x + 5 / 2; # BigInt "3" 5074 $x = $x ** 3; # BigInt "27" 5075 $x *= 2; # BigInt "54" 5076 $x = Math::BigInt->new(0); # BigInt "0" 5077 $x--; # BigInt "-1" 5078 $x = Math::BigInt->badd(4,5) # BigInt "9" 5079 print $x->bsstr(); # 9e+0 5080 5081Examples for rounding: 5082 5083 use Math::BigFloat; 5084 use Test::More; 5085 5086 $x = Math::BigFloat->new(123.4567); 5087 $y = Math::BigFloat->new(123.456789); 5088 Math::BigFloat->accuracy(4); # no more A than 4 5089 5090 is ($x->copy()->bround(),123.4); # even rounding 5091 print $x->copy()->bround(),"\n"; # 123.4 5092 Math::BigFloat->round_mode('odd'); # round to odd 5093 print $x->copy()->bround(),"\n"; # 123.5 5094 Math::BigFloat->accuracy(5); # no more A than 5 5095 Math::BigFloat->round_mode('odd'); # round to odd 5096 print $x->copy()->bround(),"\n"; # 123.46 5097 $y = $x->copy()->bround(4),"\n"; # A = 4: 123.4 5098 print "$y, ",$y->accuracy(),"\n"; # 123.4, 4 5099 5100 Math::BigFloat->accuracy(undef); # A not important now 5101 Math::BigFloat->precision(2); # P important 5102 print $x->copy()->bnorm(),"\n"; # 123.46 5103 print $x->copy()->bround(),"\n"; # 123.46 5104 5105Examples for converting: 5106 5107 my $x = Math::BigInt->new('0b1'.'01' x 123); 5108 print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n"; 5109 5110=head1 Autocreating constants 5111 5112After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal 5113and binary constants in the given scope are converted to C<Math::BigInt>. 5114This conversion happens at compile time. 5115 5116In particular, 5117 5118 perl -MMath::BigInt=:constant -e 'print 2**100,"\n"' 5119 5120prints the integer value of C<2**100>. Note that without conversion of 5121constants the expression 2**100 will be calculated as perl scalar. 5122 5123Please note that strings and floating point constants are not affected, 5124so that 5125 5126 use Math::BigInt qw/:constant/; 5127 5128 $x = 1234567890123456789012345678901234567890 5129 + 123456789123456789; 5130 $y = '1234567890123456789012345678901234567890' 5131 + '123456789123456789'; 5132 5133do not work. You need an explicit Math::BigInt->new() around one of the 5134operands. You should also quote large constants to protect loss of precision: 5135 5136 use Math::BigInt; 5137 5138 $x = Math::BigInt->new('1234567889123456789123456789123456789'); 5139 5140Without the quotes Perl would convert the large number to a floating point 5141constant at compile time and then hand the result to BigInt, which results in 5142an truncated result or a NaN. 5143 5144This also applies to integers that look like floating point constants: 5145 5146 use Math::BigInt ':constant'; 5147 5148 print ref(123e2),"\n"; 5149 print ref(123.2e2),"\n"; 5150 5151will print nothing but newlines. Use either L<bignum> or L<Math::BigFloat> 5152to get this to work. 5153 5154=head1 PERFORMANCE 5155 5156Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x 5157must be made in the second case. For long numbers, the copy can eat up to 20% 5158of the work (in the case of addition/subtraction, less for 5159multiplication/division). If $y is very small compared to $x, the form 5160$x += $y is MUCH faster than $x = $x + $y since making the copy of $x takes 5161more time then the actual addition. 5162 5163With a technique called copy-on-write, the cost of copying with overload could 5164be minimized or even completely avoided. A test implementation of COW did show 5165performance gains for overloaded math, but introduced a performance loss due 5166to a constant overhead for all other operations. So Math::BigInt does currently 5167not COW. 5168 5169The rewritten version of this module (vs. v0.01) is slower on certain 5170operations, like C<new()>, C<bstr()> and C<numify()>. The reason are that it 5171does now more work and handles much more cases. The time spent in these 5172operations is usually gained in the other math operations so that code on 5173the average should get (much) faster. If they don't, please contact the author. 5174 5175Some operations may be slower for small numbers, but are significantly faster 5176for big numbers. Other operations are now constant (O(1), like C<bneg()>, 5177C<babs()> etc), instead of O(N) and thus nearly always take much less time. 5178These optimizations were done on purpose. 5179 5180If you find the Calc module to slow, try to install any of the replacement 5181modules and see if they help you. 5182 5183=head2 Alternative math libraries 5184 5185You can use an alternative library to drive Math::BigInt. See the section 5186L</MATH LIBRARY> for more information. 5187 5188For more benchmark results see L<http://bloodgate.com/perl/benchmarks.html>. 5189 5190=head1 SUBCLASSING 5191 5192=head2 Subclassing Math::BigInt 5193 5194The basic design of Math::BigInt allows simple subclasses with very little 5195work, as long as a few simple rules are followed: 5196 5197=over 5198 5199=item * 5200 5201The public API must remain consistent, i.e. if a sub-class is overloading 5202addition, the sub-class must use the same name, in this case badd(). The 5203reason for this is that Math::BigInt is optimized to call the object methods 5204directly. 5205 5206=item * 5207 5208The private object hash keys like C<< $x->{sign} >> may not be changed, but 5209additional keys can be added, like C<< $x->{_custom} >>. 5210 5211=item * 5212 5213Accessor functions are available for all existing object hash keys and should 5214be used instead of directly accessing the internal hash keys. The reason for 5215this is that Math::BigInt itself has a pluggable interface which permits it 5216to support different storage methods. 5217 5218=back 5219 5220More complex sub-classes may have to replicate more of the logic internal of 5221Math::BigInt if they need to change more basic behaviors. A subclass that 5222needs to merely change the output only needs to overload C<bstr()>. 5223 5224All other object methods and overloaded functions can be directly inherited 5225from the parent class. 5226 5227At the very minimum, any subclass will need to provide its own C<new()> and can 5228store additional hash keys in the object. There are also some package globals 5229that must be defined, e.g.: 5230 5231 # Globals 5232 $accuracy = undef; 5233 $precision = -2; # round to 2 decimal places 5234 $round_mode = 'even'; 5235 $div_scale = 40; 5236 5237Additionally, you might want to provide the following two globals to allow 5238auto-upgrading and auto-downgrading to work correctly: 5239 5240 $upgrade = undef; 5241 $downgrade = undef; 5242 5243This allows Math::BigInt to correctly retrieve package globals from the 5244subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or 5245t/Math/BigFloat/SubClass.pm completely functional subclass examples. 5246 5247Don't forget to 5248 5249 use overload; 5250 5251in your subclass to automatically inherit the overloading from the parent. If 5252you like, you can change part of the overloading, look at Math::String for an 5253example. 5254 5255=head1 UPGRADING 5256 5257When used like this: 5258 5259 use Math::BigInt upgrade => 'Foo::Bar'; 5260 5261certain operations will 'upgrade' their calculation and thus the result to 5262the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat: 5263 5264 use Math::BigInt upgrade => 'Math::BigFloat'; 5265 5266As a shortcut, you can use the module L<bignum>: 5267 5268 use bignum; 5269 5270Also good for one-liners: 5271 5272 perl -Mbignum -le 'print 2 ** 255' 5273 5274This makes it possible to mix arguments of different classes (as in 2.5 + 2) 5275as well es preserve accuracy (as in sqrt(3)). 5276 5277Beware: This feature is not fully implemented yet. 5278 5279=head2 Auto-upgrade 5280 5281The following methods upgrade themselves unconditionally; that is if upgrade 5282is in effect, they will always hand up their work: 5283 5284=over 5285 5286=item bsqrt() 5287 5288=item div() 5289 5290=item blog() 5291 5292=item bexp() 5293 5294=item bpi() 5295 5296=item bcos() 5297 5298=item bsin() 5299 5300=item batan2() 5301 5302=item batan() 5303 5304=back 5305 5306All other methods upgrade themselves only when one (or all) of their 5307arguments are of the class mentioned in $upgrade. 5308 5309=head1 EXPORTS 5310 5311C<Math::BigInt> exports nothing by default, but can export the following methods: 5312 5313 bgcd 5314 blcm 5315 5316=head1 CAVEATS 5317 5318Some things might not work as you expect them. Below is documented what is 5319known to be troublesome: 5320 5321=over 5322 5323=item bstr(), bsstr() and 'cmp' 5324 5325Both C<bstr()> and C<bsstr()> as well as automated stringify via overload now 5326drop the leading '+'. The old code would return '+3', the new returns '3'. 5327This is to be consistent with Perl and to make C<cmp> (especially with 5328overloading) to work as you expect. It also solves problems with C<Test.pm> 5329and L<Test::More>, which stringify arguments before comparing them. 5330 5331Mark Biggar said, when asked about to drop the '+' altogether, or make only 5332C<cmp> work: 5333 5334 I agree (with the first alternative), don't add the '+' on positive 5335 numbers. It's not as important anymore with the new internal 5336 form for numbers. It made doing things like abs and neg easier, 5337 but those have to be done differently now anyway. 5338 5339So, the following examples will now work all as expected: 5340 5341 use Test::More tests => 1; 5342 use Math::BigInt; 5343 5344 my $x = Math::BigInt -> new(3*3); 5345 my $y = Math::BigInt -> new(3*3); 5346 5347 is ($x,3*3, 'multiplication'); 5348 print "$x eq 9" if $x eq $y; 5349 print "$x eq 9" if $x eq '9'; 5350 print "$x eq 9" if $x eq 3*3; 5351 5352Additionally, the following still works: 5353 5354 print "$x == 9" if $x == $y; 5355 print "$x == 9" if $x == 9; 5356 print "$x == 9" if $x == 3*3; 5357 5358There is now a C<bsstr()> method to get the string in scientific notation aka 5359C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr() 5360for comparison, but Perl will represent some numbers as 100 and others 5361as 1e+308. If in doubt, convert both arguments to Math::BigInt before 5362comparing them as strings: 5363 5364 use Test::More tests => 3; 5365 use Math::BigInt; 5366 5367 $x = Math::BigInt->new('1e56'); $y = 1e56; 5368 is ($x,$y); # will fail 5369 is ($x->bsstr(),$y); # okay 5370 $y = Math::BigInt->new($y); 5371 is ($x,$y); # okay 5372 5373Alternatively, simply use C<< <=> >> for comparisons, this will get it 5374always right. There is not yet a way to get a number automatically represented 5375as a string that matches exactly the way Perl represents it. 5376 5377See also the section about L<Infinity and Not a Number> for problems in 5378comparing NaNs. 5379 5380=item int() 5381 5382C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a 5383Perl scalar: 5384 5385 $x = Math::BigInt->new(123); 5386 $y = int($x); # BigInt 123 5387 $x = Math::BigFloat->new(123.45); 5388 $y = int($x); # BigInt 123 5389 5390In all Perl versions you can use C<as_number()> or C<as_int> for the same 5391effect: 5392 5393 $x = Math::BigFloat->new(123.45); 5394 $y = $x->as_number(); # BigInt 123 5395 $y = $x->as_int(); # ditto 5396 5397This also works for other subclasses, like Math::String. 5398 5399If you want a real Perl scalar, use C<numify()>: 5400 5401 $y = $x->numify(); # 123 as scalar 5402 5403This is seldom necessary, though, because this is done automatically, like 5404when you access an array: 5405 5406 $z = $array[$x]; # does work automatically 5407 5408=item length() 5409 5410The following will probably not do what you expect: 5411 5412 $c = Math::BigInt->new(123); 5413 print $c->length(),"\n"; # prints 30 5414 5415It prints both the number of digits in the number and in the fraction part 5416since print calls C<length()> in list context. Use something like: 5417 5418 print scalar $c->length(),"\n"; # prints 3 5419 5420=item bdiv() 5421 5422The following will probably not do what you expect: 5423 5424 print $c->bdiv(10000),"\n"; 5425 5426It prints both quotient and remainder since print calls C<bdiv()> in list 5427context. Also, C<bdiv()> will modify $c, so be careful. You probably want 5428to use 5429 5430 print $c / 10000,"\n"; 5431 5432or, if you want to modify $c instead, 5433 5434 print scalar $c->bdiv(10000),"\n"; 5435 5436The quotient is always the greatest integer less than or equal to the 5437real-valued quotient of the two operands, and the remainder (when it is 5438non-zero) always has the same sign as the second operand; so, for 5439example, 5440 5441 1 / 4 => ( 0, 1) 5442 1 / -4 => (-1,-3) 5443 -3 / 4 => (-1, 1) 5444 -3 / -4 => ( 0,-3) 5445 -11 / 2 => (-5,1) 5446 11 /-2 => (-5,-1) 5447 5448As a consequence, the behavior of the operator % agrees with the 5449behavior of Perl's built-in % operator (as documented in the perlop 5450manpage), and the equation 5451 5452 $x == ($x / $y) * $y + ($x % $y) 5453 5454holds true for any $x and $y, which justifies calling the two return 5455values of bdiv() the quotient and remainder. The only exception to this rule 5456are when $y == 0 and $x is negative, then the remainder will also be 5457negative. See below under "infinity handling" for the reasoning behind this. 5458 5459Perl's 'use integer;' changes the behaviour of % and / for scalars, but will 5460not change BigInt's way to do things. This is because under 'use integer' Perl 5461will do what the underlying C thinks is right and this is different for each 5462system. If you need BigInt's behaving exactly like Perl's 'use integer', bug 5463the author to implement it ;) 5464 5465=item infinity handling 5466 5467Here are some examples that explain the reasons why certain results occur while 5468handling infinity: 5469 5470The following table shows the result of the division and the remainder, so that 5471the equation above holds true. Some "ordinary" cases are strewn in to show more 5472clearly the reasoning: 5473 5474 A / B = C, R so that C * B + R = A 5475 ========================================================= 5476 5 / 8 = 0, 5 0 * 8 + 5 = 5 5477 0 / 8 = 0, 0 0 * 8 + 0 = 0 5478 0 / inf = 0, 0 0 * inf + 0 = 0 5479 0 /-inf = 0, 0 0 * -inf + 0 = 0 5480 5 / inf = 0, 5 0 * inf + 5 = 5 5481 5 /-inf = 0, 5 0 * -inf + 5 = 5 5482 -5/ inf = 0, -5 0 * inf + -5 = -5 5483 -5/-inf = 0, -5 0 * -inf + -5 = -5 5484 inf/ 5 = inf, 0 inf * 5 + 0 = inf 5485 -inf/ 5 = -inf, 0 -inf * 5 + 0 = -inf 5486 inf/ -5 = -inf, 0 -inf * -5 + 0 = inf 5487 -inf/ -5 = inf, 0 inf * -5 + 0 = -inf 5488 5/ 5 = 1, 0 1 * 5 + 0 = 5 5489 -5/ -5 = 1, 0 1 * -5 + 0 = -5 5490 inf/ inf = 1, 0 1 * inf + 0 = inf 5491 -inf/-inf = 1, 0 1 * -inf + 0 = -inf 5492 inf/-inf = -1, 0 -1 * -inf + 0 = inf 5493 -inf/ inf = -1, 0 1 * -inf + 0 = -inf 5494 8/ 0 = inf, 8 inf * 0 + 8 = 8 5495 inf/ 0 = inf, inf inf * 0 + inf = inf 5496 0/ 0 = NaN 5497 5498These cases below violate the "remainder has the sign of the second of the two 5499arguments", since they wouldn't match up otherwise. 5500 5501 A / B = C, R so that C * B + R = A 5502 ======================================================== 5503 -inf/ 0 = -inf, -inf -inf * 0 + inf = -inf 5504 -8/ 0 = -inf, -8 -inf * 0 + 8 = -8 5505 5506=item Modifying and = 5507 5508Beware of: 5509 5510 $x = Math::BigFloat->new(5); 5511 $y = $x; 5512 5513It will not do what you think, e.g. making a copy of $x. Instead it just makes 5514a second reference to the B<same> object and stores it in $y. Thus anything 5515that modifies $x (except overloaded operators) will modify $y, and vice versa. 5516Or in other words, C<=> is only safe if you modify your BigInts only via 5517overloaded math. As soon as you use a method call it breaks: 5518 5519 $x->bmul(2); 5520 print "$x, $y\n"; # prints '10, 10' 5521 5522If you want a true copy of $x, use: 5523 5524 $y = $x->copy(); 5525 5526You can also chain the calls like this, this will make first a copy and then 5527multiply it by 2: 5528 5529 $y = $x->copy()->bmul(2); 5530 5531See also the documentation for overload.pm regarding C<=>. 5532 5533=item bpow 5534 5535C<bpow()> (and the rounding functions) now modifies the first argument and 5536returns it, unlike the old code which left it alone and only returned the 5537result. This is to be consistent with C<badd()> etc. The first three will 5538modify $x, the last one won't: 5539 5540 print bpow($x,$i),"\n"; # modify $x 5541 print $x->bpow($i),"\n"; # ditto 5542 print $x **= $i,"\n"; # the same 5543 print $x ** $i,"\n"; # leave $x alone 5544 5545The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though. 5546 5547=item Overloading -$x 5548 5549The following: 5550 5551 $x = -$x; 5552 5553is slower than 5554 5555 $x->bneg(); 5556 5557since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant 5558needs to preserve $x since it does not know that it later will get overwritten. 5559This makes a copy of $x and takes O(N), but $x->bneg() is O(1). 5560 5561=item Mixing different object types 5562 5563With overloaded operators, it is the first (dominating) operand that determines 5564which method is called. Here are some examples showing what actually gets 5565called in various cases. 5566 5567 use Math::BigInt; 5568 use Math::BigFloat; 5569 5570 $mbf = Math::BigFloat->new(5); 5571 $mbi2 = Math::BigInt->new(5); 5572 $mbi = Math::BigInt->new(2); 5573 # what actually gets called: 5574 $float = $mbf + $mbi; # $mbf->badd($mbi) 5575 $float = $mbf / $mbi; # $mbf->bdiv($mbi) 5576 $integer = $mbi + $mbf; # $mbi->badd($mbf) 5577 $integer = $mbi2 / $mbi; # $mbi2->bdiv($mbi) 5578 $integer = $mbi2 / $mbf; # $mbi2->bdiv($mbf) 5579 5580For instance, Math::BigInt->bdiv() will always return a Math::BigInt, regardless of 5581whether the second operant is a Math::BigFloat. To get a Math::BigFloat you 5582either need to call the operation manually, make sure each operand already is a 5583Math::BigFloat, or cast to that type via Math::BigFloat->new(): 5584 5585 $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5 5586 5587Beware of casting the entire expression, as this would cast the 5588result, at which point it is too late: 5589 5590 $float = Math::BigFloat->new($mbi2 / $mbi); # = 2 5591 5592Beware also of the order of more complicated expressions like: 5593 5594 $integer = ($mbi2 + $mbi) / $mbf; # int / float => int 5595 $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto 5596 5597If in doubt, break the expression into simpler terms, or cast all operands 5598to the desired resulting type. 5599 5600Scalar values are a bit different, since: 5601 5602 $float = 2 + $mbf; 5603 $float = $mbf + 2; 5604 5605will both result in the proper type due to the way the overloaded math works. 5606 5607This section also applies to other overloaded math packages, like Math::String. 5608 5609One solution to you problem might be autoupgrading|upgrading. See the 5610pragmas L<bignum>, L<bigint> and L<bigrat> for an easy way to do this. 5611 5612=item bsqrt() 5613 5614C<bsqrt()> works only good if the result is a big integer, e.g. the square 5615root of 144 is 12, but from 12 the square root is 3, regardless of rounding 5616mode. The reason is that the result is always truncated to an integer. 5617 5618If you want a better approximation of the square root, then use: 5619 5620 $x = Math::BigFloat->new(12); 5621 Math::BigFloat->precision(0); 5622 Math::BigFloat->round_mode('even'); 5623 print $x->copy->bsqrt(),"\n"; # 4 5624 5625 Math::BigFloat->precision(2); 5626 print $x->bsqrt(),"\n"; # 3.46 5627 print $x->bsqrt(3),"\n"; # 3.464 5628 5629=item brsft() 5630 5631For negative numbers in base see also L<brsft|/brsft()>. 5632 5633=back 5634 5635=head1 BUGS 5636 5637Please report any bugs or feature requests to 5638C<bug-math-bigint at rt.cpan.org>, or through the web interface at 5639L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt> 5640(requires login). 5641We will be notified, and then you'll automatically be notified of progress on 5642your bug as I make changes. 5643 5644=head1 SUPPORT 5645 5646You can find documentation for this module with the perldoc command. 5647 5648 perldoc Math::BigInt 5649 5650You can also look for information at: 5651 5652=over 4 5653 5654=item * RT: CPAN's request tracker 5655 5656L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt> 5657 5658=item * AnnoCPAN: Annotated CPAN documentation 5659 5660L<http://annocpan.org/dist/Math-BigInt> 5661 5662=item * CPAN Ratings 5663 5664L<http://cpanratings.perl.org/dist/Math-BigInt> 5665 5666=item * Search CPAN 5667 5668L<http://search.cpan.org/dist/Math-BigInt/> 5669 5670=item * CPAN Testers Matrix 5671 5672L<http://matrix.cpantesters.org/?dist=Math-BigInt> 5673 5674=item * The Bignum mailing list 5675 5676=over 4 5677 5678=item * Post to mailing list 5679 5680C<bignum at lists.scsys.co.uk> 5681 5682=item * View mailing list 5683 5684L<http://lists.scsys.co.uk/pipermail/bignum/> 5685 5686=item * Subscribe/Unsubscribe 5687 5688L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum> 5689 5690=back 5691 5692=back 5693 5694=head1 LICENSE 5695 5696This program is free software; you may redistribute it and/or modify it under 5697the same terms as Perl itself. 5698 5699=head1 SEE ALSO 5700 5701L<Math::BigFloat> and L<Math::BigRat> as well as the backends 5702L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>. 5703 5704The pragmas L<bignum>, L<bigint> and L<bigrat> also might be of interest 5705because they solve the autoupgrading/downgrading issue, at least partly. 5706 5707=head1 AUTHORS 5708 5709=over 4 5710 5711=item * 5712 5713Mark Biggar, overloaded interface by Ilya Zakharevich, 1996-2001. 5714 5715=item * 5716 5717Completely rewritten by Tels L<http://bloodgate.com>, 2001-2008. 5718 5719=item * 5720 5721Florian Ragwitz E<lt>flora@cpan.orgE<gt>, 2010. 5722 5723=item * 5724 5725Peter John Acklam E<lt>pjacklam@online.noE<gt>, 2011-. 5726 5727=back 5728 5729Many people contributed in one or more ways to the final beast, see the file 5730CREDITS for an (incomplete) list. If you miss your name, please drop me a 5731mail. Thank you! 5732 5733=cut 5734