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