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