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