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