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