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