1# -*- coding: utf-8-unix -*- 2 3package Math::BigInt; 4 5# 6# "Mike had an infinite amount to do and a negative amount of time in which 7# to do it." - Before and After 8# 9 10# The following hash values are used: 11# value: unsigned int with actual value (as a Math::BigInt::Calc or similar) 12# sign : +, -, NaN, +inf, -inf 13# _a : accuracy 14# _p : precision 15 16# Remember not to take shortcuts ala $xs = $x->{value}; $LIB->foo($xs); since 17# underlying lib might change the reference! 18 19use 5.006001; 20use strict; 21use warnings; 22 23use Carp qw< carp croak >; 24use Scalar::Util qw< blessed refaddr >; 25 26our $VERSION = '1.999837'; 27$VERSION =~ tr/_//d; 28 29require Exporter; 30our @ISA = qw(Exporter); 31our @EXPORT_OK = qw(objectify bgcd blcm); 32 33# Inside overload, the first arg is always an object. If the original code had 34# it reversed (like $x = 2 * $y), then the third parameter is true. 35# In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes 36# no difference, but in some cases it does. 37 38# For overloaded ops with only one argument we simple use $_[0]->copy() to 39# preserve the argument. 40 41# Thus inheritance of overload operators becomes possible and transparent for 42# our subclasses without the need to repeat the entire overload section there. 43 44use overload 45 46 # overload key: with_assign 47 48 '+' => sub { $_[0] -> copy() -> badd($_[1]); }, 49 50 '-' => sub { my $c = $_[0] -> copy(); 51 $_[2] ? $c -> bneg() -> badd($_[1]) 52 : $c -> bsub($_[1]); }, 53 54 '*' => sub { $_[0] -> copy() -> bmul($_[1]); }, 55 56 '/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0]) 57 : $_[0] -> copy() -> bdiv($_[1]); }, 58 59 '%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0]) 60 : $_[0] -> copy() -> bmod($_[1]); }, 61 '**' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0]) 62 : $_[0] -> copy() -> bpow($_[1]); }, 63 64 '<<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0]) 65 : $_[0] -> copy() -> blsft($_[1]); }, 66 67 '>>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0]) 68 : $_[0] -> copy() -> brsft($_[1]); }, 69 70 # overload key: assign 71 72 '+=' => sub { $_[0] -> badd($_[1]); }, 73 74 '-=' => sub { $_[0] -> bsub($_[1]); }, 75 76 '*=' => sub { $_[0] -> bmul($_[1]); }, 77 78 '/=' => sub { scalar $_[0] -> bdiv($_[1]); }, 79 80 '%=' => sub { $_[0] -> bmod($_[1]); }, 81 82 '**=' => sub { $_[0] -> bpow($_[1]); }, 83 84 '<<=' => sub { $_[0] -> blsft($_[1]); }, 85 86 '>>=' => sub { $_[0] -> brsft($_[1]); }, 87 88# 'x=' => sub { }, 89 90# '.=' => sub { }, 91 92 # overload key: num_comparison 93 94 '<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0]) 95 : $_[0] -> blt($_[1]); }, 96 97 '<=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0]) 98 : $_[0] -> ble($_[1]); }, 99 100 '>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0]) 101 : $_[0] -> bgt($_[1]); }, 102 103 '>=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0]) 104 : $_[0] -> bge($_[1]); }, 105 106 '==' => sub { $_[0] -> beq($_[1]); }, 107 108 '!=' => sub { $_[0] -> bne($_[1]); }, 109 110 # overload key: 3way_comparison 111 112 '<=>' => sub { my $cmp = $_[0] -> bcmp($_[1]); 113 defined($cmp) && $_[2] ? -$cmp : $cmp; }, 114 115 'cmp' => sub { $_[2] ? "$_[1]" cmp $_[0] -> bstr() 116 : $_[0] -> bstr() cmp "$_[1]"; }, 117 118 # overload key: str_comparison 119 120# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0]) 121# : $_[0] -> bstrlt($_[1]); }, 122# 123# 'le' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0]) 124# : $_[0] -> bstrle($_[1]); }, 125# 126# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0]) 127# : $_[0] -> bstrgt($_[1]); }, 128# 129# 'ge' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0]) 130# : $_[0] -> bstrge($_[1]); }, 131# 132# 'eq' => sub { $_[0] -> bstreq($_[1]); }, 133# 134# 'ne' => sub { $_[0] -> bstrne($_[1]); }, 135 136 # overload key: binary 137 138 '&' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0]) 139 : $_[0] -> copy() -> band($_[1]); }, 140 141 '&=' => sub { $_[0] -> band($_[1]); }, 142 143 '|' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0]) 144 : $_[0] -> copy() -> bior($_[1]); }, 145 146 '|=' => sub { $_[0] -> bior($_[1]); }, 147 148 '^' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0]) 149 : $_[0] -> copy() -> bxor($_[1]); }, 150 151 '^=' => sub { $_[0] -> bxor($_[1]); }, 152 153# '&.' => sub { }, 154 155# '&.=' => sub { }, 156 157# '|.' => sub { }, 158 159# '|.=' => sub { }, 160 161# '^.' => sub { }, 162 163# '^.=' => sub { }, 164 165 # overload key: unary 166 167 'neg' => sub { $_[0] -> copy() -> bneg(); }, 168 169# '!' => sub { }, 170 171 '~' => sub { $_[0] -> copy() -> bnot(); }, 172 173# '~.' => sub { }, 174 175 # overload key: mutators 176 177 '++' => sub { $_[0] -> binc() }, 178 179 '--' => sub { $_[0] -> bdec() }, 180 181 # overload key: func 182 183 'atan2' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0]) 184 : $_[0] -> copy() -> batan2($_[1]); }, 185 186 'cos' => sub { $_[0] -> copy() -> bcos(); }, 187 188 'sin' => sub { $_[0] -> copy() -> bsin(); }, 189 190 'exp' => sub { $_[0] -> copy() -> bexp($_[1]); }, 191 192 'abs' => sub { $_[0] -> copy() -> babs(); }, 193 194 'log' => sub { $_[0] -> copy() -> blog(); }, 195 196 'sqrt' => sub { $_[0] -> copy() -> bsqrt(); }, 197 198 'int' => sub { $_[0] -> copy() -> bint(); }, 199 200 # overload key: conversion 201 202 'bool' => sub { $_[0] -> is_zero() ? '' : 1; }, 203 204 '""' => sub { $_[0] -> bstr(); }, 205 206 '0+' => sub { $_[0] -> numify(); }, 207 208 '=' => sub { $_[0] -> copy(); }, 209 210 ; 211 212############################################################################## 213# global constants, flags and accessory 214 215# These vars are public, but their direct usage is not recommended, use the 216# accessor methods instead 217 218# $round_mode is 'even', 'odd', '+inf', '-inf', 'zero', 'trunc', or 'common'. 219our $round_mode = 'even'; 220our $accuracy = undef; 221our $precision = undef; 222our $div_scale = 40; 223our $upgrade = undef; # default is no upgrade 224our $downgrade = undef; # default is no downgrade 225 226# These are internally, and not to be used from the outside at all 227 228our $_trap_nan = 0; # are NaNs ok? set w/ config() 229our $_trap_inf = 0; # are infs ok? set w/ config() 230 231my $nan = 'NaN'; # constants for easier life 232 233# Module to do the low level math. 234 235my $DEFAULT_LIB = 'Math::BigInt::Calc'; 236my $LIB; 237 238# Has import() been called yet? Needed to make "require" work. 239 240my $IMPORT = 0; 241 242############################################################################## 243# the old code had $rnd_mode, so we need to support it, too 244 245our $rnd_mode = 'even'; 246 247sub TIESCALAR { 248 my ($class) = @_; 249 bless \$round_mode, $class; 250} 251 252sub FETCH { 253 return $round_mode; 254} 255 256sub STORE { 257 $rnd_mode = $_[0]->round_mode($_[1]); 258} 259 260BEGIN { 261 # tie to enable $rnd_mode to work transparently 262 tie $rnd_mode, 'Math::BigInt'; 263 264 # set up some handy alias names 265 *is_pos = \&is_positive; 266 *is_neg = \&is_negative; 267 *as_number = \&as_int; 268} 269 270############################################################################### 271# Configuration methods 272############################################################################### 273 274sub round_mode { 275 my $self = shift; 276 my $class = ref($self) || $self || __PACKAGE__; 277 278 if (@_) { # setter 279 my $m = shift; 280 croak("The value for 'round_mode' must be defined") 281 unless defined $m; 282 croak("Unknown round mode '$m'") 283 unless $m =~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/; 284 no strict 'refs'; 285 ${"${class}::round_mode"} = $m; 286 } 287 288 else { # getter 289 no strict 'refs'; 290 my $m = ${"${class}::round_mode"}; 291 defined($m) ? $m : $round_mode; 292 } 293} 294 295sub upgrade { 296 no strict 'refs'; 297 # make Class->upgrade() work 298 my $self = shift; 299 my $class = ref($self) || $self || __PACKAGE__; 300 301 # need to set new value? 302 if (@_ > 0) { 303 return ${"${class}::upgrade"} = $_[0]; 304 } 305 ${"${class}::upgrade"}; 306} 307 308sub downgrade { 309 no strict 'refs'; 310 # make Class->downgrade() work 311 my $self = shift; 312 my $class = ref($self) || $self || __PACKAGE__; 313 # need to set new value? 314 if (@_ > 0) { 315 return ${"${class}::downgrade"} = $_[0]; 316 } 317 ${"${class}::downgrade"}; 318} 319 320sub div_scale { 321 my $self = shift; 322 my $class = ref($self) || $self || __PACKAGE__; 323 324 if (@_) { # setter 325 my $ds = shift; 326 croak("The value for 'div_scale' must be defined") unless defined $ds; 327 croak("The value for 'div_scale' must be positive") unless $ds > 0; 328 $ds = $ds -> numify() if defined(blessed($ds)); 329 no strict 'refs'; 330 ${"${class}::div_scale"} = $ds; 331 } 332 333 else { # getter 334 no strict 'refs'; 335 my $ds = ${"${class}::div_scale"}; 336 defined($ds) ? $ds : $div_scale; 337 } 338} 339 340sub accuracy { 341 # $x->accuracy($a); ref($x) $a 342 # $x->accuracy(); ref($x) 343 # Class->accuracy(); class 344 # Class->accuracy($a); class $a 345 346 my $x = shift; 347 my $class = ref($x) || $x || __PACKAGE__; 348 349 no strict 'refs'; 350 if (@_ > 0) { 351 my $a = shift; 352 if (defined $a) { 353 $a = $a->numify() if ref($a) && $a->can('numify'); 354 # also croak on non-numerical 355 if (!$a || $a <= 0) { 356 croak('Argument to accuracy must be greater than zero'); 357 } 358 if (int($a) != $a) { 359 croak('Argument to accuracy must be an integer'); 360 } 361 } 362 363 if (ref($x)) { 364 # Set instance variable. 365 $x = $x->bround($a) if $a; # not for undef, 0 366 $x->{_a} = $a; # set/overwrite, even if not rounded 367 delete $x->{_p}; # clear P 368 # Why return class variable here? Fixme! 369 $a = ${"${class}::accuracy"} unless defined $a; 370 } else { 371 # Set class variable. 372 ${"${class}::accuracy"} = $a; # set global A 373 ${"${class}::precision"} = undef; # clear global P 374 } 375 376 return $a; # shortcut 377 } 378 379 # Return instance variable. 380 return $x->{_a} if ref($x) && (defined($x->{_a}) || defined($x->{_p})); 381 382 # Return class variable. 383 return ${"${class}::accuracy"}; 384} 385 386sub precision { 387 # $x->precision($p); ref($x) $p 388 # $x->precision(); ref($x) 389 # Class->precision(); class 390 # Class->precision($p); class $p 391 392 my $x = shift; 393 my $class = ref($x) || $x || __PACKAGE__; 394 395 no strict 'refs'; 396 if (@_ > 0) { 397 my $p = shift; 398 if (defined $p) { 399 $p = $p->numify() if ref($p) && $p->can('numify'); 400 if ($p != int $p) { 401 croak('Argument to precision must be an integer'); 402 } 403 } 404 405 if (ref($x)) { 406 # Set instance variable. 407 $x = $x->bfround($p) if $p; # not for undef, 0 408 $x->{_p} = $p; # set/overwrite, even if not rounded 409 delete $x->{_a}; # clear A 410 # Why return class variable here? Fixme! 411 $p = ${"${class}::precision"} unless defined $p; 412 } else { 413 # Set class variable. 414 ${"${class}::precision"} = $p; # set global P 415 ${"${class}::accuracy"} = undef; # clear global A 416 } 417 418 return $p; # shortcut 419 } 420 421 # Return instance variable. 422 return $x->{_p} if ref($x) && (defined($x->{_a}) || defined($x->{_p})); 423 424 # Return class variable. 425 return ${"${class}::precision"}; 426} 427 428sub config { 429 # return (or set) configuration data. 430 my $class = shift || __PACKAGE__; 431 432 no strict 'refs'; 433 if (@_ > 1 || (@_ == 1 && (ref($_[0]) eq 'HASH'))) { 434 # try to set given options as arguments from hash 435 436 my $args = $_[0]; 437 if (ref($args) ne 'HASH') { 438 $args = { @_ }; 439 } 440 # these values can be "set" 441 my $set_args = {}; 442 foreach my $key (qw/ 443 accuracy precision 444 round_mode div_scale 445 upgrade downgrade 446 trap_inf trap_nan 447 /) 448 { 449 $set_args->{$key} = $args->{$key} if exists $args->{$key}; 450 delete $args->{$key}; 451 } 452 if (keys %$args > 0) { 453 croak("Illegal key(s) '", join("', '", keys %$args), 454 "' passed to $class\->config()"); 455 } 456 foreach my $key (keys %$set_args) { 457 if ($key =~ /^trap_(inf|nan)\z/) { 458 ${"${class}::_trap_$1"} = ($set_args->{"trap_$1"} ? 1 : 0); 459 next; 460 } 461 # use a call instead of just setting the $variable to check argument 462 $class->$key($set_args->{$key}); 463 } 464 } 465 466 # now return actual configuration 467 468 my $cfg = { 469 lib => $LIB, 470 lib_version => ${"${LIB}::VERSION"}, 471 class => $class, 472 trap_nan => ${"${class}::_trap_nan"}, 473 trap_inf => ${"${class}::_trap_inf"}, 474 version => ${"${class}::VERSION"}, 475 }; 476 foreach my $key (qw/ 477 accuracy precision 478 round_mode div_scale 479 upgrade downgrade 480 /) 481 { 482 $cfg->{$key} = ${"${class}::$key"}; 483 } 484 if (@_ == 1 && (ref($_[0]) ne 'HASH')) { 485 # calls of the style config('lib') return just this value 486 return $cfg->{$_[0]}; 487 } 488 $cfg; 489} 490 491sub _scale_a { 492 # select accuracy parameter based on precedence, 493 # used by bround() and bfround(), may return undef for scale (means no op) 494 my ($x, $scale, $mode) = @_; 495 496 $scale = $x->{_a} unless defined $scale; 497 498 no strict 'refs'; 499 my $class = ref($x); 500 501 $scale = ${ $class . '::accuracy' } unless defined $scale; 502 $mode = ${ $class . '::round_mode' } unless defined $mode; 503 504 if (defined $scale) { 505 $scale = $scale->can('numify') ? $scale->numify() 506 : "$scale" if ref($scale); 507 $scale = int($scale); 508 } 509 510 ($scale, $mode); 511} 512 513sub _scale_p { 514 # select precision parameter based on precedence, 515 # used by bround() and bfround(), may return undef for scale (means no op) 516 my ($x, $scale, $mode) = @_; 517 518 $scale = $x->{_p} unless defined $scale; 519 520 no strict 'refs'; 521 my $class = ref($x); 522 523 $scale = ${ $class . '::precision' } unless defined $scale; 524 $mode = ${ $class . '::round_mode' } unless defined $mode; 525 526 if (defined $scale) { 527 $scale = $scale->can('numify') ? $scale->numify() 528 : "$scale" if ref($scale); 529 $scale = int($scale); 530 } 531 532 ($scale, $mode); 533} 534 535############################################################################### 536# Constructor methods 537############################################################################### 538 539sub new { 540 # Create a new Math::BigInt object from a string or another Math::BigInt 541 # object. See hash keys documented at top. 542 543 # The argument could be an object, so avoid ||, && etc. on it. This would 544 # cause costly overloaded code to be called. The only allowed ops are ref() 545 # and defined. 546 547 my $self = shift; 548 my $selfref = ref $self; 549 my $class = $selfref || $self; 550 551 # Make "require" work. 552 553 $class -> import() if $IMPORT == 0; 554 555 # Calling new() with no input arguments has been discouraged for more than 556 # 10 years, but people apparently still use it, so we still support it. 557 558 return $class -> bzero() unless @_; 559 560 my ($wanted, @r) = @_; 561 562 if (!defined($wanted)) { 563 #carp("Use of uninitialized value in new()") 564 # if warnings::enabled("uninitialized"); 565 return $class -> bzero(@r); 566 } 567 568 if (!ref($wanted) && $wanted eq "") { 569 #carp(q|Argument "" isn't numeric in new()|) 570 # if warnings::enabled("numeric"); 571 #return $class -> bzero(@r); 572 return $class -> bnan(@r); 573 } 574 575 # Initialize a new object. 576 577 $self = bless {}, $class; 578 579 # Math::BigInt or subclass 580 581 if (defined(blessed($wanted)) && $wanted -> isa($class)) { 582 583 # Don't copy the accuracy and precision, because a new object should get 584 # them from the global configuration. 585 586 $self -> {sign} = $wanted -> {sign}; 587 $self -> {value} = $LIB -> _copy($wanted -> {value}); 588 $self = $self->round(@r) 589 unless @r >= 2 && !defined($r[0]) && !defined($r[1]); 590 return $self; 591 } 592 593 # Shortcut for non-zero scalar integers with no non-zero exponent. 594 595 if ($wanted =~ 596 / ^ 597 ( [+-]? ) # optional sign 598 ( [1-9] [0-9]* ) # non-zero significand 599 ( \.0* )? # ... with optional zero fraction 600 ( [Ee] [+-]? 0+ )? # optional zero exponent 601 \z 602 /x) 603 { 604 my $sgn = $1; 605 my $abs = $2; 606 $self->{sign} = $sgn || '+'; 607 $self->{value} = $LIB->_new($abs); 608 $self = $self->round(@r); 609 return $self; 610 } 611 612 # Handle Infs. 613 614 if ($wanted =~ / ^ 615 \s* 616 ( [+-]? ) 617 inf (?: inity )? 618 \s* 619 \z 620 /ix) 621 { 622 my $sgn = $1 || '+'; 623 return $class -> binf($sgn, @r); 624 } 625 626 # Handle explicit NaNs (not the ones returned due to invalid input). 627 628 if ($wanted =~ / ^ 629 \s* 630 ( [+-]? ) 631 nan 632 \s* 633 \z 634 /ix) 635 { 636 return $class -> bnan(@r); 637 } 638 639 my @parts; 640 641 if ( 642 # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they 643 # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct(). 644 645 $wanted =~ /^\s*[+-]?0?[Xx]/ and 646 @parts = $class -> _hex_str_to_flt_lib_parts($wanted) 647 648 or 649 650 # Handle octal numbers. We auto-detect octal numbers if they have a 651 # "0o", "0O", "o", "O" prefix, cf. CORE::oct(). 652 653 $wanted =~ /^\s*[+-]?0?[Oo]/ and 654 @parts = $class -> _oct_str_to_flt_lib_parts($wanted) 655 656 or 657 658 # Handle binary numbers. We auto-detect binary numbers if they have a 659 # "0b", "0B", "b", or "B" prefix, cf. CORE::oct(). 660 661 $wanted =~ /^\s*[+-]?0?[Bb]/ and 662 @parts = $class -> _bin_str_to_flt_lib_parts($wanted) 663 664 or 665 666 # At this point, what is left are decimal numbers that aren't handled 667 # above and octal floating point numbers that don't have any of the 668 # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number. 669 670 @parts = $class -> _dec_str_to_flt_lib_parts($wanted) 671 or 672 673 # See if it is an octal floating point number. The extra check is 674 # included because _oct_str_to_flt_lib_parts() accepts octal numbers 675 # that don't have a prefix (this is needed to make it work with, e.g., 676 # from_oct() that don't require a prefix). However, Perl requires a 677 # prefix for octal floating point literals. For example, "1p+0" is not 678 # valid, but "01p+0" and "0__1p+0" are. 679 680 $wanted =~ /^\s*[+-]?0_*\d/ and 681 @parts = $class -> _oct_str_to_flt_lib_parts($wanted)) 682 { 683 # The value is an integer iff the exponent is non-negative. 684 685 if ($parts[2] eq '+') { 686 $self -> {sign} = $parts[0]; 687 $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); 688 $self = $self->round(@r) 689 unless @r >= 2 && !defined($r[0]) && !defined($r[1]); 690 return $self; 691 } 692 693 # The value is not an integer, so upgrade if upgrading is enabled. 694 695 return $upgrade -> new($wanted, @r) if defined $upgrade; 696 } 697 698 # If we get here, the value is neither a valid decimal, binary, octal, or 699 # hexadecimal number. It is not explicit an Inf or a NaN either. 700 701 return $class -> bnan(@r); 702} 703 704# Create a Math::BigInt from a decimal string. This is an equivalent to 705# from_hex(), from_oct(), and from_bin(). It is like new() except that it does 706# not accept anything but a string representing a finite decimal number. 707 708sub from_dec { 709 my $self = shift; 710 my $selfref = ref $self; 711 my $class = $selfref || $self; 712 713 # Don't modify constant (read-only) objects. 714 715 return $self if $selfref && $self->modify('from_dec'); 716 717 my $str = shift; 718 my @r = @_; 719 720 # If called as a class method, initialize a new object. 721 722 $self = $class -> bzero(@r) unless $selfref; 723 724 if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) { 725 726 # The value is an integer iff the exponent is non-negative. 727 728 if ($parts[2] eq '+') { 729 $self -> {sign} = $parts[0]; 730 $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); 731 return $self -> round(@r); 732 } 733 734 # The value is not an integer, so upgrade if upgrading is enabled. 735 736 return $upgrade -> new($str, @r) if defined $upgrade; 737 } 738 739 return $self -> bnan(@r); 740} 741 742# Create a Math::BigInt from a hexadecimal string. 743 744sub from_hex { 745 my $self = shift; 746 my $selfref = ref $self; 747 my $class = $selfref || $self; 748 749 # Don't modify constant (read-only) objects. 750 751 return $self if $selfref && $self->modify('from_hex'); 752 753 my $str = shift; 754 my @r = @_; 755 756 # If called as a class method, initialize a new object. 757 758 $self = $class -> bzero(@r) unless $selfref; 759 760 if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) { 761 762 # The value is an integer iff the exponent is non-negative. 763 764 if ($parts[2] eq '+') { 765 $self -> {sign} = $parts[0]; 766 $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); 767 return $self -> round(@r); 768 } 769 770 # The value is not an integer, so upgrade if upgrading is enabled. 771 772 return $upgrade -> new($str, @r) if defined $upgrade; 773 } 774 775 return $self -> bnan(@r); 776} 777 778# Create a Math::BigInt from an octal string. 779 780sub from_oct { 781 my $self = shift; 782 my $selfref = ref $self; 783 my $class = $selfref || $self; 784 785 # Don't modify constant (read-only) objects. 786 787 return $self if $selfref && $self->modify('from_oct'); 788 789 my $str = shift; 790 my @r = @_; 791 792 # If called as a class method, initialize a new object. 793 794 $self = $class -> bzero(@r) unless $selfref; 795 796 if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) { 797 798 # The value is an integer iff the exponent is non-negative. 799 800 if ($parts[2] eq '+') { 801 $self -> {sign} = $parts[0]; 802 $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); 803 return $self -> round(@r); 804 } 805 806 # The value is not an integer, so upgrade if upgrading is enabled. 807 808 return $upgrade -> new($str, @r) if defined $upgrade; 809 } 810 811 return $self -> bnan(@r); 812} 813 814# Create a Math::BigInt from a binary string. 815 816sub from_bin { 817 my $self = shift; 818 my $selfref = ref $self; 819 my $class = $selfref || $self; 820 821 # Don't modify constant (read-only) objects. 822 823 return $self if $selfref && $self->modify('from_bin'); 824 825 my $str = shift; 826 my @r = @_; 827 828 # If called as a class method, initialize a new object. 829 830 $self = $class -> bzero(@r) unless $selfref; 831 832 if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) { 833 834 # The value is an integer iff the exponent is non-negative. 835 836 if ($parts[2] eq '+') { 837 $self -> {sign} = $parts[0]; 838 $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10); 839 return $self -> round(@r); 840 } 841 842 # The value is not an integer, so upgrade if upgrading is enabled. 843 844 return $upgrade -> new($str, @r) if defined $upgrade; 845 } 846 847 return $self -> bnan(@r); 848} 849 850# Create a Math::BigInt from a byte string. 851 852sub from_bytes { 853 my $self = shift; 854 my $selfref = ref $self; 855 my $class = $selfref || $self; 856 857 # Don't modify constant (read-only) objects. 858 859 return $self if $selfref && $self->modify('from_bytes'); 860 861 croak("from_bytes() requires a newer version of the $LIB library.") 862 unless $LIB->can('_from_bytes'); 863 864 my $str = shift; 865 my @r = @_; 866 867 # If called as a class method, initialize a new object. 868 869 $self = $class -> bzero(@r) unless $selfref; 870 $self -> {sign} = '+'; 871 $self -> {value} = $LIB -> _from_bytes($str); 872 return $self -> round(@r); 873} 874 875sub from_base { 876 my $self = shift; 877 my $selfref = ref $self; 878 my $class = $selfref || $self; 879 880 # Don't modify constant (read-only) objects. 881 882 return $self if $selfref && $self->modify('from_base'); 883 884 my ($str, $base, $cs, @r) = @_; # $cs is the collation sequence 885 886 $base = $class->new($base) unless ref($base); 887 888 croak("the base must be a finite integer >= 2") 889 if $base < 2 || ! $base -> is_int(); 890 891 # If called as a class method, initialize a new object. 892 893 $self = $class -> bzero() unless $selfref; 894 895 # If no collating sequence is given, pass some of the conversions to 896 # methods optimized for those cases. 897 898 unless (defined $cs) { 899 return $self -> from_bin($str, @r) if $base == 2; 900 return $self -> from_oct($str, @r) if $base == 8; 901 return $self -> from_hex($str, @r) if $base == 16; 902 if ($base == 10) { 903 my $tmp = $class -> from_dec($str, @r); 904 $self -> {value} = $tmp -> {value}; 905 $self -> {sign} = '+'; 906 return $self -> bround(@r); 907 } 908 } 909 910 croak("from_base() requires a newer version of the $LIB library.") 911 unless $LIB->can('_from_base'); 912 913 $self -> {sign} = '+'; 914 $self -> {value} 915 = $LIB->_from_base($str, $base -> {value}, defined($cs) ? $cs : ()); 916 return $self -> bround(@r); 917} 918 919sub from_base_num { 920 my $self = shift; 921 my $selfref = ref $self; 922 my $class = $selfref || $self; 923 924 # Don't modify constant (read-only) objects. 925 926 return $self if $selfref && $self->modify('from_base_num'); 927 928 # Make sure we have an array of non-negative, finite, numerical objects. 929 930 my $nums = shift; 931 $nums = [ @$nums ]; # create new reference 932 933 for my $i (0 .. $#$nums) { 934 # Make sure we have an object. 935 $nums -> [$i] = $class -> new($nums -> [$i]) 936 unless ref($nums -> [$i]) && $nums -> [$i] -> isa($class); 937 # Make sure we have a finite, non-negative integer. 938 croak "the elements must be finite non-negative integers" 939 if $nums -> [$i] -> is_neg() || ! $nums -> [$i] -> is_int(); 940 } 941 942 my $base = shift; 943 $base = $class -> new($base) unless ref($base) && $base -> isa($class); 944 945 my @r = @_; 946 947 # If called as a class method, initialize a new object. 948 949 $self = $class -> bzero(@r) unless $selfref; 950 951 croak("from_base_num() requires a newer version of the $LIB library.") 952 unless $LIB->can('_from_base_num'); 953 954 $self -> {sign} = '+'; 955 $self -> {value} = $LIB -> _from_base_num([ map { $_ -> {value} } @$nums ], 956 $base -> {value}); 957 958 return $self -> round(@r); 959} 960 961sub bzero { 962 # create/assign '+0' 963 964 # Class::method(...) -> Class->method(...) 965 unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || 966 $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) 967 { 968 #carp "Using ", (caller(0))[3], "() as a function is deprecated;", 969 # " use is as a method instead"; 970 unshift @_, __PACKAGE__; 971 } 972 973 my $self = shift; 974 my $selfref = ref $self; 975 my $class = $selfref || $self; 976 977 $self->import() if $IMPORT == 0; # make require work 978 979 # Don't modify constant (read-only) objects. 980 981 return $self if $selfref && $self->modify('bzero'); 982 983 # Get the rounding parameters, if any. 984 985 my @r = @_; 986 987 # If called as a class method, initialize a new object. 988 989 $self = bless {}, $class unless $selfref; 990 991 $self->{sign} = '+'; 992 $self->{value} = $LIB->_zero(); 993 994 # If rounding parameters are given as arguments, use them. If no rounding 995 # parameters are given, and if called as a class method, initialize the new 996 # instance with the class variables. 997 998 if (@r) { 999 croak "can't specify both accuracy and precision" 1000 if @r >= 2 && defined($r[0]) && defined($r[1]); 1001 $self->{_a} = $_[0]; 1002 $self->{_p} = $_[1]; 1003 } elsif (!$selfref) { 1004 $self->{_a} = $class -> accuracy(); 1005 $self->{_p} = $class -> precision(); 1006 } 1007 1008 return $self; 1009} 1010 1011sub bone { 1012 # Create or assign '+1' (or -1 if given sign '-'). 1013 1014 # Class::method(...) -> Class->method(...) 1015 unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || 1016 $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) 1017 { 1018 #carp "Using ", (caller(0))[3], "() as a function is deprecated;", 1019 # " use is as a method instead"; 1020 unshift @_, __PACKAGE__; 1021 } 1022 1023 my $self = shift; 1024 my $selfref = ref $self; 1025 my $class = $selfref || $self; 1026 1027 $self->import() if $IMPORT == 0; # make require work 1028 1029 # Don't modify constant (read-only) objects. 1030 1031 return $self if $selfref && $self->modify('bone'); 1032 1033 my ($sign, @r) = @_; 1034 1035 # Get the sign. 1036 1037 if (defined($_[0]) && $_[0] =~ /^\s*([+-])\s*$/) { 1038 $sign = $1; 1039 shift; 1040 } else { 1041 $sign = '+'; 1042 } 1043 1044 # If called as a class method, initialize a new object. 1045 1046 $self = bless {}, $class unless $selfref; 1047 1048 $self->{sign} = $sign; 1049 $self->{value} = $LIB->_one(); 1050 1051 # If rounding parameters are given as arguments, use them. If no rounding 1052 # parameters are given, and if called as a class method, initialize the new 1053 # instance with the class variables. 1054 1055 if (@r) { 1056 croak "can't specify both accuracy and precision" 1057 if @r >= 2 && defined($r[0]) && defined($r[1]); 1058 $self->{_a} = $_[0]; 1059 $self->{_p} = $_[1]; 1060 } elsif (!$selfref) { 1061 $self->{_a} = $class -> accuracy(); 1062 $self->{_p} = $class -> precision(); 1063 } 1064 1065 return $self; 1066} 1067 1068sub binf { 1069 # create/assign a '+inf' or '-inf' 1070 1071 # Class::method(...) -> Class->method(...) 1072 unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || 1073 $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) 1074 { 1075 #carp "Using ", (caller(0))[3], "() as a function is deprecated;", 1076 # " use is as a method instead"; 1077 unshift @_, __PACKAGE__; 1078 } 1079 1080 my $self = shift; 1081 my $selfref = ref $self; 1082 my $class = $selfref || $self; 1083 1084 { 1085 no strict 'refs'; 1086 if (${"${class}::_trap_inf"}) { 1087 croak("Tried to create +-inf in $class->binf()"); 1088 } 1089 } 1090 1091 $self->import() if $IMPORT == 0; # make require work 1092 1093 # Don't modify constant (read-only) objects. 1094 1095 return $self if $selfref && $self->modify('binf'); 1096 1097 # Get the sign. 1098 1099 my $sign = '+'; # default is to return positive infinity 1100 if (defined($_[0]) && $_[0] =~ /^\s*([+-])(inf|$)/i) { 1101 $sign = $1; 1102 shift; 1103 } 1104 1105 # Get the rounding parameters, if any. 1106 1107 my @r = @_; 1108 1109 # If called as a class method, initialize a new object. 1110 1111 $self = bless {}, $class unless $selfref; 1112 1113 $self -> {sign} = $sign . 'inf'; 1114 $self -> {value} = $LIB -> _zero(); 1115 1116 # If rounding parameters are given as arguments, use them. If no rounding 1117 # parameters are given, and if called as a class method, initialize the new 1118 # instance with the class variables. 1119 1120 if (@r) { 1121 croak "can't specify both accuracy and precision" 1122 if @r >= 2 && defined($r[0]) && defined($r[1]); 1123 $self->{_a} = $_[0]; 1124 $self->{_p} = $_[1]; 1125 } elsif (!$selfref) { 1126 $self->{_a} = $class -> accuracy(); 1127 $self->{_p} = $class -> precision(); 1128 } 1129 1130 return $self; 1131} 1132 1133sub bnan { 1134 # create/assign a 'NaN' 1135 1136 # Class::method(...) -> Class->method(...) 1137 unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || 1138 $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) 1139 { 1140 #carp "Using ", (caller(0))[3], "() as a function is deprecated;", 1141 # " use is as a method instead"; 1142 unshift @_, __PACKAGE__; 1143 } 1144 1145 my $self = shift; 1146 my $selfref = ref($self); 1147 my $class = $selfref || $self; 1148 1149 { 1150 no strict 'refs'; 1151 if (${"${class}::_trap_nan"}) { 1152 croak("Tried to create NaN in $class->bnan()"); 1153 } 1154 } 1155 1156 $self->import() if $IMPORT == 0; # make require work 1157 1158 # Don't modify constant (read-only) objects. 1159 1160 return $self if $selfref && $self->modify('bnan'); 1161 1162 # Get the rounding parameters, if any. 1163 1164 my @r = @_; 1165 1166 $self = bless {}, $class unless $selfref; 1167 1168 $self -> {sign} = $nan; 1169 $self -> {value} = $LIB -> _zero(); 1170 1171 # If rounding parameters are given as arguments, use them. If no rounding 1172 # parameters are given, and if called as a class method, initialize the new 1173 # instance with the class variables. 1174 1175 if (@r) { 1176 croak "can't specify both accuracy and precision" 1177 if @r >= 2 && defined($r[0]) && defined($r[1]); 1178 $self->{_a} = $_[0]; 1179 $self->{_p} = $_[1]; 1180 } elsif (!$selfref) { 1181 $self->{_a} = $class -> accuracy(); 1182 $self->{_p} = $class -> precision(); 1183 } 1184 1185 return $self; 1186} 1187 1188sub bpi { 1189 1190 # Class::method(...) -> Class->method(...) 1191 unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || 1192 $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) 1193 { 1194 #carp "Using ", (caller(0))[3], "() as a function is deprecated;", 1195 # " use is as a method instead"; 1196 unshift @_, __PACKAGE__; 1197 } 1198 1199 # Called as Argument list 1200 # --------- ------------- 1201 # Math::BigFloat->bpi() ("Math::BigFloat") 1202 # Math::BigFloat->bpi(10) ("Math::BigFloat", 10) 1203 # $x->bpi() ($x) 1204 # $x->bpi(10) ($x, 10) 1205 # Math::BigFloat::bpi() () 1206 # Math::BigFloat::bpi(10) (10) 1207 # 1208 # In ambiguous cases, we favour the OO-style, so the following case 1209 # 1210 # $n = Math::BigFloat->new("10"); 1211 # $x = Math::BigFloat->bpi($n); 1212 # 1213 # which gives an argument list with the single element $n, is resolved as 1214 # 1215 # $n->bpi(); 1216 1217 my $self = shift; 1218 my $selfref = ref $self; 1219 my $class = $selfref || $self; 1220 my @r = @_; # rounding paramters 1221 1222 if ($selfref) { # bpi() called as an instance method 1223 return $self if $self -> modify('bpi'); 1224 } else { # bpi() called as a class method 1225 $self = bless {}, $class; # initialize new instance 1226 } 1227 1228 return $upgrade -> bpi(@r) if defined $upgrade; 1229 1230 # hard-wired to "3" 1231 $self -> {sign} = '+'; 1232 $self -> {value} = $LIB -> _new("3"); 1233 $self = $self -> round(@r); 1234 return $self; 1235} 1236 1237sub copy { 1238 my ($x, $class); 1239 if (ref($_[0])) { # $y = $x -> copy() 1240 $x = shift; 1241 $class = ref($x); 1242 } else { # $y = Math::BigInt -> copy($y) 1243 $class = shift; 1244 $x = shift; 1245 } 1246 1247 carp "Rounding is not supported for ", (caller(0))[3], "()" if @_; 1248 1249 my $copy = bless {}, $class; 1250 1251 $copy->{sign} = $x->{sign}; 1252 $copy->{value} = $LIB->_copy($x->{value}); 1253 $copy->{_a} = $x->{_a} if exists $x->{_a}; 1254 $copy->{_p} = $x->{_p} if exists $x->{_p}; 1255 1256 return $copy; 1257} 1258 1259sub as_int { 1260 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1261 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1262 1263 # If called as an instance method, and the instance class is something we 1264 # upgrade to, $x might not be a Math::BigInt, so don't just call copy(). 1265 1266 return $x -> copy() if $x -> isa("Math::BigInt"); 1267 1268 # disable upgrading and downgrading 1269 1270 my $upg = Math::BigInt -> upgrade(); 1271 my $dng = Math::BigInt -> downgrade(); 1272 Math::BigInt -> upgrade(undef); 1273 Math::BigInt -> downgrade(undef); 1274 1275 my $y = Math::BigInt -> new($x); 1276 1277 # reset upgrading and downgrading 1278 1279 Math::BigInt -> upgrade($upg); 1280 Math::BigInt -> downgrade($dng); 1281 1282 return $y; 1283} 1284 1285sub as_float { 1286 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1287 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1288 1289 # disable upgrading and downgrading 1290 1291 require Math::BigFloat; 1292 my $upg = Math::BigFloat -> upgrade(); 1293 my $dng = Math::BigFloat -> downgrade(); 1294 Math::BigFloat -> upgrade(undef); 1295 Math::BigFloat -> downgrade(undef); 1296 1297 my $y = Math::BigFloat -> new($x); 1298 1299 # reset upgrading and downgrading 1300 1301 Math::BigFloat -> upgrade($upg); 1302 Math::BigFloat -> downgrade($dng); 1303 1304 return $y; 1305} 1306 1307sub as_rat { 1308 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1309 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1310 1311 # disable upgrading and downgrading 1312 1313 require Math::BigRat; 1314 my $upg = Math::BigRat -> upgrade(); 1315 my $dng = Math::BigRat -> downgrade(); 1316 Math::BigRat -> upgrade(undef); 1317 Math::BigRat -> downgrade(undef); 1318 1319 my $y = Math::BigRat -> new($x); 1320 1321 # reset upgrading and downgrading 1322 1323 Math::BigRat -> upgrade($upg); 1324 Math::BigRat -> downgrade($dng); 1325 1326 return $y; 1327} 1328 1329############################################################################### 1330# Boolean methods 1331############################################################################### 1332 1333sub is_zero { 1334 # return true if arg (BINT or num_str) is zero (array '+', '0') 1335 my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1336 1337 return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't 1338 $LIB->_is_zero($x->{value}); 1339} 1340 1341sub is_one { 1342 # return true if arg (BINT or num_str) is +1, or -1 if sign is given 1343 my (undef, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1344 1345 $sign = '+' if !defined($sign) || $sign ne '-'; 1346 1347 return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either 1348 $LIB->_is_one($x->{value}); 1349} 1350 1351sub is_finite { 1352 my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1353 return $x->{sign} eq '+' || $x->{sign} eq '-'; 1354} 1355 1356sub is_inf { 1357 # return true if arg (BINT or num_str) is +-inf 1358 my (undef, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1359 1360 if (defined $sign) { 1361 $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf 1362 $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-' 1363 return $x->{sign} =~ /^$sign$/ ? 1 : 0; 1364 } 1365 $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity 1366} 1367 1368sub is_nan { 1369 # return true if arg (BINT or num_str) is NaN 1370 my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1371 1372 $x->{sign} eq $nan ? 1 : 0; 1373} 1374 1375sub is_positive { 1376 # return true when arg (BINT or num_str) is positive (> 0) 1377 my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1378 1379 return 1 if $x->{sign} eq '+inf'; # +inf is positive 1380 1381 # 0+ is neither positive nor negative 1382 ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0; 1383} 1384 1385sub is_negative { 1386 # return true when arg (BINT or num_str) is negative (< 0) 1387 my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1388 1389 $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not 1390} 1391 1392sub is_non_negative { 1393 # Return true if argument is non-negative (>= 0). 1394 my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1395 1396 return 1 if $x->{sign} =~ /^\+/; 1397 return 1 if $x -> is_zero(); 1398 return 0; 1399} 1400 1401sub is_non_positive { 1402 # Return true if argument is non-positive (<= 0). 1403 my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1404 1405 return 1 if $x->{sign} =~ /^\-/; 1406 return 1 if $x -> is_zero(); 1407 return 0; 1408} 1409 1410sub is_odd { 1411 # return true when arg (BINT or num_str) is odd, false for even 1412 my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1413 1414 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't 1415 $LIB->_is_odd($x->{value}); 1416} 1417 1418sub is_even { 1419 # return true when arg (BINT or num_str) is even, false for odd 1420 my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1421 1422 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't 1423 $LIB->_is_even($x->{value}); 1424} 1425 1426sub is_int { 1427 # return true when arg (BINT or num_str) is an integer 1428 my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 1429 1430 $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't 1431} 1432 1433############################################################################### 1434# Comparison methods 1435############################################################################### 1436 1437sub bcmp { 1438 # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort) 1439 # (BINT or num_str, BINT or num_str) return cond_code 1440 1441 # set up parameters 1442 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1443 ? (ref($_[0]), @_) 1444 : objectify(2, @_); 1445 1446 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1447 1448 return $upgrade->bcmp($x, $y) 1449 if defined($upgrade) && (!$x->isa($class) || !$y->isa($class)); 1450 1451 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { 1452 # handle +-inf and NaN 1453 return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 1454 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; 1455 return +1 if $x->{sign} eq '+inf'; 1456 return -1 if $x->{sign} eq '-inf'; 1457 return -1 if $y->{sign} eq '+inf'; 1458 return +1; 1459 } 1460 1461 # check sign for speed first 1462 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y 1463 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0 1464 1465 # have same sign, so compare absolute values. Don't make tests for zero 1466 # here because it's actually slower than testing in Calc (especially w/ Pari 1467 # et al) 1468 1469 # post-normalized compare for internal use (honors signs) 1470 if ($x->{sign} eq '+') { 1471 # $x and $y both > 0 1472 return $LIB->_acmp($x->{value}, $y->{value}); 1473 } 1474 1475 # $x && $y both < 0 1476 $LIB->_acmp($y->{value}, $x->{value}); # swapped acmp (lib returns 0, 1, -1) 1477} 1478 1479sub bacmp { 1480 # Compares 2 values, ignoring their signs. 1481 # Returns one of undef, <0, =0, >0. (suitable for sort) 1482 # (BINT, BINT) return cond_code 1483 1484 # set up parameters 1485 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1486 ? (ref($_[0]), @_) 1487 : objectify(2, @_); 1488 1489 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1490 1491 return $upgrade->bacmp($x, $y) 1492 if defined($upgrade) && (!$x->isa($class) || !$y->isa($class)); 1493 1494 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { 1495 # handle +-inf and NaN 1496 return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 1497 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; 1498 return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; 1499 return -1; 1500 } 1501 $LIB->_acmp($x->{value}, $y->{value}); # lib does only 0, 1, -1 1502} 1503 1504sub beq { 1505 my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1506 ? (undef, @_) 1507 : objectify(2, @_); 1508 1509 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1510 1511 my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary 1512 return defined($cmp) && !$cmp; 1513} 1514 1515sub bne { 1516 my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1517 ? (undef, @_) 1518 : objectify(2, @_); 1519 1520 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1521 1522 my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary 1523 return defined($cmp) && !$cmp ? '' : 1; 1524} 1525 1526sub blt { 1527 my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1528 ? (undef, @_) 1529 : objectify(2, @_); 1530 1531 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1532 1533 my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary 1534 return defined($cmp) && $cmp < 0; 1535} 1536 1537sub ble { 1538 my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1539 ? (undef, @_) 1540 : objectify(2, @_); 1541 1542 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1543 1544 my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary 1545 return defined($cmp) && $cmp <= 0; 1546} 1547 1548sub bgt { 1549 my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1550 ? (undef, @_) 1551 : objectify(2, @_); 1552 1553 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1554 1555 my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary 1556 return defined($cmp) && $cmp > 0; 1557} 1558 1559sub bge { 1560 my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1561 ? (undef, @_) 1562 : objectify(2, @_); 1563 1564 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1565 1566 my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary 1567 return defined($cmp) && $cmp >= 0; 1568} 1569 1570############################################################################### 1571# Arithmetic methods 1572############################################################################### 1573 1574sub bneg { 1575 # (BINT or num_str) return BINT 1576 # negate number or make a negated number from string 1577 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1578 1579 return $x if $x->modify('bneg'); 1580 1581 return $upgrade -> bneg($x, @r) if defined($upgrade) && !$x->isa($class); 1582 1583 # Don't negate +0 so we always have the normalized form +0. Does nothing for 1584 # 'NaN'. 1585 $x->{sign} =~ tr/+-/-+/ 1586 unless $x->{sign} eq '+' && $LIB->_is_zero($x->{value}); 1587 1588 $x -> round(@r); 1589} 1590 1591sub babs { 1592 # (BINT or num_str) return BINT 1593 # make number absolute, or return absolute BINT from string 1594 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1595 1596 return $x if $x->modify('babs'); 1597 1598 return $upgrade -> babs($x, @r) if defined($upgrade) && !$x->isa($class); 1599 1600 $x->{sign} =~ s/^-/+/; 1601 1602 $x -> round(@r); 1603} 1604 1605sub bsgn { 1606 # Signum function. 1607 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1608 1609 return $x if $x->modify('bsgn'); 1610 1611 return $upgrade -> bsgn($x, @r) if defined($upgrade) && !$x->isa($class); 1612 1613 return $x -> bone("+", @r) if $x -> is_pos(); 1614 return $x -> bone("-", @r) if $x -> is_neg(); 1615 1616 $x -> round(@r); 1617} 1618 1619sub bnorm { 1620 # (numstr or BINT) return BINT 1621 # Normalize number -- no-op here 1622 my ($class, $x, @r) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 1623 1624 # This method is called from the rounding methods, so if this method 1625 # supports rounding by calling the rounding methods, we get an infinite 1626 # recursion. 1627 1628 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 1629 1630 $x; 1631} 1632 1633sub binc { 1634 # increment arg by one 1635 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1636 1637 return $x if $x->modify('binc'); 1638 1639 return $x->round(@r) if $x -> is_inf() || $x -> is_nan(); 1640 1641 return $upgrade -> binc($x, @r) if defined($upgrade) && !$x -> isa($class); 1642 1643 if ($x->{sign} eq '+') { 1644 $x->{value} = $LIB->_inc($x->{value}); 1645 } elsif ($x->{sign} eq '-') { 1646 $x->{value} = $LIB->_dec($x->{value}); 1647 $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # -1 +1 => -0 => +0 1648 } 1649 1650 return $x->round(@r); 1651} 1652 1653sub bdec { 1654 # decrement arg by one 1655 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1656 1657 return $x if $x->modify('bdec'); 1658 1659 return $x->round(@r) if $x -> is_inf() || $x -> is_nan(); 1660 1661 return $upgrade -> bdec($x, @r) if defined($upgrade) && !$x -> isa($class);; 1662 1663 if ($x->{sign} eq '-') { 1664 $x->{value} = $LIB->_inc($x->{value}); 1665 } elsif ($x->{sign} eq '+') { 1666 if ($LIB->_is_zero($x->{value})) { # +1 - 1 => +0 1667 $x->{value} = $LIB->_one(); 1668 $x->{sign} = '-'; 1669 } else { 1670 $x->{value} = $LIB->_dec($x->{value}); 1671 } 1672 } 1673 1674 return $x->round(@r); 1675} 1676 1677#sub bstrcmp { 1678# my $self = shift; 1679# my $selfref = ref $self; 1680# my $class = $selfref || $self; 1681# 1682# croak 'bstrcmp() is an instance method, not a class method' 1683# unless $selfref; 1684# croak 'Wrong number of arguments for bstrcmp()' unless @_ == 1; 1685# 1686# return $self -> bstr() CORE::cmp shift; 1687#} 1688# 1689#sub bstreq { 1690# my $self = shift; 1691# my $selfref = ref $self; 1692# my $class = $selfref || $self; 1693# 1694# croak 'bstreq() is an instance method, not a class method' 1695# unless $selfref; 1696# croak 'Wrong number of arguments for bstreq()' unless @_ == 1; 1697# 1698# my $cmp = $self -> bstrcmp(shift); 1699# return defined($cmp) && ! $cmp; 1700#} 1701# 1702#sub bstrne { 1703# my $self = shift; 1704# my $selfref = ref $self; 1705# my $class = $selfref || $self; 1706# 1707# croak 'bstrne() is an instance method, not a class method' 1708# unless $selfref; 1709# croak 'Wrong number of arguments for bstrne()' unless @_ == 1; 1710# 1711# my $cmp = $self -> bstrcmp(shift); 1712# return defined($cmp) && ! $cmp ? '' : 1; 1713#} 1714# 1715#sub bstrlt { 1716# my $self = shift; 1717# my $selfref = ref $self; 1718# my $class = $selfref || $self; 1719# 1720# croak 'bstrlt() is an instance method, not a class method' 1721# unless $selfref; 1722# croak 'Wrong number of arguments for bstrlt()' unless @_ == 1; 1723# 1724# my $cmp = $self -> bstrcmp(shift); 1725# return defined($cmp) && $cmp < 0; 1726#} 1727# 1728#sub bstrle { 1729# my $self = shift; 1730# my $selfref = ref $self; 1731# my $class = $selfref || $self; 1732# 1733# croak 'bstrle() is an instance method, not a class method' 1734# unless $selfref; 1735# croak 'Wrong number of arguments for bstrle()' unless @_ == 1; 1736# 1737# my $cmp = $self -> bstrcmp(shift); 1738# return defined($cmp) && $cmp <= 0; 1739#} 1740# 1741#sub bstrgt { 1742# my $self = shift; 1743# my $selfref = ref $self; 1744# my $class = $selfref || $self; 1745# 1746# croak 'bstrgt() is an instance method, not a class method' 1747# unless $selfref; 1748# croak 'Wrong number of arguments for bstrgt()' unless @_ == 1; 1749# 1750# my $cmp = $self -> bstrcmp(shift); 1751# return defined($cmp) && $cmp > 0; 1752#} 1753# 1754#sub bstrge { 1755# my $self = shift; 1756# my $selfref = ref $self; 1757# my $class = $selfref || $self; 1758# 1759# croak 'bstrge() is an instance method, not a class method' 1760# unless $selfref; 1761# croak 'Wrong number of arguments for bstrge()' unless @_ == 1; 1762# 1763# my $cmp = $self -> bstrcmp(shift); 1764# return defined($cmp) && $cmp >= 0; 1765#} 1766 1767sub badd { 1768 # add second arg (BINT or string) to first (BINT) (modifies first) 1769 # return result as BINT 1770 1771 # set up parameters 1772 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1773 ? (ref($_[0]), @_) 1774 : objectify(2, @_); 1775 1776 return $x if $x->modify('badd'); 1777 1778 $r[3] = $y; # no push! 1779 1780 return $upgrade->badd($x, $y, @r) 1781 if defined($upgrade) && (!$x->isa($class) || !$y->isa($class)); 1782 1783 # Inf and NaN handling 1784 if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { 1785 # NaN first 1786 return $x->bnan(@r) if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 1787 # Inf handling 1788 if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) { 1789 # +Inf + +Inf or -Inf + -Inf => same, rest is NaN 1790 return $x->round(@r) if $x->{sign} eq $y->{sign}; 1791 return $x->bnan(@r); 1792 } 1793 # ��Inf + something => ��Inf 1794 # something + ��Inf => ��Inf 1795 if ($y->{sign} =~ /^[+-]inf$/) { 1796 $x->{sign} = $y->{sign}; 1797 } 1798 return $x -> round(@r); 1799 } 1800 1801 ($x->{value}, $x->{sign}) 1802 = $LIB -> _sadd($x->{value}, $x->{sign}, $y->{value}, $y->{sign}); 1803 $x->round(@r); 1804} 1805 1806sub bsub { 1807 # (BINT or num_str, BINT or num_str) return BINT 1808 # subtract second arg from first, modify first 1809 1810 # set up parameters 1811 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1812 ? (ref($_[0]), @_) 1813 : objectify(2, @_); 1814 1815 return $x if $x -> modify('bsub'); 1816 1817 return $upgrade -> bsub($x, $y, @r) 1818 if defined($upgrade) && (!$x->isa($class) || !$y->isa($class)); 1819 1820 return $x -> round(@r) if $y -> is_zero(); 1821 1822 # To correctly handle the lone special case $x -> bsub($x), we note the 1823 # sign of $x, then flip the sign from $y, and if the sign of $x did change, 1824 # too, then we caught the special case: 1825 1826 my $xsign = $x -> {sign}; 1827 $y -> {sign} =~ tr/+-/-+/; # does nothing for NaN 1828 if ($xsign ne $x -> {sign}) { 1829 # special case of $x -> bsub($x) results in 0 1830 return $x -> bzero(@r) if $xsign =~ /^[+-]$/; 1831 return $x -> bnan(@r); # NaN, -inf, +inf 1832 } 1833 1834 $x = $x -> badd($y, @r); # badd() does not leave internal zeros 1835 $y -> {sign} =~ tr/+-/-+/; # refix $y (does nothing for NaN) 1836 $x; # already rounded by badd() or no rounding 1837} 1838 1839sub bmul { 1840 # multiply the first number by the second number 1841 # (BINT or num_str, BINT or num_str) return BINT 1842 1843 # set up parameters 1844 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 1845 ? (ref($_[0]), @_) 1846 : objectify(2, @_); 1847 1848 return $x if $x->modify('bmul'); 1849 1850 return $x->bnan(@r) if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 1851 1852 # inf handling 1853 if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { 1854 return $x->bnan(@r) if $x->is_zero() || $y->is_zero(); 1855 # result will always be +-inf: 1856 # +inf * +/+inf => +inf, -inf * -/-inf => +inf 1857 # +inf * -/-inf => -inf, -inf * +/+inf => -inf 1858 return $x->binf(@r) if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); 1859 return $x->binf(@r) if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); 1860 return $x->binf('-', @r); 1861 } 1862 1863 return $upgrade->bmul($x, $y, @r) 1864 if defined($upgrade) && (!$x->isa($class) || !$y->isa($class)); 1865 1866 $r[3] = $y; # no push here 1867 1868 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + 1869 1870 $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math 1871 $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # no -0 1872 1873 $x->round(@r); 1874} 1875 1876sub bmuladd { 1877 # multiply two numbers and then add the third to the result 1878 # (BINT or num_str, BINT or num_str, BINT or num_str) return BINT 1879 1880 # set up parameters 1881 my ($class, $x, $y, $z, @r) 1882 = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2]) 1883 ? (ref($_[0]), @_) 1884 : objectify(3, @_); 1885 1886 return $x if $x->modify('bmuladd'); 1887 1888 # x, y, and z are finite numbers 1889 1890 if ($x->{sign} =~ /^[+-]$/ && 1891 $y->{sign} =~ /^[+-]$/ && 1892 $z->{sign} =~ /^[+-]$/) 1893 { 1894 return $upgrade->bmuladd($x, $y, $z, @r) 1895 if defined($upgrade) 1896 && (!$x->isa($class) || !$y->isa($class) || !$z->isa($class)); 1897 1898 # TODO: what if $y and $z have A or P set? 1899 $r[3] = $z; # no push here 1900 1901 my $zs = $z->{sign}; 1902 my $zv = $z->{value}; 1903 $zv = $LIB -> _copy($zv) if refaddr($x) eq refaddr($z); 1904 1905 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + 1906 $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math 1907 $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # no -0 1908 1909 ($x->{value}, $x->{sign}) 1910 = $LIB -> _sadd($x->{value}, $x->{sign}, $zv, $zs); 1911 return $x->round(@r); 1912 } 1913 1914 # At least one of x, y, and z is a NaN 1915 1916 return $x->bnan(@r) if (($x->{sign} eq $nan) || 1917 ($y->{sign} eq $nan) || 1918 ($z->{sign} eq $nan)); 1919 1920 # At least one of x, y, and z is an Inf 1921 1922 if ($x->{sign} eq "-inf") { 1923 1924 if ($y -> is_neg()) { # x = -inf, y < 0 1925 if ($z->{sign} eq "-inf") { 1926 return $x->bnan(@r); 1927 } else { 1928 return $x->binf("+", @r); 1929 } 1930 } elsif ($y -> is_zero()) { # x = -inf, y = 0 1931 return $x->bnan(@r); 1932 } else { # x = -inf, y > 0 1933 if ($z->{sign} eq "+inf") { 1934 return $x->bnan(@r); 1935 } else { 1936 return $x->binf("-", @r); 1937 } 1938 } 1939 1940 } elsif ($x->{sign} eq "+inf") { 1941 1942 if ($y -> is_neg()) { # x = +inf, y < 0 1943 if ($z->{sign} eq "+inf") { 1944 return $x->bnan(@r); 1945 } else { 1946 return $x->binf("-", @r); 1947 } 1948 } elsif ($y -> is_zero()) { # x = +inf, y = 0 1949 return $x->bnan(@r); 1950 } else { # x = +inf, y > 0 1951 if ($z->{sign} eq "-inf") { 1952 return $x->bnan(@r); 1953 } else { 1954 return $x->binf("+", @r); 1955 } 1956 } 1957 1958 } elsif ($x -> is_neg()) { 1959 1960 if ($y->{sign} eq "-inf") { # -inf < x < 0, y = -inf 1961 if ($z->{sign} eq "-inf") { 1962 return $x->bnan(@r); 1963 } else { 1964 return $x->binf("+", @r); 1965 } 1966 } elsif ($y->{sign} eq "+inf") { # -inf < x < 0, y = +inf 1967 if ($z->{sign} eq "+inf") { 1968 return $x->bnan(@r); 1969 } else { 1970 return $x->binf("-", @r); 1971 } 1972 } else { # -inf < x < 0, -inf < y < +inf 1973 if ($z->{sign} eq "-inf") { 1974 return $x->binf("-", @r); 1975 } elsif ($z->{sign} eq "+inf") { 1976 return $x->binf("+", @r); 1977 } 1978 } 1979 1980 } elsif ($x -> is_zero()) { 1981 1982 if ($y->{sign} eq "-inf") { # x = 0, y = -inf 1983 return $x->bnan(@r); 1984 } elsif ($y->{sign} eq "+inf") { # x = 0, y = +inf 1985 return $x->bnan(@r); 1986 } else { # x = 0, -inf < y < +inf 1987 if ($z->{sign} eq "-inf") { 1988 return $x->binf("-", @r); 1989 } elsif ($z->{sign} eq "+inf") { 1990 return $x->binf("+", @r); 1991 } 1992 } 1993 1994 } elsif ($x -> is_pos()) { 1995 1996 if ($y->{sign} eq "-inf") { # 0 < x < +inf, y = -inf 1997 if ($z->{sign} eq "+inf") { 1998 return $x->bnan(@r); 1999 } else { 2000 return $x->binf("-", @r); 2001 } 2002 } elsif ($y->{sign} eq "+inf") { # 0 < x < +inf, y = +inf 2003 if ($z->{sign} eq "-inf") { 2004 return $x->bnan(@r); 2005 } else { 2006 return $x->binf("+", @r); 2007 } 2008 } else { # 0 < x < +inf, -inf < y < +inf 2009 if ($z->{sign} eq "-inf") { 2010 return $x->binf("-", @r); 2011 } elsif ($z->{sign} eq "+inf") { 2012 return $x->binf("+", @r); 2013 } 2014 } 2015 } 2016 2017 die; 2018} 2019 2020sub bdiv { 2021 # This does floored division, where the quotient is floored, i.e., rounded 2022 # towards negative infinity. As a consequence, the remainder has the same 2023 # sign as the divisor. 2024 2025 # Set up parameters. 2026 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 2027 ? (ref($_[0]), @_) 2028 : objectify(2, @_); 2029 2030 return $x if $x -> modify('bdiv'); 2031 2032 my $wantarray = wantarray; # call only once 2033 2034 # At least one argument is NaN. Return NaN for both quotient and the 2035 # modulo/remainder. 2036 2037 if ($x -> is_nan() || $y -> is_nan()) { 2038 return $wantarray ? ($x -> bnan(@r), $class -> bnan(@r)) 2039 : $x -> bnan(@r); 2040 } 2041 2042 # Divide by zero and modulo zero. 2043 # 2044 # Division: Use the common convention that x / 0 is inf with the same sign 2045 # as x, except when x = 0, where we return NaN. This is also what earlier 2046 # versions did. 2047 # 2048 # Modulo: In modular arithmetic, the congruence relation z = x (mod y) 2049 # means that there is some integer k such that z - x = k y. If y = 0, we 2050 # get z - x = 0 or z = x. This is also what earlier versions did, except 2051 # that 0 % 0 returned NaN. 2052 # 2053 # inf / 0 = inf inf % 0 = inf 2054 # 5 / 0 = inf 5 % 0 = 5 2055 # 0 / 0 = NaN 0 % 0 = 0 2056 # -5 / 0 = -inf -5 % 0 = -5 2057 # -inf / 0 = -inf -inf % 0 = -inf 2058 2059 if ($y -> is_zero()) { 2060 my $rem; 2061 if ($wantarray) { 2062 $rem = $x -> copy() -> round(@r); 2063 } 2064 if ($x -> is_zero()) { 2065 $x = $x -> bnan(@r); 2066 } else { 2067 $x = $x -> binf($x -> {sign}, @r); 2068 } 2069 return $wantarray ? ($x, $rem) : $x; 2070 } 2071 2072 # Numerator (dividend) is +/-inf, and denominator is finite and non-zero. 2073 # The divide by zero cases are covered above. In all of the cases listed 2074 # below we return the same as core Perl. 2075 # 2076 # inf / -inf = NaN inf % -inf = NaN 2077 # inf / -5 = -inf inf % -5 = NaN 2078 # inf / 5 = inf inf % 5 = NaN 2079 # inf / inf = NaN inf % inf = NaN 2080 # 2081 # -inf / -inf = NaN -inf % -inf = NaN 2082 # -inf / -5 = inf -inf % -5 = NaN 2083 # -inf / 5 = -inf -inf % 5 = NaN 2084 # -inf / inf = NaN -inf % inf = NaN 2085 2086 if ($x -> is_inf()) { 2087 my $rem; 2088 $rem = $class -> bnan(@r) if $wantarray; 2089 if ($y -> is_inf()) { 2090 $x = $x -> bnan(@r); 2091 } else { 2092 my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-'; 2093 $x = $x -> binf($sign, @r); 2094 } 2095 return $wantarray ? ($x, $rem) : $x; 2096 } 2097 2098 # Denominator (divisor) is +/-inf. The cases when the numerator is +/-inf 2099 # are covered above. In the modulo cases (in the right column) we return 2100 # the same as core Perl, which does floored division, so for consistency we 2101 # also do floored division in the division cases (in the left column). 2102 # 2103 # -5 / inf = -1 -5 % inf = inf 2104 # 0 / inf = 0 0 % inf = 0 2105 # 5 / inf = 0 5 % inf = 5 2106 # 2107 # -5 / -inf = 0 -5 % -inf = -5 2108 # 0 / -inf = 0 0 % -inf = 0 2109 # 5 / -inf = -1 5 % -inf = -inf 2110 2111 if ($y -> is_inf()) { 2112 my $rem; 2113 if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { 2114 $rem = $x -> copy() -> round(@r) if $wantarray; 2115 $x = $x -> bzero(@r); 2116 } else { 2117 $rem = $class -> binf($y -> {sign}, @r) if $wantarray; 2118 $x = $x -> bone('-', @r); 2119 } 2120 return $wantarray ? ($x, $rem) : $x; 2121 } 2122 2123 # At this point, both the numerator and denominator are finite numbers, and 2124 # the denominator (divisor) is non-zero. 2125 2126 # Division might return a non-integer result, so upgrade unconditionally, if 2127 # upgrading is enabled. 2128 2129 return $upgrade -> bdiv($x, $y, @r) if defined $upgrade; 2130 2131 $r[3] = $y; # no push! 2132 2133 # Inialize remainder. 2134 2135 my $rem = $class -> bzero(); 2136 2137 # Are both operands the same object, i.e., like $x -> bdiv($x)? If so, 2138 # flipping the sign of $y also flips the sign of $x. 2139 2140 my $xsign = $x -> {sign}; 2141 my $ysign = $y -> {sign}; 2142 2143 $y -> {sign} =~ tr/+-/-+/; # Flip the sign of $y, and see ... 2144 my $same = $xsign ne $x -> {sign}; # ... if that changed the sign of $x. 2145 $y -> {sign} = $ysign; # Re-insert the original sign. 2146 2147 if ($same) { 2148 $x = $x -> bone(); 2149 } else { 2150 ($x -> {value}, $rem -> {value}) = 2151 $LIB -> _div($x -> {value}, $y -> {value}); 2152 2153 if ($LIB -> _is_zero($rem -> {value})) { 2154 if ($xsign eq $ysign || $LIB -> _is_zero($x -> {value})) { 2155 $x -> {sign} = '+'; 2156 } else { 2157 $x -> {sign} = '-'; 2158 } 2159 } else { 2160 if ($xsign eq $ysign) { 2161 $x -> {sign} = '+'; 2162 } else { 2163 if ($xsign eq '+') { 2164 $x = $x -> badd(1); 2165 } else { 2166 $x = $x -> bsub(1); 2167 } 2168 $x -> {sign} = '-'; 2169 } 2170 } 2171 } 2172 2173 $x = $x -> round(@r); 2174 2175 if ($wantarray) { 2176 unless ($LIB -> _is_zero($rem -> {value})) { 2177 if ($xsign ne $ysign) { 2178 $rem = $y -> copy() -> babs() -> bsub($rem); 2179 } 2180 $rem -> {sign} = $ysign; 2181 } 2182 $rem -> {_a} = $x -> {_a}; 2183 $rem -> {_p} = $x -> {_p}; 2184 $rem = $rem -> round(@r); 2185 return ($x, $rem); 2186 } 2187 2188 return $x; 2189} 2190 2191sub btdiv { 2192 # This does truncated division, where the quotient is truncted, i.e., 2193 # rounded towards zero. 2194 # 2195 # ($q, $r) = $x -> btdiv($y) returns $q and $r so that $q is int($x / $y) 2196 # and $q * $y + $r = $x. 2197 2198 # Set up parameters 2199 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 2200 ? (ref($_[0]), @_) 2201 : objectify(2, @_); 2202 2203 return $x if $x -> modify('btdiv'); 2204 2205 my $wantarray = wantarray; # call only once 2206 2207 # At least one argument is NaN. Return NaN for both quotient and the 2208 # modulo/remainder. 2209 2210 if ($x -> is_nan() || $y -> is_nan()) { 2211 return $wantarray ? ($x -> bnan(@r), $class -> bnan(@r)) 2212 : $x -> bnan(@r); 2213 } 2214 2215 # Divide by zero and modulo zero. 2216 # 2217 # Division: Use the common convention that x / 0 is inf with the same sign 2218 # as x, except when x = 0, where we return NaN. This is also what earlier 2219 # versions did. 2220 # 2221 # Modulo: In modular arithmetic, the congruence relation z = x (mod y) 2222 # means that there is some integer k such that z - x = k y. If y = 0, we 2223 # get z - x = 0 or z = x. This is also what earlier versions did, except 2224 # that 0 % 0 returned NaN. 2225 # 2226 # inf / 0 = inf inf % 0 = inf 2227 # 5 / 0 = inf 5 % 0 = 5 2228 # 0 / 0 = NaN 0 % 0 = 0 2229 # -5 / 0 = -inf -5 % 0 = -5 2230 # -inf / 0 = -inf -inf % 0 = -inf 2231 2232 if ($y -> is_zero()) { 2233 my $rem; 2234 if ($wantarray) { 2235 $rem = $x -> copy(@r); 2236 } 2237 if ($x -> is_zero()) { 2238 $x = $x -> bnan(@r); 2239 } else { 2240 $x = $x -> binf($x -> {sign}, @r); 2241 } 2242 return $wantarray ? ($x, $rem) : $x; 2243 } 2244 2245 # Numerator (dividend) is +/-inf, and denominator is finite and non-zero. 2246 # The divide by zero cases are covered above. In all of the cases listed 2247 # below we return the same as core Perl. 2248 # 2249 # inf / -inf = NaN inf % -inf = NaN 2250 # inf / -5 = -inf inf % -5 = NaN 2251 # inf / 5 = inf inf % 5 = NaN 2252 # inf / inf = NaN inf % inf = NaN 2253 # 2254 # -inf / -inf = NaN -inf % -inf = NaN 2255 # -inf / -5 = inf -inf % -5 = NaN 2256 # -inf / 5 = -inf -inf % 5 = NaN 2257 # -inf / inf = NaN -inf % inf = NaN 2258 2259 if ($x -> is_inf()) { 2260 my $rem; 2261 $rem = $class -> bnan(@r) if $wantarray; 2262 if ($y -> is_inf()) { 2263 $x = $x -> bnan(@r); 2264 } else { 2265 my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-'; 2266 $x = $x -> binf($sign,@r ); 2267 } 2268 return $wantarray ? ($x, $rem) : $x; 2269 } 2270 2271 # Denominator (divisor) is +/-inf. The cases when the numerator is +/-inf 2272 # are covered above. In the modulo cases (in the right column) we return 2273 # the same as core Perl, which does floored division, so for consistency we 2274 # also do floored division in the division cases (in the left column). 2275 # 2276 # -5 / inf = 0 -5 % inf = -5 2277 # 0 / inf = 0 0 % inf = 0 2278 # 5 / inf = 0 5 % inf = 5 2279 # 2280 # -5 / -inf = 0 -5 % -inf = -5 2281 # 0 / -inf = 0 0 % -inf = 0 2282 # 5 / -inf = 0 5 % -inf = 5 2283 2284 if ($y -> is_inf()) { 2285 my $rem; 2286 $rem = $x -> copy() -> round(@r) if $wantarray; 2287 $x = $x -> bzero(@r); 2288 return $wantarray ? ($x, $rem) : $x; 2289 } 2290 2291 # Division might return a non-integer result, so upgrade unconditionally, if 2292 # upgrading is enabled. 2293 2294 return $upgrade -> btdiv($x, $y, @r) if defined $upgrade; 2295 2296 $r[3] = $y; # no push! 2297 2298 # Inialize remainder. 2299 2300 my $rem = $class -> bzero(); 2301 2302 # Are both operands the same object, i.e., like $x -> bdiv($x)? If so, 2303 # flipping the sign of $y also flips the sign of $x. 2304 2305 my $xsign = $x -> {sign}; 2306 my $ysign = $y -> {sign}; 2307 2308 $y -> {sign} =~ tr/+-/-+/; # Flip the sign of $y, and see ... 2309 my $same = $xsign ne $x -> {sign}; # ... if that changed the sign of $x. 2310 $y -> {sign} = $ysign; # Re-insert the original sign. 2311 2312 if ($same) { 2313 $x = $x -> bone(@r); 2314 } else { 2315 ($x -> {value}, $rem -> {value}) = 2316 $LIB -> _div($x -> {value}, $y -> {value}); 2317 2318 $x -> {sign} = $xsign eq $ysign ? '+' : '-'; 2319 $x -> {sign} = '+' if $LIB -> _is_zero($x -> {value}); 2320 $x = $x -> round(@r); 2321 } 2322 2323 if (wantarray) { 2324 $rem -> {sign} = $xsign; 2325 $rem -> {sign} = '+' if $LIB -> _is_zero($rem -> {value}); 2326 $rem -> {_a} = $x -> {_a}; 2327 $rem -> {_p} = $x -> {_p}; 2328 $rem = $rem -> round(@r); 2329 return ($x, $rem); 2330 } 2331 2332 return $x; 2333} 2334 2335sub bmod { 2336 # This is the remainder after floored division. 2337 2338 # Set up parameters. 2339 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 2340 ? (ref($_[0]), @_) 2341 : objectify(2, @_); 2342 2343 return $x if $x -> modify('bmod'); 2344 2345 $r[3] = $y; # no push! 2346 2347 # At least one argument is NaN. 2348 2349 if ($x -> is_nan() || $y -> is_nan()) { 2350 return $x -> bnan(@r); 2351 } 2352 2353 # Modulo zero. See documentation for bdiv(). 2354 2355 if ($y -> is_zero()) { 2356 return $x -> round(@r); 2357 } 2358 2359 # Numerator (dividend) is +/-inf. 2360 2361 if ($x -> is_inf()) { 2362 return $x -> bnan(@r); 2363 } 2364 2365 # Denominator (divisor) is +/-inf. 2366 2367 if ($y -> is_inf()) { 2368 if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { 2369 return $x -> round(@r); 2370 } else { 2371 return $x -> binf($y -> sign(), @r); 2372 } 2373 } 2374 2375 return $upgrade -> bmod($x, $y, @r) 2376 if defined($upgrade) && (!$x -> isa($class) || !$y -> isa($class)); 2377 2378 # Calc new sign and in case $y == +/- 1, return $x. 2379 2380 $x -> {value} = $LIB -> _mod($x -> {value}, $y -> {value}); 2381 if ($LIB -> _is_zero($x -> {value})) { 2382 $x -> {sign} = '+'; # do not leave -0 2383 } else { 2384 $x -> {value} = $LIB -> _sub($y -> {value}, $x -> {value}, 1) # $y-$x 2385 if ($x -> {sign} ne $y -> {sign}); 2386 $x -> {sign} = $y -> {sign}; 2387 } 2388 2389 $x -> round(@r); 2390} 2391 2392sub btmod { 2393 # Remainder after truncated division. 2394 2395 # set up parameters 2396 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 2397 ? (ref($_[0]), @_) 2398 : objectify(2, @_); 2399 2400 return $x if $x -> modify('btmod'); 2401 2402 # At least one argument is NaN. 2403 2404 if ($x -> is_nan() || $y -> is_nan()) { 2405 return $x -> bnan(@r); 2406 } 2407 2408 # Modulo zero. See documentation for btdiv(). 2409 2410 if ($y -> is_zero()) { 2411 return $x -> round(@r); 2412 } 2413 2414 # Numerator (dividend) is +/-inf. 2415 2416 if ($x -> is_inf()) { 2417 return $x -> bnan(@r); 2418 } 2419 2420 # Denominator (divisor) is +/-inf. 2421 2422 if ($y -> is_inf()) { 2423 return $x -> round(@r); 2424 } 2425 2426 return $upgrade -> btmod($x, $y, @r) 2427 if defined($upgrade) && (!$x -> isa($class) || !$y -> isa($class)); 2428 2429 $r[3] = $y; # no push! 2430 2431 my $xsign = $x -> {sign}; 2432 2433 $x -> {value} = $LIB -> _mod($x -> {value}, $y -> {value}); 2434 2435 $x -> {sign} = $xsign; 2436 $x -> {sign} = '+' if $LIB -> _is_zero($x -> {value}); 2437 $x -> round(@r); 2438} 2439 2440sub bmodinv { 2441 # Return modular multiplicative inverse: 2442 # 2443 # z is the modular inverse of x (mod y) if and only if 2444 # 2445 # x*z ��� 1 (mod y) 2446 # 2447 # If the modulus y is larger than one, x and z are relative primes (i.e., 2448 # their greatest common divisor is one). 2449 # 2450 # If no modular multiplicative inverse exists, NaN is returned. 2451 2452 # set up parameters 2453 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 2454 ? (ref($_[0]), @_) 2455 : objectify(2, @_); 2456 2457 return $x if $x->modify('bmodinv'); 2458 2459 # Return NaN if one or both arguments is +inf, -inf, or nan. 2460 2461 return $x->bnan(@r) if ($y->{sign} !~ /^[+-]$/ || 2462 $x->{sign} !~ /^[+-]$/); 2463 2464 # Return NaN if $y is zero; 1 % 0 makes no sense. 2465 2466 return $x->bnan(@r) if $y->is_zero(); 2467 2468 # Return 0 in the trivial case. $x % 1 or $x % -1 is zero for all finite 2469 # integers $x. 2470 2471 return $x->bzero(@r) if ($y->is_one('+') || 2472 $y->is_one('-')); 2473 2474 return $upgrade -> bmodinv($x, $y, @r) 2475 if defined($upgrade) && (!$x -> isa($class) || !$y -> isa($class)); 2476 2477 # Return NaN if $x = 0, or $x modulo $y is zero. The only valid case when 2478 # $x = 0 is when $y = 1 or $y = -1, but that was covered above. 2479 # 2480 # Note that computing $x modulo $y here affects the value we'll feed to 2481 # $LIB->_modinv() below when $x and $y have opposite signs. E.g., if $x = 2482 # 5 and $y = 7, those two values are fed to _modinv(), but if $x = -5 and 2483 # $y = 7, the values fed to _modinv() are $x = 2 (= -5 % 7) and $y = 7. 2484 # The value if $x is affected only when $x and $y have opposite signs. 2485 2486 $x = $x->bmod($y); 2487 return $x->bnan(@r) if $x->is_zero(); 2488 2489 # Compute the modular multiplicative inverse of the absolute values. We'll 2490 # correct for the signs of $x and $y later. Return NaN if no GCD is found. 2491 2492 ($x->{value}, $x->{sign}) = $LIB->_modinv($x->{value}, $y->{value}); 2493 return $x->bnan(@r) if !defined($x->{value}); 2494 2495 # Library inconsistency workaround: _modinv() in Math::BigInt::GMP versions 2496 # <= 1.32 return undef rather than a "+" for the sign. 2497 2498 $x->{sign} = '+' unless defined $x->{sign}; 2499 2500 # When one or both arguments are negative, we have the following 2501 # relations. If x and y are positive: 2502 # 2503 # modinv(-x, -y) = -modinv(x, y) 2504 # modinv(-x, y) = y - modinv(x, y) = -modinv(x, y) (mod y) 2505 # modinv( x, -y) = modinv(x, y) - y = modinv(x, y) (mod -y) 2506 2507 # We must swap the sign of the result if the original $x is negative. 2508 # However, we must compensate for ignoring the signs when computing the 2509 # inverse modulo. The net effect is that we must swap the sign of the 2510 # result if $y is negative. 2511 2512 $x = $x -> bneg() if $y->{sign} eq '-'; 2513 2514 # Compute $x modulo $y again after correcting the sign. 2515 2516 $x = $x -> bmod($y) if $x->{sign} ne $y->{sign}; 2517 2518 $x -> round(@r); 2519} 2520 2521sub bmodpow { 2522 # Modular exponentiation. Raises a very large number to a very large 2523 # exponent in a given very large modulus quickly, thanks to binary 2524 # exponentiation. Supports negative exponents. 2525 my ($class, $num, $exp, $mod, @r) 2526 = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2]) 2527 ? (ref($_[0]), @_) 2528 : objectify(3, @_); 2529 2530 return $num if $num->modify('bmodpow'); 2531 2532 # When the exponent 'e' is negative, use the following relation, which is 2533 # based on finding the multiplicative inverse 'd' of 'b' modulo 'm': 2534 # 2535 # b^(-e) (mod m) = d^e (mod m) where b*d = 1 (mod m) 2536 2537 $num = $num -> bmodinv($mod) if ($exp->{sign} eq '-'); 2538 2539 # Check for valid input. All operands must be finite, and the modulus must 2540 # be non-zero. 2541 2542 return $num->bnan(@r) if ($num->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf 2543 $exp->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf 2544 $mod->{sign} =~ /NaN|inf/); # NaN, -inf, +inf 2545 2546 # Modulo zero. See documentation for Math::BigInt's bmod() method. 2547 2548 if ($mod -> is_zero()) { 2549 if ($num -> is_zero()) { 2550 return $class -> bnan(@r); 2551 } else { 2552 return $num -> copy(@r); 2553 } 2554 } 2555 2556 return $upgrade -> bmodinv($num, $exp, $mod, @r) 2557 if defined($upgrade) && (!$num -> isa($class) || 2558 !$exp -> isa($class) || 2559 !$mod -> ($class)); 2560 2561 # Compute 'a (mod m)', ignoring the signs on 'a' and 'm'. If the resulting 2562 # value is zero, the output is also zero, regardless of the signs on 'a' and 2563 # 'm'. 2564 2565 my $value = $LIB->_modpow($num->{value}, $exp->{value}, $mod->{value}); 2566 my $sign = '+'; 2567 2568 # If the resulting value is non-zero, we have four special cases, depending 2569 # on the signs on 'a' and 'm'. 2570 2571 unless ($LIB->_is_zero($value)) { 2572 2573 # There is a negative sign on 'a' (= $num**$exp) only if the number we 2574 # are exponentiating ($num) is negative and the exponent ($exp) is odd. 2575 2576 if ($num->{sign} eq '-' && $exp->is_odd()) { 2577 2578 # When both the number 'a' and the modulus 'm' have a negative sign, 2579 # use this relation: 2580 # 2581 # -a (mod -m) = -(a (mod m)) 2582 2583 if ($mod->{sign} eq '-') { 2584 $sign = '-'; 2585 } 2586 2587 # When only the number 'a' has a negative sign, use this relation: 2588 # 2589 # -a (mod m) = m - (a (mod m)) 2590 2591 else { 2592 # Use copy of $mod since _sub() modifies the first argument. 2593 my $mod = $LIB->_copy($mod->{value}); 2594 $value = $LIB->_sub($mod, $value); 2595 $sign = '+'; 2596 } 2597 2598 } else { 2599 2600 # When only the modulus 'm' has a negative sign, use this relation: 2601 # 2602 # a (mod -m) = (a (mod m)) - m 2603 # = -(m - (a (mod m))) 2604 2605 if ($mod->{sign} eq '-') { 2606 # Use copy of $mod since _sub() modifies the first argument. 2607 my $mod = $LIB->_copy($mod->{value}); 2608 $value = $LIB->_sub($mod, $value); 2609 $sign = '-'; 2610 } 2611 2612 # When neither the number 'a' nor the modulus 'm' have a negative 2613 # sign, directly return the already computed value. 2614 # 2615 # (a (mod m)) 2616 2617 } 2618 2619 } 2620 2621 $num->{value} = $value; 2622 $num->{sign} = $sign; 2623 2624 return $num -> round(@r); 2625} 2626 2627sub bpow { 2628 # (BINT or num_str, BINT or num_str) return BINT 2629 # compute power of two numbers -- stolen from Knuth Vol 2 pg 233 2630 # modifies first argument 2631 2632 # set up parameters 2633 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 2634 ? (ref($_[0]), @_) 2635 : objectify(2, @_); 2636 2637 return $x if $x -> modify('bpow'); 2638 2639 # $x and/or $y is a NaN 2640 return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan(); 2641 2642 # $x and/or $y is a +/-Inf 2643 if ($x -> is_inf("-")) { 2644 return $x -> bzero(@r) if $y -> is_negative(); 2645 return $x -> bnan(@r) if $y -> is_zero(); 2646 return $x -> round(@r) if $y -> is_odd(); 2647 return $x -> bneg(@r); 2648 } elsif ($x -> is_inf("+")) { 2649 return $x -> bzero(@r) if $y -> is_negative(); 2650 return $x -> bnan(@r) if $y -> is_zero(); 2651 return $x -> round(@r); 2652 } elsif ($y -> is_inf("-")) { 2653 return $x -> bnan(@r) if $x -> is_one("-"); 2654 return $x -> binf("+", @r) if $x -> is_zero(); 2655 return $x -> bone(@r) if $x -> is_one("+"); 2656 return $x -> bzero(@r); 2657 } elsif ($y -> is_inf("+")) { 2658 return $x -> bnan(@r) if $x -> is_one("-"); 2659 return $x -> bzero(@r) if $x -> is_zero(); 2660 return $x -> bone(@r) if $x -> is_one("+"); 2661 return $x -> binf("+", @r); 2662 } 2663 2664 if ($x -> is_zero()) { 2665 return $x -> bone(@r) if $y -> is_zero(); 2666 return $x -> binf(@r) if $y -> is_negative(); 2667 return $x -> round(@r); 2668 } 2669 2670 if ($x -> is_one("+")) { 2671 return $x -> round(@r); 2672 } 2673 2674 if ($x -> is_one("-")) { 2675 return $x -> round(@r) if $y -> is_odd(); 2676 return $x -> bneg(@r); 2677 } 2678 2679 return $upgrade -> bpow($x, $y, @r) if defined $upgrade; 2680 2681 # We don't support finite non-integers, so return zero. The reason for 2682 # returning zero, not NaN, is that all output is in the open interval (0,1), 2683 # and truncating that to integer gives zero. 2684 2685 if ($y->{sign} eq '-' || !$y -> isa($class)) { 2686 return $x -> bzero(@r); 2687 } 2688 2689 $r[3] = $y; # no push! 2690 2691 $x->{value} = $LIB -> _pow($x->{value}, $y->{value}); 2692 $x->{sign} = $x -> is_negative() && $y -> is_odd() ? '-' : '+'; 2693 $x -> round(@r); 2694} 2695 2696sub blog { 2697 # Return the logarithm of the operand. If a second operand is defined, that 2698 # value is used as the base, otherwise the base is assumed to be Euler's 2699 # constant. 2700 2701 my ($class, $x, $base, @r); 2702 2703 # Don't objectify the base, since an undefined base, as in $x->blog() or 2704 # $x->blog(undef) signals that the base is Euler's number. 2705 2706 if (!ref($_[0]) && $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i) { 2707 # E.g., Math::BigInt->blog(256, 2) 2708 ($class, $x, $base, @r) = 2709 defined $_[2] ? objectify(2, @_) : objectify(1, @_); 2710 } else { 2711 # E.g., $x->blog(2) or the deprecated Math::BigInt::blog(256, 2) 2712 ($class, $x, $base, @r) = 2713 defined $_[1] ? objectify(2, @_) : objectify(1, @_); 2714 } 2715 2716 return $x if $x->modify('blog'); 2717 2718 # Handle all exception cases and all trivial cases. I have used Wolfram 2719 # Alpha (http://www.wolframalpha.com) as the reference for these cases. 2720 2721 return $x -> bnan(@r) if $x -> is_nan(); 2722 2723 if (defined $base) { 2724 $base = $class -> new($base) unless ref $base; 2725 if ($base -> is_nan() || $base -> is_one()) { 2726 return $x -> bnan(@r); 2727 } elsif ($base -> is_inf() || $base -> is_zero()) { 2728 return $x -> bnan(@r) if $x -> is_inf() || $x -> is_zero(); 2729 return $x -> bzero(@r); 2730 } elsif ($base -> is_negative()) { # -inf < base < 0 2731 return $x -> bzero(@r) if $x -> is_one(); # x = 1 2732 return $x -> bone(@r) if $x == $base; # x = base 2733 return $x -> bnan(@r); # otherwise 2734 } 2735 return $x -> bone(@r) if $x == $base; # 0 < base && 0 < x < inf 2736 } 2737 2738 # We now know that the base is either undefined or >= 2 and finite. 2739 2740 return $x -> binf('+', @r) if $x -> is_inf(); # x = +/-inf 2741 return $x -> bnan(@r) if $x -> is_neg(); # -inf < x < 0 2742 return $x -> bzero(@r) if $x -> is_one(); # x = 1 2743 return $x -> binf('-', @r) if $x -> is_zero(); # x = 0 2744 2745 # At this point we are done handling all exception cases and trivial cases. 2746 2747 return $upgrade -> blog($x, $base, @r) if defined $upgrade; 2748 2749 # fix for bug #24969: 2750 # the default base is e (Euler's number) which is not an integer 2751 if (!defined $base) { 2752 require Math::BigFloat; 2753 my $u = Math::BigFloat->blog($x)->as_int(); 2754 # modify $x in place 2755 $x->{value} = $u->{value}; 2756 $x->{sign} = $u->{sign}; 2757 return $x -> round(@r); 2758 } 2759 2760 my ($rc) = $LIB->_log_int($x->{value}, $base->{value}); 2761 return $x->bnan(@r) unless defined $rc; # not possible to take log? 2762 $x->{value} = $rc; 2763 $x = $x -> round(@r); 2764} 2765 2766sub bexp { 2767 # Calculate e ** $x (Euler's number to the power of X), truncated to 2768 # an integer value. 2769 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 2770 2771 return $x if $x->modify('bexp'); 2772 2773 # inf, -inf, NaN, <0 => NaN 2774 return $x -> bnan(@r) if $x->{sign} eq 'NaN'; 2775 return $x -> bone(@r) if $x->is_zero(); 2776 return $x -> round(@r) if $x->{sign} eq '+inf'; 2777 return $x -> bzero(@r) if $x->{sign} eq '-inf'; 2778 2779 return $upgrade -> bexp($x, @r) if defined $upgrade; 2780 2781 require Math::BigFloat; 2782 my $tmp = Math::BigFloat -> bexp($x, @r) -> as_int(); 2783 $x->{value} = $tmp->{value}; 2784 return $x -> round(@r); 2785} 2786 2787sub bnok { 2788 # Calculate n over k (binomial coefficient or "choose" function) as 2789 # integer. 2790 2791 # Set up parameters. 2792 my ($class, $n, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 2793 ? (ref($_[0]), @_) 2794 : objectify(2, @_); 2795 2796 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 2797 2798 return $n if $n->modify('bnok'); 2799 2800 # All cases where at least one argument is NaN. 2801 2802 return $n->bnan(@r) if $n->{sign} eq 'NaN' || $k->{sign} eq 'NaN'; 2803 2804 # All cases where at least one argument is +/-inf. 2805 2806 if ($n -> is_inf()) { 2807 if ($k -> is_inf()) { # bnok(+/-inf,+/-inf) 2808 return $n -> bnan(@r); 2809 } elsif ($k -> is_neg()) { # bnok(+/-inf,k), k < 0 2810 return $n -> bzero(@r); 2811 } elsif ($k -> is_zero()) { # bnok(+/-inf,k), k = 0 2812 return $n -> bone(@r); 2813 } else { 2814 if ($n -> is_inf("+", @r)) { # bnok(+inf,k), 0 < k < +inf 2815 return $n -> binf("+"); 2816 } else { # bnok(-inf,k), k > 0 2817 my $sign = $k -> is_even() ? "+" : "-"; 2818 return $n -> binf($sign, @r); 2819 } 2820 } 2821 } 2822 2823 elsif ($k -> is_inf()) { # bnok(n,+/-inf), -inf <= n <= inf 2824 return $n -> bnan(@r); 2825 } 2826 2827 # At this point, both n and k are real numbers. 2828 2829 return $upgrade -> bnok($n, $k, @r) 2830 if defined($upgrade) && (!$n -> isa($class) || !$k -> isa($class)); 2831 2832 my $sign = 1; 2833 2834 if ($n >= 0) { 2835 if ($k < 0 || $k > $n) { 2836 return $n -> bzero(@r); 2837 } 2838 } else { 2839 2840 if ($k >= 0) { 2841 2842 # n < 0 and k >= 0: bnok(n,k) = (-1)^k * bnok(-n+k-1,k) 2843 2844 $sign = (-1) ** $k; 2845 $n = $n -> bneg() -> badd($k) -> bdec(); 2846 2847 } elsif ($k <= $n) { 2848 2849 # n < 0 and k <= n: bnok(n,k) = (-1)^(n-k) * bnok(-k-1,n-k) 2850 2851 $sign = (-1) ** ($n - $k); 2852 my $x0 = $n -> copy(); 2853 $n = $n -> bone() -> badd($k) -> bneg(); 2854 $k = $k -> copy(); 2855 $k = $k -> bneg() -> badd($x0); 2856 2857 } else { 2858 2859 # n < 0 and n < k < 0: 2860 2861 return $n -> bzero(@r); 2862 } 2863 } 2864 2865 $n->{value} = $LIB->_nok($n->{value}, $k->{value}); 2866 $n = $n -> bneg() if $sign == -1; 2867 2868 $n -> round(@r); 2869} 2870 2871sub buparrow { 2872 my $a = shift; 2873 my $y = $a -> uparrow(@_); 2874 $a -> {value} = $y -> {value}; 2875 return $a; 2876} 2877 2878sub uparrow { 2879 # Knuth's up-arrow notation buparrow(a, n, b) 2880 # 2881 # The following is a simple, recursive implementation of the up-arrow 2882 # notation, just to show the idea. Such implementations cause "Deep 2883 # recursion on subroutine ..." warnings, so we use a faster, non-recursive 2884 # algorithm below with @_ as a stack. 2885 # 2886 # sub buparrow { 2887 # my ($a, $n, $b) = @_; 2888 # return $a ** $b if $n == 1; 2889 # return $a * $b if $n == 0; 2890 # return 1 if $b == 0; 2891 # return buparrow($a, $n - 1, buparrow($a, $n, $b - 1)); 2892 # } 2893 2894 my ($a, $b, $n) = @_; 2895 my $class = ref $a; 2896 croak("a must be non-negative") if $a < 0; 2897 croak("n must be non-negative") if $n < 0; 2898 croak("b must be non-negative") if $b < 0; 2899 2900 while (@_ >= 3) { 2901 2902 # return $a ** $b if $n == 1; 2903 2904 if ($_[-2] == 1) { 2905 my ($a, $n, $b) = splice @_, -3; 2906 push @_, $a ** $b; 2907 next; 2908 } 2909 2910 # return $a * $b if $n == 0; 2911 2912 if ($_[-2] == 0) { 2913 my ($a, $n, $b) = splice @_, -3; 2914 push @_, $a * $b; 2915 next; 2916 } 2917 2918 # return 1 if $b == 0; 2919 2920 if ($_[-1] == 0) { 2921 splice @_, -3; 2922 push @_, $class -> bone(); 2923 next; 2924 } 2925 2926 # return buparrow($a, $n - 1, buparrow($a, $n, $b - 1)); 2927 2928 my ($a, $n, $b) = splice @_, -3; 2929 push @_, ($a, $n - 1, 2930 $a, $n, $b - 1); 2931 2932 } 2933 2934 pop @_; 2935} 2936 2937sub backermann { 2938 my $m = shift; 2939 my $y = $m -> ackermann(@_); 2940 $m -> {value} = $y -> {value}; 2941 return $m; 2942} 2943 2944sub ackermann { 2945 # Ackermann's function ackermann(m, n) 2946 # 2947 # The following is a simple, recursive implementation of the ackermann 2948 # function, just to show the idea. Such implementations cause "Deep 2949 # recursion on subroutine ..." warnings, so we use a faster, non-recursive 2950 # algorithm below with @_ as a stack. 2951 # 2952 # sub ackermann { 2953 # my ($m, $n) = @_; 2954 # return $n + 1 if $m == 0; 2955 # return ackermann($m - 1, 1) if $m > 0 && $n == 0; 2956 # return ackermann($m - 1, ackermann($m, $n - 1) if $m > 0 && $n > 0; 2957 # } 2958 2959 my ($m, $n) = @_; 2960 my $class = ref $m; 2961 croak("m must be non-negative") if $m < 0; 2962 croak("n must be non-negative") if $n < 0; 2963 2964 my $two = $class -> new("2"); 2965 my $three = $class -> new("3"); 2966 my $thirteen = $class -> new("13"); 2967 2968 $n = pop; 2969 $n = $class -> new($n) unless ref($n); 2970 while (@_) { 2971 my $m = pop; 2972 if ($m > $three) { 2973 push @_, (--$m) x $n; 2974 while (--$m >= $three) { 2975 push @_, $m; 2976 } 2977 $n = $thirteen; 2978 } elsif ($m == $three) { 2979 $n = $class -> bone() -> blsft($n + $three) -> bsub($three); 2980 } elsif ($m == $two) { 2981 $n = $n -> bmul($two) -> badd($three); 2982 } elsif ($m >= 0) { 2983 $n = $n -> badd($m) -> binc(); 2984 } else { 2985 die "negative m!"; 2986 } 2987 } 2988 $n; 2989} 2990 2991sub bsin { 2992 # Calculate sin(x) to N digits. Unless upgrading is in effect, returns the 2993 # result truncated to an integer. 2994 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 2995 2996 return $x if $x->modify('bsin'); 2997 2998 return $x->bnan(@r) if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN 2999 return $x->bzero(@r) if $x->is_zero(); 3000 3001 return $upgrade -> bsin($x, @r) if defined $upgrade; 3002 3003 require Math::BigFloat; 3004 # calculate the result and truncate it to integer 3005 my $t = Math::BigFloat->new($x)->bsin(@r)->as_int(); 3006 3007 $x = $x->bone(@r) if $t->is_one(); 3008 $x = $x->bzero(@r) if $t->is_zero(); 3009 $x->round(@r); 3010} 3011 3012sub bcos { 3013 # Calculate cos(x) to N digits. Unless upgrading is in effect, returns the 3014 # result truncated to an integer. 3015 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3016 3017 return $x if $x->modify('bcos'); 3018 3019 return $x->bnan(@r) if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN 3020 return $x->bone(@r) if $x->is_zero(); 3021 3022 return $upgrade -> bcos($x, @r) if defined $upgrade; 3023 3024 require Math::BigFloat; 3025 my $tmp = Math::BigFloat -> bcos($x, @r) -> as_int(); 3026 $x->{value} = $tmp->{value}; 3027 return $x -> round(@r); 3028} 3029 3030sub batan { 3031 # Calculate arctan(x) to N digits. Unless upgrading is in effect, returns 3032 # the result truncated to an integer. 3033 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3034 3035 return $x if $x->modify('batan'); 3036 3037 return $x -> bnan(@r) if $x -> is_nan(); 3038 return $x -> bzero(@r) if $x -> is_zero(); 3039 3040 return $upgrade -> batan($x, @r) if defined $upgrade; 3041 3042 return $x -> bone("+", @r) if $x -> bgt("1"); 3043 return $x -> bone("-", @r) if $x -> blt("-1"); 3044 3045 $x -> bzero(@r); 3046} 3047 3048sub batan2 { 3049 # calculate arcus tangens of ($y/$x) 3050 3051 my ($class, $y, $x, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 3052 ? (ref($_[0]), @_) : objectify(2, @_); 3053 3054 return $y if $y->modify('batan2'); 3055 3056 return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan); 3057 3058 return $upgrade->batan2($y, $x, @r) if defined $upgrade; 3059 3060 # Y X 3061 # != 0 -inf result is +- pi 3062 if ($x->is_inf() || $y->is_inf()) { 3063 if ($y->is_inf()) { 3064 if ($x->{sign} eq '-inf') { 3065 # calculate 3 pi/4 => 2.3.. => 2 3066 $y = $y->bone(substr($y->{sign}, 0, 1)); 3067 $y = $y->bmul($class->new(2)); 3068 } elsif ($x->{sign} eq '+inf') { 3069 # calculate pi/4 => 0.7 => 0 3070 $y = $y->bzero(); 3071 } else { 3072 # calculate pi/2 => 1.5 => 1 3073 $y = $y->bone(substr($y->{sign}, 0, 1)); 3074 } 3075 } else { 3076 if ($x->{sign} eq '+inf') { 3077 # calculate pi/4 => 0.7 => 0 3078 $y = $y->bzero(); 3079 } else { 3080 # PI => 3.1415.. => 3 3081 $y = $y->bone(substr($y->{sign}, 0, 1)); 3082 $y = $y->bmul($class->new(3)); 3083 } 3084 } 3085 return $y; 3086 } 3087 3088 require Math::BigFloat; 3089 my $r = Math::BigFloat->new($y) 3090 ->batan2(Math::BigFloat->new($x), @r) 3091 ->as_int(); 3092 3093 $x->{value} = $r->{value}; 3094 $x->{sign} = $r->{sign}; 3095 3096 $x->round(@r); 3097} 3098 3099sub bsqrt { 3100 # calculate square root of $x 3101 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3102 3103 return $x if $x->modify('bsqrt'); 3104 3105 return $x->bnan(@r) if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN 3106 return $x->round(@r) if $x->{sign} eq '+inf'; # sqrt(+inf) == inf 3107 3108 return $upgrade->bsqrt($x, @r) if defined $upgrade; 3109 3110 $x->{value} = $LIB->_sqrt($x->{value}); 3111 $x->round(@r); 3112} 3113 3114sub broot { 3115 # calculate $y'th root of $x 3116 3117 # set up parameters 3118 3119 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 3120 ? (ref($_[0]), @_) : objectify(2, @_); 3121 3122 $y = $class->new(2) unless defined $y; 3123 3124 return $x if $x->modify('broot'); 3125 3126 # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0 3127 return $x->bnan(@r) if $x->{sign} !~ /^\+/ || $y->is_zero() || 3128 $y->{sign} !~ /^\+$/; 3129 3130 return $x->round(@r) 3131 if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one(); 3132 3133 return $upgrade->broot($x, $y, @r) if defined $upgrade; 3134 3135 $x->{value} = $LIB->_root($x->{value}, $y->{value}); 3136 $x->round(@r); 3137} 3138 3139sub bfac { 3140 # (BINT or num_str, BINT or num_str) return BINT 3141 # compute factorial number from $x, modify $x in place 3142 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3143 3144 return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf 3145 3146 return $x->bnan(@r) if $x->{sign} ne '+'; # NaN, <0 => NaN 3147 3148 return $upgrade -> bfac($x, @r) 3149 if defined($upgrade) && !$x -> isa($class); 3150 3151 $x->{value} = $LIB->_fac($x->{value}); 3152 $x->round(@r); 3153} 3154 3155sub bdfac { 3156 # compute double factorial, modify $x in place 3157 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3158 3159 return $x if $x->modify('bdfac') || $x->{sign} eq '+inf'; # inf => inf 3160 3161 return $x->bnan(@r) if $x->is_nan() || $x <= -2; 3162 return $x->bone(@r) if $x <= 1; 3163 3164 return $upgrade -> bdfac($x, @r) 3165 if defined($upgrade) && !$x -> isa($class); 3166 3167 croak("bdfac() requires a newer version of the $LIB library.") 3168 unless $LIB->can('_dfac'); 3169 3170 $x->{value} = $LIB->_dfac($x->{value}); 3171 $x->round(@r); 3172} 3173 3174sub btfac { 3175 # compute triple factorial, modify $x in place 3176 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3177 3178 return $x if $x->modify('btfac') || $x->{sign} eq '+inf'; # inf => inf 3179 3180 return $x->bnan(@r) if $x->is_nan(); 3181 3182 return $upgrade -> btfac($x, @r) if defined($upgrade) && !$x -> isa($class); 3183 3184 my $k = $class -> new("3"); 3185 return $x->bnan(@r) if $x <= -$k; 3186 3187 my $one = $class -> bone(); 3188 return $x->bone(@r) if $x <= $one; 3189 3190 my $f = $x -> copy(); 3191 while ($f -> bsub($k) > $one) { 3192 $x = $x -> bmul($f); 3193 } 3194 $x->round(@r); 3195} 3196 3197sub bmfac { 3198 # compute multi-factorial 3199 3200 my ($class, $x, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 3201 ? (ref($_[0]), @_) : objectify(2, @_); 3202 3203 return $x if $x->modify('bmfac') || $x->{sign} eq '+inf'; 3204 return $x->bnan(@r) if $x->is_nan() || $k->is_nan() || $k < 1 || $x <= -$k; 3205 3206 return $upgrade -> bmfac($x, $k, @r) 3207 if defined($upgrade) && !$x -> isa($class); 3208 3209 my $one = $class -> bone(); 3210 return $x->bone(@r) if $x <= $one; 3211 3212 my $f = $x -> copy(); 3213 while ($f -> bsub($k) > $one) { 3214 $x = $x -> bmul($f); 3215 } 3216 $x->round(@r); 3217} 3218 3219sub bfib { 3220 # compute Fibonacci number(s) 3221 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3222 3223 croak("bfib() requires a newer version of the $LIB library.") 3224 unless $LIB->can('_fib'); 3225 3226 return $x if $x->modify('bfib'); 3227 3228 return $upgrade -> bfib($x, @r) 3229 if defined($upgrade) && !$x -> isa($class); 3230 3231 # List context. 3232 3233 if (wantarray) { 3234 return () if $x -> is_nan(); 3235 croak("bfib() can't return an infinitely long list of numbers") 3236 if $x -> is_inf(); 3237 3238 # Use the backend library to compute the first $x Fibonacci numbers. 3239 3240 my @values = $LIB->_fib($x->{value}); 3241 3242 # Make objects out of them. The last element in the array is the 3243 # invocand. 3244 3245 for (my $i = 0 ; $i < $#values ; ++ $i) { 3246 my $fib = $class -> bzero(); 3247 $fib -> {value} = $values[$i]; 3248 $values[$i] = $fib; 3249 } 3250 3251 $x -> {value} = $values[-1]; 3252 $values[-1] = $x; 3253 3254 # If negative, insert sign as appropriate. 3255 3256 if ($x -> is_neg()) { 3257 for (my $i = 2 ; $i <= $#values ; $i += 2) { 3258 $values[$i]{sign} = '-'; 3259 } 3260 } 3261 3262 @values = map { $_ -> round(@r) } @values; 3263 return @values; 3264 } 3265 3266 # Scalar context. 3267 3268 else { 3269 return $x if $x->modify('bdfac') || $x -> is_inf('+'); 3270 return $x->bnan() if $x -> is_nan() || $x -> is_inf('-'); 3271 3272 $x->{sign} = $x -> is_neg() && $x -> is_even() ? '-' : '+'; 3273 $x->{value} = $LIB->_fib($x->{value}); 3274 return $x->round(@r); 3275 } 3276} 3277 3278sub blucas { 3279 # compute Lucas number(s) 3280 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3281 3282 croak("blucas() requires a newer version of the $LIB library.") 3283 unless $LIB->can('_lucas'); 3284 3285 return $x if $x->modify('blucas'); 3286 3287 return $upgrade -> blucas($x, @r) 3288 if defined($upgrade) && !$x -> isa($class); 3289 3290 # List context. 3291 3292 if (wantarray) { 3293 return () if $x -> is_nan(); 3294 croak("blucas() can't return an infinitely long list of numbers") 3295 if $x -> is_inf(); 3296 3297 # Use the backend library to compute the first $x Lucas numbers. 3298 3299 my @values = $LIB->_lucas($x->{value}); 3300 3301 # Make objects out of them. The last element in the array is the 3302 # invocand. 3303 3304 for (my $i = 0 ; $i < $#values ; ++ $i) { 3305 my $lucas = $class -> bzero(); 3306 $lucas -> {value} = $values[$i]; 3307 $values[$i] = $lucas; 3308 } 3309 3310 $x -> {value} = $values[-1]; 3311 $values[-1] = $x; 3312 3313 # If negative, insert sign as appropriate. 3314 3315 if ($x -> is_neg()) { 3316 for (my $i = 2 ; $i <= $#values ; $i += 2) { 3317 $values[$i]{sign} = '-'; 3318 } 3319 } 3320 3321 @values = map { $_ -> round(@r) } @values; 3322 return @values; 3323 } 3324 3325 # Scalar context. 3326 3327 else { 3328 return $x if $x -> is_inf('+'); 3329 return $x->bnan() if $x -> is_nan() || $x -> is_inf('-'); 3330 3331 $x->{sign} = $x -> is_neg() && $x -> is_even() ? '-' : '+'; 3332 $x->{value} = $LIB->_lucas($x->{value}); 3333 return $x->round(@r); 3334 } 3335} 3336 3337sub blsft { 3338 # (BINT or num_str, BINT or num_str) return BINT 3339 # compute x << y, base n, y >= 0 3340 3341 my ($class, $x, $y, $b, @r); 3342 3343 # Objectify the base only when it is defined, since an undefined base, as 3344 # in $x->blsft(3) or $x->blog(3, undef) means use the default base 2. 3345 3346 if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) { 3347 # E.g., Math::BigInt->blog(256, 5, 2) 3348 ($class, $x, $y, $b, @r) = 3349 defined $_[3] ? objectify(3, @_) : objectify(2, @_); 3350 } else { 3351 # E.g., Math::BigInt::blog(256, 5, 2) or $x->blog(5, 2) 3352 ($class, $x, $y, $b, @r) = 3353 defined $_[2] ? objectify(3, @_) : objectify(2, @_); 3354 } 3355 3356 return $x if $x -> modify('blsft'); 3357 return $x -> bnan() if ($x -> {sign} !~ /^[+-]$/ || 3358 $y -> {sign} !~ /^[+-]$/); 3359 return $x -> round(@r) if $y -> is_zero(); 3360 return $x -> bzero(@r) if $x -> is_zero(); # 0 => 0 3361 3362 $b = 2 if !defined $b; 3363 return $x -> bnan(@r) if $b <= 0 || $y -> {sign} eq '-'; 3364 $b = $class -> new($b) unless defined(blessed($b)); 3365 3366 #return $upgrade -> blsft($x, $y, $b, @r) 3367 # if defined($upgrade) && (!$x -> isa($class) || 3368 # !$y -> isa($class) || 3369 # !$b -> isa($class)); 3370 3371 # shift by a negative amount? 3372 #return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/; 3373 3374 # While some of the libraries support an arbitrarily large base, not all of 3375 # them do, so rather than returning an incorrect result in those cases, 3376 # disallow bases that don't work with all libraries. 3377 3378 my $uintmax = ~0; 3379 croak("Base is too large.") if $b > $uintmax; 3380 3381 $b = $b -> numify(); 3382 3383 return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-'; 3384 3385 $x -> {value} = $LIB -> _lsft($x -> {value}, $y -> {value}, $b); 3386 $x -> round(@r); 3387} 3388 3389sub brsft { 3390 # (BINT or num_str, BINT or num_str) return BINT 3391 # compute x >> y, base n, y >= 0 3392 3393 my ($class, $x, $y, $b, @r) = (ref($_[0]), @_); 3394 3395 # Objectify the base only when it is defined, since an undefined base, as 3396 # in $x->blsft(3) or $x->blog(3, undef) means use the default base 2. 3397 3398 if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) { 3399 # E.g., Math::BigInt->blog(256, 5, 2) 3400 ($class, $x, $y, $b, @r) = 3401 defined $_[3] ? objectify(3, @_) : objectify(2, @_); 3402 } else { 3403 # E.g., Math::BigInt::blog(256, 5, 2) or $x->blog(5, 2) 3404 ($class, $x, $y, $b, @r) = 3405 defined $_[2] ? objectify(3, @_) : objectify(2, @_); 3406 } 3407 3408 return $x if $x -> modify('brsft'); 3409 return $x -> bnan(@r) if $x -> {sign} !~ /^[+-]$/ || 3410 $y -> {sign} !~ /^[+-]$/; 3411 return $x -> round(@r) if $y -> is_zero(); 3412 return $x -> bzero(@r) if $x -> is_zero(); # 0 => 0 3413 3414 $b = 2 if !defined $b; 3415 return $x -> bnan(@r) if $b <= 0 || $y -> {sign} eq '-'; 3416 $b = $class -> new($b) unless defined(blessed($b)); 3417 3418 # Shifting right by a positive amount might lead to a non-integer result, so 3419 # include this case in the test. 3420 3421 return $upgrade -> brsft($x, $y, $b, @r) 3422 if defined($upgrade) && (!$x -> isa($class) || 3423 !$y -> isa($class) || 3424 !$b -> isa($class) || 3425 $y -> is_pos()); 3426 3427 # While some of the libraries support an arbitrarily large base, not all of 3428 # them do, so rather than returning an incorrect result in those cases, 3429 # disallow bases that don't work with all libraries. 3430 3431 my $uintmax = ~0; 3432 croak("Base is too large.") if $b > $uintmax; 3433 3434 $b = $b -> numify(); 3435 3436 # this only works for negative numbers when shifting in base 2 3437 if (($x -> {sign} eq '-') && ($b == 2)) { 3438 return $x -> round(@r) if $x -> is_one('-'); # -1 => -1 3439 if (!$y -> is_one()) { 3440 # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et 3441 # al but perhaps there is a better emulation for two's complement 3442 # shift... 3443 # if $y != 1, we must simulate it by doing: 3444 # convert to bin, flip all bits, shift, and be done 3445 $x = $x -> binc(); # -3 => -2 3446 my $bin = $x -> as_bin(); 3447 $bin =~ s/^-0b//; # strip '-0b' prefix 3448 $bin =~ tr/10/01/; # flip bits 3449 # now shift 3450 if ($y >= CORE::length($bin)) { 3451 $bin = '0'; # shifting to far right creates -1 3452 # 0, because later increment makes 3453 # that 1, attached '-' makes it '-1' 3454 # because -1 >> x == -1 ! 3455 } else { 3456 $bin =~ s/.{$y}$//; # cut off at the right side 3457 $bin = '1' . $bin; # extend left side by one dummy '1' 3458 $bin =~ tr/10/01/; # flip bits back 3459 } 3460 my $res = $class -> new('0b' . $bin); # add prefix and convert back 3461 $res = $res -> binc(); # remember to increment 3462 $x -> {value} = $res -> {value}; # take over value 3463 return $x -> round(@r); # we are done now, magic, isn't? 3464 } 3465 3466 # x < 0, n == 2, y == 1 3467 $x = $x -> bdec(); # n == 2, but $y == 1: this fixes it 3468 } 3469 3470 $x -> {value} = $LIB -> _rsft($x -> {value}, $y -> {value}, $b); 3471 $x -> round(@r); 3472} 3473 3474############################################################################### 3475# Bitwise methods 3476############################################################################### 3477 3478sub band { 3479 #(BINT or num_str, BINT or num_str) return BINT 3480 # compute x & y 3481 3482 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 3483 ? (ref($_[0]), @_) : objectify(2, @_); 3484 3485 return $x if $x->modify('band'); 3486 3487 return $upgrade -> band($x, $y, @r) 3488 if defined($upgrade) && (!$x -> isa($class) || 3489 !$y -> isa($class)); 3490 3491 $r[3] = $y; # no push! 3492 3493 return $x->bnan(@r) if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/; 3494 3495 if ($x->{sign} eq '+' && $y->{sign} eq '+') { 3496 $x->{value} = $LIB->_and($x->{value}, $y->{value}); 3497 } else { 3498 ($x->{value}, $x->{sign}) = $LIB->_sand($x->{value}, $x->{sign}, 3499 $y->{value}, $y->{sign}); 3500 } 3501 return $x->round(@r); 3502} 3503 3504sub bior { 3505 #(BINT or num_str, BINT or num_str) return BINT 3506 # compute x | y 3507 3508 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 3509 ? (ref($_[0]), @_) : objectify(2, @_); 3510 3511 return $x if $x->modify('bior'); 3512 3513 return $upgrade -> bior($x, $y, @r) 3514 if defined($upgrade) && (!$x -> isa($class) || 3515 !$y -> isa($class)); 3516 3517 $r[3] = $y; # no push! 3518 3519 return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); 3520 3521 if ($x->{sign} eq '+' && $y->{sign} eq '+') { 3522 $x->{value} = $LIB->_or($x->{value}, $y->{value}); 3523 } else { 3524 ($x->{value}, $x->{sign}) = $LIB->_sor($x->{value}, $x->{sign}, 3525 $y->{value}, $y->{sign}); 3526 } 3527 return $x->round(@r); 3528} 3529 3530sub bxor { 3531 #(BINT or num_str, BINT or num_str) return BINT 3532 # compute x ^ y 3533 3534 my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 3535 ? (ref($_[0]), @_) : objectify(2, @_); 3536 3537 return $x if $x->modify('bxor'); 3538 3539 return $upgrade -> bxor($x, $y, @r) 3540 if defined($upgrade) && (!$x -> isa($class) || 3541 !$y -> isa($class)); 3542 3543 $r[3] = $y; # no push! 3544 3545 return $x->bnan(@r) if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/; 3546 3547 if ($x->{sign} eq '+' && $y->{sign} eq '+') { 3548 $x->{value} = $LIB->_xor($x->{value}, $y->{value}); 3549 } else { 3550 ($x->{value}, $x->{sign}) = $LIB->_sxor($x->{value}, $x->{sign}, 3551 $y->{value}, $y->{sign}); 3552 } 3553 return $x->round(@r); 3554} 3555 3556sub bnot { 3557 # (num_str or BINT) return BINT 3558 # represent ~x as twos-complement number 3559 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3560 3561 return $x if $x->modify('bnot'); 3562 3563 return $upgrade -> bnot($x, @r) 3564 if defined($upgrade) && !$x -> isa($class); 3565 3566 $x -> binc() -> bneg(@r); 3567} 3568 3569############################################################################### 3570# Rounding methods 3571############################################################################### 3572 3573sub round { 3574 # Round $self according to given parameters, or given second argument's 3575 # parameters or global defaults 3576 3577 my ($class, $self, @args) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3578 3579 # $x->round(undef, undef) signals no rounding 3580 3581 if (@args >= 2 && @args <= 3 && !defined($args[0]) && !defined($args[1])) { 3582 $self->{_a} = undef; 3583 $self->{_p} = undef; 3584 return $self; 3585 } 3586 3587 my ($a, $p, $r) = splice @args, 0, 3; 3588 3589 # $a accuracy, if given by caller 3590 # $p precision, if given by caller 3591 # $r round_mode, if given by caller 3592 # @args all 'other' arguments (0 for unary, 1 for binary ops) 3593 3594 if (defined $a) { 3595 croak "accuracy must be a number, not '$a'" 3596 unless $a =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/; 3597 } 3598 3599 if (defined $p) { 3600 croak "precision must be a number, not '$p'" 3601 unless $p =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/; 3602 } 3603 3604 # now pick $a or $p, but only if we have got "arguments" 3605 if (!defined $a) { 3606 foreach ($self, @args) { 3607 # take the defined one, or if both defined, the one that is smaller 3608 $a = $_->{_a} 3609 if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a); 3610 } 3611 } 3612 if (!defined $p) { 3613 # even if $a is defined, take $p, to signal error for both defined 3614 foreach ($self, @args) { 3615 # take the defined one, or if both defined, the one that is bigger 3616 # -2 > -3, and 3 > 2 3617 $p = $_->{_p} 3618 if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); 3619 } 3620 } 3621 3622 no strict 'refs'; 3623 3624 # if still none defined, use globals 3625 unless (defined $a || defined $p) { 3626 $a = ${"$class\::accuracy"}; 3627 $p = ${"$class\::precision"}; 3628 } 3629 3630 # A == 0 is useless, so undef it to signal no rounding 3631 $a = undef if defined $a && $a == 0; 3632 3633 # no rounding today? 3634 return $self unless defined $a || defined $p; # early out 3635 3636 # set A and set P is an fatal error 3637 return $self->bnan() if defined $a && defined $p; 3638 3639 $r = ${"$class\::round_mode"} unless defined $r; 3640 if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) { 3641 croak("Unknown round mode '$r'"); 3642 } 3643 3644 # now round, by calling either bround or bfround: 3645 if (defined $a) { 3646 $self = $self->bround(int($a), $r) 3647 if !defined $self->{_a} || $self->{_a} >= $a; 3648 } else { # both can't be undefined due to early out 3649 $self = $self->bfround(int($p), $r) 3650 if !defined $self->{_p} || $self->{_p} <= $p; 3651 } 3652 3653 # bround() or bfround() already called bnorm() if nec. 3654 $self; 3655} 3656 3657sub bround { 3658 # accuracy: +$n preserve $n digits from left, 3659 # -$n preserve $n digits from right (f.i. for 0.1234 style in MBF) 3660 # no-op for $n == 0 3661 # and overwrite the rest with 0's, return normalized number 3662 # do not return $x->bnorm(), but $x 3663 3664 my ($class, $x, @a) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3665 3666 my ($scale, $mode) = $x->_scale_a(@a); 3667 return $x if !defined $scale || $x->modify('bround'); # no-op 3668 3669 if ($x->is_zero() || $scale == 0) { 3670 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2 3671 return $x; 3672 } 3673 return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN 3674 3675 # we have fewer digits than we want to scale to 3676 my $len = $x->length(); 3677 # convert $scale to a scalar in case it is an object (put's a limit on the 3678 # number length, but this would already limited by memory constraints), 3679 # makes it faster 3680 $scale = $scale->numify() if ref ($scale); 3681 3682 # scale < 0, but > -len (not >=!) 3683 if (($scale < 0 && $scale < -$len-1) || ($scale >= $len)) { 3684 $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2 3685 return $x; 3686 } 3687 3688 # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6 3689 my ($pad, $digit_round, $digit_after); 3690 $pad = $len - $scale; 3691 $pad = abs($scale-1) if $scale < 0; 3692 3693 # do not use digit(), it is very costly for binary => decimal 3694 # getting the entire string is also costly, but we need to do it only once 3695 my $xs = $LIB->_str($x->{value}); 3696 my $pl = -$pad-1; 3697 3698 # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4 3699 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3 3700 $digit_round = '0'; 3701 $digit_round = substr($xs, $pl, 1) if $pad <= $len; 3702 $pl++; 3703 $pl ++ if $pad >= $len; 3704 $digit_after = '0'; 3705 $digit_after = substr($xs, $pl, 1) if $pad > 0; 3706 3707 # in case of 01234 we round down, for 6789 up, and only in case 5 we look 3708 # closer at the remaining digits of the original $x, remember decision 3709 my $round_up = 1; # default round up 3710 $round_up -- if 3711 ($mode eq 'trunc') || # trunc by round down 3712 ($digit_after =~ /[01234]/) || # round down anyway, 3713 # 6789 => round up 3714 ($digit_after eq '5') && # not 5000...0000 3715 ($x->_scan_for_nonzero($pad, $xs, $len) == 0) && 3716 ( 3717 ($mode eq 'even') && ($digit_round =~ /[24680]/) || 3718 ($mode eq 'odd') && ($digit_round =~ /[13579]/) || 3719 ($mode eq '+inf') && ($x->{sign} eq '-') || 3720 ($mode eq '-inf') && ($x->{sign} eq '+') || 3721 ($mode eq 'zero') # round down if zero, sign adjusted below 3722 ); 3723 my $put_back = 0; # not yet modified 3724 3725 if (($pad > 0) && ($pad <= $len)) { 3726 substr($xs, -$pad, $pad) = '0' x $pad; # replace with '00...' 3727 $xs =~ s/^0+(\d)/$1/; # "00000" -> "0" 3728 $put_back = 1; # need to put back 3729 } elsif ($pad > $len) { 3730 $x = $x->bzero(); # round to '0' 3731 } 3732 3733 if ($round_up) { # what gave test above? 3734 $put_back = 1; # need to put back 3735 $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0 3736 3737 # we modify directly the string variant instead of creating a number and 3738 # adding it, since that is faster (we already have the string) 3739 my $c = 0; 3740 $pad ++; # for $pad == $len case 3741 while ($pad <= $len) { 3742 $c = substr($xs, -$pad, 1) + 1; 3743 $c = '0' if $c eq '10'; 3744 substr($xs, -$pad, 1) = $c; 3745 $pad++; 3746 last if $c != 0; # no overflow => early out 3747 } 3748 $xs = '1'.$xs if $c == 0; 3749 } 3750 $x->{value} = $LIB->_new($xs) if $put_back == 1; # put back, if needed 3751 3752 $x->{_a} = $scale if $scale >= 0; 3753 if ($scale < 0) { 3754 $x->{_a} = $len+$scale; 3755 $x->{_a} = 0 if $scale < -$len; 3756 } 3757 $x; 3758} 3759 3760sub bfround { 3761 # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' 3762 # $n == 0 || $n == 1 => round to integer 3763 3764 my ($class, $x, @p) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3765 3766 my ($scale, $mode) = $x->_scale_p(@p); 3767 3768 return $x if !defined $scale || $x->modify('bfround'); # no-op 3769 3770 # no-op for Math::BigInt objects if $n <= 0 3771 $x = $x->bround($x->length()-$scale, $mode) if $scale > 0; 3772 3773 delete $x->{_a}; # delete to save memory 3774 $x->{_p} = $scale; # store new _p 3775 $x; 3776} 3777 3778sub fround { 3779 # Exists to make life easier for switch between MBF and MBI (should we 3780 # autoload fxxx() like MBF does for bxxx()?) 3781 my $x = shift; 3782 $x = __PACKAGE__->new($x) unless ref $x; 3783 $x->bround(@_); 3784} 3785 3786sub bfloor { 3787 # round towards minus infinity; no-op since it's already integer 3788 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3789 3790 return $upgrade -> bfloor($x) 3791 if defined($upgrade) && !$x -> isa($class); 3792 3793 $x->round(@r); 3794} 3795 3796sub bceil { 3797 # round towards plus infinity; no-op since it's already int 3798 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3799 3800 return $upgrade -> bceil($x) 3801 if defined($upgrade) && !$x -> isa($class); 3802 3803 $x->round(@r); 3804} 3805 3806sub bint { 3807 # round towards zero; no-op since it's already integer 3808 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3809 3810 return $upgrade -> bint($x) 3811 if defined($upgrade) && !$x -> isa($class); 3812 3813 $x->round(@r); 3814} 3815 3816############################################################################### 3817# Other mathematical methods 3818############################################################################### 3819 3820sub bgcd { 3821 # (BINT or num_str, BINT or num_str) return BINT 3822 # does not modify arguments, but returns new object 3823 # GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff) 3824 3825 # Class::method(...) -> Class->method(...) 3826 unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || 3827 $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) 3828 { 3829 #carp "Using ", (caller(0))[3], "() as a function is deprecated;", 3830 # " use is as a method instead"; 3831 unshift @_, __PACKAGE__; 3832 } 3833 3834 my ($class, @args) = objectify(0, @_); 3835 3836 # Upgrade? 3837 3838 if (defined $upgrade) { 3839 my $do_upgrade = 0; 3840 for my $arg (@args) { 3841 unless ($arg -> isa($class)) { 3842 $do_upgrade = 1; 3843 last; 3844 } 3845 } 3846 return $upgrade -> bgcd(@args) if $do_upgrade; 3847 } 3848 3849 my $x = shift @args; 3850 $x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x); 3851 3852 return $class->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? 3853 3854 while (@args) { 3855 my $y = shift @args; 3856 $y = $class->new($y) unless ref($y) && $y -> isa($class); 3857 return $class->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN? 3858 $x->{value} = $LIB->_gcd($x->{value}, $y->{value}); 3859 last if $LIB->_is_one($x->{value}); 3860 } 3861 3862 return $x -> babs(); 3863} 3864 3865sub blcm { 3866 # (BINT or num_str, BINT or num_str) return BINT 3867 # does not modify arguments, but returns new object 3868 # Least Common Multiple 3869 3870 # Class::method(...) -> Class->method(...) 3871 unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) || 3872 $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i)) 3873 { 3874 #carp "Using ", (caller(0))[3], "() as a function is deprecated;", 3875 # " use is as a method instead"; 3876 unshift @_, __PACKAGE__; 3877 } 3878 3879 my ($class, @args) = objectify(0, @_); 3880 3881 # Upgrade? 3882 3883 if (defined $upgrade) { 3884 my $do_upgrade = 0; 3885 for my $arg (@args) { 3886 unless ($arg -> isa($class)) { 3887 $do_upgrade = 1; 3888 last; 3889 } 3890 } 3891 return $upgrade -> blcm(@args) if $do_upgrade; 3892 } 3893 3894 my $x = shift @args; 3895 $x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x); 3896 return $class->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? 3897 3898 while (@args) { 3899 my $y = shift @args; 3900 $y = $class -> new($y) unless ref($y) && $y -> isa($class); 3901 return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y not integer 3902 $x -> {value} = $LIB->_lcm($x -> {value}, $y -> {value}); 3903 } 3904 3905 return $x -> babs(); 3906} 3907 3908############################################################################### 3909# Object property methods 3910############################################################################### 3911 3912sub sign { 3913 # return the sign of the number: +/-/-inf/+inf/NaN 3914 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3915 3916 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 3917 3918 $x->{sign}; 3919} 3920 3921sub digit { 3922 # return the nth decimal digit, negative values count backward, 0 is right 3923 my (undef, $x, $n, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); 3924 3925 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 3926 3927 $n = $n->numify() if ref($n); 3928 $LIB->_digit($x->{value}, $n || 0); 3929} 3930 3931sub bdigitsum { 3932 # like digitsum(), but assigns the result to the invocand 3933 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3934 3935 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 3936 3937 return $x if $x -> is_nan(); 3938 return $x -> bnan() if $x -> is_inf(); 3939 3940 $x -> {value} = $LIB -> _digitsum($x -> {value}); 3941 $x -> {sign} = '+'; 3942 return $x; 3943} 3944 3945sub digitsum { 3946 # compute sum of decimal digits and return it 3947 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3948 3949 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 3950 3951 return $class -> bnan() if $x -> is_nan(); 3952 return $class -> bnan() if $x -> is_inf(); 3953 3954 my $y = $class -> bzero(); 3955 $y -> {value} = $LIB -> _digitsum($x -> {value}); 3956 $y -> round(@r); 3957} 3958 3959sub length { 3960 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3961 3962 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 3963 3964 my $e = $LIB->_len($x->{value}); 3965 wantarray ? ($e, 0) : $e; 3966} 3967 3968sub exponent { 3969 # return a copy of the exponent (here always 0, NaN or 1 for $m == 0) 3970 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3971 3972 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 3973 3974 # Upgrade? 3975 3976 return $upgrade -> exponent($x, @r) 3977 if defined($upgrade) && !$x -> isa($class); 3978 3979 if ($x->{sign} !~ /^[+-]$/) { 3980 my $s = $x->{sign}; 3981 $s =~ s/^[+-]//; # NaN, -inf, +inf => NaN or inf 3982 return $class->new($s, @r); 3983 } 3984 return $class->bzero(@r) if $x->is_zero(); 3985 3986 # 12300 => 2 trailing zeros => exponent is 2 3987 $class->new($LIB->_zeros($x->{value}), @r); 3988} 3989 3990sub mantissa { 3991 # return the mantissa (compatible to Math::BigFloat, e.g. reduced) 3992 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 3993 3994 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 3995 3996 # Upgrade? 3997 3998 return $upgrade -> mantissa($x, @r) 3999 if defined($upgrade) && !$x -> isa($class); 4000 4001 if ($x->{sign} !~ /^[+-]$/) { 4002 # for NaN, +inf, -inf: keep the sign 4003 return $class->new($x->{sign}, @r); 4004 } 4005 my $m = $x->copy(); 4006 delete $m->{_p}; 4007 delete $m->{_a}; 4008 4009 # that's a bit inefficient: 4010 my $zeros = $LIB->_zeros($m->{value}); 4011 $m = $m->brsft($zeros, 10) if $zeros != 0; 4012 $m -> round(@r); 4013} 4014 4015sub parts { 4016 # return a copy of both the exponent and the mantissa 4017 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4018 4019 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4020 4021 # Upgrade? 4022 4023 return $upgrade -> parts($x, @r) 4024 if defined($upgrade) && !$x -> isa($class); 4025 4026 ($x->mantissa(@r), $x->exponent(@r)); 4027} 4028 4029# Parts used for scientific notation with significand/mantissa and exponent as 4030# integers. E.g., "12345.6789" is returned as "123456789" (mantissa) and "-4" 4031# (exponent). 4032 4033sub sparts { 4034 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4035 4036 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4037 4038 # Not-a-number. 4039 4040 if ($x -> is_nan()) { 4041 my $mant = $class -> bnan(@r); # mantissa 4042 return $mant unless wantarray; # scalar context 4043 my $expo = $class -> bnan(@r); # exponent 4044 return ($mant, $expo); # list context 4045 } 4046 4047 # Infinity. 4048 4049 if ($x -> is_inf()) { 4050 my $mant = $class -> binf($x->{sign}, @r); # mantissa 4051 return $mant unless wantarray; # scalar context 4052 my $expo = $class -> binf('+', @r); # exponent 4053 return ($mant, $expo); # list context 4054 } 4055 4056 # Upgrade? 4057 4058 return $upgrade -> sparts($x, @r) 4059 if defined($upgrade) && !$x -> isa($class); 4060 4061 # Finite number. 4062 4063 my $mant = $x -> copy(); 4064 my $nzeros = $LIB -> _zeros($mant -> {value}); 4065 4066 $mant -> {value} 4067 = $LIB -> _rsft($mant -> {value}, $LIB -> _new($nzeros), 10) 4068 if $nzeros != 0; 4069 return $mant unless wantarray; 4070 4071 my $expo = $class -> new($nzeros, @r); 4072 return ($mant, $expo); 4073} 4074 4075# Parts used for normalized notation with significand/mantissa as either 0 or a 4076# number in the semi-open interval [1,10). E.g., "12345.6789" is returned as 4077# "1.23456789" and "4". 4078 4079sub nparts { 4080 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4081 4082 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4083 4084 # Not-a-Number and Infinity. 4085 4086 return $x -> sparts(@r) if $x -> is_nan() || $x -> is_inf(); 4087 4088 # Upgrade? 4089 4090 return $upgrade -> nparts($x, @r) 4091 if defined($upgrade) && !$x -> isa($class); 4092 4093 # Finite number. 4094 4095 my ($mant, $expo) = $x -> sparts(@r); 4096 if ($mant -> bcmp(0)) { 4097 my ($ndigtot, $ndigfrac) = $mant -> length(); 4098 my $expo10adj = $ndigtot - $ndigfrac - 1; 4099 4100 if ($expo10adj > 0) { # if mantissa is not an integer 4101 return $upgrade -> nparts($x, @r) if defined $upgrade; 4102 $mant = $mant -> bnan(@r); 4103 return $mant unless wantarray; 4104 $expo = $expo -> badd($expo10adj, @r); 4105 return ($mant, $expo); 4106 } 4107 } 4108 4109 return $mant unless wantarray; 4110 return ($mant, $expo); 4111} 4112 4113# Parts used for engineering notation with significand/mantissa as either 0 or a 4114# number in the semi-open interval [1,1000) and the exponent is a multiple of 3. 4115# E.g., "12345.6789" is returned as "12.3456789" and "3". 4116 4117sub eparts { 4118 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4119 4120 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4121 4122 # Not-a-number and Infinity. 4123 4124 return $x -> sparts(@r) if $x -> is_nan() || $x -> is_inf(); 4125 4126 # Upgrade? 4127 4128 return $upgrade -> eparts($x, @r) 4129 if defined($upgrade) && !$x -> isa($class); 4130 4131 # Finite number. 4132 4133 my ($mant, $expo) = $x -> sparts(@r); 4134 4135 if ($mant -> bcmp(0)) { 4136 my $ndigmant = $mant -> length(); 4137 $expo = $expo -> badd($ndigmant, @r); 4138 4139 # $c is the number of digits that will be in the integer part of the 4140 # final mantissa. 4141 4142 my $c = $expo -> copy() -> bdec() -> bmod(3) -> binc(); 4143 $expo = $expo -> bsub($c); 4144 4145 if ($ndigmant > $c) { 4146 return $upgrade -> eparts($x, @r) if defined $upgrade; 4147 $mant = $mant -> bnan(@r); 4148 return $mant unless wantarray; 4149 return ($mant, $expo); 4150 } 4151 4152 $mant = $mant -> blsft($c - $ndigmant, 10, @r); 4153 } 4154 4155 return $mant unless wantarray; 4156 return ($mant, $expo); 4157} 4158 4159# Parts used for decimal notation, e.g., "12345.6789" is returned as "12345" 4160# (integer part) and "0.6789" (fraction part). 4161 4162sub dparts { 4163 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4164 4165 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4166 4167 # Not-a-number. 4168 4169 if ($x -> is_nan()) { 4170 my $int = $class -> bnan(@r); 4171 return $int unless wantarray; 4172 my $frc = $class -> bzero(@r); # or NaN? 4173 return ($int, $frc); 4174 } 4175 4176 # Infinity. 4177 4178 if ($x -> is_inf()) { 4179 my $int = $class -> binf($x->{sign}, @r); 4180 return $int unless wantarray; 4181 my $frc = $class -> bzero(@r); 4182 return ($int, $frc); 4183 } 4184 4185 # Upgrade? 4186 4187 return $upgrade -> dparts($x, @r) 4188 if defined($upgrade) && !$x -> isa($class); 4189 4190 # Finite number. 4191 4192 my $int = $x -> copy() -> round(@r); 4193 return $int unless wantarray; 4194 4195 my $frc = $class -> bzero(@r); 4196 return ($int, $frc); 4197} 4198 4199# Fractional parts with the numerator and denominator as integers. E.g., 4200# "123.4375" is returned as "1975" and "16". 4201 4202sub fparts { 4203 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4204 4205 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4206 4207 # NaN => NaN/NaN 4208 4209 if ($x -> is_nan()) { 4210 return $class -> bnan(@r) unless wantarray; 4211 return $class -> bnan(@r), $class -> bnan(@r); 4212 } 4213 4214 # ��Inf => ��Inf/1 4215 4216 if ($x -> is_inf()) { 4217 my $numer = $class -> binf($x->{sign}, @r); 4218 return $numer unless wantarray; 4219 my $denom = $class -> bone(@r); 4220 return $numer, $denom; 4221 } 4222 4223 # Upgrade? 4224 4225 return $upgrade -> fparts($x, @r) 4226 if defined($upgrade) && !$x -> isa($class); 4227 4228 # N => N/1 4229 4230 my $numer = $x -> copy() -> round(@r); 4231 return $numer unless wantarray; 4232 my $denom = $class -> bone(@r); 4233 return $numer, $denom; 4234} 4235 4236sub numerator { 4237 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4238 4239 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4240 4241 return $upgrade -> numerator($x, @r) 4242 if defined($upgrade) && !$x -> isa($class); 4243 4244 return $x -> copy() -> round(@r); 4245} 4246 4247sub denominator { 4248 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4249 4250 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4251 4252 return $upgrade -> denominator($x, @r) 4253 if defined($upgrade) && !$x -> isa($class); 4254 4255 return $x -> is_nan() ? $class -> bnan(@r) : $class -> bone(@r); 4256} 4257 4258############################################################################### 4259# String conversion methods 4260############################################################################### 4261 4262sub bstr { 4263 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4264 4265 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4266 4267 # Inf and NaN 4268 4269 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 4270 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 4271 return 'inf'; # +inf 4272 } 4273 4274 # Upgrade? 4275 4276 return $upgrade -> bstr($x, @r) 4277 if defined($upgrade) && !$x -> isa($class); 4278 4279 # Finite number 4280 4281 my $str = $LIB->_str($x->{value}); 4282 return $x->{sign} eq '-' ? "-$str" : $str; 4283} 4284 4285# Scientific notation with significand/mantissa as an integer, e.g., "12345" is 4286# written as "1.2345e+4". 4287 4288sub bsstr { 4289 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4290 4291 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4292 4293 # Inf and NaN 4294 4295 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 4296 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 4297 return 'inf'; # +inf 4298 } 4299 4300 # Upgrade? 4301 4302 return $upgrade -> bsstr($x, @r) 4303 if defined($upgrade) && !$x -> isa($class); 4304 4305 # Finite number 4306 4307 my $expo = $LIB -> _zeros($x->{value}); 4308 my $mant = $LIB -> _str($x->{value}); 4309 $mant = substr($mant, 0, -$expo) if $expo; # strip trailing zeros 4310 4311 ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo; 4312} 4313 4314# Normalized notation, e.g., "12345" is written as "1.2345e+4". 4315 4316sub bnstr { 4317 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4318 4319 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4320 4321 # Inf and NaN 4322 4323 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 4324 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 4325 return 'inf'; # +inf 4326 } 4327 4328 # Upgrade? 4329 4330 return $upgrade -> bnstr($x, @r) 4331 if defined($upgrade) && !$x -> isa($class); 4332 4333 # Finite number 4334 4335 my $expo = $LIB -> _zeros($x->{value}); 4336 my $mant = $LIB -> _str($x->{value}); 4337 $mant = substr($mant, 0, -$expo) if $expo; # strip trailing zeros 4338 4339 my $mantlen = CORE::length($mant); 4340 if ($mantlen > 1) { 4341 $expo += $mantlen - 1; # adjust exponent 4342 substr $mant, 1, 0, "."; # insert decimal point 4343 } 4344 4345 ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo; 4346} 4347 4348# Engineering notation, e.g., "12345" is written as "12.345e+3". 4349 4350sub bestr { 4351 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4352 4353 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4354 4355 # Inf and NaN 4356 4357 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 4358 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 4359 return 'inf'; # +inf 4360 } 4361 4362 # Upgrade? 4363 4364 return $upgrade -> bestr($x, @r) 4365 if defined($upgrade) && !$x -> isa($class); 4366 4367 # Finite number 4368 4369 my $expo = $LIB -> _zeros($x->{value}); # number of trailing zeros 4370 my $mant = $LIB -> _str($x->{value}); # mantissa as a string 4371 $mant = substr($mant, 0, -$expo) if $expo; # strip trailing zeros 4372 my $mantlen = CORE::length($mant); # length of mantissa 4373 $expo += $mantlen; 4374 4375 my $dotpos = ($expo - 1) % 3 + 1; # offset of decimal point 4376 $expo -= $dotpos; 4377 4378 if ($dotpos < $mantlen) { 4379 substr $mant, $dotpos, 0, "."; # insert decimal point 4380 } elsif ($dotpos > $mantlen) { 4381 $mant .= "0" x ($dotpos - $mantlen); # append zeros 4382 } 4383 4384 ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo; 4385} 4386 4387# Decimal notation, e.g., "12345" (no exponent). 4388 4389sub bdstr { 4390 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4391 4392 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4393 4394 # Inf and NaN 4395 4396 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 4397 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 4398 return 'inf'; # +inf 4399 } 4400 4401 # Upgrade? 4402 4403 return $upgrade -> bdstr($x, @r) 4404 if defined($upgrade) && !$x -> isa($class); 4405 4406 # Finite number 4407 4408 ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{value}); 4409} 4410 4411# Fraction notation, e.g., "123.4375" is written as "1975/16", but "123" is 4412# written as "123", not "123/1". 4413 4414sub bfstr { 4415 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4416 4417 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4418 4419 # Inf and NaN 4420 4421 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 4422 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 4423 return 'inf'; # +inf 4424 } 4425 4426 # Upgrade? 4427 4428 return $upgrade -> bfstr($x, @r) 4429 if defined($upgrade) && !$x -> isa($class); 4430 4431 # Finite number 4432 4433 ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{value}); 4434} 4435 4436sub to_hex { 4437 # return as hex string with no prefix 4438 4439 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4440 4441 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4442 4443 # Inf and NaN 4444 4445 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 4446 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 4447 return 'inf'; # +inf 4448 } 4449 4450 # Upgrade? 4451 4452 return $upgrade -> to_hex($x, @r) 4453 if defined($upgrade) && !$x -> isa($class); 4454 4455 # Finite number 4456 4457 my $hex = $LIB->_to_hex($x->{value}); 4458 return $x->{sign} eq '-' ? "-$hex" : $hex; 4459} 4460 4461sub to_oct { 4462 # return as octal string with no prefix 4463 4464 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4465 4466 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4467 4468 # Inf and NaN 4469 4470 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 4471 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 4472 return 'inf'; # +inf 4473 } 4474 4475 # Upgrade? 4476 4477 return $upgrade -> to_oct($x, @r) 4478 if defined($upgrade) && !$x -> isa($class); 4479 4480 # Finite number 4481 4482 my $oct = $LIB->_to_oct($x->{value}); 4483 return $x->{sign} eq '-' ? "-$oct" : $oct; 4484} 4485 4486sub to_bin { 4487 # return as binary string with no prefix 4488 4489 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4490 4491 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4492 4493 # Inf and NaN 4494 4495 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 4496 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 4497 return 'inf'; # +inf 4498 } 4499 4500 # Upgrade? 4501 4502 return $upgrade -> to_bin($x, @r) 4503 if defined($upgrade) && !$x -> isa($class); 4504 4505 # Finite number 4506 4507 my $bin = $LIB->_to_bin($x->{value}); 4508 return $x->{sign} eq '-' ? "-$bin" : $bin; 4509} 4510 4511sub to_bytes { 4512 # return a byte string 4513 4514 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4515 4516 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4517 4518 croak("to_bytes() requires a finite, non-negative integer") 4519 if $x -> is_neg() || ! $x -> is_int(); 4520 4521 return $upgrade -> to_bytes($x, @r) 4522 if defined($upgrade) && !$x -> isa($class); 4523 4524 croak("to_bytes() requires a newer version of the $LIB library.") 4525 unless $LIB->can('_to_bytes'); 4526 4527 return $LIB->_to_bytes($x->{value}); 4528} 4529 4530sub to_base { 4531 # return a base anything string 4532 4533 # $cs is the collation sequence 4534 my ($class, $x, $base, $cs, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 4535 ? (ref($_[0]), @_) : objectify(2, @_); 4536 4537 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4538 4539 croak("the value to convert must be a finite, non-negative integer") 4540 if $x -> is_neg() || !$x -> is_int(); 4541 4542 croak("the base must be a finite integer >= 2") 4543 if $base < 2 || ! $base -> is_int(); 4544 4545 # If no collating sequence is given, pass some of the conversions to 4546 # methods optimized for those cases. 4547 4548 unless (defined $cs) { 4549 return $x -> to_bin() if $base == 2; 4550 return $x -> to_oct() if $base == 8; 4551 return uc $x -> to_hex() if $base == 16; 4552 return $x -> bstr() if $base == 10; 4553 } 4554 4555 croak("to_base() requires a newer version of the $LIB library.") 4556 unless $LIB->can('_to_base'); 4557 4558 return $upgrade -> to_base($x, $base, $cs, @r) 4559 if defined($upgrade) && (!$x -> isa($class) || !$base -> isa($class)); 4560 4561 return $LIB->_to_base($x->{value}, $base -> {value}, 4562 defined($cs) ? $cs : ()); 4563} 4564 4565sub to_base_num { 4566 # return a base anything array ref, e.g., 4567 # Math::BigInt -> new(255) -> to_base_num(10) returns [2, 5, 5]; 4568 4569 # $cs is the collation sequence 4570 my ($class, $x, $base, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1]) 4571 ? (ref($_[0]), @_) : objectify(2, @_); 4572 4573 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4574 4575 croak("the value to convert must be a finite non-negative integer") 4576 if $x -> is_neg() || !$x -> is_int(); 4577 4578 croak("the base must be a finite integer >= 2") 4579 if $base < 2 || ! $base -> is_int(); 4580 4581 croak("to_base() requires a newer version of the $LIB library.") 4582 unless $LIB->can('_to_base'); 4583 4584 return $upgrade -> to_base_num($x, $base, @r) 4585 if defined($upgrade) && (!$x -> isa($class) || !$base -> isa($class)); 4586 4587 # Get a reference to an array of library thingies, and replace each element 4588 # with a Math::BigInt object using that thingy. 4589 4590 my $vals = $LIB -> _to_base_num($x->{value}, $base -> {value}); 4591 4592 for my $i (0 .. $#$vals) { 4593 my $x = $class -> bzero(); 4594 $x -> {value} = $vals -> [$i]; 4595 $vals -> [$i] = $x; 4596 } 4597 4598 return $vals; 4599} 4600 4601sub as_hex { 4602 # return as hex string, with prefixed 0x 4603 4604 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4605 4606 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4607 4608 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc 4609 4610 return $upgrade -> as_hex($x, @r) 4611 if defined($upgrade) && !$x -> isa($class); 4612 4613 my $hex = $LIB->_as_hex($x->{value}); 4614 return $x->{sign} eq '-' ? "-$hex" : $hex; 4615} 4616 4617sub as_oct { 4618 # return as octal string, with prefixed 0 4619 4620 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4621 4622 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4623 4624 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc 4625 4626 return $upgrade -> as_oct($x, @r) 4627 if defined($upgrade) && !$x -> isa($class); 4628 4629 my $oct = $LIB->_as_oct($x->{value}); 4630 return $x->{sign} eq '-' ? "-$oct" : $oct; 4631} 4632 4633sub as_bin { 4634 # return as binary string, with prefixed 0b 4635 4636 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4637 4638 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4639 4640 return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc 4641 4642 return $upgrade -> as_bin($x, @r) 4643 if defined($upgrade) && !$x -> isa($class); 4644 4645 my $bin = $LIB->_as_bin($x->{value}); 4646 return $x->{sign} eq '-' ? "-$bin" : $bin; 4647} 4648 4649*as_bytes = \&to_bytes; 4650 4651############################################################################### 4652# Other conversion methods 4653############################################################################### 4654 4655sub numify { 4656 # Make a Perl scalar number from a Math::BigInt object. 4657 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 4658 4659 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 4660 4661 if ($x -> is_nan()) { 4662 require Math::Complex; 4663 my $inf = $Math::Complex::Inf; 4664 return $inf - $inf; 4665 } 4666 4667 if ($x -> is_inf()) { 4668 require Math::Complex; 4669 my $inf = $Math::Complex::Inf; 4670 return $x -> is_negative() ? -$inf : $inf; 4671 } 4672 4673 return $upgrade -> numify($x, @r) 4674 if defined($upgrade) && !$x -> isa($class); 4675 4676 my $num = 0 + $LIB->_num($x->{value}); 4677 return $x->{sign} eq '-' ? -$num : $num; 4678} 4679 4680############################################################################### 4681# Private methods and functions. 4682############################################################################### 4683 4684sub objectify { 4685 # Convert strings and "foreign objects" to the objects we want. 4686 4687 # The first argument, $count, is the number of following arguments that 4688 # objectify() looks at and converts to objects. The first is a classname. 4689 # If the given count is 0, all arguments will be used. 4690 4691 # After the count is read, objectify obtains the name of the class to which 4692 # the following arguments are converted. If the second argument is a 4693 # reference, use the reference type as the class name. Otherwise, if it is 4694 # a string that looks like a class name, use that. Otherwise, use $class. 4695 4696 # Caller: Gives us: 4697 # 4698 # $x->badd(1); => ref x, scalar y 4699 # Class->badd(1, 2); => classname x (scalar), scalar x, scalar y 4700 # Class->badd(Class->(1), 2); => classname x (scalar), ref x, scalar y 4701 # Math::BigInt::badd(1, 2); => scalar x, scalar y 4702 4703 # A shortcut for the common case $x->unary_op(), in which case the argument 4704 # list is (0, $x) or (1, $x). 4705 4706 return (ref($_[1]), $_[1]) if @_ == 2 && ($_[0] || 0) == 1 && ref($_[1]); 4707 4708 # Check the context. 4709 4710 unless (wantarray) { 4711 croak(__PACKAGE__ . "::objectify() needs list context"); 4712 } 4713 4714 # Get the number of arguments to objectify. 4715 4716 my $count = shift; 4717 4718 # Initialize the output array. 4719 4720 my @a = @_; 4721 4722 # If the first argument is a reference, use that reference type as our 4723 # class name. Otherwise, if the first argument looks like a class name, 4724 # then use that as our class name. Otherwise, use the default class name. 4725 4726 my $class; 4727 if (ref($a[0])) { # reference? 4728 $class = ref($a[0]); 4729 } elsif ($a[0] =~ /^[A-Z].*::/) { # string with class name? 4730 $class = shift @a; 4731 } else { 4732 $class = __PACKAGE__; # default class name 4733 } 4734 4735 $count ||= @a; 4736 unshift @a, $class; 4737 4738 no strict 'refs'; 4739 4740 # What we upgrade to, if anything. Note that we need the whole upgrade 4741 # chain, since there might be multiple levels of upgrading. E.g., class A 4742 # upgrades to class B, which upgrades to class C. Delay getting the chain 4743 # until we actually need it. 4744 4745 my @upg = (); 4746 my $have_upgrade_chain = 0; 4747 4748 # Disable downgrading, because Math::BigFloat -> foo('1.0', '2.0') needs 4749 # floats. 4750 4751 my $down; 4752 if (defined ${"$a[0]::downgrade"}) { 4753 $down = ${"$a[0]::downgrade"}; 4754 ${"$a[0]::downgrade"} = undef; 4755 } 4756 4757 ARG: for my $i (1 .. $count) { 4758 4759 my $ref = ref $a[$i]; 4760 4761 # Perl scalars are fed to the appropriate constructor. 4762 4763 unless ($ref) { 4764 $a[$i] = $a[0] -> new($a[$i]); 4765 next; 4766 } 4767 4768 # If it is an object of the right class, all is fine. 4769 4770 next if $ref -> isa($a[0]); 4771 4772 # Upgrading is OK, so skip further tests if the argument is upgraded, 4773 # but first get the whole upgrade chain if we haven't got it yet. 4774 4775 unless ($have_upgrade_chain) { 4776 my $cls = $class; 4777 my $upg = $cls -> upgrade(); 4778 while (defined $upg) { 4779 last if $upg eq $cls; 4780 push @upg, $upg; 4781 $cls = $upg; 4782 $upg = $cls -> upgrade(); 4783 } 4784 $have_upgrade_chain = 1; 4785 } 4786 4787 for my $upg (@upg) { 4788 next ARG if $ref -> isa($upg); 4789 } 4790 4791 # See if we can call one of the as_xxx() methods. We don't know whether 4792 # the as_xxx() method returns an object or a scalar, so re-check 4793 # afterwards. 4794 4795 my $recheck = 0; 4796 4797 if ($a[0] -> isa('Math::BigInt')) { 4798 if ($a[$i] -> can('as_int')) { 4799 $a[$i] = $a[$i] -> as_int(); 4800 $recheck = 1; 4801 } elsif ($a[$i] -> can('as_number')) { 4802 $a[$i] = $a[$i] -> as_number(); 4803 $recheck = 1; 4804 } 4805 } 4806 4807 elsif ($a[0] -> isa('Math::BigFloat')) { 4808 if ($a[$i] -> can('as_float')) { 4809 $a[$i] = $a[$i] -> as_float(); 4810 $recheck = $1; 4811 } 4812 } 4813 4814 # If we called one of the as_xxx() methods, recheck. 4815 4816 if ($recheck) { 4817 $ref = ref($a[$i]); 4818 4819 # Perl scalars are fed to the appropriate constructor. 4820 4821 unless ($ref) { 4822 $a[$i] = $a[0] -> new($a[$i]); 4823 next; 4824 } 4825 4826 # If it is an object of the right class, all is fine. 4827 4828 next if $ref -> isa($a[0]); 4829 } 4830 4831 # Last resort. 4832 4833 $a[$i] = $a[0] -> new($a[$i]); 4834 } 4835 4836 # Reset the downgrading. 4837 4838 ${"$a[0]::downgrade"} = $down; 4839 4840 return @a; 4841} 4842 4843sub import { 4844 my $class = shift; 4845 $IMPORT++; # remember we did import() 4846 my @a; # unrecognized arguments 4847 4848 while (@_) { 4849 my $param = shift; 4850 4851 # Enable overloading of constants. 4852 4853 if ($param eq ':constant') { 4854 overload::constant 4855 4856 integer => sub { 4857 $class -> new(shift); 4858 }, 4859 4860 float => sub { 4861 $class -> new(shift); 4862 }, 4863 4864 binary => sub { 4865 # E.g., a literal 0377 shall result in an object whose value 4866 # is decimal 255, but new("0377") returns decimal 377. 4867 return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; 4868 $class -> new(shift); 4869 }; 4870 next; 4871 } 4872 4873 # Upgrading. 4874 4875 if ($param eq 'upgrade') { 4876 $class -> upgrade(shift); 4877 next; 4878 } 4879 4880 # Downgrading. 4881 4882 if ($param eq 'downgrade') { 4883 $class -> downgrade(shift); 4884 next; 4885 } 4886 4887 # Accuracy. 4888 4889 if ($param eq 'accuracy') { 4890 $class -> accuracy(shift); 4891 next; 4892 } 4893 4894 # Precision. 4895 4896 if ($param eq 'precision') { 4897 $class -> precision(shift); 4898 next; 4899 } 4900 4901 # Rounding mode. 4902 4903 if ($param eq 'round_mode') { 4904 $class -> round_mode(shift); 4905 next; 4906 } 4907 4908 # Backend library. 4909 4910 if ($param =~ /^(lib|try|only)\z/) { 4911 # try => 0 (no warn if unavailable module) 4912 # lib => 1 (warn on fallback) 4913 # only => 2 (die on fallback) 4914 4915 # Get the list of user-specified libraries. 4916 4917 croak "Library argument for import parameter '$param' is missing" 4918 unless @_; 4919 my $libs = shift; 4920 croak "Library argument for import parameter '$param' is undefined" 4921 unless defined($libs); 4922 4923 # Check and clean up the list of user-specified libraries. 4924 4925 my @libs; 4926 for my $lib (split /,/, $libs) { 4927 $lib =~ s/^\s+//; 4928 $lib =~ s/\s+$//; 4929 4930 if ($lib =~ /[^a-zA-Z0-9_:]/) { 4931 carp "Library name '$lib' contains invalid characters"; 4932 next; 4933 } 4934 4935 if (! CORE::length $lib) { 4936 carp "Library name is empty"; 4937 next; 4938 } 4939 4940 $lib = "Math::BigInt::$lib" if $lib !~ /^Math::BigInt::/i; 4941 4942 # If a library has already been loaded, that is OK only if the 4943 # requested library is identical to the loaded one. 4944 4945 if (defined($LIB)) { 4946 if ($lib ne $LIB) { 4947 #carp "Library '$LIB' has already been loaded, so", 4948 # " ignoring requested library '$lib'"; 4949 } 4950 next; 4951 } 4952 4953 push @libs, $lib; 4954 } 4955 4956 next if defined $LIB; 4957 4958 croak "Library list contains no valid libraries" unless @libs; 4959 4960 # Try to load the specified libraries, if any. 4961 4962 for (my $i = 0 ; $i <= $#libs ; $i++) { 4963 my $lib = $libs[$i]; 4964 eval "require $lib"; 4965 unless ($@) { 4966 $LIB = $lib; 4967 last; 4968 } 4969 } 4970 4971 next if defined $LIB; 4972 4973 # No library has been loaded, and none of the requested libraries 4974 # could be loaded, and fallback and the user doesn't allow fallback. 4975 4976 if ($param eq 'only') { 4977 croak "Couldn't load the specified math lib(s) ", 4978 join(", ", map "'$_'", @libs), 4979 ", and fallback to '$DEFAULT_LIB' is not allowed"; 4980 } 4981 4982 # No library has been loaded, and none of the requested libraries 4983 # could be loaded, but the user accepts the use of a fallback 4984 # library, so try to load it. 4985 4986 eval "require $DEFAULT_LIB"; 4987 if ($@) { 4988 croak "Couldn't load the specified math lib(s) ", 4989 join(", ", map "'$_'", @libs), 4990 ", not even the fallback lib '$DEFAULT_LIB'"; 4991 } 4992 4993 # The fallback library was successfully loaded, but the user 4994 # might want to know that we are using the fallback. 4995 4996 if ($param eq 'lib') { 4997 carp "Couldn't load the specified math lib(s) ", 4998 join(", ", map "'$_'", @libs), 4999 ", so using fallback lib '$DEFAULT_LIB'"; 5000 } 5001 5002 next; 5003 } 5004 5005 # Unrecognized parameter. 5006 5007 push @a, $param; 5008 } 5009 5010 # Any non-':constant' stuff is handled by our parent, Exporter 5011 5012 if (@a) { 5013 $class->SUPER::import(@a); # need it for subclasses 5014 $class->export_to_level(1, $class, @a); # need it for Math::BigFloat 5015 } 5016 5017 # We might not have loaded any backend library yet, either because the user 5018 # didn't specify any, or because the specified libraries failed to load and 5019 # the user allows the use of a fallback library. 5020 5021 unless (defined $LIB) { 5022 eval "require $DEFAULT_LIB"; 5023 if ($@) { 5024 croak "No lib specified, and couldn't load the default", 5025 " lib '$DEFAULT_LIB'"; 5026 } 5027 $LIB = $DEFAULT_LIB; 5028 } 5029 5030 # import done 5031} 5032 5033sub _trailing_zeros { 5034 # return the amount of trailing zeros in $x (as scalar) 5035 my $x = shift; 5036 $x = __PACKAGE__->new($x) unless ref $x; 5037 5038 return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc 5039 5040 $LIB->_zeros($x->{value}); # must handle odd values, 0 etc 5041} 5042 5043sub _scan_for_nonzero { 5044 # internal, used by bround() to scan for non-zeros after a '5' 5045 my ($x, $pad, $xs, $len) = @_; 5046 5047 return 0 if $len == 1; # "5" is trailed by invisible zeros 5048 my $follow = $pad - 1; 5049 return 0 if $follow > $len || $follow < 1; 5050 5051 # use the string form to check whether only '0's follow or not 5052 substr ($xs, -$follow) =~ /[^0]/ ? 1 : 0; 5053} 5054 5055sub _find_round_parameters { 5056 # After any operation or when calling round(), the result is rounded by 5057 # regarding the A & P from arguments, local parameters, or globals. 5058 5059 # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!! 5060 5061 # This procedure finds the round parameters, but it is for speed reasons 5062 # duplicated in round. Otherwise, it is tested by the testsuite and used 5063 # by bdiv(). 5064 5065 # returns ($self) or ($self, $a, $p, $r) - sets $self to NaN of both A and P 5066 # were requested/defined (locally or globally or both) 5067 5068 my ($self, $a, $p, $r, @args) = @_; 5069 # $a accuracy, if given by caller 5070 # $p precision, if given by caller 5071 # $r round_mode, if given by caller 5072 # @args all 'other' arguments (0 for unary, 1 for binary ops) 5073 5074 my $class = ref($self); # find out class of argument(s) 5075 no strict 'refs'; 5076 5077 # convert to normal scalar for speed and correctness in inner parts 5078 $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a); 5079 $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p); 5080 5081 # now pick $a or $p, but only if we have got "arguments" 5082 if (!defined $a) { 5083 foreach ($self, @args) { 5084 # take the defined one, or if both defined, the one that is smaller 5085 $a = $_->{_a} 5086 if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a); 5087 } 5088 } 5089 if (!defined $p) { 5090 # even if $a is defined, take $p, to signal error for both defined 5091 foreach ($self, @args) { 5092 # take the defined one, or if both defined, the one that is bigger 5093 # -2 > -3, and 3 > 2 5094 $p = $_->{_p} 5095 if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); 5096 } 5097 } 5098 5099 # if still none defined, use globals (#2) 5100 $a = ${"$class\::accuracy"} unless defined $a; 5101 $p = ${"$class\::precision"} unless defined $p; 5102 5103 # A == 0 is useless, so undef it to signal no rounding 5104 $a = undef if defined $a && $a == 0; 5105 5106 # no rounding today? 5107 return ($self) unless defined $a || defined $p; # early out 5108 5109 # set A and set P is an fatal error 5110 return ($self->bnan()) if defined $a && defined $p; # error 5111 5112 $r = ${"$class\::round_mode"} unless defined $r; 5113 if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) { 5114 croak("Unknown round mode '$r'"); 5115 } 5116 5117 $a = int($a) if defined $a; 5118 $p = int($p) if defined $p; 5119 5120 ($self, $a, $p, $r); 5121} 5122 5123# Return true if the input is numeric and false if it is a string. 5124 5125sub _is_numeric { 5126 shift; # class name 5127 my $value = shift; 5128 no warnings 'numeric'; 5129 # detect numbers 5130 # string & "" -> "" 5131 # number & "" -> 0 (with warning) 5132 # nan and inf can detect as numbers, so check with * 0 5133 return unless CORE::length((my $dummy = "") & $value); 5134 return unless 0 + $value eq $value; 5135 return 1 if $value * 0 == 0; 5136 return -1; # Inf/NaN 5137} 5138 5139# Trims the sign of the significand, the (absolute value of the) significand, 5140# the sign of the exponent, and the (absolute value of the) exponent. The 5141# returned values have no underscores ("_") or unnecessary leading or trailing 5142# zeros. 5143 5144sub _trim_split_parts { 5145 shift; # class name 5146 5147 my $sig_sgn = shift() || '+'; 5148 my $sig_str = shift() || '0'; 5149 my $exp_sgn = shift() || '+'; 5150 my $exp_str = shift() || '0'; 5151 5152 $sig_str =~ tr/_//d; # "1.0_0_0" -> "1.000" 5153 $sig_str =~ s/^0+//; # "01.000" -> "1.000" 5154 $sig_str =~ s/\.0*$// # "1.000" -> "1" 5155 || $sig_str =~ s/(\..*[^0])0+$/$1/; # "1.010" -> "1.01" 5156 $sig_str = '0' unless CORE::length($sig_str); 5157 5158 return '+', '0', '+', '0' if $sig_str eq '0'; 5159 5160 $exp_str =~ tr/_//d; # "01_234" -> "01234" 5161 $exp_str =~ s/^0+//; # "01234" -> "1234" 5162 $exp_str = '0' unless CORE::length($exp_str); 5163 $exp_sgn = '+' if $exp_str eq '0'; # "+3e-0" -> "+3e+0" 5164 5165 return $sig_sgn, $sig_str, $exp_sgn, $exp_str; 5166} 5167 5168# Takes any string representing a valid decimal number and splits it into four 5169# strings: the sign of the significand, the absolute value of the significand, 5170# the sign of the exponent, and the absolute value of the exponent. Both the 5171# significand and the exponent are in base 10. 5172# 5173# Perl accepts literals like the following. The value is 100.1. 5174# 5175# 1__0__.__0__1__e+0__1__ (prints "Misplaced _ in number") 5176# 1_0.0_1e+0_1 5177# 5178# Strings representing decimal numbers do not allow underscores, so only the 5179# following is valid 5180# 5181# "10.01e+01" 5182 5183sub _dec_str_to_dec_str_parts { 5184 my $class = shift; 5185 my $str = shift; 5186 5187 if ($str =~ / 5188 ^ 5189 5190 # optional leading whitespace 5191 \s* 5192 5193 # optional sign 5194 ( [+-]? ) 5195 5196 # significand 5197 ( 5198 # integer part and optional fraction part ... 5199 \d+ (?: _+ \d+ )* _* 5200 (?: 5201 \. 5202 (?: _* \d+ (?: _+ \d+ )* _* )? 5203 )? 5204 | 5205 # ... or mandatory fraction part 5206 \. 5207 \d+ (?: _+ \d+ )* _* 5208 ) 5209 5210 # optional exponent 5211 (?: 5212 [Ee] 5213 ( [+-]? ) 5214 ( \d+ (?: _+ \d+ )* _* ) 5215 )? 5216 5217 # optional trailing whitespace 5218 \s* 5219 5220 $ 5221 /x) 5222 { 5223 return $class -> _trim_split_parts($1, $2, $3, $4); 5224 } 5225 5226 return; 5227} 5228 5229# Takes any string representing a valid hexadecimal number and splits it into 5230# four strings: the sign of the significand, the absolute value of the 5231# significand, the sign of the exponent, and the absolute value of the exponent. 5232# The significand is in base 16, and the exponent is in base 2. 5233# 5234# Perl accepts literals like the following. The "x" might be a capital "X". The 5235# value is 32.0078125. 5236# 5237# 0x__1__0__.0__1__p+0__1__ (prints "Misplaced _ in number") 5238# 0x1_0.0_1p+0_1 5239# 5240# The CORE::hex() function does not accept floating point accepts 5241# 5242# "0x_1_0" 5243# "x_1_0" 5244# "_1_0" 5245 5246sub _hex_str_to_hex_str_parts { 5247 my $class = shift; 5248 my $str = shift; 5249 5250 if ($str =~ / 5251 ^ 5252 5253 # optional leading whitespace 5254 \s* 5255 5256 # optional sign 5257 ( [+-]? ) 5258 5259 # optional hex prefix 5260 (?: 0? [Xx] _* )? 5261 5262 # significand using the hex digits 0..9 and a..f 5263 ( 5264 # integer part and optional fraction part ... 5265 [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* 5266 (?: 5267 \. 5268 (?: _* [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* )? 5269 )? 5270 | 5271 # ... or mandatory fraction part 5272 \. 5273 [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* 5274 ) 5275 5276 # optional exponent (power of 2) using decimal digits 5277 (?: 5278 [Pp] 5279 ( [+-]? ) 5280 ( \d+ (?: _+ \d+ )* _* ) 5281 )? 5282 5283 # optional trailing whitespace 5284 \s* 5285 5286 $ 5287 /x) 5288 { 5289 return $class -> _trim_split_parts($1, $2, $3, $4); 5290 } 5291 5292 return; 5293} 5294 5295# Takes any string representing a valid octal number and splits it into four 5296# strings: the sign of the significand, the absolute value of the significand, 5297# the sign of the exponent, and the absolute value of the exponent. The 5298# significand is in base 8, and the exponent is in base 2. 5299 5300sub _oct_str_to_oct_str_parts { 5301 my $class = shift; 5302 my $str = shift; 5303 5304 if ($str =~ / 5305 ^ 5306 5307 # optional leading whitespace 5308 \s* 5309 5310 # optional sign 5311 ( [+-]? ) 5312 5313 # optional octal prefix 5314 (?: 0? [Oo] _* )? 5315 5316 # significand using the octal digits 0..7 5317 ( 5318 # integer part and optional fraction part ... 5319 [0-7]+ (?: _+ [0-7]+ )* _* 5320 (?: 5321 \. 5322 (?: _* [0-7]+ (?: _+ [0-7]+ )* _* )? 5323 )? 5324 | 5325 # ... or mandatory fraction part 5326 \. 5327 [0-7]+ (?: _+ [0-7]+ )* _* 5328 ) 5329 5330 # optional exponent (power of 2) using decimal digits 5331 (?: 5332 [Pp] 5333 ( [+-]? ) 5334 ( \d+ (?: _+ \d+ )* _* ) 5335 )? 5336 5337 # optional trailing whitespace 5338 \s* 5339 5340 $ 5341 /x) 5342 { 5343 return $class -> _trim_split_parts($1, $2, $3, $4); 5344 } 5345 5346 return; 5347} 5348 5349# Takes any string representing a valid binary number and splits it into four 5350# strings: the sign of the significand, the absolute value of the significand, 5351# the sign of the exponent, and the absolute value of the exponent. The 5352# significand is in base 2, and the exponent is in base 2. 5353 5354sub _bin_str_to_bin_str_parts { 5355 my $class = shift; 5356 my $str = shift; 5357 5358 if ($str =~ / 5359 ^ 5360 5361 # optional leading whitespace 5362 \s* 5363 5364 # optional sign 5365 ( [+-]? ) 5366 5367 # optional binary prefix 5368 (?: 0? [Bb] _* )? 5369 5370 # significand using the binary digits 0 and 1 5371 ( 5372 # integer part and optional fraction part ... 5373 [01]+ (?: _+ [01]+ )* _* 5374 (?: 5375 \. 5376 (?: _* [01]+ (?: _+ [01]+ )* _* )? 5377 )? 5378 | 5379 # ... or mandatory fraction part 5380 \. 5381 [01]+ (?: _+ [01]+ )* _* 5382 ) 5383 5384 # optional exponent (power of 2) using decimal digits 5385 (?: 5386 [Pp] 5387 ( [+-]? ) 5388 ( \d+ (?: _+ \d+ )* _* ) 5389 )? 5390 5391 # optional trailing whitespace 5392 \s* 5393 5394 $ 5395 /x) 5396 { 5397 return $class -> _trim_split_parts($1, $2, $3, $4); 5398 } 5399 5400 return; 5401} 5402 5403# Takes any string representing a valid decimal number and splits it into four 5404# parts: the sign of the significand, the absolute value of the significand as a 5405# libray thingy, the sign of the exponent, and the absolute value of the 5406# exponent as a library thingy. 5407 5408sub _dec_str_parts_to_flt_lib_parts { 5409 shift; # class name 5410 5411 my ($sig_sgn, $sig_str, $exp_sgn, $exp_str) = @_; 5412 5413 # Handle zero. 5414 5415 if ($sig_str eq '0') { 5416 return '+', $LIB -> _zero(), '+', $LIB -> _zero(); 5417 } 5418 5419 # Absolute value of exponent as library "object". 5420 5421 my $exp_lib = $LIB -> _new($exp_str); 5422 5423 # If there is a dot in the significand, remove it so the significand 5424 # becomes an integer and adjust the exponent accordingly. Also remove 5425 # leading zeros which might now appear in the significand. E.g., 5426 # 5427 # 12.345e-2 -> 12345e-5 5428 # 12.345e+2 -> 12345e-1 5429 # 0.0123e+5 -> 00123e+1 -> 123e+1 5430 5431 my $idx = index $sig_str, '.'; 5432 if ($idx >= 0) { 5433 substr($sig_str, $idx, 1) = ''; 5434 5435 # delta = length - index 5436 my $delta = $LIB -> _new(CORE::length($sig_str)); 5437 $delta = $LIB -> _sub($delta, $LIB -> _new($idx)); 5438 5439 # exponent - delta 5440 ($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+'); 5441 5442 $sig_str =~ s/^0+//; 5443 } 5444 5445 # If there are trailing zeros in the significand, remove them and 5446 # adjust the exponent. E.g., 5447 # 5448 # 12340e-5 -> 1234e-4 5449 # 12340e-1 -> 1234e0 5450 # 12340e+3 -> 1234e4 5451 5452 if ($sig_str =~ s/(0+)\z//) { 5453 my $len = CORE::length($1); 5454 ($exp_lib, $exp_sgn) = 5455 $LIB -> _sadd($exp_lib, $exp_sgn, $LIB -> _new($len), '+'); 5456 } 5457 5458 # At this point, the significand is empty or an integer with no trailing 5459 # zeros. The exponent is in base 10. 5460 5461 unless (CORE::length $sig_str) { 5462 return '+', $LIB -> _zero(), '+', $LIB -> _zero(); 5463 } 5464 5465 # Absolute value of significand as library "object". 5466 5467 my $sig_lib = $LIB -> _new($sig_str); 5468 5469 return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib; 5470} 5471 5472# Takes any string representing a valid binary number and splits it into four 5473# parts: the sign of the significand, the absolute value of the significand as a 5474# libray thingy, the sign of the exponent, and the absolute value of the 5475# exponent as a library thingy. 5476 5477sub _bin_str_parts_to_flt_lib_parts { 5478 shift; # class name 5479 5480 my ($sig_sgn, $sig_str, $exp_sgn, $exp_str, $bpc) = @_; 5481 my $bpc_lib = $LIB -> _new($bpc); 5482 5483 # Handle zero. 5484 5485 if ($sig_str eq '0') { 5486 return '+', $LIB -> _zero(), '+', $LIB -> _zero(); 5487 } 5488 5489 # Absolute value of exponent as library "object". 5490 5491 my $exp_lib = $LIB -> _new($exp_str); 5492 5493 # If there is a dot in the significand, remove it so the significand 5494 # becomes an integer and adjust the exponent accordingly. Also remove 5495 # leading zeros which might now appear in the significand. E.g., with 5496 # hexadecimal numbers 5497 # 5498 # 12.345p-2 -> 12345p-14 5499 # 12.345p+2 -> 12345p-10 5500 # 0.0123p+5 -> 00123p-11 -> 123p-11 5501 5502 my $idx = index $sig_str, '.'; 5503 if ($idx >= 0) { 5504 substr($sig_str, $idx, 1) = ''; 5505 5506 # delta = (length - index) * bpc 5507 my $delta = $LIB -> _new(CORE::length($sig_str)); 5508 $delta = $LIB -> _sub($delta, $LIB -> _new($idx)); 5509 $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1; 5510 5511 # exponent - delta 5512 ($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+'); 5513 5514 $sig_str =~ s/^0+//; 5515 } 5516 5517 # If there are trailing zeros in the significand, remove them and 5518 # adjust the exponent accordingly. E.g., with hexadecimal numbers 5519 # 5520 # 12340p-5 -> 1234p-1 5521 # 12340p-1 -> 1234p+3 5522 # 12340p+3 -> 1234p+7 5523 5524 if ($sig_str =~ s/(0+)\z//) { 5525 5526 # delta = length * bpc 5527 my $delta = $LIB -> _new(CORE::length($1)); 5528 $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1; 5529 5530 # exponent + delta 5531 ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $delta, '+'); 5532 } 5533 5534 # At this point, the significand is empty or an integer with no leading 5535 # or trailing zeros. The exponent is in base 2. 5536 5537 unless (CORE::length $sig_str) { 5538 return '+', $LIB -> _zero(), '+', $LIB -> _zero(); 5539 } 5540 5541 # Absolute value of significand as library "object". 5542 5543 my $sig_lib = $bpc == 1 ? $LIB -> _from_bin('0b' . $sig_str) 5544 : $bpc == 3 ? $LIB -> _from_oct('0' . $sig_str) 5545 : $bpc == 4 ? $LIB -> _from_hex('0x' . $sig_str) 5546 : die "internal error: invalid exponent multiplier"; 5547 5548 # If the exponent (in base 2) is positive or zero ... 5549 5550 if ($exp_sgn eq '+') { 5551 5552 if (!$LIB -> _is_zero($exp_lib)) { 5553 5554 # Multiply significand by 2 raised to the exponent. 5555 5556 my $p = $LIB -> _pow($LIB -> _two(), $exp_lib); 5557 $sig_lib = $LIB -> _mul($sig_lib, $p); 5558 $exp_lib = $LIB -> _zero(); 5559 } 5560 } 5561 5562 # ... else if the exponent is negative ... 5563 5564 else { 5565 5566 # Rather than dividing the significand by 2 raised to the absolute 5567 # value of the exponent, multiply the significand by 5 raised to the 5568 # absolute value of the exponent and let the exponent be in base 10: 5569 # 5570 # a * 2^(-b) = a * 5^b * 10^(-b) = c * 10^(-b), where c = a * 5^b 5571 5572 my $p = $LIB -> _pow($LIB -> _new("5"), $exp_lib); 5573 $sig_lib = $LIB -> _mul($sig_lib, $p); 5574 } 5575 5576 # Adjust for the case when the conversion to decimal introduced trailing 5577 # zeros in the significand. 5578 5579 my $n = $LIB -> _zeros($sig_lib); 5580 if ($n) { 5581 $n = $LIB -> _new($n); 5582 $sig_lib = $LIB -> _rsft($sig_lib, $n, 10); 5583 ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $n, '+'); 5584 } 5585 5586 return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib; 5587} 5588 5589# Takes any string representing a valid hexadecimal number and splits it into 5590# four parts: the sign of the significand, the absolute value of the significand 5591# as a libray thingy, the sign of the exponent, and the absolute value of the 5592# exponent as a library thingy. 5593 5594sub _hex_str_to_flt_lib_parts { 5595 my $class = shift; 5596 my $str = shift; 5597 if (my @parts = $class -> _hex_str_to_hex_str_parts($str)) { 5598 return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 4); # 4 bits pr. chr 5599 } 5600 return; 5601} 5602 5603# Takes any string representing a valid octal number and splits it into four 5604# parts: the sign of the significand, the absolute value of the significand as a 5605# libray thingy, the sign of the exponent, and the absolute value of the 5606# exponent as a library thingy. 5607 5608sub _oct_str_to_flt_lib_parts { 5609 my $class = shift; 5610 my $str = shift; 5611 if (my @parts = $class -> _oct_str_to_oct_str_parts($str)) { 5612 return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 3); # 3 bits pr. chr 5613 } 5614 return; 5615} 5616 5617# Takes any string representing a valid binary number and splits it into four 5618# parts: the sign of the significand, the absolute value of the significand as a 5619# libray thingy, the sign of the exponent, and the absolute value of the 5620# exponent as a library thingy. 5621 5622sub _bin_str_to_flt_lib_parts { 5623 my $class = shift; 5624 my $str = shift; 5625 if (my @parts = $class -> _bin_str_to_bin_str_parts($str)) { 5626 return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 1); # 1 bit pr. chr 5627 } 5628 return; 5629} 5630 5631# Decimal string is split into the sign of the signficant, the absolute value of 5632# the significand as library thingy, the sign of the exponent, and the absolute 5633# value of the exponent as a a library thingy. 5634 5635sub _dec_str_to_flt_lib_parts { 5636 my $class = shift; 5637 my $str = shift; 5638 if (my @parts = $class -> _dec_str_to_dec_str_parts($str)) { 5639 return $class -> _dec_str_parts_to_flt_lib_parts(@parts); 5640 } 5641 return; 5642} 5643 5644# Hexdecimal string to a string using decimal floating point notation. 5645 5646sub hex_str_to_dec_flt_str { 5647 my $class = shift; 5648 my $str = shift; 5649 if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) { 5650 return $class -> _flt_lib_parts_to_flt_str(@parts); 5651 } 5652 return; 5653} 5654 5655# Octal string to a string using decimal floating point notation. 5656 5657sub oct_str_to_dec_flt_str { 5658 my $class = shift; 5659 my $str = shift; 5660 if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) { 5661 return $class -> _flt_lib_parts_to_flt_str(@parts); 5662 } 5663 return; 5664} 5665 5666# Binary string to a string decimal floating point notation. 5667 5668sub bin_str_to_dec_flt_str { 5669 my $class = shift; 5670 my $str = shift; 5671 if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) { 5672 return $class -> _flt_lib_parts_to_flt_str(@parts); 5673 } 5674 return; 5675} 5676 5677# Decimal string to a string using decimal floating point notation. 5678 5679sub dec_str_to_dec_flt_str { 5680 my $class = shift; 5681 my $str = shift; 5682 if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) { 5683 return $class -> _flt_lib_parts_to_flt_str(@parts); 5684 } 5685 return; 5686} 5687 5688# Hexdecimal string to decimal notation (no exponent). 5689 5690sub hex_str_to_dec_str { 5691 my $class = shift; 5692 my $str = shift; 5693 if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) { 5694 return $class -> _flt_lib_parts_to_dec_str(@parts); 5695 } 5696 return; 5697} 5698 5699# Octal string to decimal notation (no exponent). 5700 5701sub oct_str_to_dec_str { 5702 my $class = shift; 5703 my $str = shift; 5704 if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) { 5705 return $class -> _flt_lib_parts_to_dec_str(@parts); 5706 } 5707 return; 5708} 5709 5710# Binary string to decimal notation (no exponent). 5711 5712sub bin_str_to_dec_str { 5713 my $class = shift; 5714 my $str = shift; 5715 if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) { 5716 return $class -> _flt_lib_parts_to_dec_str(@parts); 5717 } 5718 return; 5719} 5720 5721# Decimal string to decimal notation (no exponent). 5722 5723sub dec_str_to_dec_str { 5724 my $class = shift; 5725 my $str = shift; 5726 if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) { 5727 return $class -> _flt_lib_parts_to_dec_str(@parts); 5728 } 5729 return; 5730} 5731 5732sub _flt_lib_parts_to_flt_str { 5733 my $class = shift; 5734 my @parts = @_; 5735 return $parts[0] . $LIB -> _str($parts[1]) 5736 . 'e' . $parts[2] . $LIB -> _str($parts[3]); 5737} 5738 5739sub _flt_lib_parts_to_dec_str { 5740 my $class = shift; 5741 my @parts = @_; 5742 5743 # The number is an integer iff the exponent is non-negative. 5744 5745 if ($parts[2] eq '+') { 5746 my $str = $parts[0] 5747 . $LIB -> _str($LIB -> _lsft($parts[1], $parts[3], 10)); 5748 return $str; 5749 } 5750 5751 # If it is not an integer, add a decimal point. 5752 5753 else { 5754 my $mant = $LIB -> _str($parts[1]); 5755 my $mant_len = CORE::length($mant); 5756 my $expo = $LIB -> _num($parts[3]); 5757 my $len_cmp = $mant_len <=> $expo; 5758 if ($len_cmp <= 0) { 5759 return $parts[0] . '0.' . '0' x ($expo - $mant_len) . $mant; 5760 } else { 5761 substr $mant, $mant_len - $expo, 0, '.'; 5762 return $parts[0] . $mant; 5763 } 5764 } 5765} 5766 5767# Takes four arguments, the sign of the significand, the absolute value of the 5768# significand as a libray thingy, the sign of the exponent, and the absolute 5769# value of the exponent as a library thingy, and returns three parts: the sign 5770# of the rational number, the absolute value of the numerator as a libray 5771# thingy, and the absolute value of the denominator as a library thingy. 5772# 5773# For example, to convert data representing the value "+12e-2", then 5774# 5775# $sm = "+"; 5776# $m = $LIB -> _new("12"); 5777# $se = "-"; 5778# $e = $LIB -> _new("2"); 5779# ($sr, $n, $d) = $class -> _flt_lib_parts_to_rat_lib_parts($sm, $m, $se, $e); 5780# 5781# returns data representing the same value written as the fraction "+3/25" 5782# 5783# $sr = "+" 5784# $n = $LIB -> _new("3"); 5785# $d = $LIB -> _new("12"); 5786 5787sub _flt_lib_parts_to_rat_lib_parts { 5788 my $self = shift; 5789 my ($msgn, $mabs, $esgn, $eabs) = @_; 5790 5791 if ($esgn eq '-') { # "12e-2" -> "12/100" -> "3/25" 5792 my $num_lib = $LIB -> _copy($mabs); 5793 my $den_lib = $LIB -> _1ex($LIB -> _num($eabs)); 5794 my $gcd_lib = $LIB -> _gcd($LIB -> _copy($num_lib), $den_lib); 5795 $num_lib = $LIB -> _div($LIB -> _copy($num_lib), $gcd_lib); 5796 $den_lib = $LIB -> _div($den_lib, $gcd_lib); 5797 return $msgn, $num_lib, $den_lib; 5798 } 5799 5800 elsif (!$LIB -> _is_zero($eabs)) { # "12e+2" -> "1200" -> "1200/1" 5801 return $msgn, $LIB -> _lsft($LIB -> _copy($mabs), $eabs, 10), 5802 $LIB -> _one(); 5803 } 5804 5805 else { # "12e+0" -> "12" -> "12/1" 5806 return $msgn, $mabs, $LIB -> _one(); 5807 } 5808} 5809 5810# Add the function _register_callback() to Math::BigInt. It is provided for 5811# backwards compabibility so that old version of Math::BigRat etc. don't 5812# complain about missing it. 5813 5814sub _register_callback { } 5815 5816############################################################################### 5817# this method returns 0 if the object can be modified, or 1 if not. 5818# We use a fast constant sub() here, to avoid costly calls. Subclasses 5819# may override it with special code (f.i. Math::BigInt::Constant does so) 5820 5821sub modify () { 0; } 5822 58231; 5824 5825__END__ 5826 5827=pod 5828 5829=head1 NAME 5830 5831Math::BigInt - arbitrary size integer math package 5832 5833=head1 SYNOPSIS 5834 5835 use Math::BigInt; 5836 5837 # or make it faster with huge numbers: install (optional) 5838 # Math::BigInt::GMP and always use (it falls back to 5839 # pure Perl if the GMP library is not installed): 5840 # (See also the L<MATH LIBRARY> section!) 5841 5842 # to warn if Math::BigInt::GMP cannot be found, use 5843 use Math::BigInt lib => 'GMP'; 5844 5845 # to suppress the warning if Math::BigInt::GMP cannot be found, use 5846 # use Math::BigInt try => 'GMP'; 5847 5848 # to die if Math::BigInt::GMP cannot be found, use 5849 # use Math::BigInt only => 'GMP'; 5850 5851 # Configuration methods (may be used as class methods and instance methods) 5852 5853 Math::BigInt->accuracy(); # get class accuracy 5854 Math::BigInt->accuracy($n); # set class accuracy 5855 Math::BigInt->precision(); # get class precision 5856 Math::BigInt->precision($n); # set class precision 5857 Math::BigInt->round_mode(); # get class rounding mode 5858 Math::BigInt->round_mode($m); # set global round mode, must be one of 5859 # 'even', 'odd', '+inf', '-inf', 'zero', 5860 # 'trunc', or 'common' 5861 Math::BigInt->config(); # return hash with configuration 5862 5863 # Constructor methods (when the class methods below are used as instance 5864 # methods, the value is assigned the invocand) 5865 5866 $x = Math::BigInt->new($str); # defaults to 0 5867 $x = Math::BigInt->new('0x123'); # from hexadecimal 5868 $x = Math::BigInt->new('0b101'); # from binary 5869 $x = Math::BigInt->from_hex('cafe'); # from hexadecimal 5870 $x = Math::BigInt->from_oct('377'); # from octal 5871 $x = Math::BigInt->from_bin('1101'); # from binary 5872 $x = Math::BigInt->from_base('why', 36); # from any base 5873 $x = Math::BigInt->from_base_num([1, 0], 2); # from any base 5874 $x = Math::BigInt->bzero(); # create a +0 5875 $x = Math::BigInt->bone(); # create a +1 5876 $x = Math::BigInt->bone('-'); # create a -1 5877 $x = Math::BigInt->binf(); # create a +inf 5878 $x = Math::BigInt->binf('-'); # create a -inf 5879 $x = Math::BigInt->bnan(); # create a Not-A-Number 5880 $x = Math::BigInt->bpi(); # returns pi 5881 5882 $y = $x->copy(); # make a copy (unlike $y = $x) 5883 $y = $x->as_int(); # return as a Math::BigInt 5884 $y = $x->as_float(); # return as a Math::BigFloat 5885 $y = $x->as_rat(); # return as a Math::BigRat 5886 5887 # Boolean methods (these don't modify the invocand) 5888 5889 $x->is_zero(); # if $x is 0 5890 $x->is_one(); # if $x is +1 5891 $x->is_one("+"); # ditto 5892 $x->is_one("-"); # if $x is -1 5893 $x->is_inf(); # if $x is +inf or -inf 5894 $x->is_inf("+"); # if $x is +inf 5895 $x->is_inf("-"); # if $x is -inf 5896 $x->is_nan(); # if $x is NaN 5897 5898 $x->is_positive(); # if $x > 0 5899 $x->is_pos(); # ditto 5900 $x->is_negative(); # if $x < 0 5901 $x->is_neg(); # ditto 5902 5903 $x->is_odd(); # if $x is odd 5904 $x->is_even(); # if $x is even 5905 $x->is_int(); # if $x is an integer 5906 5907 # Comparison methods 5908 5909 $x->bcmp($y); # compare numbers (undef, < 0, == 0, > 0) 5910 $x->bacmp($y); # compare absolutely (undef, < 0, == 0, > 0) 5911 $x->beq($y); # true if and only if $x == $y 5912 $x->bne($y); # true if and only if $x != $y 5913 $x->blt($y); # true if and only if $x < $y 5914 $x->ble($y); # true if and only if $x <= $y 5915 $x->bgt($y); # true if and only if $x > $y 5916 $x->bge($y); # true if and only if $x >= $y 5917 5918 # Arithmetic methods 5919 5920 $x->bneg(); # negation 5921 $x->babs(); # absolute value 5922 $x->bsgn(); # sign function (-1, 0, 1, or NaN) 5923 $x->bnorm(); # normalize (no-op) 5924 $x->binc(); # increment $x by 1 5925 $x->bdec(); # decrement $x by 1 5926 $x->badd($y); # addition (add $y to $x) 5927 $x->bsub($y); # subtraction (subtract $y from $x) 5928 $x->bmul($y); # multiplication (multiply $x by $y) 5929 $x->bmuladd($y,$z); # $x = $x * $y + $z 5930 $x->bdiv($y); # division (floored), set $x to quotient 5931 # return (quo,rem) or quo if scalar 5932 $x->btdiv($y); # division (truncated), set $x to quotient 5933 # return (quo,rem) or quo if scalar 5934 $x->bmod($y); # modulus (x % y) 5935 $x->btmod($y); # modulus (truncated) 5936 $x->bmodinv($mod); # modular multiplicative inverse 5937 $x->bmodpow($y,$mod); # modular exponentiation (($x ** $y) % $mod) 5938 $x->bpow($y); # power of arguments (x ** y) 5939 $x->blog(); # logarithm of $x to base e (Euler's number) 5940 $x->blog($base); # logarithm of $x to base $base (e.g., base 2) 5941 $x->bexp(); # calculate e ** $x where e is Euler's number 5942 $x->bnok($y); # x over y (binomial coefficient n over k) 5943 $x->buparrow($n, $y); # Knuth's up-arrow notation 5944 $x->backermann($y); # the Ackermann function 5945 $x->bsin(); # sine 5946 $x->bcos(); # cosine 5947 $x->batan(); # inverse tangent 5948 $x->batan2($y); # two-argument inverse tangent 5949 $x->bsqrt(); # calculate square root 5950 $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root) 5951 $x->bfac(); # factorial of $x (1*2*3*4*..$x) 5952 $x->bdfac(); # double factorial of $x ($x*($x-2)*($x-4)*...) 5953 $x->btfac(); # triple factorial of $x ($x*($x-3)*($x-6)*...) 5954 $x->bmfac($k); # $k'th multi-factorial of $x ($x*($x-$k)*...) 5955 5956 $x->blsft($n); # left shift $n places in base 2 5957 $x->blsft($n,$b); # left shift $n places in base $b 5958 # returns (quo,rem) or quo (scalar context) 5959 $x->brsft($n); # right shift $n places in base 2 5960 $x->brsft($n,$b); # right shift $n places in base $b 5961 # returns (quo,rem) or quo (scalar context) 5962 5963 # Bitwise methods 5964 5965 $x->band($y); # bitwise and 5966 $x->bior($y); # bitwise inclusive or 5967 $x->bxor($y); # bitwise exclusive or 5968 $x->bnot(); # bitwise not (two's complement) 5969 5970 # Rounding methods 5971 $x->round($A,$P,$mode); # round to accuracy or precision using 5972 # rounding mode $mode 5973 $x->bround($n); # accuracy: preserve $n digits 5974 $x->bfround($n); # $n > 0: round to $nth digit left of dec. point 5975 # $n < 0: round to $nth digit right of dec. point 5976 $x->bfloor(); # round towards minus infinity 5977 $x->bceil(); # round towards plus infinity 5978 $x->bint(); # round towards zero 5979 5980 # Other mathematical methods 5981 5982 $x->bgcd($y); # greatest common divisor 5983 $x->blcm($y); # least common multiple 5984 5985 # Object property methods (do not modify the invocand) 5986 5987 $x->sign(); # the sign, either +, - or NaN 5988 $x->digit($n); # the nth digit, counting from the right 5989 $x->digit(-$n); # the nth digit, counting from the left 5990 $x->length(); # return number of digits in number 5991 ($xl,$f) = $x->length(); # length of number and length of fraction 5992 # part, latter is always 0 digits long 5993 # for Math::BigInt objects 5994 $x->mantissa(); # return (signed) mantissa as a Math::BigInt 5995 $x->exponent(); # return exponent as a Math::BigInt 5996 $x->parts(); # return (mantissa,exponent) as a Math::BigInt 5997 $x->sparts(); # mantissa and exponent (as integers) 5998 $x->nparts(); # mantissa and exponent (normalised) 5999 $x->eparts(); # mantissa and exponent (engineering notation) 6000 $x->dparts(); # integer and fraction part 6001 $x->fparts(); # numerator and denominator 6002 $x->numerator(); # numerator 6003 $x->denominator(); # denominator 6004 6005 # Conversion methods (do not modify the invocand) 6006 6007 $x->bstr(); # decimal notation, possibly zero padded 6008 $x->bsstr(); # string in scientific notation with integers 6009 $x->bnstr(); # string in normalized notation 6010 $x->bestr(); # string in engineering notation 6011 $x->bfstr(); # string in fractional notation 6012 6013 $x->to_hex(); # as signed hexadecimal string 6014 $x->to_bin(); # as signed binary string 6015 $x->to_oct(); # as signed octal string 6016 $x->to_bytes(); # as byte string 6017 $x->to_base($b); # as string in any base 6018 $x->to_base_num($b); # as array of integers in any base 6019 6020 $x->as_hex(); # as signed hexadecimal string with prefixed 0x 6021 $x->as_bin(); # as signed binary string with prefixed 0b 6022 $x->as_oct(); # as signed octal string with prefixed 0 6023 6024 # Other conversion methods 6025 6026 $x->numify(); # return as scalar (might overflow or underflow) 6027 6028=head1 DESCRIPTION 6029 6030Math::BigInt provides support for arbitrary precision integers. Overloading is 6031also provided for Perl operators. 6032 6033=head2 Input 6034 6035Input values to these routines may be any scalar number or string that looks 6036like a number and represents an integer. Anything that is accepted by Perl as a 6037literal numeric constant should be accepted by this module, except that finite 6038non-integers return NaN. 6039 6040=over 6041 6042=item * 6043 6044Leading and trailing whitespace is ignored. 6045 6046=item * 6047 6048Leading zeros are ignored, except for floating point numbers with a binary 6049exponent, in which case the number is interpreted as an octal floating point 6050number. For example, "01.4p+0" gives 1.5, "00.4p+0" gives 0.5, but "0.4p+0" 6051gives a NaN. And while "0377" gives 255, "0377p0" gives 255. 6052 6053=item * 6054 6055If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal 6056number. 6057 6058=item * 6059 6060If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A 6061floating point literal with a "0" prefix is also interpreted as an octal number. 6062 6063=item * 6064 6065If the string has a "0b" or "0B" prefix, it is interpreted as a binary number. 6066 6067=item * 6068 6069Underline characters are allowed in the same way as they are allowed in literal 6070numerical constants. 6071 6072=item * 6073 6074If the string can not be interpreted, or does not represent a finite integer, 6075NaN is returned. 6076 6077=item * 6078 6079For hexadecimal, octal, and binary floating point numbers, the exponent must be 6080separated from the significand (mantissa) by the letter "p" or "P", not "e" or 6081"E" as with decimal numbers. 6082 6083=back 6084 6085Some examples of valid string input 6086 6087 Input string Resulting value 6088 6089 123 123 6090 1.23e2 123 6091 12300e-2 123 6092 6093 67_538_754 67538754 6094 -4_5_6.7_8_9e+0_1_0 -4567890000000 6095 6096 0x13a 314 6097 0x13ap0 314 6098 0x1.3ap+8 314 6099 0x0.00013ap+24 314 6100 0x13a000p-12 314 6101 6102 0o472 314 6103 0o1.164p+8 314 6104 0o0.0001164p+20 314 6105 0o1164000p-10 314 6106 6107 0472 472 Note! 6108 01.164p+8 314 6109 00.0001164p+20 314 6110 01164000p-10 314 6111 6112 0b100111010 314 6113 0b1.0011101p+8 314 6114 0b0.00010011101p+12 314 6115 0b100111010000p-3 314 6116 6117Input given as scalar numbers might lose precision. Quote your input to ensure 6118that no digits are lost: 6119 6120 $x = Math::BigInt->new( 56789012345678901234 ); # bad 6121 $x = Math::BigInt->new('56789012345678901234'); # good 6122 6123Currently, C<Math::BigInt->new()> (no input argument) and 6124C<Math::BigInt->new("")> return 0. This might change in the future, so always 6125use the following explicit forms to get a zero: 6126 6127 $zero = Math::BigInt->bzero(); 6128 6129=head2 Output 6130 6131Output values are usually Math::BigInt objects. 6132 6133Boolean operators C<is_zero()>, C<is_one()>, C<is_inf()>, etc. return true or 6134false. 6135 6136Comparison operators C<bcmp()> and C<bacmp()>) return -1, 0, 1, or 6137undef. 6138 6139=head1 METHODS 6140 6141=head2 Configuration methods 6142 6143Each of the methods below (except config(), accuracy() and precision()) accepts 6144three additional parameters. These arguments C<$A>, C<$P> and C<$R> are 6145C<accuracy>, C<precision> and C<round_mode>. Please see the section about 6146L</ACCURACY and PRECISION> for more information. 6147 6148Setting a class variable effects all object instance that are created 6149afterwards. 6150 6151=over 6152 6153=item accuracy() 6154 6155 Math::BigInt->accuracy(5); # set class accuracy 6156 $x->accuracy(5); # set instance accuracy 6157 6158 $A = Math::BigInt->accuracy(); # get class accuracy 6159 $A = $x->accuracy(); # get instance accuracy 6160 6161Set or get the accuracy, i.e., the number of significant digits. The accuracy 6162must be an integer. If the accuracy is set to C<undef>, no rounding is done. 6163 6164Alternatively, one can round the results explicitly using one of L</round()>, 6165L</bround()> or L</bfround()> or by passing the desired accuracy to the method 6166as an additional parameter: 6167 6168 my $x = Math::BigInt->new(30000); 6169 my $y = Math::BigInt->new(7); 6170 print scalar $x->copy()->bdiv($y, 2); # prints 4300 6171 print scalar $x->copy()->bdiv($y)->bround(2); # prints 4300 6172 6173Please see the section about L</ACCURACY and PRECISION> for further details. 6174 6175 $y = Math::BigInt->new(1234567); # $y is not rounded 6176 Math::BigInt->accuracy(4); # set class accuracy to 4 6177 $x = Math::BigInt->new(1234567); # $x is rounded automatically 6178 print "$x $y"; # prints "1235000 1234567" 6179 6180 print $x->accuracy(); # prints "4" 6181 print $y->accuracy(); # also prints "4", since 6182 # class accuracy is 4 6183 6184 Math::BigInt->accuracy(5); # set class accuracy to 5 6185 print $x->accuracy(); # prints "4", since instance 6186 # accuracy is 4 6187 print $y->accuracy(); # prints "5", since no instance 6188 # accuracy, and class accuracy is 5 6189 6190Note: Each class has it's own globals separated from Math::BigInt, but it is 6191possible to subclass Math::BigInt and make the globals of the subclass aliases 6192to the ones from Math::BigInt. 6193 6194=item precision() 6195 6196 Math::BigInt->precision(-2); # set class precision 6197 $x->precision(-2); # set instance precision 6198 6199 $P = Math::BigInt->precision(); # get class precision 6200 $P = $x->precision(); # get instance precision 6201 6202Set or get the precision, i.e., the place to round relative to the decimal 6203point. The precision must be a integer. Setting the precision to $P means that 6204each number is rounded up or down, depending on the rounding mode, to the 6205nearest multiple of 10**$P. If the precision is set to C<undef>, no rounding is 6206done. 6207 6208You might want to use L</accuracy()> instead. With L</accuracy()> you set the 6209number of digits each result should have, with L</precision()> you set the 6210place where to round. 6211 6212Please see the section about L</ACCURACY and PRECISION> for further details. 6213 6214 $y = Math::BigInt->new(1234567); # $y is not rounded 6215 Math::BigInt->precision(4); # set class precision to 4 6216 $x = Math::BigInt->new(1234567); # $x is rounded automatically 6217 print $x; # prints "1230000" 6218 6219Note: Each class has its own globals separated from Math::BigInt, but it is 6220possible to subclass Math::BigInt and make the globals of the subclass aliases 6221to the ones from Math::BigInt. 6222 6223=item div_scale() 6224 6225Set/get the fallback accuracy. This is the accuracy used when neither accuracy 6226nor precision is set explicitly. It is used when a computation might otherwise 6227attempt to return an infinite number of digits. 6228 6229=item round_mode() 6230 6231Set/get the rounding mode. 6232 6233=item upgrade() 6234 6235Set/get the class for upgrading. When a computation might result in a 6236non-integer, the operands are upgraded to this class. This is used for instance 6237by L<bignum>. The default is C<undef>, i.e., no upgrading. 6238 6239 # with no upgrading 6240 $x = Math::BigInt->new(12); 6241 $y = Math::BigInt->new(5); 6242 print $x / $y, "\n"; # 2 as a Math::BigInt 6243 6244 # with upgrading to Math::BigFloat 6245 Math::BigInt -> upgrade("Math::BigFloat"); 6246 print $x / $y, "\n"; # 2.4 as a Math::BigFloat 6247 6248 # with upgrading to Math::BigRat (after loading Math::BigRat) 6249 Math::BigInt -> upgrade("Math::BigRat"); 6250 print $x / $y, "\n"; # 12/5 as a Math::BigRat 6251 6252=item downgrade() 6253 6254Set/get the class for downgrading. The default is C<undef>, i.e., no 6255downgrading. Downgrading is not done by Math::BigInt. 6256 6257=item modify() 6258 6259 $x->modify('bpowd'); 6260 6261This method returns 0 if the object can be modified with the given operation, 6262or 1 if not. 6263 6264This is used for instance by L<Math::BigInt::Constant>. 6265 6266=item config() 6267 6268 Math::BigInt->config("trap_nan" => 1); # set 6269 $accu = Math::BigInt->config("accuracy"); # get 6270 6271Set or get class variables. Read-only parameters are marked as RO. Read-write 6272parameters are marked as RW. The following parameters are supported. 6273 6274 Parameter RO/RW Description 6275 Example 6276 ============================================================ 6277 lib RO Name of the math backend library 6278 Math::BigInt::Calc 6279 lib_version RO Version of the math backend library 6280 0.30 6281 class RO The class of config you just called 6282 Math::BigRat 6283 version RO version number of the class you used 6284 0.10 6285 upgrade RW To which class numbers are upgraded 6286 undef 6287 downgrade RW To which class numbers are downgraded 6288 undef 6289 precision RW Global precision 6290 undef 6291 accuracy RW Global accuracy 6292 undef 6293 round_mode RW Global round mode 6294 even 6295 div_scale RW Fallback accuracy for division etc. 6296 40 6297 trap_nan RW Trap NaNs 6298 undef 6299 trap_inf RW Trap +inf/-inf 6300 undef 6301 6302=back 6303 6304=head2 Constructor methods 6305 6306=over 6307 6308=item new() 6309 6310 $x = Math::BigInt->new($str,$A,$P,$R); 6311 6312Creates a new Math::BigInt object from a scalar or another Math::BigInt object. 6313The input is accepted as decimal, hexadecimal (with leading '0x'), octal (with 6314leading ('0o') or binary (with leading '0b'). 6315 6316See L</Input> for more info on accepted input formats. 6317 6318=item from_dec() 6319 6320 $x = Math::BigInt->from_dec("314159"); # input is decimal 6321 6322Interpret input as a decimal. It is equivalent to new(), but does not accept 6323anything but strings representing finite, decimal numbers. 6324 6325=item from_hex() 6326 6327 $x = Math::BigInt->from_hex("0xcafe"); # input is hexadecimal 6328 6329Interpret input as a hexadecimal string. A "0x" or "x" prefix is optional. A 6330single underscore character may be placed right after the prefix, if present, 6331or between any two digits. If the input is invalid, a NaN is returned. 6332 6333=item from_oct() 6334 6335 $x = Math::BigInt->from_oct("0775"); # input is octal 6336 6337Interpret the input as an octal string and return the corresponding value. A 6338"0" (zero) prefix is optional. A single underscore character may be placed 6339right after the prefix, if present, or between any two digits. If the input is 6340invalid, a NaN is returned. 6341 6342=item from_bin() 6343 6344 $x = Math::BigInt->from_bin("0b10011"); # input is binary 6345 6346Interpret the input as a binary string. A "0b" or "b" prefix is optional. A 6347single underscore character may be placed right after the prefix, if present, 6348or between any two digits. If the input is invalid, a NaN is returned. 6349 6350=item from_bytes() 6351 6352 $x = Math::BigInt->from_bytes("\xf3\x6b"); # $x = 62315 6353 6354Interpret the input as a byte string, assuming big endian byte order. The 6355output is always a non-negative, finite integer. 6356 6357In some special cases, from_bytes() matches the conversion done by unpack(): 6358 6359 $b = "\x4e"; # one char byte string 6360 $x = Math::BigInt->from_bytes($b); # = 78 6361 $y = unpack "C", $b; # ditto, but scalar 6362 6363 $b = "\xf3\x6b"; # two char byte string 6364 $x = Math::BigInt->from_bytes($b); # = 62315 6365 $y = unpack "S>", $b; # ditto, but scalar 6366 6367 $b = "\x2d\xe0\x49\xad"; # four char byte string 6368 $x = Math::BigInt->from_bytes($b); # = 769673645 6369 $y = unpack "L>", $b; # ditto, but scalar 6370 6371 $b = "\x2d\xe0\x49\xad\x2d\xe0\x49\xad"; # eight char byte string 6372 $x = Math::BigInt->from_bytes($b); # = 3305723134637787565 6373 $y = unpack "Q>", $b; # ditto, but scalar 6374 6375=item from_base() 6376 6377Given a string, a base, and an optional collation sequence, interpret the 6378string as a number in the given base. The collation sequence describes the 6379value of each character in the string. 6380 6381If a collation sequence is not given, a default collation sequence is used. If 6382the base is less than or equal to 36, the collation sequence is the string 6383consisting of the 36 characters "0" to "9" and "A" to "Z". In this case, the 6384letter case in the input is ignored. If the base is greater than 36, and 6385smaller than or equal to 62, the collation sequence is the string consisting of 6386the 62 characters "0" to "9", "A" to "Z", and "a" to "z". A base larger than 62 6387requires the collation sequence to be specified explicitly. 6388 6389These examples show standard binary, octal, and hexadecimal conversion. All 6390cases return 250. 6391 6392 $x = Math::BigInt->from_base("11111010", 2); 6393 $x = Math::BigInt->from_base("372", 8); 6394 $x = Math::BigInt->from_base("fa", 16); 6395 6396When the base is less than or equal to 36, and no collation sequence is given, 6397the letter case is ignored, so both of these also return 250: 6398 6399 $x = Math::BigInt->from_base("6Y", 16); 6400 $x = Math::BigInt->from_base("6y", 16); 6401 6402When the base greater than 36, and no collation sequence is given, the default 6403collation sequence contains both uppercase and lowercase letters, so 6404the letter case in the input is not ignored: 6405 6406 $x = Math::BigInt->from_base("6S", 37); # $x is 250 6407 $x = Math::BigInt->from_base("6s", 37); # $x is 276 6408 $x = Math::BigInt->from_base("121", 3); # $x is 16 6409 $x = Math::BigInt->from_base("XYZ", 36); # $x is 44027 6410 $x = Math::BigInt->from_base("Why", 42); # $x is 58314 6411 6412The collation sequence can be any set of unique characters. These two cases 6413are equivalent 6414 6415 $x = Math::BigInt->from_base("100", 2, "01"); # $x is 4 6416 $x = Math::BigInt->from_base("|--", 2, "-|"); # $x is 4 6417 6418=item from_base_num() 6419 6420Returns a new Math::BigInt object given an array of values and a base. This 6421method is equivalent to C<from_base()>, but works on numbers in an array rather 6422than characters in a string. Unlike C<from_base()>, all input values may be 6423arbitrarily large. 6424 6425 $x = Math::BigInt->from_base_num([1, 1, 0, 1], 2) # $x is 13 6426 $x = Math::BigInt->from_base_num([3, 125, 39], 128) # $x is 65191 6427 6428=item bzero() 6429 6430 $x = Math::BigInt->bzero(); 6431 $x->bzero(); 6432 6433Returns a new Math::BigInt object representing zero. If used as an instance 6434method, assigns the value to the invocand. 6435 6436=item bone() 6437 6438 $x = Math::BigInt->bone(); # +1 6439 $x = Math::BigInt->bone("+"); # +1 6440 $x = Math::BigInt->bone("-"); # -1 6441 $x->bone(); # +1 6442 $x->bone("+"); # +1 6443 $x->bone('-'); # -1 6444 6445Creates a new Math::BigInt object representing one. The optional argument is 6446either '-' or '+', indicating whether you want plus one or minus one. If used 6447as an instance method, assigns the value to the invocand. 6448 6449=item binf() 6450 6451 $x = Math::BigInt->binf($sign); 6452 6453Creates a new Math::BigInt object representing infinity. The optional argument 6454is either '-' or '+', indicating whether you want infinity or minus infinity. 6455If used as an instance method, assigns the value to the invocand. 6456 6457 $x->binf(); 6458 $x->binf('-'); 6459 6460=item bnan() 6461 6462 $x = Math::BigInt->bnan(); 6463 6464Creates a new Math::BigInt object representing NaN (Not A Number). If used as 6465an instance method, assigns the value to the invocand. 6466 6467 $x->bnan(); 6468 6469=item bpi() 6470 6471 $x = Math::BigInt->bpi(100); # 3 6472 $x->bpi(100); # 3 6473 6474Creates a new Math::BigInt object representing PI. If used as an instance 6475method, assigns the value to the invocand. With Math::BigInt this always 6476returns 3. 6477 6478If upgrading is in effect, returns PI, rounded to N digits with the current 6479rounding mode: 6480 6481 use Math::BigFloat; 6482 use Math::BigInt upgrade => "Math::BigFloat"; 6483 print Math::BigInt->bpi(3), "\n"; # 3.14 6484 print Math::BigInt->bpi(100), "\n"; # 3.1415.... 6485 6486=item copy() 6487 6488 $x->copy(); # make a true copy of $x (unlike $y = $x) 6489 6490=item as_int() 6491 6492=item as_number() 6493 6494These methods are called when Math::BigInt encounters an object it doesn't know 6495how to handle. For instance, assume $x is a Math::BigInt, or subclass thereof, 6496and $y is defined, but not a Math::BigInt, or subclass thereof. If you do 6497 6498 $x -> badd($y); 6499 6500$y needs to be converted into an object that $x can deal with. This is done by 6501first checking if $y is something that $x might be upgraded to. If that is the 6502case, no further attempts are made. The next is to see if $y supports the 6503method C<as_int()>. If it does, C<as_int()> is called, but if it doesn't, the 6504next thing is to see if $y supports the method C<as_number()>. If it does, 6505C<as_number()> is called. The method C<as_int()> (and C<as_number()>) is 6506expected to return either an object that has the same class as $x, a subclass 6507thereof, or a string that C<ref($x)-E<gt>new()> can parse to create an object. 6508 6509C<as_number()> is an alias to C<as_int()>. C<as_number> was introduced in 6510v1.22, while C<as_int()> was introduced in v1.68. 6511 6512In Math::BigInt, C<as_int()> has the same effect as C<copy()>. 6513 6514=item as_float() 6515 6516Return the argument as a Math::BigFloat object. 6517 6518=item as_rat() 6519 6520Return the argument as a Math::BigRat object. 6521 6522=back 6523 6524=head2 Boolean methods 6525 6526None of these methods modify the invocand object. 6527 6528=over 6529 6530=item is_zero() 6531 6532 $x->is_zero(); # true if $x is 0 6533 6534Returns true if the invocand is zero and false otherwise. 6535 6536=item is_one( [ SIGN ]) 6537 6538 $x->is_one(); # true if $x is +1 6539 $x->is_one("+"); # ditto 6540 $x->is_one("-"); # true if $x is -1 6541 6542Returns true if the invocand is one and false otherwise. 6543 6544=item is_finite() 6545 6546 $x->is_finite(); # true if $x is not +inf, -inf or NaN 6547 6548Returns true if the invocand is a finite number, i.e., it is neither +inf, 6549-inf, nor NaN. 6550 6551=item is_inf( [ SIGN ] ) 6552 6553 $x->is_inf(); # true if $x is +inf 6554 $x->is_inf("+"); # ditto 6555 $x->is_inf("-"); # true if $x is -inf 6556 6557Returns true if the invocand is infinite and false otherwise. 6558 6559=item is_nan() 6560 6561 $x->is_nan(); # true if $x is NaN 6562 6563=item is_positive() 6564 6565=item is_pos() 6566 6567 $x->is_positive(); # true if > 0 6568 $x->is_pos(); # ditto 6569 6570Returns true if the invocand is positive and false otherwise. A C<NaN> is 6571neither positive nor negative. 6572 6573=item is_negative() 6574 6575=item is_neg() 6576 6577 $x->is_negative(); # true if < 0 6578 $x->is_neg(); # ditto 6579 6580Returns true if the invocand is negative and false otherwise. A C<NaN> is 6581neither positive nor negative. 6582 6583=item is_non_positive() 6584 6585 $x->is_non_positive(); # true if <= 0 6586 6587Returns true if the invocand is negative or zero. 6588 6589=item is_non_negative() 6590 6591 $x->is_non_negative(); # true if >= 0 6592 6593Returns true if the invocand is positive or zero. 6594 6595=item is_odd() 6596 6597 $x->is_odd(); # true if odd, false for even 6598 6599Returns true if the invocand is odd and false otherwise. C<NaN>, C<+inf>, and 6600C<-inf> are neither odd nor even. 6601 6602=item is_even() 6603 6604 $x->is_even(); # true if $x is even 6605 6606Returns true if the invocand is even and false otherwise. C<NaN>, C<+inf>, 6607C<-inf> are not integers and are neither odd nor even. 6608 6609=item is_int() 6610 6611 $x->is_int(); # true if $x is an integer 6612 6613Returns true if the invocand is an integer and false otherwise. C<NaN>, 6614C<+inf>, C<-inf> are not integers. 6615 6616=back 6617 6618=head2 Comparison methods 6619 6620None of these methods modify the invocand object. Note that a C<NaN> is neither 6621less than, greater than, or equal to anything else, even a C<NaN>. 6622 6623=over 6624 6625=item bcmp() 6626 6627 $x->bcmp($y); 6628 6629Returns -1, 0, 1 depending on whether $x is less than, equal to, or grater than 6630$y. Returns undef if any operand is a NaN. 6631 6632=item bacmp() 6633 6634 $x->bacmp($y); 6635 6636Returns -1, 0, 1 depending on whether the absolute value of $x is less than, 6637equal to, or grater than the absolute value of $y. Returns undef if any operand 6638is a NaN. 6639 6640=item beq() 6641 6642 $x -> beq($y); 6643 6644Returns true if and only if $x is equal to $y, and false otherwise. 6645 6646=item bne() 6647 6648 $x -> bne($y); 6649 6650Returns true if and only if $x is not equal to $y, and false otherwise. 6651 6652=item blt() 6653 6654 $x -> blt($y); 6655 6656Returns true if and only if $x is equal to $y, and false otherwise. 6657 6658=item ble() 6659 6660 $x -> ble($y); 6661 6662Returns true if and only if $x is less than or equal to $y, and false 6663otherwise. 6664 6665=item bgt() 6666 6667 $x -> bgt($y); 6668 6669Returns true if and only if $x is greater than $y, and false otherwise. 6670 6671=item bge() 6672 6673 $x -> bge($y); 6674 6675Returns true if and only if $x is greater than or equal to $y, and false 6676otherwise. 6677 6678=back 6679 6680=head2 Arithmetic methods 6681 6682These methods modify the invocand object and returns it. 6683 6684=over 6685 6686=item bneg() 6687 6688 $x->bneg(); 6689 6690Negate the number, e.g. change the sign between '+' and '-', or between '+inf' 6691and '-inf', respectively. Does nothing for NaN or zero. 6692 6693=item babs() 6694 6695 $x->babs(); 6696 6697Set the number to its absolute value, e.g. change the sign from '-' to '+' 6698and from '-inf' to '+inf', respectively. Does nothing for NaN or positive 6699numbers. 6700 6701=item bsgn() 6702 6703 $x->bsgn(); 6704 6705Signum function. Set the number to -1, 0, or 1, depending on whether the 6706number is negative, zero, or positive, respectively. Does not modify NaNs. 6707 6708=item bnorm() 6709 6710 $x->bnorm(); # normalize (no-op) 6711 6712Normalize the number. This is a no-op and is provided only for backwards 6713compatibility. 6714 6715=item binc() 6716 6717 $x->binc(); # increment x by 1 6718 6719=item bdec() 6720 6721 $x->bdec(); # decrement x by 1 6722 6723=item badd() 6724 6725 $x->badd($y); # addition (add $y to $x) 6726 6727=item bsub() 6728 6729 $x->bsub($y); # subtraction (subtract $y from $x) 6730 6731=item bmul() 6732 6733 $x->bmul($y); # multiplication (multiply $x by $y) 6734 6735=item bmuladd() 6736 6737 $x->bmuladd($y,$z); 6738 6739Multiply $x by $y, and then add $z to the result, 6740 6741This method was added in v1.87 of Math::BigInt (June 2007). 6742 6743=item bdiv() 6744 6745 $x->bdiv($y); # divide, set $x to quotient 6746 6747Divides $x by $y by doing floored division (F-division), where the quotient is 6748the floored (rounded towards negative infinity) quotient of the two operands. 6749In list context, returns the quotient and the remainder. The remainder is 6750either zero or has the same sign as the second operand. In scalar context, only 6751the quotient is returned. 6752 6753The quotient is always the greatest integer less than or equal to the 6754real-valued quotient of the two operands, and the remainder (when it is 6755non-zero) always has the same sign as the second operand; so, for example, 6756 6757 1 / 4 => ( 0, 1) 6758 1 / -4 => (-1, -3) 6759 -3 / 4 => (-1, 1) 6760 -3 / -4 => ( 0, -3) 6761 -11 / 2 => (-5, 1) 6762 11 / -2 => (-5, -1) 6763 6764The behavior of the overloaded operator % agrees with the behavior of Perl's 6765built-in % operator (as documented in the perlop manpage), and the equation 6766 6767 $x == ($x / $y) * $y + ($x % $y) 6768 6769holds true for any finite $x and finite, non-zero $y. 6770 6771Perl's "use integer" might change the behaviour of % and / for scalars. This is 6772because under 'use integer' Perl does what the underlying C library thinks is 6773right, and this varies. However, "use integer" does not change the way things 6774are done with Math::BigInt objects. 6775 6776=item btdiv() 6777 6778 $x->btdiv($y); # divide, set $x to quotient 6779 6780Divides $x by $y by doing truncated division (T-division), where quotient is 6781the truncated (rouneded towards zero) quotient of the two operands. In list 6782context, returns the quotient and the remainder. The remainder is either zero 6783or has the same sign as the first operand. In scalar context, only the quotient 6784is returned. 6785 6786=item bmod() 6787 6788 $x->bmod($y); # modulus (x % y) 6789 6790Returns $x modulo $y, i.e., the remainder after floored division (F-division). 6791This method is like Perl's % operator. See L</bdiv()>. 6792 6793=item btmod() 6794 6795 $x->btmod($y); # modulus 6796 6797Returns the remainer after truncated division (T-division). See L</btdiv()>. 6798 6799=item bmodinv() 6800 6801 $x->bmodinv($mod); # modular multiplicative inverse 6802 6803Returns the multiplicative inverse of C<$x> modulo C<$mod>. If 6804 6805 $y = $x -> copy() -> bmodinv($mod) 6806 6807then C<$y> is the number closest to zero, and with the same sign as C<$mod>, 6808satisfying 6809 6810 ($x * $y) % $mod = 1 % $mod 6811 6812If C<$x> and C<$y> are non-zero, they must be relative primes, i.e., 6813C<bgcd($y, $mod)==1>. 'C<NaN>' is returned when no modular multiplicative 6814inverse exists. 6815 6816=item bmodpow() 6817 6818 $num->bmodpow($exp,$mod); # modular exponentiation 6819 # ($num**$exp % $mod) 6820 6821Returns the value of C<$num> taken to the power C<$exp> in the modulus 6822C<$mod> using binary exponentiation. C<bmodpow> is far superior to 6823writing 6824 6825 $num ** $exp % $mod 6826 6827because it is much faster - it reduces internal variables into 6828the modulus whenever possible, so it operates on smaller numbers. 6829 6830C<bmodpow> also supports negative exponents. 6831 6832 bmodpow($num, -1, $mod) 6833 6834is exactly equivalent to 6835 6836 bmodinv($num, $mod) 6837 6838=item bpow() 6839 6840 $x->bpow($y); # power of arguments (x ** y) 6841 6842C<bpow()> (and the rounding functions) now modifies the first argument and 6843returns it, unlike the old code which left it alone and only returned the 6844result. This is to be consistent with C<badd()> etc. The first three modifies 6845$x, the last one won't: 6846 6847 print bpow($x,$i),"\n"; # modify $x 6848 print $x->bpow($i),"\n"; # ditto 6849 print $x **= $i,"\n"; # the same 6850 print $x ** $i,"\n"; # leave $x alone 6851 6852The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though. 6853 6854=item blog() 6855 6856 $x->blog($base, $accuracy); # logarithm of x to the base $base 6857 6858If C<$base> is not defined, Euler's number (e) is used: 6859 6860 print $x->blog(undef, 100); # log(x) to 100 digits 6861 6862=item bexp() 6863 6864 $x->bexp($accuracy); # calculate e ** X 6865 6866Calculates the expression C<e ** $x> where C<e> is Euler's number. 6867 6868This method was added in v1.82 of Math::BigInt (April 2007). 6869 6870See also L</blog()>. 6871 6872=item bnok() 6873 6874 $x->bnok($y); # x over y (binomial coefficient n over k) 6875 6876Calculates the binomial coefficient n over k, also called the "choose" 6877function, which is 6878 6879 ( n ) n! 6880 | | = -------- 6881 ( k ) k!(n-k)! 6882 6883when n and k are non-negative. This method implements the full Kronenburg 6884extension (Kronenburg, M.J. "The Binomial Coefficient for Negative Arguments." 688518 May 2011. http://arxiv.org/abs/1105.3689/) illustrated by the following 6886pseudo-code: 6887 6888 if n >= 0 and k >= 0: 6889 return binomial(n, k) 6890 if k >= 0: 6891 return (-1)^k*binomial(-n+k-1, k) 6892 if k <= n: 6893 return (-1)^(n-k)*binomial(-k-1, n-k) 6894 else 6895 return 0 6896 6897The behaviour is identical to the behaviour of the Maple and Mathematica 6898function for negative integers n, k. 6899 6900=item buparrow() 6901 6902=item uparrow() 6903 6904 $a -> buparrow($n, $b); # modifies $a 6905 $x = $a -> uparrow($n, $b); # does not modify $a 6906 6907This method implements Knuth's up-arrow notation, where $n is a non-negative 6908integer representing the number of up-arrows. $n = 0 gives multiplication, $n = 69091 gives exponentiation, $n = 2 gives tetration, $n = 3 gives hexation etc. The 6910following illustrates the relation between the first values of $n. 6911 6912See L<https://en.wikipedia.org/wiki/Knuth%27s_up-arrow_notation>. 6913 6914=item backermann() 6915 6916=item ackermann() 6917 6918 $m -> backermann($n); # modifies $a 6919 $x = $m -> ackermann($n); # does not modify $a 6920 6921This method implements the Ackermann function: 6922 6923 / n + 1 if m = 0 6924 A(m, n) = | A(m-1, 1) if m > 0 and n = 0 6925 \ A(m-1, A(m, n-1)) if m > 0 and n > 0 6926 6927Its value grows rapidly, even for small inputs. For example, A(4, 2) is an 6928integer of 19729 decimal digits. 6929 6930See https://en.wikipedia.org/wiki/Ackermann_function 6931 6932=item bsin() 6933 6934 my $x = Math::BigInt->new(1); 6935 print $x->bsin(100), "\n"; 6936 6937Calculate the sine of $x, modifying $x in place. 6938 6939In Math::BigInt, unless upgrading is in effect, the result is truncated to an 6940integer. 6941 6942This method was added in v1.87 of Math::BigInt (June 2007). 6943 6944=item bcos() 6945 6946 my $x = Math::BigInt->new(1); 6947 print $x->bcos(100), "\n"; 6948 6949Calculate the cosine of $x, modifying $x in place. 6950 6951In Math::BigInt, unless upgrading is in effect, the result is truncated to an 6952integer. 6953 6954This method was added in v1.87 of Math::BigInt (June 2007). 6955 6956=item batan() 6957 6958 my $x = Math::BigFloat->new(0.5); 6959 print $x->batan(100), "\n"; 6960 6961Calculate the arcus tangens of $x, modifying $x in place. 6962 6963In Math::BigInt, unless upgrading is in effect, the result is truncated to an 6964integer. 6965 6966This method was added in v1.87 of Math::BigInt (June 2007). 6967 6968=item batan2() 6969 6970 my $x = Math::BigInt->new(1); 6971 my $y = Math::BigInt->new(1); 6972 print $y->batan2($x), "\n"; 6973 6974Calculate the arcus tangens of C<$y> divided by C<$x>, modifying $y in place. 6975 6976In Math::BigInt, unless upgrading is in effect, the result is truncated to an 6977integer. 6978 6979This method was added in v1.87 of Math::BigInt (June 2007). 6980 6981=item bsqrt() 6982 6983 $x->bsqrt(); # calculate square root 6984 6985C<bsqrt()> returns the square root truncated to an integer. 6986 6987If you want a better approximation of the square root, then use: 6988 6989 $x = Math::BigFloat->new(12); 6990 Math::BigFloat->precision(0); 6991 Math::BigFloat->round_mode('even'); 6992 print $x->copy->bsqrt(),"\n"; # 4 6993 6994 Math::BigFloat->precision(2); 6995 print $x->bsqrt(),"\n"; # 3.46 6996 print $x->bsqrt(3),"\n"; # 3.464 6997 6998=item broot() 6999 7000 $x->broot($N); 7001 7002Calculates the N'th root of C<$x>. 7003 7004=item bfac() 7005 7006 $x->bfac(); # factorial of $x 7007 7008Returns the factorial of C<$x>, i.e., $x*($x-1)*($x-2)*...*2*1, the product of 7009all positive integers up to and including C<$x>. C<$x> must be > -1. The 7010factorial of N is commonly written as N!, or N!1, when using the multifactorial 7011notation. 7012 7013=item bdfac() 7014 7015 $x->bdfac(); # double factorial of $x 7016 7017Returns the double factorial of C<$x>, i.e., $x*($x-2)*($x-4)*... C<$x> must be 7018> -2. The double factorial of N is commonly written as N!!, or N!2, when using 7019the multifactorial notation. 7020 7021=item btfac() 7022 7023 $x->btfac(); # triple factorial of $x 7024 7025Returns the triple factorial of C<$x>, i.e., $x*($x-3)*($x-6)*... C<$x> must be 7026> -3. The triple factorial of N is commonly written as N!!!, or N!3, when using 7027the multifactorial notation. 7028 7029=item bmfac() 7030 7031 $x->bmfac($k); # $k'th multifactorial of $x 7032 7033Returns the multi-factorial of C<$x>, i.e., $x*($x-$k)*($x-2*$k)*... C<$x> must 7034be > -$k. The multi-factorial of N is commonly written as N!K. 7035 7036=item bfib() 7037 7038 $F = $n->bfib(); # a single Fibonacci number 7039 @F = $n->bfib(); # a list of Fibonacci numbers 7040 7041In scalar context, returns a single Fibonacci number. In list context, returns 7042a list of Fibonacci numbers. The invocand is the last element in the output. 7043 7044The Fibonacci sequence is defined by 7045 7046 F(0) = 0 7047 F(1) = 1 7048 F(n) = F(n-1) + F(n-2) 7049 7050In list context, F(0) and F(n) is the first and last number in the output, 7051respectively. For example, if $n is 12, then C<< @F = $n->bfib() >> returns the 7052following values, F(0) to F(12): 7053 7054 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144 7055 7056The sequence can also be extended to negative index n using the re-arranged 7057recurrence relation 7058 7059 F(n-2) = F(n) - F(n-1) 7060 7061giving the bidirectional sequence 7062 7063 n -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7 7064 F(n) 13 -8 5 -3 2 -1 1 0 1 1 2 3 5 8 13 7065 7066If $n is -12, the following values, F(0) to F(12), are returned: 7067 7068 0, 1, -1, 2, -3, 5, -8, 13, -21, 34, -55, 89, -144 7069 7070=item blucas() 7071 7072 $F = $n->blucas(); # a single Lucas number 7073 @F = $n->blucas(); # a list of Lucas numbers 7074 7075In scalar context, returns a single Lucas number. In list context, returns a 7076list of Lucas numbers. The invocand is the last element in the output. 7077 7078The Lucas sequence is defined by 7079 7080 L(0) = 2 7081 L(1) = 1 7082 L(n) = L(n-1) + L(n-2) 7083 7084In list context, L(0) and L(n) is the first and last number in the output, 7085respectively. For example, if $n is 12, then C<< @L = $n->blucas() >> returns 7086the following values, L(0) to L(12): 7087 7088 2, 1, 3, 4, 7, 11, 18, 29, 47, 76, 123, 199, 322 7089 7090The sequence can also be extended to negative index n using the re-arranged 7091recurrence relation 7092 7093 L(n-2) = L(n) - L(n-1) 7094 7095giving the bidirectional sequence 7096 7097 n -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7 7098 L(n) 29 -18 11 -7 4 -3 1 2 1 3 4 7 11 18 29 7099 7100If $n is -12, the following values, L(0) to L(-12), are returned: 7101 7102 2, 1, -3, 4, -7, 11, -18, 29, -47, 76, -123, 199, -322 7103 7104=item brsft() 7105 7106 $x->brsft($n); # right shift $n places in base 2 7107 $x->brsft($n, $b); # right shift $n places in base $b 7108 7109The latter is equivalent to 7110 7111 $x -> bdiv($b -> copy() -> bpow($n)) 7112 7113=item blsft() 7114 7115 $x->blsft($n); # left shift $n places in base 2 7116 $x->blsft($n, $b); # left shift $n places in base $b 7117 7118The latter is equivalent to 7119 7120 $x -> bmul($b -> copy() -> bpow($n)) 7121 7122=back 7123 7124=head2 Bitwise methods 7125 7126=over 7127 7128=item band() 7129 7130 $x->band($y); # bitwise and 7131 7132=item bior() 7133 7134 $x->bior($y); # bitwise inclusive or 7135 7136=item bxor() 7137 7138 $x->bxor($y); # bitwise exclusive or 7139 7140=item bnot() 7141 7142 $x->bnot(); # bitwise not (two's complement) 7143 7144Two's complement (bitwise not). This is equivalent to, but faster than, 7145 7146 $x->binc()->bneg(); 7147 7148=back 7149 7150=head2 Rounding methods 7151 7152=over 7153 7154=item round() 7155 7156 $x->round($A,$P,$round_mode); 7157 7158Round $x to accuracy C<$A> or precision C<$P> using the round mode 7159C<$round_mode>. 7160 7161=item bround() 7162 7163 $x->bround($N); # accuracy: preserve $N digits 7164 7165Rounds $x to an accuracy of $N digits. 7166 7167=item bfround() 7168 7169 $x->bfround($N); 7170 7171Rounds to a multiple of 10**$N. Examples: 7172 7173 Input N Result 7174 7175 123456.123456 3 123500 7176 123456.123456 2 123450 7177 123456.123456 -2 123456.12 7178 123456.123456 -3 123456.123 7179 7180=item bfloor() 7181 7182 $x->bfloor(); 7183 7184Round $x towards minus infinity, i.e., set $x to the largest integer less than 7185or equal to $x. 7186 7187=item bceil() 7188 7189 $x->bceil(); 7190 7191Round $x towards plus infinity, i.e., set $x to the smallest integer greater 7192than or equal to $x). 7193 7194=item bint() 7195 7196 $x->bint(); 7197 7198Round $x towards zero. 7199 7200=back 7201 7202=head2 Other mathematical methods 7203 7204=over 7205 7206=item bgcd() 7207 7208 $x -> bgcd($y); # GCD of $x and $y 7209 $x -> bgcd($y, $z, ...); # GCD of $x, $y, $z, ... 7210 7211Returns the greatest common divisor (GCD). 7212 7213=item blcm() 7214 7215 $x -> blcm($y); # LCM of $x and $y 7216 $x -> blcm($y, $z, ...); # LCM of $x, $y, $z, ... 7217 7218Returns the least common multiple (LCM). 7219 7220=back 7221 7222=head2 Object property methods 7223 7224=over 7225 7226=item sign() 7227 7228 $x->sign(); 7229 7230Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN. 7231 7232If you want $x to have a certain sign, use one of the following methods: 7233 7234 $x->babs(); # '+' 7235 $x->babs()->bneg(); # '-' 7236 $x->bnan(); # 'NaN' 7237 $x->binf(); # '+inf' 7238 $x->binf('-'); # '-inf' 7239 7240=item digit() 7241 7242 $x->digit($n); # return the nth digit, counting from right 7243 7244If C<$n> is negative, returns the digit counting from left. 7245 7246=item digitsum() 7247 7248 $x->digitsum(); 7249 7250Computes the sum of the base 10 digits and returns it. 7251 7252=item bdigitsum() 7253 7254 $x->bdigitsum(); 7255 7256Computes the sum of the base 10 digits and assigns the result to the invocand. 7257 7258=item length() 7259 7260 $x->length(); 7261 ($xl, $fl) = $x->length(); 7262 7263Returns the number of digits in the decimal representation of the number. In 7264list context, returns the length of the integer and fraction part. For 7265Math::BigInt objects, the length of the fraction part is always 0. 7266 7267The following probably doesn't do what you expect: 7268 7269 $c = Math::BigInt->new(123); 7270 print $c->length(),"\n"; # prints 30 7271 7272It prints both the number of digits in the number and in the fraction part 7273since print calls C<length()> in list context. Use something like: 7274 7275 print scalar $c->length(),"\n"; # prints 3 7276 7277=item mantissa() 7278 7279 $x->mantissa(); 7280 7281Return the signed mantissa of $x as a Math::BigInt. 7282 7283=item exponent() 7284 7285 $x->exponent(); 7286 7287Return the exponent of $x as a Math::BigInt. 7288 7289=item parts() 7290 7291 $x->parts(); 7292 7293Returns the significand (mantissa) and the exponent as integers. In 7294Math::BigFloat, both are returned as Math::BigInt objects. 7295 7296=item sparts() 7297 7298Returns the significand (mantissa) and the exponent as integers. In scalar 7299context, only the significand is returned. The significand is the integer with 7300the smallest absolute value. The output of C<sparts()> corresponds to the 7301output from C<bsstr()>. 7302 7303In Math::BigInt, this method is identical to C<parts()>. 7304 7305=item nparts() 7306 7307Returns the significand (mantissa) and exponent corresponding to normalized 7308notation. In scalar context, only the significand is returned. For finite 7309non-zero numbers, the significand's absolute value is greater than or equal to 73101 and less than 10. The output of C<nparts()> corresponds to the output from 7311C<bnstr()>. In Math::BigInt, if the significand can not be represented as an 7312integer, upgrading is performed or NaN is returned. 7313 7314=item eparts() 7315 7316Returns the significand (mantissa) and exponent corresponding to engineering 7317notation. In scalar context, only the significand is returned. For finite 7318non-zero numbers, the significand's absolute value is greater than or equal to 73191 and less than 1000, and the exponent is a multiple of 3. The output of 7320C<eparts()> corresponds to the output from C<bestr()>. In Math::BigInt, if the 7321significand can not be represented as an integer, upgrading is performed or NaN 7322is returned. 7323 7324=item dparts() 7325 7326Returns the integer part and the fraction part. If the fraction part can not be 7327represented as an integer, upgrading is performed or NaN is returned. The 7328output of C<dparts()> corresponds to the output from C<bdstr()>. 7329 7330=item fparts() 7331 7332Returns the smallest possible numerator and denominator so that the numerator 7333divided by the denominator gives back the original value. For finite numbers, 7334both values are integers. Mnemonic: fraction. 7335 7336=item numerator() 7337 7338Together with L</denominator()>, returns the smallest integers so that the 7339numerator divided by the denominator reproduces the original value. With 7340Math::BigInt, numerator() simply returns a copy of the invocand. 7341 7342=item denominator() 7343 7344Together with L</numerator()>, returns the smallest integers so that the 7345numerator divided by the denominator reproduces the original value. With 7346Math::BigInt, denominator() always returns either a 1 or a NaN. 7347 7348=back 7349 7350=head2 String conversion methods 7351 7352=over 7353 7354=item bstr() 7355 7356Returns a string representing the number using decimal notation. In 7357Math::BigFloat, the output is zero padded according to the current accuracy or 7358precision, if any of those are defined. 7359 7360=item bsstr() 7361 7362Returns a string representing the number using scientific notation where both 7363the significand (mantissa) and the exponent are integers. The output 7364corresponds to the output from C<sparts()>. 7365 7366 123 is returned as "123e+0" 7367 1230 is returned as "123e+1" 7368 12300 is returned as "123e+2" 7369 12000 is returned as "12e+3" 7370 10000 is returned as "1e+4" 7371 7372=item bnstr() 7373 7374Returns a string representing the number using normalized notation, the most 7375common variant of scientific notation. For finite non-zero numbers, the 7376absolute value of the significand is greater than or equal to 1 and less than 737710. The output corresponds to the output from C<nparts()>. 7378 7379 123 is returned as "1.23e+2" 7380 1230 is returned as "1.23e+3" 7381 12300 is returned as "1.23e+4" 7382 12000 is returned as "1.2e+4" 7383 10000 is returned as "1e+4" 7384 7385=item bestr() 7386 7387Returns a string representing the number using engineering notation. For finite 7388non-zero numbers, the absolute value of the significand is greater than or 7389equal to 1 and less than 1000, and the exponent is a multiple of 3. The output 7390corresponds to the output from C<eparts()>. 7391 7392 123 is returned as "123e+0" 7393 1230 is returned as "1.23e+3" 7394 12300 is returned as "12.3e+3" 7395 12000 is returned as "12e+3" 7396 10000 is returned as "10e+3" 7397 7398=item bdstr() 7399 7400Returns a string representing the number using decimal notation. The output 7401corresponds to the output from C<dparts()>. 7402 7403 123 is returned as "123" 7404 1230 is returned as "1230" 7405 12300 is returned as "12300" 7406 12000 is returned as "12000" 7407 10000 is returned as "10000" 7408 7409=item bfstr() 7410 7411Returns a string representing the number using fractional notation. The output 7412corresponds to the output from C<fparts()>. 7413 7414 12.345 is returned as "2469/200" 7415 123.45 is returned as "2469/20" 7416 1234.5 is returned as "2469/2" 7417 12345 is returned as "12345" 7418 123450 is returned as "123450" 7419 7420=item to_hex() 7421 7422 $x->to_hex(); 7423 7424Returns a hexadecimal string representation of the number. See also from_hex(). 7425 7426=item to_bin() 7427 7428 $x->to_bin(); 7429 7430Returns a binary string representation of the number. See also from_bin(). 7431 7432=item to_oct() 7433 7434 $x->to_oct(); 7435 7436Returns an octal string representation of the number. See also from_oct(). 7437 7438=item to_bytes() 7439 7440 $x = Math::BigInt->new("1667327589"); 7441 $s = $x->to_bytes(); # $s = "cafe" 7442 7443Returns a byte string representation of the number using big endian byte order. 7444The invocand must be a non-negative, finite integer. See also from_bytes(). 7445 7446=item to_base() 7447 7448 $x = Math::BigInt->new("250"); 7449 $x->to_base(2); # returns "11111010" 7450 $x->to_base(8); # returns "372" 7451 $x->to_base(16); # returns "fa" 7452 7453Returns a string representation of the number in the given base. If a collation 7454sequence is given, the collation sequence determines which characters are used 7455in the output. 7456 7457Here are some more examples 7458 7459 $x = Math::BigInt->new("16")->to_base(3); # returns "121" 7460 $x = Math::BigInt->new("44027")->to_base(36); # returns "XYZ" 7461 $x = Math::BigInt->new("58314")->to_base(42); # returns "Why" 7462 $x = Math::BigInt->new("4")->to_base(2, "-|"); # returns "|--" 7463 7464See from_base() for information and examples. 7465 7466=item to_base_num() 7467 7468Converts the given number to the given base. This method is equivalent to 7469C<_to_base()>, but returns numbers in an array rather than characters in a 7470string. In the output, the first element is the most significant. Unlike 7471C<_to_base()>, all input values may be arbitrarily large. 7472 7473 $x = Math::BigInt->new(13); 7474 $x->to_base_num(2); # returns [1, 1, 0, 1] 7475 7476 $x = Math::BigInt->new(65191); 7477 $x->to_base_num(128); # returns [3, 125, 39] 7478 7479=item as_hex() 7480 7481 $x->as_hex(); 7482 7483As, C<to_hex()>, but with a "0x" prefix. 7484 7485=item as_bin() 7486 7487 $x->as_bin(); 7488 7489As, C<to_bin()>, but with a "0b" prefix. 7490 7491=item as_oct() 7492 7493 $x->as_oct(); 7494 7495As, C<to_oct()>, but with a "0" prefix. 7496 7497=item as_bytes() 7498 7499This is just an alias for C<to_bytes()>. 7500 7501=back 7502 7503=head2 Other conversion methods 7504 7505=over 7506 7507=item numify() 7508 7509 print $x->numify(); 7510 7511Returns a Perl scalar from $x. It is used automatically whenever a scalar is 7512needed, for instance in array index operations. 7513 7514=back 7515 7516=head2 Utility methods 7517 7518These utility methods are made public 7519 7520=over 7521 7522=item dec_str_to_dec_flt_str() 7523 7524Takes a string representing any valid number using decimal notation and converts 7525it to a string representing the same number using decimal floating point 7526notation. The output consists of five parts joined together: the sign of the 7527significand, the absolute value of the significand as the smallest possible 7528integer, the letter "e", the sign of the exponent, and the absolute value of the 7529exponent. If the input is invalid, nothing is returned. 7530 7531 $str2 = $class -> dec_str_to_dec_flt_str($str1); 7532 7533Some examples 7534 7535 Input Output 7536 31400.00e-4 +314e-2 7537 -0.00012300e8 -123e+2 7538 0 +0e+0 7539 7540=item hex_str_to_dec_flt_str() 7541 7542Takes a string representing any valid number using hexadecimal notation and 7543converts it to a string representing the same number using decimal floating 7544point notation. The output has the same format as that of 7545L</dec_str_to_dec_flt_str()>. 7546 7547 $str2 = $class -> hex_str_to_dec_flt_str($str1); 7548 7549Some examples 7550 7551 Input Output 7552 0xff +255e+0 7553 7554Some examples 7555 7556=item oct_str_to_dec_flt_str() 7557 7558Takes a string representing any valid number using octal notation and converts 7559it to a string representing the same number using decimal floating point 7560notation. The output has the same format as that of 7561L</dec_str_to_dec_flt_str()>. 7562 7563 $str2 = $class -> oct_str_to_dec_flt_str($str1); 7564 7565=item bin_str_to_dec_flt_str() 7566 7567Takes a string representing any valid number using binary notation and converts 7568it to a string representing the same number using decimal floating point 7569notation. The output has the same format as that of 7570L</dec_str_to_dec_flt_str()>. 7571 7572 $str2 = $class -> bin_str_to_dec_flt_str($str1); 7573 7574=item dec_str_to_dec_str() 7575 7576Takes a string representing any valid number using decimal notation and converts 7577it to a string representing the same number using decimal notation. If the 7578number represents an integer, the output consists of a sign and the absolute 7579value. If the number represents a non-integer, the output consists of a sign, 7580the integer part of the number, the decimal point ".", and the fraction part of 7581the number without any trailing zeros. If the input is invalid, nothing is 7582returned. 7583 7584=item hex_str_to_dec_str() 7585 7586Takes a string representing any valid number using hexadecimal notation and 7587converts it to a string representing the same number using decimal notation. The 7588output has the same format as that of L</dec_str_to_dec_str()>. 7589 7590=item oct_str_to_dec_str() 7591 7592Takes a string representing any valid number using octal notation and converts 7593it to a string representing the same number using decimal notation. The 7594output has the same format as that of L</dec_str_to_dec_str()>. 7595 7596=item bin_str_to_dec_str() 7597 7598Takes a string representing any valid number using binary notation and converts 7599it to a string representing the same number using decimal notation. The output 7600has the same format as that of L</dec_str_to_dec_str()>. 7601 7602=back 7603 7604=head1 ACCURACY and PRECISION 7605 7606Math::BigInt and Math::BigFloat have full support for accuracy and precision 7607based rounding, both automatically after every operation, as well as manually. 7608 7609This section describes the accuracy/precision handling in Math::BigInt and 7610Math::BigFloat as it used to be and as it is now, complete with an explanation 7611of all terms and abbreviations. 7612 7613Not yet implemented things (but with correct description) are marked with '!', 7614things that need to be answered are marked with '?'. 7615 7616In the next paragraph follows a short description of terms used here (because 7617these may differ from terms used by others people or documentation). 7618 7619During the rest of this document, the shortcuts A (for accuracy), P (for 7620precision), F (fallback) and R (rounding mode) are be used. 7621 7622=head2 Precision P 7623 7624Precision is a fixed number of digits before (positive) or after (negative) the 7625decimal point. For example, 123.45 has a precision of -2. 0 means an integer 7626like 123 (or 120). A precision of 2 means at least two digits to the left of 7627the decimal point are zero, so 123 with P = 1 becomes 120. Note that numbers 7628with zeros before the decimal point may have different precisions, because 1200 7629can have P = 0, 1 or 2 (depending on what the initial value was). It could also 7630have p < 0, when the digits after the decimal point are zero. 7631 7632The string output (of floating point numbers) is padded with zeros: 7633 7634 Initial value P A Result String 7635 ------------------------------------------------------------ 7636 1234.01 -3 1000 1000 7637 1234 -2 1200 1200 7638 1234.5 -1 1230 1230 7639 1234.001 1 1234 1234.0 7640 1234.01 0 1234 1234 7641 1234.01 2 1234.01 1234.01 7642 1234.01 5 1234.01 1234.01000 7643 7644For Math::BigInt objects, no padding occurs. 7645 7646=head2 Accuracy A 7647 7648Number of significant digits. Leading zeros are not counted. A number may have 7649an accuracy greater than the non-zero digits when there are zeros in it or 7650trailing zeros. For example, 123.456 has A of 6, 10203 has 5, 123.0506 has 7, 7651123.45000 has 8 and 0.000123 has 3. 7652 7653The string output (of floating point numbers) is padded with zeros: 7654 7655 Initial value P A Result String 7656 ------------------------------------------------------------ 7657 1234.01 3 1230 1230 7658 1234.01 6 1234.01 1234.01 7659 1234.1 8 1234.1 1234.1000 7660 7661For Math::BigInt objects, no padding occurs. 7662 7663=head2 Fallback F 7664 7665When both A and P are undefined, this is used as a fallback accuracy when 7666dividing numbers. 7667 7668=head2 Rounding mode R 7669 7670When rounding a number, different 'styles' or 'kinds' of rounding are possible. 7671(Note that random rounding, as in Math::Round, is not implemented.) 7672 7673=head3 Directed rounding 7674 7675These round modes always round in the same direction. 7676 7677=over 7678 7679=item 'trunc' 7680 7681Round towards zero. Remove all digits following the rounding place, i.e., 7682replace them with zeros. Thus, 987.65 rounded to tens (P=1) becomes 980, and 7683rounded to the fourth significant digit becomes 987.6 (A=4). 123.456 rounded to 7684the second place after the decimal point (P=-2) becomes 123.46. This 7685corresponds to the IEEE 754 rounding mode 'roundTowardZero'. 7686 7687=back 7688 7689=head3 Rounding to nearest 7690 7691These rounding modes round to the nearest digit. They differ in how they 7692determine which way to round in the ambiguous case when there is a tie. 7693 7694=over 7695 7696=item 'even' 7697 7698Round towards the nearest even digit, e.g., when rounding to nearest integer, 7699-5.5 becomes -6, 4.5 becomes 4, but 4.501 becomes 5. This corresponds to the 7700IEEE 754 rounding mode 'roundTiesToEven'. 7701 7702=item 'odd' 7703 7704Round towards the nearest odd digit, e.g., when rounding to nearest integer, 77054.5 becomes 5, -5.5 becomes -5, but 5.501 becomes 6. This corresponds to the 7706IEEE 754 rounding mode 'roundTiesToOdd'. 7707 7708=item '+inf' 7709 7710Round towards plus infinity, i.e., always round up. E.g., when rounding to the 7711nearest integer, 4.5 becomes 5, -5.5 becomes -5, and 4.501 also becomes 5. This 7712corresponds to the IEEE 754 rounding mode 'roundTiesToPositive'. 7713 7714=item '-inf' 7715 7716Round towards minus infinity, i.e., always round down. E.g., when rounding to 7717the nearest integer, 4.5 becomes 4, -5.5 becomes -6, but 4.501 becomes 5. This 7718corresponds to the IEEE 754 rounding mode 'roundTiesToNegative'. 7719 7720=item 'zero' 7721 7722Round towards zero, i.e., round positive numbers down and negative numbers up. 7723E.g., when rounding to the nearest integer, 4.5 becomes 4, -5.5 becomes -5, but 77244.501 becomes 5. This corresponds to the IEEE 754 rounding mode 7725'roundTiesToZero'. 7726 7727=item 'common' 7728 7729Round away from zero, i.e., round to the number with the largest absolute 7730value. E.g., when rounding to the nearest integer, -1.5 becomes -2, 1.5 becomes 77312 and 1.49 becomes 1. This corresponds to the IEEE 754 rounding mode 7732'roundTiesToAway'. 7733 7734=back 7735 7736The handling of A & P in MBI/MBF (the old core code shipped with Perl versions 7737<= 5.7.2) is like this: 7738 7739=over 7740 7741=item Precision 7742 7743 * bfround($p) is able to round to $p number of digits after the decimal 7744 point 7745 * otherwise P is unused 7746 7747=item Accuracy (significant digits) 7748 7749 * bround($a) rounds to $a significant digits 7750 * only bdiv() and bsqrt() take A as (optional) parameter 7751 + other operations simply create the same number (bneg etc), or 7752 more (bmul) of digits 7753 + rounding/truncating is only done when explicitly calling one 7754 of bround or bfround, and never for Math::BigInt (not implemented) 7755 * bsqrt() simply hands its accuracy argument over to bdiv. 7756 * the documentation and the comment in the code indicate two 7757 different ways on how bdiv() determines the maximum number 7758 of digits it should calculate, and the actual code does yet 7759 another thing 7760 POD: 7761 max($Math::BigFloat::div_scale,length(dividend)+length(divisor)) 7762 Comment: 7763 result has at most max(scale, length(dividend), length(divisor)) digits 7764 Actual code: 7765 scale = max(scale, length(dividend)-1,length(divisor)-1); 7766 scale += length(divisor) - length(dividend); 7767 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10 7768 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 7769 (10+9-3). Actually, the 'difference' added to the scale is cal- 7770 culated from the number of "significant digits" in dividend and 7771 divisor, which is derived by looking at the length of the man- 7772 tissa. Which is wrong, since it includes the + sign (oops) and 7773 actually gets 2 for '+100' and 4 for '+101'. Oops again. Thus 7774 124/3 with div_scale=1 will get you '41.3' based on the strange 7775 assumption that 124 has 3 significant digits, while 120/7 will 7776 get you '17', not '17.1' since 120 is thought to have 2 signif- 7777 icant digits. The rounding after the division then uses the 7778 remainder and $y to determine whether it must round up or down. 7779 ? I have no idea which is the right way. That's why I used a slightly more 7780 ? simple scheme and tweaked the few failing testcases to match it. 7781 7782=back 7783 7784This is how it works now: 7785 7786=over 7787 7788=item Setting/Accessing 7789 7790 * You can set the A global via Math::BigInt->accuracy() or 7791 Math::BigFloat->accuracy() or whatever class you are using. 7792 * You can also set P globally by using Math::SomeClass->precision() 7793 likewise. 7794 * Globals are classwide, and not inherited by subclasses. 7795 * to undefine A, use Math::SomeClass->accuracy(undef); 7796 * to undefine P, use Math::SomeClass->precision(undef); 7797 * Setting Math::SomeClass->accuracy() clears automatically 7798 Math::SomeClass->precision(), and vice versa. 7799 * To be valid, A must be > 0, P can have any value. 7800 * If P is negative, this means round to the P'th place to the right of the 7801 decimal point; positive values mean to the left of the decimal point. 7802 P of 0 means round to integer. 7803 * to find out the current global A, use Math::SomeClass->accuracy() 7804 * to find out the current global P, use Math::SomeClass->precision() 7805 * use $x->accuracy() respective $x->precision() for the local 7806 setting of $x. 7807 * Please note that $x->accuracy() respective $x->precision() 7808 return eventually defined global A or P, when $x's A or P is not 7809 set. 7810 7811=item Creating numbers 7812 7813 * When you create a number, you can give the desired A or P via: 7814 $x = Math::BigInt->new($number,$A,$P); 7815 * Only one of A or P can be defined, otherwise the result is NaN 7816 * If no A or P is give ($x = Math::BigInt->new($number) form), then the 7817 globals (if set) will be used. Thus changing the global defaults later on 7818 will not change the A or P of previously created numbers (i.e., A and P of 7819 $x will be what was in effect when $x was created) 7820 * If given undef for A and P, NO rounding will occur, and the globals will 7821 NOT be used. This is used by subclasses to create numbers without 7822 suffering rounding in the parent. Thus a subclass is able to have its own 7823 globals enforced upon creation of a number by using 7824 $x = Math::BigInt->new($number,undef,undef): 7825 7826 use Math::BigInt::SomeSubclass; 7827 use Math::BigInt; 7828 7829 Math::BigInt->accuracy(2); 7830 Math::BigInt::SomeSubclass->accuracy(3); 7831 $x = Math::BigInt::SomeSubclass->new(1234); 7832 7833 $x is now 1230, and not 1200. A subclass might choose to implement 7834 this otherwise, e.g. falling back to the parent's A and P. 7835 7836=item Usage 7837 7838 * If A or P are enabled/defined, they are used to round the result of each 7839 operation according to the rules below 7840 * Negative P is ignored in Math::BigInt, since Math::BigInt objects never 7841 have digits after the decimal point 7842 * Math::BigFloat uses Math::BigInt internally, but setting A or P inside 7843 Math::BigInt as globals does not tamper with the parts of a Math::BigFloat. 7844 A flag is used to mark all Math::BigFloat numbers as 'never round'. 7845 7846=item Precedence 7847 7848 * It only makes sense that a number has only one of A or P at a time. 7849 If you set either A or P on one object, or globally, the other one will 7850 be automatically cleared. 7851 * If two objects are involved in an operation, and one of them has A in 7852 effect, and the other P, this results in an error (NaN). 7853 * A takes precedence over P (Hint: A comes before P). 7854 If neither of them is defined, nothing is used, i.e. the result will have 7855 as many digits as it can (with an exception for bdiv/bsqrt) and will not 7856 be rounded. 7857 * There is another setting for bdiv() (and thus for bsqrt()). If neither of 7858 A or P is defined, bdiv() will use a fallback (F) of $div_scale digits. 7859 If either the dividend's or the divisor's mantissa has more digits than 7860 the value of F, the higher value will be used instead of F. 7861 This is to limit the digits (A) of the result (just consider what would 7862 happen with unlimited A and P in the case of 1/3 :-) 7863 * bdiv will calculate (at least) 4 more digits than required (determined by 7864 A, P or F), and, if F is not used, round the result 7865 (this will still fail in the case of a result like 0.12345000000001 with A 7866 or P of 5, but this can not be helped - or can it?) 7867 * Thus you can have the math done by on Math::Big* class in two modi: 7868 + never round (this is the default): 7869 This is done by setting A and P to undef. No math operation 7870 will round the result, with bdiv() and bsqrt() as exceptions to guard 7871 against overflows. You must explicitly call bround(), bfround() or 7872 round() (the latter with parameters). 7873 Note: Once you have rounded a number, the settings will 'stick' on it 7874 and 'infect' all other numbers engaged in math operations with it, since 7875 local settings have the highest precedence. So, to get SaferRound[tm], 7876 use a copy() before rounding like this: 7877 7878 $x = Math::BigFloat->new(12.34); 7879 $y = Math::BigFloat->new(98.76); 7880 $z = $x * $y; # 1218.6984 7881 print $x->copy()->bround(3); # 12.3 (but A is now 3!) 7882 $z = $x * $y; # still 1218.6984, without 7883 # copy would have been 1210! 7884 7885 + round after each op: 7886 After each single operation (except for testing like is_zero()), the 7887 method round() is called and the result is rounded appropriately. By 7888 setting proper values for A and P, you can have all-the-same-A or 7889 all-the-same-P modes. For example, Math::Currency might set A to undef, 7890 and P to -2, globally. 7891 7892 ?Maybe an extra option that forbids local A & P settings would be in order, 7893 ?so that intermediate rounding does not 'poison' further math? 7894 7895=item Overriding globals 7896 7897 * you will be able to give A, P and R as an argument to all the calculation 7898 routines; the second parameter is A, the third one is P, and the fourth is 7899 R (shift right by one for binary operations like badd). P is used only if 7900 the first parameter (A) is undefined. These three parameters override the 7901 globals in the order detailed as follows, i.e. the first defined value 7902 wins: 7903 (local: per object, global: global default, parameter: argument to sub) 7904 + parameter A 7905 + parameter P 7906 + local A (if defined on both of the operands: smaller one is taken) 7907 + local P (if defined on both of the operands: bigger one is taken) 7908 + global A 7909 + global P 7910 + global F 7911 * bsqrt() will hand its arguments to bdiv(), as it used to, only now for two 7912 arguments (A and P) instead of one 7913 7914=item Local settings 7915 7916 * You can set A or P locally by using $x->accuracy() or 7917 $x->precision() 7918 and thus force different A and P for different objects/numbers. 7919 * Setting A or P this way immediately rounds $x to the new value. 7920 * $x->accuracy() clears $x->precision(), and vice versa. 7921 7922=item Rounding 7923 7924 * the rounding routines will use the respective global or local settings. 7925 bround() is for accuracy rounding, while bfround() is for precision 7926 * the two rounding functions take as the second parameter one of the 7927 following rounding modes (R): 7928 'even', 'odd', '+inf', '-inf', 'zero', 'trunc', 'common' 7929 * you can set/get the global R by using Math::SomeClass->round_mode() 7930 or by setting $Math::SomeClass::round_mode 7931 * after each operation, $result->round() is called, and the result may 7932 eventually be rounded (that is, if A or P were set either locally, 7933 globally or as parameter to the operation) 7934 * to manually round a number, call $x->round($A,$P,$round_mode); 7935 this will round the number by using the appropriate rounding function 7936 and then normalize it. 7937 * rounding modifies the local settings of the number: 7938 7939 $x = Math::BigFloat->new(123.456); 7940 $x->accuracy(5); 7941 $x->bround(4); 7942 7943 Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy() 7944 will be 4 from now on. 7945 7946=item Default values 7947 7948 * R: 'even' 7949 * F: 40 7950 * A: undef 7951 * P: undef 7952 7953=item Remarks 7954 7955 * The defaults are set up so that the new code gives the same results as 7956 the old code (except in a few cases on bdiv): 7957 + Both A and P are undefined and thus will not be used for rounding 7958 after each operation. 7959 + round() is thus a no-op, unless given extra parameters A and P 7960 7961=back 7962 7963=head1 Infinity and Not a Number 7964 7965While Math::BigInt has extensive handling of inf and NaN, certain quirks 7966remain. 7967 7968=over 7969 7970=item oct()/hex() 7971 7972These perl routines currently (as of Perl v.5.8.6) cannot handle passed inf. 7973 7974 te@linux:~> perl -wle 'print 2 ** 3333' 7975 Inf 7976 te@linux:~> perl -wle 'print 2 ** 3333 == 2 ** 3333' 7977 1 7978 te@linux:~> perl -wle 'print oct(2 ** 3333)' 7979 0 7980 te@linux:~> perl -wle 'print hex(2 ** 3333)' 7981 Illegal hexadecimal digit 'I' ignored at -e line 1. 7982 0 7983 7984The same problems occur if you pass them Math::BigInt->binf() objects. Since 7985overloading these routines is not possible, this cannot be fixed from 7986Math::BigInt. 7987 7988=back 7989 7990=head1 INTERNALS 7991 7992You should neither care about nor depend on the internal representation; it 7993might change without notice. Use B<ONLY> method calls like C<< $x->sign(); >> 7994instead relying on the internal representation. 7995 7996=head2 MATH LIBRARY 7997 7998The mathematical computations are performed by a backend library. It is not 7999required to specify which backend library to use, but some backend libraries 8000are much faster than the default library. 8001 8002=head3 The default library 8003 8004The default library is L<Math::BigInt::Calc>, which is implemented in pure Perl 8005and hence does not require a compiler. 8006 8007=head3 Specifying a library 8008 8009The simple case 8010 8011 use Math::BigInt; 8012 8013is equivalent to saying 8014 8015 use Math::BigInt try => 'Calc'; 8016 8017You can use a different backend library with, e.g., 8018 8019 use Math::BigInt try => 'GMP'; 8020 8021which attempts to load the L<Math::BigInt::GMP> library, and falls back to the 8022default library if the specified library can't be loaded. 8023 8024Multiple libraries can be specified by separating them by a comma, e.g., 8025 8026 use Math::BigInt try => 'GMP,Pari'; 8027 8028If you request a specific set of libraries and do not allow fallback to the 8029default library, specify them using "only", 8030 8031 use Math::BigInt only => 'GMP,Pari'; 8032 8033If you prefer a specific set of libraries, but want to see a warning if the 8034fallback library is used, specify them using "lib", 8035 8036 use Math::BigInt lib => 'GMP,Pari'; 8037 8038The following first tries to find Math::BigInt::Foo, then Math::BigInt::Bar, and 8039if this also fails, reverts to Math::BigInt::Calc: 8040 8041 use Math::BigInt try => 'Foo,Math::BigInt::Bar'; 8042 8043=head3 Which library to use? 8044 8045B<Note>: General purpose packages should not be explicit about the library to 8046use; let the script author decide which is best. 8047 8048L<Math::BigInt::GMP>, L<Math::BigInt::Pari>, and L<Math::BigInt::GMPz> are in 8049cases involving big numbers much faster than L<Math::BigInt::Calc>. However 8050these libraries are slower when dealing with very small numbers (less than about 805120 digits) and when converting very large numbers to decimal (for instance for 8052printing, rounding, calculating their length in decimal etc.). 8053 8054So please select carefully what library you want to use. 8055 8056Different low-level libraries use different formats to store the numbers, so 8057mixing them won't work. You should not depend on the number having a specific 8058internal format. 8059 8060See the respective math library module documentation for further details. 8061 8062=head3 Loading multiple libraries 8063 8064The first library that is successfully loaded is the one that will be used. Any 8065further attempts at loading a different module will be ignored. This is to avoid 8066the situation where module A requires math library X, and module B requires math 8067library Y, causing modules A and B to be incompatible. For example, 8068 8069 use Math::BigInt; # loads default "Calc" 8070 use Math::BigFloat only => "GMP"; # ignores "GMP" 8071 8072=head2 SIGN 8073 8074The sign is either '+', '-', 'NaN', '+inf' or '-inf'. 8075 8076A sign of 'NaN' is used to represent the result when input arguments are not 8077numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively 8078minus infinity. You get '+inf' when dividing a positive number by 0, and '-inf' 8079when dividing any negative number by 0. 8080 8081=head1 EXAMPLES 8082 8083 use Math::BigInt; 8084 8085 sub bigint { Math::BigInt->new(shift); } 8086 8087 $x = Math::BigInt->bstr("1234") # string "1234" 8088 $x = "$x"; # same as bstr() 8089 $x = Math::BigInt->bneg("1234"); # Math::BigInt "-1234" 8090 $x = Math::BigInt->babs("-12345"); # Math::BigInt "12345" 8091 $x = Math::BigInt->bnorm("-0.00"); # Math::BigInt "0" 8092 $x = bigint(1) + bigint(2); # Math::BigInt "3" 8093 $x = bigint(1) + "2"; # ditto ("2" becomes a Math::BigInt) 8094 $x = bigint(1); # Math::BigInt "1" 8095 $x = $x + 5 / 2; # Math::BigInt "3" 8096 $x = $x ** 3; # Math::BigInt "27" 8097 $x *= 2; # Math::BigInt "54" 8098 $x = Math::BigInt->new(0); # Math::BigInt "0" 8099 $x--; # Math::BigInt "-1" 8100 $x = Math::BigInt->badd(4,5) # Math::BigInt "9" 8101 print $x->bsstr(); # 9e+0 8102 8103Examples for rounding: 8104 8105 use Math::BigFloat; 8106 use Test::More; 8107 8108 $x = Math::BigFloat->new(123.4567); 8109 $y = Math::BigFloat->new(123.456789); 8110 Math::BigFloat->accuracy(4); # no more A than 4 8111 8112 is ($x->copy()->bround(),123.4); # even rounding 8113 print $x->copy()->bround(),"\n"; # 123.4 8114 Math::BigFloat->round_mode('odd'); # round to odd 8115 print $x->copy()->bround(),"\n"; # 123.5 8116 Math::BigFloat->accuracy(5); # no more A than 5 8117 Math::BigFloat->round_mode('odd'); # round to odd 8118 print $x->copy()->bround(),"\n"; # 123.46 8119 $y = $x->copy()->bround(4),"\n"; # A = 4: 123.4 8120 print "$y, ",$y->accuracy(),"\n"; # 123.4, 4 8121 8122 Math::BigFloat->accuracy(undef); # A not important now 8123 Math::BigFloat->precision(2); # P important 8124 print $x->copy()->bnorm(),"\n"; # 123.46 8125 print $x->copy()->bround(),"\n"; # 123.46 8126 8127Examples for converting: 8128 8129 my $x = Math::BigInt->new('0b1'.'01' x 123); 8130 print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n"; 8131 8132=head1 NUMERIC LITERALS 8133 8134After C<use Math::BigInt ':constant'> all numeric literals in the given scope 8135are converted to C<Math::BigInt> objects. This conversion happens at compile 8136time. Every non-integer is convert to a NaN. 8137 8138For example, 8139 8140 perl -MMath::BigInt=:constant -le 'print 2**150' 8141 8142prints the exact value of C<2**150>. Note that without conversion of constants 8143to objects the expression C<2**150> is calculated using Perl scalars, which 8144leads to an inaccurate result. 8145 8146Please note that strings are not affected, so that 8147 8148 use Math::BigInt qw/:constant/; 8149 8150 $x = "1234567890123456789012345678901234567890" 8151 + "123456789123456789"; 8152 8153does give you what you expect. You need an explicit Math::BigInt->new() around 8154at least one of the operands. You should also quote large constants to prevent 8155loss of precision: 8156 8157 use Math::BigInt; 8158 8159 $x = Math::BigInt->new("1234567889123456789123456789123456789"); 8160 8161Without the quotes Perl first converts the large number to a floating point 8162constant at compile time, and then converts the result to a Math::BigInt object 8163at run time, which results in an inaccurate result. 8164 8165=head2 Hexadecimal, octal, and binary floating point literals 8166 8167Perl (and this module) accepts hexadecimal, octal, and binary floating point 8168literals, but use them with care with Perl versions before v5.32.0, because some 8169versions of Perl silently give the wrong result. Below are some examples of 8170different ways to write the number decimal 314. 8171 8172Hexadecimal floating point literals: 8173 8174 0x1.3ap+8 0X1.3AP+8 8175 0x1.3ap8 0X1.3AP8 8176 0x13a0p-4 0X13A0P-4 8177 8178Octal floating point literals (with "0" prefix): 8179 8180 01.164p+8 01.164P+8 8181 01.164p8 01.164P8 8182 011640p-4 011640P-4 8183 8184Octal floating point literals (with "0o" prefix) (requires v5.34.0): 8185 8186 0o1.164p+8 0O1.164P+8 8187 0o1.164p8 0O1.164P8 8188 0o11640p-4 0O11640P-4 8189 8190Binary floating point literals: 8191 8192 0b1.0011101p+8 0B1.0011101P+8 8193 0b1.0011101p8 0B1.0011101P8 8194 0b10011101000p-2 0B10011101000P-2 8195 8196=head1 PERFORMANCE 8197 8198Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x 8199must be made in the second case. For long numbers, the copy can eat up to 20% 8200of the work (in the case of addition/subtraction, less for 8201multiplication/division). If $y is very small compared to $x, the form $x += $y 8202is MUCH faster than $x = $x + $y since making the copy of $x takes more time 8203then the actual addition. 8204 8205With a technique called copy-on-write, the cost of copying with overload could 8206be minimized or even completely avoided. A test implementation of COW did show 8207performance gains for overloaded math, but introduced a performance loss due to 8208a constant overhead for all other operations. So Math::BigInt does currently 8209not COW. 8210 8211The rewritten version of this module (vs. v0.01) is slower on certain 8212operations, like C<new()>, C<bstr()> and C<numify()>. The reason are that it 8213does now more work and handles much more cases. The time spent in these 8214operations is usually gained in the other math operations so that code on the 8215average should get (much) faster. If they don't, please contact the author. 8216 8217Some operations may be slower for small numbers, but are significantly faster 8218for big numbers. Other operations are now constant (O(1), like C<bneg()>, 8219C<babs()> etc), instead of O(N) and thus nearly always take much less time. 8220These optimizations were done on purpose. 8221 8222If you find the Calc module to slow, try to install any of the replacement 8223modules and see if they help you. 8224 8225=head2 Alternative math libraries 8226 8227You can use an alternative library to drive Math::BigInt. See the section 8228L</MATH LIBRARY> for more information. 8229 8230For more benchmark results see L<http://bloodgate.com/perl/benchmarks.html>. 8231 8232=head1 SUBCLASSING 8233 8234=head2 Subclassing Math::BigInt 8235 8236The basic design of Math::BigInt allows simple subclasses with very little 8237work, as long as a few simple rules are followed: 8238 8239=over 8240 8241=item * 8242 8243The public API must remain consistent, i.e. if a sub-class is overloading 8244addition, the sub-class must use the same name, in this case badd(). The reason 8245for this is that Math::BigInt is optimized to call the object methods directly. 8246 8247=item * 8248 8249The private object hash keys like C<< $x->{sign} >> may not be changed, but 8250additional keys can be added, like C<< $x->{_custom} >>. 8251 8252=item * 8253 8254Accessor functions are available for all existing object hash keys and should 8255be used instead of directly accessing the internal hash keys. The reason for 8256this is that Math::BigInt itself has a pluggable interface which permits it to 8257support different storage methods. 8258 8259=back 8260 8261More complex sub-classes may have to replicate more of the logic internal of 8262Math::BigInt if they need to change more basic behaviors. A subclass that needs 8263to merely change the output only needs to overload C<bstr()>. 8264 8265All other object methods and overloaded functions can be directly inherited 8266from the parent class. 8267 8268At the very minimum, any subclass needs to provide its own C<new()> and can 8269store additional hash keys in the object. There are also some package globals 8270that must be defined, e.g.: 8271 8272 # Globals 8273 $accuracy = undef; 8274 $precision = -2; # round to 2 decimal places 8275 $round_mode = 'even'; 8276 $div_scale = 40; 8277 8278Additionally, you might want to provide the following two globals to allow 8279auto-upgrading and auto-downgrading to work correctly: 8280 8281 $upgrade = undef; 8282 $downgrade = undef; 8283 8284This allows Math::BigInt to correctly retrieve package globals from the 8285subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or 8286t/Math/BigFloat/SubClass.pm completely functional subclass examples. 8287 8288Don't forget to 8289 8290 use overload; 8291 8292in your subclass to automatically inherit the overloading from the parent. If 8293you like, you can change part of the overloading, look at Math::String for an 8294example. 8295 8296=head1 UPGRADING 8297 8298When used like this: 8299 8300 use Math::BigInt upgrade => 'Foo::Bar'; 8301 8302certain operations 'upgrade' their calculation and thus the result to the class 8303Foo::Bar. Usually this is used in conjunction with Math::BigFloat: 8304 8305 use Math::BigInt upgrade => 'Math::BigFloat'; 8306 8307As a shortcut, you can use the module L<bignum>: 8308 8309 use bignum; 8310 8311Also good for one-liners: 8312 8313 perl -Mbignum -le 'print 2 ** 255' 8314 8315This makes it possible to mix arguments of different classes (as in 2.5 + 2) as 8316well es preserve accuracy (as in sqrt(3)). 8317 8318Beware: This feature is not fully implemented yet. 8319 8320=head2 Auto-upgrade 8321 8322The following methods upgrade themselves unconditionally; that is if upgrade is 8323in effect, they always hands up their work: 8324 8325 div bsqrt blog bexp bpi bsin bcos batan batan2 8326 8327All other methods upgrade themselves only when one (or all) of their arguments 8328are of the class mentioned in $upgrade. 8329 8330=head1 EXPORTS 8331 8332C<Math::BigInt> exports nothing by default, but can export the following 8333methods: 8334 8335 bgcd 8336 blcm 8337 8338=head1 CAVEATS 8339 8340Some things might not work as you expect them. Below is documented what is 8341known to be troublesome: 8342 8343=over 8344 8345=item Comparing numbers as strings 8346 8347Both C<bstr()> and C<bsstr()> as well as stringify via overload drop the 8348leading '+'. This is to be consistent with Perl and to make C<cmp> (especially 8349with overloading) to work as you expect. It also solves problems with 8350C<Test.pm> and L<Test::More>, which stringify arguments before comparing them. 8351 8352Mark Biggar said, when asked about to drop the '+' altogether, or make only 8353C<cmp> work: 8354 8355 I agree (with the first alternative), don't add the '+' on positive 8356 numbers. It's not as important anymore with the new internal form 8357 for numbers. It made doing things like abs and neg easier, but 8358 those have to be done differently now anyway. 8359 8360So, the following examples now works as expected: 8361 8362 use Test::More tests => 1; 8363 use Math::BigInt; 8364 8365 my $x = Math::BigInt -> new(3*3); 8366 my $y = Math::BigInt -> new(3*3); 8367 8368 is($x,3*3, 'multiplication'); 8369 print "$x eq 9" if $x eq $y; 8370 print "$x eq 9" if $x eq '9'; 8371 print "$x eq 9" if $x eq 3*3; 8372 8373Additionally, the following still works: 8374 8375 print "$x == 9" if $x == $y; 8376 print "$x == 9" if $x == 9; 8377 print "$x == 9" if $x == 3*3; 8378 8379There is now a C<bsstr()> method to get the string in scientific notation aka 8380C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr() 8381for comparison, but Perl represents some numbers as 100 and others as 1e+308. 8382If in doubt, convert both arguments to Math::BigInt before comparing them as 8383strings: 8384 8385 use Test::More tests => 3; 8386 use Math::BigInt; 8387 8388 $x = Math::BigInt->new('1e56'); 8389 $y = 1e56; 8390 is($x,$y); # fails 8391 is($x->bsstr(), $y); # okay 8392 $y = Math::BigInt->new($y); 8393 is($x, $y); # okay 8394 8395Alternatively, simply use C<< <=> >> for comparisons, this always gets it 8396right. There is not yet a way to get a number automatically represented as a 8397string that matches exactly the way Perl represents it. 8398 8399See also the section about L<Infinity and Not a Number> for problems in 8400comparing NaNs. 8401 8402=item int() 8403 8404C<int()> returns (at least for Perl v5.7.1 and up) another Math::BigInt, not a 8405Perl scalar: 8406 8407 $x = Math::BigInt->new(123); 8408 $y = int($x); # 123 as a Math::BigInt 8409 $x = Math::BigFloat->new(123.45); 8410 $y = int($x); # 123 as a Math::BigFloat 8411 8412If you want a real Perl scalar, use C<numify()>: 8413 8414 $y = $x->numify(); # 123 as a scalar 8415 8416This is seldom necessary, though, because this is done automatically, like when 8417you access an array: 8418 8419 $z = $array[$x]; # does work automatically 8420 8421=item Modifying and = 8422 8423Beware of: 8424 8425 $x = Math::BigFloat->new(5); 8426 $y = $x; 8427 8428This makes a second reference to the B<same> object and stores it in $y. Thus 8429anything that modifies $x (except overloaded operators) also modifies $y, and 8430vice versa. Or in other words, C<=> is only safe if you modify your 8431Math::BigInt objects only via overloaded math. As soon as you use a method call 8432it breaks: 8433 8434 $x->bmul(2); 8435 print "$x, $y\n"; # prints '10, 10' 8436 8437If you want a true copy of $x, use: 8438 8439 $y = $x->copy(); 8440 8441You can also chain the calls like this, this first makes a copy and then 8442multiply it by 2: 8443 8444 $y = $x->copy()->bmul(2); 8445 8446See also the documentation for overload.pm regarding C<=>. 8447 8448=item Overloading -$x 8449 8450The following: 8451 8452 $x = -$x; 8453 8454is slower than 8455 8456 $x->bneg(); 8457 8458since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant 8459needs to preserve $x since it does not know that it later gets overwritten. 8460This makes a copy of $x and takes O(N), but $x->bneg() is O(1). 8461 8462=item Mixing different object types 8463 8464With overloaded operators, it is the first (dominating) operand that determines 8465which method is called. Here are some examples showing what actually gets 8466called in various cases. 8467 8468 use Math::BigInt; 8469 use Math::BigFloat; 8470 8471 $mbf = Math::BigFloat->new(5); 8472 $mbi2 = Math::BigInt->new(5); 8473 $mbi = Math::BigInt->new(2); 8474 # what actually gets called: 8475 $float = $mbf + $mbi; # $mbf->badd($mbi) 8476 $float = $mbf / $mbi; # $mbf->bdiv($mbi) 8477 $integer = $mbi + $mbf; # $mbi->badd($mbf) 8478 $integer = $mbi2 / $mbi; # $mbi2->bdiv($mbi) 8479 $integer = $mbi2 / $mbf; # $mbi2->bdiv($mbf) 8480 8481For instance, Math::BigInt->bdiv() always returns a Math::BigInt, regardless of 8482whether the second operant is a Math::BigFloat. To get a Math::BigFloat you 8483either need to call the operation manually, make sure each operand already is a 8484Math::BigFloat, or cast to that type via Math::BigFloat->new(): 8485 8486 $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5 8487 8488Beware of casting the entire expression, as this would cast the 8489result, at which point it is too late: 8490 8491 $float = Math::BigFloat->new($mbi2 / $mbi); # = 2 8492 8493Beware also of the order of more complicated expressions like: 8494 8495 $integer = ($mbi2 + $mbi) / $mbf; # int / float => int 8496 $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto 8497 8498If in doubt, break the expression into simpler terms, or cast all operands 8499to the desired resulting type. 8500 8501Scalar values are a bit different, since: 8502 8503 $float = 2 + $mbf; 8504 $float = $mbf + 2; 8505 8506both result in the proper type due to the way the overloaded math works. 8507 8508This section also applies to other overloaded math packages, like Math::String. 8509 8510One solution to you problem might be autoupgrading|upgrading. See the 8511pragmas L<bignum>, L<bigint> and L<bigrat> for an easy way to do this. 8512 8513=back 8514 8515=head1 BUGS 8516 8517Please report any bugs or feature requests to 8518C<bug-math-bigint at rt.cpan.org>, or through the web interface at 8519L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt> (requires login). 8520We will be notified, and then you'll automatically be notified of progress on 8521your bug as I make changes. 8522 8523=head1 SUPPORT 8524 8525You can find documentation for this module with the perldoc command. 8526 8527 perldoc Math::BigInt 8528 8529You can also look for information at: 8530 8531=over 4 8532 8533=item * GitHub 8534 8535L<https://github.com/pjacklam/p5-Math-BigInt> 8536 8537=item * RT: CPAN's request tracker 8538 8539L<https://rt.cpan.org/Dist/Display.html?Name=Math-BigInt> 8540 8541=item * MetaCPAN 8542 8543L<https://metacpan.org/release/Math-BigInt> 8544 8545=item * CPAN Testers Matrix 8546 8547L<http://matrix.cpantesters.org/?dist=Math-BigInt> 8548 8549=item * CPAN Ratings 8550 8551L<https://cpanratings.perl.org/dist/Math-BigInt> 8552 8553=item * The Bignum mailing list 8554 8555=over 4 8556 8557=item * Post to mailing list 8558 8559C<bignum at lists.scsys.co.uk> 8560 8561=item * View mailing list 8562 8563L<http://lists.scsys.co.uk/pipermail/bignum/> 8564 8565=item * Subscribe/Unsubscribe 8566 8567L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum> 8568 8569=back 8570 8571=back 8572 8573=head1 LICENSE 8574 8575This program is free software; you may redistribute it and/or modify it under 8576the same terms as Perl itself. 8577 8578=head1 SEE ALSO 8579 8580L<Math::BigFloat> and L<Math::BigRat> as well as the backends 8581L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>. 8582 8583The pragmas L<bignum>, L<bigint> and L<bigrat> also might be of interest 8584because they solve the autoupgrading/downgrading issue, at least partly. 8585 8586=head1 AUTHORS 8587 8588=over 4 8589 8590=item * 8591 8592Mark Biggar, overloaded interface by Ilya Zakharevich, 1996-2001. 8593 8594=item * 8595 8596Completely rewritten by Tels L<http://bloodgate.com>, 2001-2008. 8597 8598=item * 8599 8600Florian Ragwitz E<lt>flora@cpan.orgE<gt>, 2010. 8601 8602=item * 8603 8604Peter John Acklam E<lt>pjacklam@gmail.comE<gt>, 2011-. 8605 8606=back 8607 8608Many people contributed in one or more ways to the final beast, see the file 8609CREDITS for an (incomplete) list. If you miss your name, please drop me a 8610mail. Thank you! 8611 8612=cut 8613