1# 2# "Tax the rat farms." - Lord Vetinari 3# 4 5# The following hash values are used: 6 7# sign : "+", "-", "+inf", "-inf", or "NaN" 8# _d : denominator 9# _n : numerator (value = _n/_d) 10# accuracy : accuracy 11# precision : precision 12 13# You should not look at the innards of a BigRat - use the methods for this. 14 15package Math::BigRat; 16 17use 5.006; 18use strict; 19use warnings; 20 21use Carp qw< carp croak >; 22use Scalar::Util qw< blessed >; 23 24use Math::BigFloat (); 25 26our $VERSION = '2.003002'; 27$VERSION =~ tr/_//d; 28 29our @ISA = qw(Math::BigFloat); 30 31our ($accuracy, $precision, $round_mode, $div_scale, 32 $upgrade, $downgrade, $_trap_nan, $_trap_inf); 33 34use overload 35 36 # overload key: with_assign 37 38 '+' => sub { $_[0] -> copy() -> badd($_[1]); }, 39 40 '-' => sub { my $c = $_[0] -> copy; 41 $_[2] ? $c -> bneg() -> badd( $_[1]) 42 : $c -> bsub($_[1]); }, 43 44 '*' => sub { $_[0] -> copy() -> bmul($_[1]); }, 45 46 '/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0]) 47 : $_[0] -> copy() -> bdiv($_[1]); }, 48 49 '%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0]) 50 : $_[0] -> copy() -> bmod($_[1]); }, 51 52 '**' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0]) 53 : $_[0] -> copy() -> bpow($_[1]); }, 54 55 '<<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bblsft($_[0]) 56 : $_[0] -> copy() -> bblsft($_[1]); }, 57 58 '>>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bbrsft($_[0]) 59 : $_[0] -> copy() -> bbrsft($_[1]); }, 60 61 # overload key: assign 62 63 '+=' => sub { $_[0] -> badd($_[1]); }, 64 65 '-=' => sub { $_[0] -> bsub($_[1]); }, 66 67 '*=' => sub { $_[0] -> bmul($_[1]); }, 68 69 '/=' => sub { scalar $_[0] -> bdiv($_[1]); }, 70 71 '%=' => sub { $_[0] -> bmod($_[1]); }, 72 73 '**=' => sub { $_[0] -> bpow($_[1]); }, 74 75 '<<=' => sub { $_[0] -> bblsft($_[1]); }, 76 77 '>>=' => sub { $_[0] -> bbrsft($_[1]); }, 78 79# 'x=' => sub { }, 80 81# '.=' => sub { }, 82 83 # overload key: num_comparison 84 85 '<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0]) 86 : $_[0] -> blt($_[1]); }, 87 88 '<=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0]) 89 : $_[0] -> ble($_[1]); }, 90 91 '>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0]) 92 : $_[0] -> bgt($_[1]); }, 93 94 '>=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0]) 95 : $_[0] -> bge($_[1]); }, 96 97 '==' => sub { $_[0] -> beq($_[1]); }, 98 99 '!=' => sub { $_[0] -> bne($_[1]); }, 100 101 # overload key: 3way_comparison 102 103 '<=>' => sub { my $cmp = $_[0] -> bcmp($_[1]); 104 defined($cmp) && $_[2] ? -$cmp : $cmp; }, 105 106 'cmp' => sub { $_[2] ? "$_[1]" cmp $_[0] -> bstr() 107 : $_[0] -> bstr() cmp "$_[1]"; }, 108 109 # overload key: str_comparison 110 111# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0]) 112# : $_[0] -> bstrlt($_[1]); }, 113# 114# 'le' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0]) 115# : $_[0] -> bstrle($_[1]); }, 116# 117# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0]) 118# : $_[0] -> bstrgt($_[1]); }, 119# 120# 'ge' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0]) 121# : $_[0] -> bstrge($_[1]); }, 122# 123# 'eq' => sub { $_[0] -> bstreq($_[1]); }, 124# 125# 'ne' => sub { $_[0] -> bstrne($_[1]); }, 126 127 # overload key: binary 128 129 '&' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0]) 130 : $_[0] -> copy() -> band($_[1]); }, 131 132 '&=' => sub { $_[0] -> band($_[1]); }, 133 134 '|' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0]) 135 : $_[0] -> copy() -> bior($_[1]); }, 136 137 '|=' => sub { $_[0] -> bior($_[1]); }, 138 139 '^' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0]) 140 : $_[0] -> copy() -> bxor($_[1]); }, 141 142 '^=' => sub { $_[0] -> bxor($_[1]); }, 143 144# '&.' => sub { }, 145 146# '&.=' => sub { }, 147 148# '|.' => sub { }, 149 150# '|.=' => sub { }, 151 152# '^.' => sub { }, 153 154# '^.=' => sub { }, 155 156 # overload key: unary 157 158 'neg' => sub { $_[0] -> copy() -> bneg(); }, 159 160# '!' => sub { }, 161 162 '~' => sub { $_[0] -> copy() -> bnot(); }, 163 164# '~.' => sub { }, 165 166 # overload key: mutators 167 168 '++' => sub { $_[0] -> binc() }, 169 170 '--' => sub { $_[0] -> bdec() }, 171 172 # overload key: func 173 174 'atan2' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0]) 175 : $_[0] -> copy() -> batan2($_[1]); }, 176 177 'cos' => sub { $_[0] -> copy() -> bcos(); }, 178 179 'sin' => sub { $_[0] -> copy() -> bsin(); }, 180 181 'exp' => sub { $_[0] -> copy() -> bexp($_[1]); }, 182 183 'abs' => sub { $_[0] -> copy() -> babs(); }, 184 185 'log' => sub { $_[0] -> copy() -> blog(); }, 186 187 'sqrt' => sub { $_[0] -> copy() -> bsqrt(); }, 188 189 'int' => sub { $_[0] -> copy() -> bint(); }, 190 191 # overload key: conversion 192 193 'bool' => sub { $_[0] -> is_zero() ? '' : 1; }, 194 195 '""' => sub { $_[0] -> bstr(); }, 196 197 '0+' => sub { $_[0] -> numify(); }, 198 199 '=' => sub { $_[0]->copy(); }, 200 201 ; 202 203BEGIN { 204 *objectify = \&Math::BigInt::objectify; 205 206 *AUTOLOAD = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD 207 *as_number = \&as_int; 208 *is_pos = \&is_positive; 209 *is_neg = \&is_negative; 210} 211 212############################################################################## 213# Global constants and flags. Access these only via the accessor methods! 214 215$accuracy = $precision = undef; 216$round_mode = 'even'; 217$div_scale = 40; 218$upgrade = undef; 219$downgrade = undef; 220 221# These are internally, and not to be used from the outside at all! 222 223$_trap_nan = 0; # are NaNs ok? set w/ config() 224$_trap_inf = 0; # are infs ok? set w/ config() 225 226# the math backend library 227 228my $LIB = 'Math::BigInt::Calc'; 229 230my $nan = 'NaN'; 231 232# Has import() been called yet? This variable is needed to make "require" work. 233 234my $IMPORT = 0; 235 236# Compare the following function with @ISA above. This inheritance mess needs a 237# clean up. When doing so, also consider the BEGIN block and the AUTOLOAD code. 238# Fixme! 239 240sub isa { 241 return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't 242 UNIVERSAL::isa(@_); 243} 244 245############################################################################## 246 247sub new { 248 my $proto = shift; 249 my $protoref = ref $proto; 250 my $class = $protoref || $proto; 251 252 # Make "require" work. 253 254 $class -> import() if $IMPORT == 0; 255 256 # Check the way we are called. 257 258 if ($protoref) { 259 croak("new() is a class method, not an instance method"); 260 } 261 262 if (@_ < 1) { 263 #carp("Using new() with no argument is deprecated;", 264 # " use bzero() or new(0) instead"); 265 return $class -> bzero(); 266 } 267 268 if (@_ > 2) { 269 carp("Superfluous arguments to new() ignored."); 270 } 271 272 # Get numerator and denominator. If any of the arguments is undefined, 273 # return zero. 274 275 my ($n, $d) = @_; 276 277 if (@_ == 1 && !defined $n || 278 @_ == 2 && (!defined $n || !defined $d)) 279 { 280 #carp("Use of uninitialized value in new()"); 281 return $class -> bzero(); 282 } 283 284 # Initialize a new object. 285 286 my $self = bless {}, $class; 287 288 # One or two input arguments may be given. First handle the numerator $n. 289 290 if (ref($n)) { 291 $n = Math::BigFloat -> new($n, undef, undef) 292 unless ($n -> isa('Math::BigRat') || 293 $n -> isa('Math::BigInt') || 294 $n -> isa('Math::BigFloat')); 295 } else { 296 if (defined $d) { 297 # If the denominator is defined, the numerator is not a string 298 # fraction, e.g., "355/113". 299 $n = Math::BigFloat -> new($n, undef, undef); 300 } else { 301 # If the denominator is undefined, the numerator might be a string 302 # fraction, e.g., "355/113". 303 if ($n =~ m| ^ \s* (\S+) \s* / \s* (\S+) \s* $ |x) { 304 $n = Math::BigFloat -> new($1, undef, undef); 305 $d = Math::BigFloat -> new($2, undef, undef); 306 } else { 307 $n = Math::BigFloat -> new($n, undef, undef); 308 } 309 } 310 } 311 312 # At this point $n is an object and $d is either an object or undefined. An 313 # undefined $d means that $d was not specified by the caller (not that $d 314 # was specified as an undefined value). 315 316 unless (defined $d) { 317 #return $n -> copy($n) if $n -> isa('Math::BigRat'); 318 if ($n -> isa('Math::BigRat')) { 319 return $downgrade -> new($n) 320 if defined($downgrade) && $n -> is_int(); 321 return $class -> copy($n); 322 } 323 324 if ($n -> is_nan()) { 325 return $class -> bnan(); 326 } 327 328 if ($n -> is_inf()) { 329 return $class -> binf($n -> sign()); 330 } 331 332 if ($n -> isa('Math::BigInt')) { 333 $self -> {_n} = $LIB -> _new($n -> copy() -> babs(undef, undef) 334 -> bstr()); 335 $self -> {_d} = $LIB -> _one(); 336 $self -> {sign} = $n -> sign(); 337 return $downgrade -> new($n) if defined $downgrade; 338 return $self; 339 } 340 341 if ($n -> isa('Math::BigFloat')) { 342 my $m = $n -> mantissa(undef, undef) -> babs(undef, undef); 343 my $e = $n -> exponent(undef, undef); 344 $self -> {_n} = $LIB -> _new($m -> bstr()); 345 $self -> {_d} = $LIB -> _one(); 346 347 if ($e > 0) { 348 $self -> {_n} = $LIB -> _lsft($self -> {_n}, 349 $LIB -> _new($e -> bstr()), 10); 350 } elsif ($e < 0) { 351 $self -> {_d} = $LIB -> _lsft($self -> {_d}, 352 $LIB -> _new(-$e -> bstr()), 10); 353 354 my $gcd = $LIB -> _gcd($LIB -> _copy($self -> {_n}), 355 $self -> {_d}); 356 if (!$LIB -> _is_one($gcd)) { 357 $self -> {_n} = $LIB -> _div($self->{_n}, $gcd); 358 $self -> {_d} = $LIB -> _div($self->{_d}, $gcd); 359 } 360 } 361 362 $self -> {sign} = $n -> sign(); 363 return $downgrade -> new($n, undef, undef) 364 if defined($downgrade) && $n -> is_int(); 365 return $self; 366 } 367 368 die "I don't know how to handle this"; # should never get here 369 } 370 371 # At the point we know that both $n and $d are defined. We know that $n is 372 # an object, but $d might still be a scalar. Now handle $d. 373 374 $d = Math::BigFloat -> new($d, undef, undef) 375 unless ref($d) && ($d -> isa('Math::BigRat') || 376 $d -> isa('Math::BigInt') || 377 $d -> isa('Math::BigFloat')); 378 379 # At this point both $n and $d are objects. 380 381 if ($n -> is_nan() || $d -> is_nan()) { 382 return $class -> bnan(); 383 } 384 385 # At this point neither $n nor $d is a NaN. 386 387 if ($n -> is_zero()) { 388 if ($d -> is_zero()) { # 0/0 = NaN 389 return $class -> bnan(); 390 } 391 return $class -> bzero(); 392 } 393 394 if ($d -> is_zero()) { 395 return $class -> binf($d -> sign()); 396 } 397 398 # At this point, neither $n nor $d is a NaN or a zero. 399 400 # Copy them now before manipulating them. 401 402 $n = $n -> copy(); 403 $d = $d -> copy(); 404 405 if ($d < 0) { # make sure denominator is positive 406 $n -> bneg(); 407 $d -> bneg(); 408 } 409 410 if ($n -> is_inf()) { 411 return $class -> bnan() if $d -> is_inf(); # Inf/Inf = NaN 412 return $class -> binf($n -> sign()); 413 } 414 415 # At this point $n is finite. 416 417 return $class -> bzero() if $d -> is_inf(); 418 return $class -> binf($d -> sign()) if $d -> is_zero(); 419 420 # At this point both $n and $d are finite and non-zero. 421 422 if ($n < 0) { 423 $n -> bneg(); 424 $self -> {sign} = '-'; 425 } else { 426 $self -> {sign} = '+'; 427 } 428 429 if ($n -> isa('Math::BigRat')) { 430 431 if ($d -> isa('Math::BigRat')) { 432 433 # At this point both $n and $d is a Math::BigRat. 434 435 # p r p * s (p / gcd(p, r)) * (s / gcd(s, q)) 436 # - / - = ----- = --------------------------------- 437 # q s q * r (q / gcd(s, q)) * (r / gcd(p, r)) 438 439 my $p = $n -> {_n}; 440 my $q = $n -> {_d}; 441 my $r = $d -> {_n}; 442 my $s = $d -> {_d}; 443 my $gcd_pr = $LIB -> _gcd($LIB -> _copy($p), $r); 444 my $gcd_sq = $LIB -> _gcd($LIB -> _copy($s), $q); 445 $self -> {_n} = $LIB -> _mul($LIB -> _div($LIB -> _copy($p), $gcd_pr), 446 $LIB -> _div($LIB -> _copy($s), $gcd_sq)); 447 $self -> {_d} = $LIB -> _mul($LIB -> _div($LIB -> _copy($q), $gcd_sq), 448 $LIB -> _div($LIB -> _copy($r), $gcd_pr)); 449 450 return $downgrade -> new($n->bstr()) 451 if defined($downgrade) && $self -> is_int(); 452 return $self; # no need for $self -> bnorm() here 453 } 454 455 # At this point, $n is a Math::BigRat and $d is a Math::Big(Int|Float). 456 457 my $p = $n -> {_n}; 458 my $q = $n -> {_d}; 459 my $m = $d -> mantissa(); 460 my $e = $d -> exponent(); 461 462 # / p 463 # | ------------ if e > 0 464 # | q * m * 10^e 465 # | 466 # p | p 467 # - / (m * 10^e) = | ----- if e == 0 468 # q | q * m 469 # | 470 # | p * 10^-e 471 # | -------- if e < 0 472 # \ q * m 473 474 $self -> {_n} = $LIB -> _copy($p); 475 $self -> {_d} = $LIB -> _mul($LIB -> _copy($q), $m); 476 if ($e > 0) { 477 $self -> {_d} = $LIB -> _lsft($self -> {_d}, $e, 10); 478 } elsif ($e < 0) { 479 $self -> {_n} = $LIB -> _lsft($self -> {_n}, -$e, 10); 480 } 481 482 return $self -> bnorm(); 483 484 } else { 485 486 if ($d -> isa('Math::BigRat')) { 487 488 # At this point $n is a Math::Big(Int|Float) and $d is a 489 # Math::BigRat. 490 491 my $m = $n -> mantissa(); 492 my $e = $n -> exponent(); 493 my $p = $d -> {_n}; 494 my $q = $d -> {_d}; 495 496 # / q * m * 10^e 497 # | ------------ if e > 0 498 # | p 499 # | 500 # p | m * q 501 # (m * 10^e) / - = | ----- if e == 0 502 # q | p 503 # | 504 # | q * m 505 # | --------- if e < 0 506 # \ p * 10^-e 507 508 $self -> {_n} = $LIB -> _mul($LIB -> _copy($q), $m); 509 $self -> {_d} = $LIB -> _copy($p); 510 if ($e > 0) { 511 $self -> {_n} = $LIB -> _lsft($self -> {_n}, $e, 10); 512 } elsif ($e < 0) { 513 $self -> {_d} = $LIB -> _lsft($self -> {_d}, -$e, 10); 514 } 515 return $self -> bnorm(); 516 517 } else { 518 519 # At this point $n and $d are both a Math::Big(Int|Float) 520 521 my $m1 = $n -> mantissa(); 522 my $e1 = $n -> exponent(); 523 my $m2 = $d -> mantissa(); 524 my $e2 = $d -> exponent(); 525 526 # / 527 # | m1 * 10^(e1 - e2) 528 # | ----------------- if e1 > e2 529 # | m2 530 # | 531 # m1 * 10^e1 | m1 532 # ---------- = | -- if e1 = e2 533 # m2 * 10^e2 | m2 534 # | 535 # | m1 536 # | ----------------- if e1 < e2 537 # | m2 * 10^(e2 - e1) 538 # \ 539 540 $self -> {_n} = $LIB -> _new($m1 -> bstr()); 541 $self -> {_d} = $LIB -> _new($m2 -> bstr()); 542 my $ediff = $e1 - $e2; 543 if ($ediff > 0) { 544 $self -> {_n} = $LIB -> _lsft($self -> {_n}, 545 $LIB -> _new($ediff -> bstr()), 546 10); 547 } elsif ($ediff < 0) { 548 $self -> {_d} = $LIB -> _lsft($self -> {_d}, 549 $LIB -> _new(-$ediff -> bstr()), 550 10); 551 } 552 553 return $self -> bnorm(); 554 } 555 } 556 557 return $downgrade -> new($self -> bstr()) 558 if defined($downgrade) && $self -> is_int(); 559 return $self; 560} 561 562sub copy { 563 my $self = shift; 564 my $selfref = ref $self; 565 my $class = $selfref || $self; 566 567 # If called as a class method, the object to copy is the next argument. 568 569 $self = shift() unless $selfref; 570 571 my $copy = bless {}, $class; 572 573 $copy->{sign} = $self->{sign}; 574 $copy->{_d} = $LIB->_copy($self->{_d}); 575 $copy->{_n} = $LIB->_copy($self->{_n}); 576 $copy->{accuracy} = $self->{accuracy} if defined $self->{accuracy}; 577 $copy->{precision} = $self->{precision} if defined $self->{precision}; 578 579 #($copy, $copy->{accuracy}, $copy->{precision}) 580 # = $copy->_find_round_parameters(@_); 581 582 return $copy; 583} 584 585sub bnan { 586 my $self = shift; 587 my $selfref = ref $self; 588 my $class = $selfref || $self; 589 590 # Make "require" work. 591 592 $class -> import() if $IMPORT == 0; 593 594 $self = bless {}, $class unless $selfref; 595 596 if ($_trap_nan) { 597 croak ("Tried to set a variable to NaN in $class->bnan()"); 598 } 599 600 return $downgrade -> bnan() if defined $downgrade; 601 602 $self -> {sign} = $nan; 603 $self -> {_n} = $LIB -> _zero(); 604 $self -> {_d} = $LIB -> _one(); 605 606 ($self, $self->{accuracy}, $self->{precision}) 607 = $self->_find_round_parameters(@_); 608 609 return $self; 610} 611 612sub binf { 613 my $self = shift; 614 my $selfref = ref $self; 615 my $class = $selfref || $self; 616 617 # Make "require" work. 618 619 $class -> import() if $IMPORT == 0; 620 621 $self = bless {}, $class unless $selfref; 622 623 my $sign = shift(); 624 $sign = defined($sign) && substr($sign, 0, 1) eq '-' ? '-inf' : '+inf'; 625 626 if ($_trap_inf) { 627 croak ("Tried to set a variable to +-inf in $class->binf()"); 628 } 629 630 return $downgrade -> binf($sign) if defined $downgrade; 631 632 $self -> {sign} = $sign; 633 $self -> {_n} = $LIB -> _zero(); 634 $self -> {_d} = $LIB -> _one(); 635 636 ($self, $self->{accuracy}, $self->{precision}) 637 = $self->_find_round_parameters(@_); 638 639 return $self; 640} 641 642sub bone { 643 my $self = shift; 644 my $selfref = ref $self; 645 my $class = $selfref || $self; 646 647 # Make "require" work. 648 649 $class -> import() if $IMPORT == 0; 650 651 my $sign = shift(); 652 $sign = '+' unless defined($sign) && $sign eq '-'; 653 654 return $downgrade -> bone($sign) if defined $downgrade; 655 656 $self = bless {}, $class unless $selfref; 657 $self -> {sign} = $sign; 658 $self -> {_n} = $LIB -> _one(); 659 $self -> {_d} = $LIB -> _one(); 660 661 ($self, $self->{accuracy}, $self->{precision}) 662 = $self->_find_round_parameters(@_); 663 664 return $self; 665} 666 667sub bzero { 668 my $self = shift; 669 my $selfref = ref $self; 670 my $class = $selfref || $self; 671 672 # Make "require" work. 673 674 $class -> import() if $IMPORT == 0; 675 676 return $downgrade -> bzero() if defined $downgrade; 677 678 $self = bless {}, $class unless $selfref; 679 $self -> {sign} = '+'; 680 $self -> {_n} = $LIB -> _zero(); 681 $self -> {_d} = $LIB -> _one(); 682 683 ($self, $self->{accuracy}, $self->{precision}) 684 = $self->_find_round_parameters(@_); 685 686 return $self; 687} 688 689############################################################################## 690 691sub config { 692 # return (later set?) configuration data as hash ref 693 my $class = shift() || 'Math::BigRat'; 694 695 if (@_ == 1 && ref($_[0]) ne 'HASH') { 696 my $cfg = $class->SUPER::config(); 697 return $cfg->{$_[0]}; 698 } 699 700 my $cfg = $class->SUPER::config(@_); 701 702 # now we need only to override the ones that are different from our parent 703 $cfg->{class} = $class; 704 $cfg->{with} = $LIB; 705 706 $cfg; 707} 708 709############################################################################### 710# String conversion methods 711############################################################################### 712 713sub bstr { 714 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); 715 716 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 717 718 # Inf and NaN 719 720 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 721 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 722 return 'inf'; # +inf 723 } 724 725 # Upgrade? 726 727 return $upgrade -> bstr($x, @r) 728 if defined($upgrade) && !$x -> isa($class); 729 730 # Finite number 731 732 my $s = ''; 733 $s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2' 734 735 my $str = $x->{sign} eq '-' ? '-' : ''; 736 $str .= $LIB->_str($x->{_n}); 737 $str .= '/' . $LIB->_str($x->{_d}) unless $LIB -> _is_one($x->{_d}); 738 return $str; 739} 740 741sub bsstr { 742 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); 743 744 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 745 746 # Inf and NaN 747 748 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 749 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 750 return 'inf'; # +inf 751 } 752 753 # Upgrade? 754 755 return $upgrade -> bsstr($x, @r) 756 if defined($upgrade) && !$x -> isa($class); 757 758 # Finite number 759 760 my $str = $x->{sign} eq '-' ? '-' : ''; 761 $str .= $LIB->_str($x->{_n}); 762 $str .= '/' . $LIB->_str($x->{_d}) unless $LIB -> _is_one($x->{_d}); 763 return $str; 764} 765 766sub bfstr { 767 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); 768 769 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 770 771 # Inf and NaN 772 773 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 774 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 775 return 'inf'; # +inf 776 } 777 778 # Upgrade? 779 780 return $upgrade -> bfstr($x, @r) 781 if defined($upgrade) && !$x -> isa($class); 782 783 # Finite number 784 785 my $str = $x->{sign} eq '-' ? '-' : ''; 786 $str .= $LIB->_str($x->{_n}); 787 $str .= '/' . $LIB->_str($x->{_d}) unless $LIB -> _is_one($x->{_d}); 788 return $str; 789} 790 791sub bnorm { 792 # reduce the number to the shortest form 793 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 794 795 # Both parts must be objects of whatever we are using today. 796 if (my $c = $LIB->_check($x->{_n})) { 797 croak("n did not pass the self-check ($c) in bnorm()"); 798 } 799 if (my $c = $LIB->_check($x->{_d})) { 800 croak("d did not pass the self-check ($c) in bnorm()"); 801 } 802 803 # no normalize for NaN, inf etc. 804 if ($x->{sign} !~ /^[+-]$/) { 805 return $downgrade -> new($x) if defined $downgrade; 806 return $x; 807 } 808 809 # normalize zeros to 0/1 810 if ($LIB->_is_zero($x->{_n})) { 811 return $downgrade -> bzero() if defined($downgrade); 812 $x->{sign} = '+'; # never leave a -0 813 $x->{_d} = $LIB->_one() unless $LIB->_is_one($x->{_d}); 814 return $x; 815 } 816 817 # n/1 818 if ($LIB->_is_one($x->{_d})) { 819 return $downgrade -> new($x) if defined($downgrade); 820 return $x; # no need to reduce 821 } 822 823 # Compute the GCD. 824 my $gcd = $LIB->_gcd($LIB->_copy($x->{_n}), $x->{_d}); 825 if (!$LIB->_is_one($gcd)) { 826 $x->{_n} = $LIB->_div($x->{_n}, $gcd); 827 $x->{_d} = $LIB->_div($x->{_d}, $gcd); 828 } 829 830 $x; 831} 832 833############################################################################## 834# sign manipulation 835 836sub bneg { 837 # (BRAT or num_str) return BRAT 838 # negate number or make a negated number from string 839 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 840 841 return $x if $x->modify('bneg'); 842 843 # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN' 844 $x->{sign} =~ tr/+-/-+/ 845 unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_n})); 846 847 return $downgrade -> new($x) 848 if defined($downgrade) && $LIB -> _is_one($x->{_d}); 849 $x; 850} 851 852############################################################################## 853# mul/add/div etc 854 855sub badd { 856 # add two rational numbers 857 858 # set up parameters 859 my ($class, $x, $y, @r) = (ref($_[0]), @_); 860 # objectify is costly, so avoid it 861 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 862 ($class, $x, $y, @r) = objectify(2, @_); 863 } 864 865 unless ($x -> is_finite() && $y -> is_finite()) { 866 if ($x -> is_nan() || $y -> is_nan()) { 867 return $x -> bnan(@r); 868 } elsif ($x -> is_inf("+")) { 869 return $x -> bnan(@r) if $y -> is_inf("-"); 870 return $x -> binf("+", @r); 871 } elsif ($x -> is_inf("-")) { 872 return $x -> bnan(@r) if $y -> is_inf("+"); 873 return $x -> binf("-", @r); 874 } elsif ($y -> is_inf("+")) { 875 return $x -> binf("+", @r); 876 } elsif ($y -> is_inf("-")) { 877 return $x -> binf("-", @r); 878 } 879 } 880 881 # 1 1 gcd(3, 4) = 1 1*3 + 1*4 7 882 # - + - = --------- = -- 883 # 4 3 4*3 12 884 885 # we do not compute the gcd() here, but simple do: 886 # 5 7 5*3 + 7*4 43 887 # - + - = --------- = -- 888 # 4 3 4*3 12 889 890 # and bnorm() will then take care of the rest 891 892 # 5 * 3 893 $x->{_n} = $LIB->_mul($x->{_n}, $y->{_d}); 894 895 # 7 * 4 896 my $m = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d}); 897 898 # 5 * 3 + 7 * 4 899 ($x->{_n}, $x->{sign}) = $LIB -> _sadd($x->{_n}, $x->{sign}, $m, $y->{sign}); 900 901 # 4 * 3 902 $x->{_d} = $LIB->_mul($x->{_d}, $y->{_d}); 903 904 # normalize result, and possible round 905 $x->bnorm()->round(@r); 906} 907 908sub bsub { 909 # subtract two rational numbers 910 911 # set up parameters 912 my ($class, $x, $y, @r) = (ref($_[0]), @_); 913 # objectify is costly, so avoid it 914 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 915 ($class, $x, $y, @r) = objectify(2, @_); 916 } 917 918 # flip sign of $x, call badd(), then flip sign of result 919 $x->{sign} =~ tr/+-/-+/ 920 unless $x->{sign} eq '+' && $x -> is_zero(); # not -0 921 $x = $x->badd($y, @r); # does norm and round 922 $x->{sign} =~ tr/+-/-+/ 923 unless $x->{sign} eq '+' && $x -> is_zero(); # not -0 924 925 $x->bnorm(); 926} 927 928sub bmul { 929 # multiply two rational numbers 930 931 # set up parameters 932 my ($class, $x, $y, @r) = (ref($_[0]), @_); 933 # objectify is costly, so avoid it 934 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 935 ($class, $x, $y, @r) = objectify(2, @_); 936 } 937 938 return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'; 939 940 # inf handling 941 if ($x->{sign} =~ /^[+-]inf$/ || $y->{sign} =~ /^[+-]inf$/) { 942 return $x->bnan() if $x->is_zero() || $y->is_zero(); 943 # result will always be +-inf: 944 # +inf * +/+inf => +inf, -inf * -/-inf => +inf 945 # +inf * -/-inf => -inf, -inf * +/+inf => -inf 946 return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); 947 return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); 948 return $x->binf('-'); 949 } 950 951 # x == 0 # also: or y == 1 or y == -1 952 if ($x -> is_zero()) { 953 $x = $downgrade -> bzero($x) if defined $downgrade; 954 return wantarray ? ($x, $class->bzero()) : $x; 955 } 956 957 if ($y -> is_zero()) { 958 $x = defined($downgrade) ? $downgrade -> bzero($x) : $x -> bzero(); 959 return wantarray ? ($x, $class->bzero()) : $x; 960 } 961 962 # According to Knuth, this can be optimized by doing gcd twice (for d 963 # and n) and reducing in one step. This saves us a bnorm() at the end. 964 # 965 # p s p * s (p / gcd(p, r)) * (s / gcd(s, q)) 966 # - * - = ----- = --------------------------------- 967 # q r q * r (q / gcd(s, q)) * (r / gcd(p, r)) 968 969 my $gcd_pr = $LIB -> _gcd($LIB -> _copy($x->{_n}), $y->{_d}); 970 my $gcd_sq = $LIB -> _gcd($LIB -> _copy($y->{_n}), $x->{_d}); 971 972 $x->{_n} = $LIB -> _mul(scalar $LIB -> _div($x->{_n}, $gcd_pr), 973 scalar $LIB -> _div($LIB -> _copy($y->{_n}), 974 $gcd_sq)); 975 $x->{_d} = $LIB -> _mul(scalar $LIB -> _div($x->{_d}, $gcd_sq), 976 scalar $LIB -> _div($LIB -> _copy($y->{_d}), 977 $gcd_pr)); 978 979 # compute new sign 980 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; 981 982 $x->bnorm()->round(@r); 983} 984 985sub bdiv { 986 # (dividend: BRAT or num_str, divisor: BRAT or num_str) return 987 # (BRAT, BRAT) (quo, rem) or BRAT (only rem) 988 989 # set up parameters 990 my ($class, $x, $y, @r) = (ref($_[0]), @_); 991 # objectify is costly, so avoid it 992 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 993 ($class, $x, $y, @r) = objectify(2, @_); 994 } 995 996 return $x if $x->modify('bdiv'); 997 998 my $wantarray = wantarray; # call only once 999 1000 # At least one argument is NaN. This is handled the same way as in 1001 # Math::BigInt -> bdiv(). See the comments in the code implementing that 1002 # method. 1003 1004 if ($x -> is_nan() || $y -> is_nan()) { 1005 if ($wantarray) { 1006 return $downgrade -> bnan(), $downgrade -> bnan() 1007 if defined($downgrade); 1008 return $x -> bnan(), $class -> bnan(); 1009 } else { 1010 return $downgrade -> bnan() 1011 if defined($downgrade); 1012 return $x -> bnan(); 1013 } 1014 } 1015 1016 # Divide by zero and modulo zero. This is handled the same way as in 1017 # Math::BigInt -> bdiv(). See the comments in the code implementing that 1018 # method. 1019 1020 if ($y -> is_zero()) { 1021 my ($quo, $rem); 1022 if ($wantarray) { 1023 $rem = $x -> copy(); 1024 } 1025 if ($x -> is_zero()) { 1026 $quo = $x -> bnan(); 1027 } else { 1028 $quo = $x -> binf($x -> {sign}); 1029 } 1030 1031 $quo = $downgrade -> new($quo) 1032 if defined($downgrade) && $quo -> is_int(); 1033 $rem = $downgrade -> new($rem) 1034 if $wantarray && defined($downgrade) && $rem -> is_int(); 1035 return $wantarray ? ($quo, $rem) : $quo; 1036 } 1037 1038 # Numerator (dividend) is +/-inf. This is handled the same way as in 1039 # Math::BigInt -> bdiv(). See the comments in the code implementing that 1040 # method. 1041 1042 if ($x -> is_inf()) { 1043 my ($quo, $rem); 1044 $rem = $class -> bnan() if $wantarray; 1045 if ($y -> is_inf()) { 1046 $quo = $x -> bnan(); 1047 } else { 1048 my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-'; 1049 $quo = $x -> binf($sign); 1050 } 1051 1052 $quo = $downgrade -> new($quo) 1053 if defined($downgrade) && $quo -> is_int(); 1054 $rem = $downgrade -> new($rem) 1055 if $wantarray && defined($downgrade) && $rem -> is_int(); 1056 return $wantarray ? ($quo, $rem) : $quo; 1057 } 1058 1059 # Denominator (divisor) is +/-inf. This is handled the same way as in 1060 # Math::BigFloat -> bdiv(). See the comments in the code implementing that 1061 # method. 1062 1063 if ($y -> is_inf()) { 1064 my ($quo, $rem); 1065 if ($wantarray) { 1066 if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { 1067 $rem = $x -> copy(); 1068 $quo = $x -> bzero(); 1069 } else { 1070 $rem = $class -> binf($y -> {sign}); 1071 $quo = $x -> bone('-'); 1072 } 1073 $quo = $downgrade -> new($quo) 1074 if defined($downgrade) && $quo -> is_int(); 1075 $rem = $downgrade -> new($rem) 1076 if defined($downgrade) && $rem -> is_int(); 1077 return ($quo, $rem); 1078 } else { 1079 if ($y -> is_inf()) { 1080 if ($x -> is_nan() || $x -> is_inf()) { 1081 return $downgrade -> bnan() if defined $downgrade; 1082 return $x -> bnan(); 1083 } else { 1084 return $downgrade -> bzero() if defined $downgrade; 1085 return $x -> bzero(); 1086 } 1087 } 1088 } 1089 } 1090 1091 # At this point, both the numerator and denominator are finite numbers, and 1092 # the denominator (divisor) is non-zero. 1093 1094 # x == 0? 1095 if ($x->is_zero()) { 1096 return $wantarray ? ($downgrade -> bzero(), $downgrade -> bzero()) 1097 : $downgrade -> bzero() if defined $downgrade; 1098 return $wantarray ? ($x, $class->bzero()) : $x; 1099 } 1100 1101 # XXX TODO: list context, upgrade 1102 # According to Knuth, this can be optimized by doing gcd twice (for d and n) 1103 # and reducing in one step. This would save us the bnorm() at the end. 1104 # 1105 # p r p * s (p / gcd(p, r)) * (s / gcd(s, q)) 1106 # - / - = ----- = --------------------------------- 1107 # q s q * r (q / gcd(s, q)) * (r / gcd(p, r)) 1108 1109 $x->{_n} = $LIB->_mul($x->{_n}, $y->{_d}); 1110 $x->{_d} = $LIB->_mul($x->{_d}, $y->{_n}); 1111 1112 # compute new sign 1113 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; 1114 1115 $x -> bnorm(); 1116 if (wantarray) { 1117 my $rem = $x -> copy(); 1118 $x = $x -> bfloor(); 1119 $x = $x -> round(@r); 1120 $rem = $rem -> bsub($x -> copy()) -> bmul($y); 1121 $x = $downgrade -> new($x) if defined($downgrade) && $x -> is_int(); 1122 $rem = $downgrade -> new($rem) if defined($downgrade) && $rem -> is_int(); 1123 return $x, $rem; 1124 } else { 1125 return $x -> round(@r); 1126 } 1127} 1128 1129sub bmod { 1130 # compute "remainder" (in Perl way) of $x / $y 1131 1132 # set up parameters 1133 my ($class, $x, $y, @r) = (ref($_[0]), @_); 1134 # objectify is costly, so avoid it 1135 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 1136 ($class, $x, $y, @r) = objectify(2, @_); 1137 } 1138 1139 return $x if $x->modify('bmod'); 1140 1141 # At least one argument is NaN. This is handled the same way as in 1142 # Math::BigInt -> bmod(). 1143 1144 if ($x -> is_nan() || $y -> is_nan()) { 1145 return $x -> bnan(); 1146 } 1147 1148 # Modulo zero. This is handled the same way as in Math::BigInt -> bmod(). 1149 1150 if ($y -> is_zero()) { 1151 return $downgrade -> bzero() if defined $downgrade; 1152 return $x; 1153 } 1154 1155 # Numerator (dividend) is +/-inf. This is handled the same way as in 1156 # Math::BigInt -> bmod(). 1157 1158 if ($x -> is_inf()) { 1159 return $x -> bnan(); 1160 } 1161 1162 # Denominator (divisor) is +/-inf. This is handled the same way as in 1163 # Math::BigInt -> bmod(). 1164 1165 if ($y -> is_inf()) { 1166 if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { 1167 return $downgrade -> new($x) if defined($downgrade) && $x -> is_int(); 1168 return $x; 1169 } else { 1170 return $downgrade -> binf($y -> sign()) if defined($downgrade); 1171 return $x -> binf($y -> sign()); 1172 } 1173 } 1174 1175 # At this point, both the numerator and denominator are finite numbers, and 1176 # the denominator (divisor) is non-zero. 1177 1178 if ($x->is_zero()) { # 0 / 7 = 0, mod 0 1179 return $downgrade -> bzero() if defined $downgrade; 1180 return $x; 1181 } 1182 1183 # Compute $x - $y * floor($x/$y). This can probably be optimized by working 1184 # on a lower level. 1185 1186 $x -> bsub($x -> copy() -> bdiv($y) -> bfloor() -> bmul($y)); 1187 return $x -> round(@r); 1188} 1189 1190############################################################################## 1191# bdec/binc 1192 1193sub bdec { 1194 # decrement value (subtract 1) 1195 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1196 1197 if ($x->{sign} !~ /^[+-]$/) { # NaN, inf, -inf 1198 return $downgrade -> new($x) if defined $downgrade; 1199 return $x; 1200 } 1201 1202 if ($x->{sign} eq '-') { 1203 $x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # -5/2 => -7/2 1204 } else { 1205 if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) # n < d? 1206 { 1207 # 1/3 -- => -2/3 1208 $x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n}); 1209 $x->{sign} = '-'; 1210 } else { 1211 $x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2 1212 } 1213 } 1214 $x->bnorm()->round(@r); 1215} 1216 1217sub binc { 1218 # increment value (add 1) 1219 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1220 1221 if ($x->{sign} !~ /^[+-]$/) { # NaN, inf, -inf 1222 return $downgrade -> new($x) if defined $downgrade; 1223 return $x; 1224 } 1225 1226 if ($x->{sign} eq '-') { 1227 if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) { 1228 # -1/3 ++ => 2/3 (overflow at 0) 1229 $x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n}); 1230 $x->{sign} = '+'; 1231 } else { 1232 $x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2 1233 } 1234 } else { 1235 $x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # 5/2 => 7/2 1236 } 1237 $x->bnorm()->round(@r); 1238} 1239 1240sub binv { 1241 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); 1242 1243 return $x if $x -> modify('binv'); 1244 1245 return $x -> round(@r) if $x -> is_nan(); 1246 return $x -> bzero(@r) if $x -> is_inf(); 1247 return $x -> binf("+", @r) if $x -> is_zero(); 1248 1249 ($x -> {_n}, $x -> {_d}) = ($x -> {_d}, $x -> {_n}); 1250 $x -> round(@r); 1251} 1252 1253############################################################################## 1254# is_foo methods (the rest is inherited) 1255 1256sub is_int { 1257 # return true if arg (BRAT or num_str) is an integer 1258 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 1259 1260 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't 1261 $LIB->_is_one($x->{_d}); # x/y && y != 1 => no integer 1262 0; 1263} 1264 1265sub is_zero { 1266 # return true if arg (BRAT or num_str) is zero 1267 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 1268 1269 return 1 if $x->{sign} eq '+' && $LIB->_is_zero($x->{_n}); 1270 0; 1271} 1272 1273sub is_one { 1274 # return true if arg (BRAT or num_str) is +1 or -1 if signis given 1275 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 1276 1277 croak "too many arguments for is_one()" if @_ > 2; 1278 my $sign = $_[1] || ''; 1279 $sign = '+' if $sign ne '-'; 1280 return 1 if ($x->{sign} eq $sign && 1281 $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d})); 1282 0; 1283} 1284 1285sub is_odd { 1286 # return true if arg (BFLOAT or num_str) is odd or false if even 1287 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 1288 1289 return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't 1290 ($LIB->_is_one($x->{_d}) && $LIB->_is_odd($x->{_n})); # x/2 is not, but 3/1 1291 0; 1292} 1293 1294sub is_even { 1295 # return true if arg (BINT or num_str) is even or false if odd 1296 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 1297 1298 return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't 1299 return 1 if ($LIB->_is_one($x->{_d}) # x/3 is never 1300 && $LIB->_is_even($x->{_n})); # but 4/1 is 1301 0; 1302} 1303 1304############################################################################## 1305# parts() and friends 1306 1307sub numerator { 1308 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); 1309 1310 # NaN, inf, -inf 1311 return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/); 1312 1313 my $n = Math::BigInt->new($LIB->_str($x->{_n})); 1314 $n->{sign} = $x->{sign}; 1315 $n; 1316} 1317 1318sub denominator { 1319 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); 1320 1321 # NaN 1322 return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN'; 1323 # inf, -inf 1324 return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/; 1325 1326 Math::BigInt->new($LIB->_str($x->{_d})); 1327} 1328 1329sub parts { 1330 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); 1331 1332 my $c = 'Math::BigInt'; 1333 1334 return ($c->bnan(), $c->bnan()) if $x->{sign} eq 'NaN'; 1335 return ($c->binf(), $c->binf()) if $x->{sign} eq '+inf'; 1336 return ($c->binf('-'), $c->binf()) if $x->{sign} eq '-inf'; 1337 1338 my $n = $c->new($LIB->_str($x->{_n})); 1339 $n->{sign} = $x->{sign}; 1340 my $d = $c->new($LIB->_str($x->{_d})); 1341 ($n, $d); 1342} 1343 1344sub dparts { 1345 my $x = shift; 1346 my $class = ref $x; 1347 1348 croak("dparts() is an instance method") unless $class; 1349 1350 if ($x -> is_nan()) { 1351 return $class -> bnan(), $class -> bnan() if wantarray; 1352 return $class -> bnan(); 1353 } 1354 1355 if ($x -> is_inf()) { 1356 return $class -> binf($x -> sign()), $class -> bzero() if wantarray; 1357 return $class -> binf($x -> sign()); 1358 } 1359 1360 # 355/113 => 3 + 16/113 1361 1362 my ($q, $r) = $LIB -> _div($LIB -> _copy($x -> {_n}), $x -> {_d}); 1363 1364 my $int = Math::BigRat -> new($x -> {sign} . $LIB -> _str($q)); 1365 return $int unless wantarray; 1366 1367 my $frc = Math::BigRat -> new($x -> {sign} . $LIB -> _str($r), 1368 $LIB -> _str($x -> {_d})); 1369 1370 return $int, $frc; 1371} 1372 1373sub fparts { 1374 my $x = shift; 1375 my $class = ref $x; 1376 1377 croak("fparts() is an instance method") unless $class; 1378 1379 return ($class -> bnan(), 1380 $class -> bnan()) if $x -> is_nan(); 1381 1382 my $numer = $x -> copy(); 1383 my $denom = $class -> bzero(); 1384 1385 $denom -> {_n} = $numer -> {_d}; 1386 $numer -> {_d} = $LIB -> _one(); 1387 1388 return ($numer, $denom); 1389} 1390 1391sub length { 1392 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 1393 1394 return $nan unless $x->is_int(); 1395 $LIB->_len($x->{_n}); # length(-123/1) => length(123) 1396} 1397 1398sub digit { 1399 my ($class, $x, $n) = ref($_[0]) ? (undef, $_[0], $_[1]) : objectify(1, @_); 1400 1401 return $nan unless $x->is_int(); 1402 $LIB->_digit($x->{_n}, $n || 0); # digit(-123/1, 2) => digit(123, 2) 1403} 1404 1405############################################################################## 1406# special calc routines 1407 1408sub bceil { 1409 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); 1410 1411 if ($x->{sign} !~ /^[+-]$/ || # NaN or inf or 1412 $LIB->_is_one($x->{_d})) # integer 1413 { 1414 return $downgrade -> new($x) if defined $downgrade; 1415 return $x; 1416 } 1417 1418 $x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate 1419 $x->{_d} = $LIB->_one(); # d => 1 1420 $x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '+'; # +22/7 => 4/1 1421 $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_zero($x->{_n}); # -0 => 0 1422 return $downgrade -> new($x) if defined $downgrade; 1423 $x; 1424} 1425 1426sub bfloor { 1427 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); 1428 1429 if ($x->{sign} !~ /^[+-]$/ || # NaN or inf or 1430 $LIB->_is_one($x->{_d})) # integer 1431 { 1432 return $downgrade -> new($x) if defined $downgrade; 1433 return $x; 1434 } 1435 1436 $x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate 1437 $x->{_d} = $LIB->_one(); # d => 1 1438 $x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '-'; # -22/7 => -4/1 1439 return $downgrade -> new($x) if defined $downgrade; 1440 $x; 1441} 1442 1443sub bint { 1444 my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); 1445 1446 if ($x->{sign} !~ /^[+-]$/ || # NaN or inf or 1447 $LIB->_is_one($x->{_d})) # integer 1448 { 1449 return $downgrade -> new($x) if defined $downgrade; 1450 return $x; 1451 } 1452 1453 $x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate 1454 $x->{_d} = $LIB->_one(); # d => 1 1455 $x->{sign} = '+' if $x->{sign} eq '-' && $LIB -> _is_zero($x->{_n}); 1456 return $downgrade -> new($x) if defined $downgrade; 1457 return $x; 1458} 1459 1460sub bfac { 1461 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1462 1463 # if $x is not an integer 1464 if (($x->{sign} ne '+') || (!$LIB->_is_one($x->{_d}))) { 1465 return $x->bnan(); 1466 } 1467 1468 $x->{_n} = $LIB->_fac($x->{_n}); 1469 # since _d is 1, we don't need to reduce/norm the result 1470 $x->round(@r); 1471} 1472 1473sub bpow { 1474 # power ($x ** $y) 1475 1476 # set up parameters 1477 my ($class, $x, $y, @r) = (ref($_[0]), @_); 1478 1479 # objectify is costly, so avoid it 1480 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 1481 ($class, $x, $y, @r) = objectify(2, @_); 1482 } 1483 1484 return $x if $x->modify('bpow'); 1485 1486 # $x and/or $y is a NaN 1487 return $x->bnan() if $x->is_nan() || $y->is_nan(); 1488 1489 # $x and/or $y is a +/-Inf 1490 if ($x->is_inf("-")) { 1491 return $x->bzero() if $y->is_negative(); 1492 return $x->bnan() if $y->is_zero(); 1493 return $x if $y->is_odd(); 1494 return $x->bneg(); 1495 } elsif ($x->is_inf("+")) { 1496 return $x->bzero() if $y->is_negative(); 1497 return $x->bnan() if $y->is_zero(); 1498 return $x; 1499 } elsif ($y->is_inf("-")) { 1500 return $x->bnan() if $x -> is_one("-"); 1501 return $x->binf("+") if $x > -1 && $x < 1; 1502 return $x->bone() if $x -> is_one("+"); 1503 return $x->bzero(); 1504 } elsif ($y->is_inf("+")) { 1505 return $x->bnan() if $x -> is_one("-"); 1506 return $x->bzero() if $x > -1 && $x < 1; 1507 return $x->bone() if $x -> is_one("+"); 1508 return $x->binf("+"); 1509 } 1510 1511 if ($x -> is_zero()) { 1512 return $x -> bone() if $y -> is_zero(); 1513 return $x -> binf() if $y -> is_negative(); 1514 return $x; 1515 } 1516 1517 # We don't support complex numbers, so upgrade or return NaN. 1518 1519 if ($x -> is_negative() && !$y -> is_int()) { 1520 return $upgrade -> bpow($upgrade -> new($x), $y, @r) 1521 if defined $upgrade; 1522 return $x -> bnan(); 1523 } 1524 1525 if ($x -> is_one("+") || $y -> is_one()) { 1526 return $x; 1527 } 1528 1529 if ($x -> is_one("-")) { 1530 return $x if $y -> is_odd(); 1531 return $x -> bneg(); 1532 } 1533 1534 # (a/b)^-(c/d) = (b/a)^(c/d) 1535 ($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}) if $y->is_negative(); 1536 1537 unless ($LIB->_is_one($y->{_n})) { 1538 $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n}); 1539 $x->{_d} = $LIB->_pow($x->{_d}, $y->{_n}); 1540 $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_even($y->{_n}); 1541 } 1542 1543 unless ($LIB->_is_one($y->{_d})) { 1544 return $x->bsqrt(@r) if $LIB->_is_two($y->{_d}); # 1/2 => sqrt 1545 return $x->broot($LIB->_str($y->{_d}), @r); # 1/N => root(N) 1546 } 1547 1548 return $x->round(@r); 1549} 1550 1551sub blog { 1552 # Return the logarithm of the operand. If a second operand is defined, that 1553 # value is used as the base, otherwise the base is assumed to be Euler's 1554 # constant. 1555 1556 my ($class, $x, $base, @r); 1557 1558 # Don't objectify the base, since an undefined base, as in $x->blog() or 1559 # $x->blog(undef) signals that the base is Euler's number. 1560 1561 if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) { 1562 # E.g., Math::BigRat->blog(256, 2) 1563 ($class, $x, $base, @r) = 1564 defined $_[2] ? objectify(2, @_) : objectify(1, @_); 1565 } else { 1566 # E.g., Math::BigRat::blog(256, 2) or $x->blog(2) 1567 ($class, $x, $base, @r) = 1568 defined $_[1] ? objectify(2, @_) : objectify(1, @_); 1569 } 1570 1571 return $x if $x->modify('blog'); 1572 1573 # Handle all exception cases and all trivial cases. I have used Wolfram Alpha 1574 # (http://www.wolframalpha.com) as the reference for these cases. 1575 1576 return $x -> bnan() if $x -> is_nan(); 1577 1578 if (defined $base) { 1579 $base = $class -> new($base) unless ref $base; 1580 if ($base -> is_nan() || $base -> is_one()) { 1581 return $x -> bnan(); 1582 } elsif ($base -> is_inf() || $base -> is_zero()) { 1583 return $x -> bnan() if $x -> is_inf() || $x -> is_zero(); 1584 return $x -> bzero(); 1585 } elsif ($base -> is_negative()) { # -inf < base < 0 1586 return $x -> bzero() if $x -> is_one(); # x = 1 1587 return $x -> bone() if $x == $base; # x = base 1588 return $x -> bnan(); # otherwise 1589 } 1590 return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf 1591 } 1592 1593 # We now know that the base is either undefined or positive and finite. 1594 1595 if ($x -> is_inf()) { # x = +/-inf 1596 my $sign = defined $base && $base < 1 ? '-' : '+'; 1597 return $x -> binf($sign); 1598 } elsif ($x -> is_neg()) { # -inf < x < 0 1599 return $x -> bnan(); 1600 } elsif ($x -> is_one()) { # x = 1 1601 return $x -> bzero(); 1602 } elsif ($x -> is_zero()) { # x = 0 1603 my $sign = defined $base && $base < 1 ? '+' : '-'; 1604 return $x -> binf($sign); 1605 } 1606 1607 # Now take care of the cases where $x and/or $base is 1/N. 1608 # 1609 # log(1/N) / log(B) = -log(N)/log(B) 1610 # log(1/N) / log(1/B) = log(N)/log(B) 1611 # log(N) / log(1/B) = -log(N)/log(B) 1612 1613 my $neg = 0; 1614 if ($x -> numerator() -> is_one()) { 1615 $x -> binv(); 1616 $neg = !$neg; 1617 } 1618 if (defined(blessed($base)) && $base -> isa($class)) { 1619 if ($base -> numerator() -> is_one()) { 1620 $base = $base -> copy() -> binv(); 1621 $neg = !$neg; 1622 } 1623 } 1624 1625 # disable upgrading and downgrading 1626 1627 require Math::BigFloat; 1628 my $upg = Math::BigFloat -> upgrade(); 1629 my $dng = Math::BigFloat -> downgrade(); 1630 Math::BigFloat -> upgrade(undef); 1631 Math::BigFloat -> downgrade(undef); 1632 1633 # At this point we are done handling all exception cases and trivial cases. 1634 1635 $base = Math::BigFloat -> new($base) if defined $base; 1636 my $xnum = Math::BigFloat -> new($LIB -> _str($x->{_n})); 1637 my $xden = Math::BigFloat -> new($LIB -> _str($x->{_d})); 1638 my $xstr = $xnum -> bdiv($xden) -> blog($base, @r) -> bsstr(); 1639 1640 # reset upgrading and downgrading 1641 1642 Math::BigFloat -> upgrade($upg); 1643 Math::BigFloat -> downgrade($dng); 1644 1645 my $xobj = Math::BigRat -> new($xstr); 1646 $x -> {sign} = $xobj -> {sign}; 1647 $x -> {_n} = $xobj -> {_n}; 1648 $x -> {_d} = $xobj -> {_d}; 1649 1650 return $neg ? $x -> bneg() : $x; 1651} 1652 1653sub bexp { 1654 # set up parameters 1655 my ($class, $x, $y, @r) = (ref($_[0]), @_); 1656 1657 # objectify is costly, so avoid it 1658 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 1659 ($class, $x, $y, @r) = objectify(1, @_); 1660 } 1661 1662 return $x->binf(@r) if $x->{sign} eq '+inf'; 1663 return $x->bzero(@r) if $x->{sign} eq '-inf'; 1664 1665 # we need to limit the accuracy to protect against overflow 1666 my $fallback = 0; 1667 my ($scale, @params); 1668 ($x, @params) = $x->_find_round_parameters(@r); 1669 1670 # also takes care of the "error in _find_round_parameters?" case 1671 return $x if $x->{sign} eq 'NaN'; 1672 1673 # no rounding at all, so must use fallback 1674 if (scalar @params == 0) { 1675 # simulate old behaviour 1676 $params[0] = $class->div_scale(); # and round to it as accuracy 1677 $params[1] = undef; # P = undef 1678 $scale = $params[0]+4; # at least four more for proper round 1679 $params[2] = $r[2]; # round mode by caller or undef 1680 $fallback = 1; # to clear a/p afterwards 1681 } else { 1682 # the 4 below is empirical, and there might be cases where it's not enough... 1683 $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined 1684 } 1685 1686 return $x->bone(@params) if $x->is_zero(); 1687 1688 # See the comments in Math::BigFloat on how this algorithm works. 1689 # Basically we calculate A and B (where B is faculty(N)) so that A/B = e 1690 1691 my $x_org = $x->copy(); 1692 if ($scale <= 75) { 1693 # set $x directly from a cached string form 1694 $x->{_n} = 1695 $LIB->_new("90933395208605785401971970164779391644753259799242"); 1696 $x->{_d} = 1697 $LIB->_new("33452526613163807108170062053440751665152000000000"); 1698 $x->{sign} = '+'; 1699 } else { 1700 # compute A and B so that e = A / B. 1701 1702 # After some terms we end up with this, so we use it as a starting point: 1703 my $A = $LIB->_new("90933395208605785401971970164779391644753259799242"); 1704 my $F = $LIB->_new(42); my $step = 42; 1705 1706 # Compute how many steps we need to take to get $A and $B sufficiently big 1707 my $steps = Math::BigFloat::_len_to_steps($scale - 4); 1708 # print STDERR "# Doing $steps steps for ", $scale-4, " digits\n"; 1709 while ($step++ <= $steps) { 1710 # calculate $a * $f + 1 1711 $A = $LIB->_mul($A, $F); 1712 $A = $LIB->_inc($A); 1713 # increment f 1714 $F = $LIB->_inc($F); 1715 } 1716 # compute $B as factorial of $steps (this is faster than doing it manually) 1717 my $B = $LIB->_fac($LIB->_new($steps)); 1718 1719 # print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n"; 1720 1721 $x->{_n} = $A; 1722 $x->{_d} = $B; 1723 $x->{sign} = '+'; 1724 } 1725 1726 # $x contains now an estimate of e, with some surplus digits, so we can round 1727 if (!$x_org->is_one()) { 1728 # raise $x to the wanted power and round it in one step: 1729 $x->bpow($x_org, @params); 1730 } else { 1731 # else just round the already computed result 1732 delete $x->{accuracy}; delete $x->{precision}; 1733 # shortcut to not run through _find_round_parameters again 1734 if (defined $params[0]) { 1735 $x->bround($params[0], $params[2]); # then round accordingly 1736 } else { 1737 $x->bfround($params[1], $params[2]); # then round accordingly 1738 } 1739 } 1740 if ($fallback) { 1741 # clear a/p after round, since user did not request it 1742 delete $x->{accuracy}; delete $x->{precision}; 1743 } 1744 1745 $x; 1746} 1747 1748sub bnok { 1749 # set up parameters 1750 my ($class, $x, $y, @r) = (ref($_[0]), @_); 1751 1752 # objectify is costly, so avoid it 1753 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 1754 ($class, $x, $y, @r) = objectify(2, @_); 1755 } 1756 1757 return $x->bnan() if $x->is_nan() || $y->is_nan(); 1758 return $x->bnan() if (($x->is_finite() && !$x->is_int()) || 1759 ($y->is_finite() && !$y->is_int())); 1760 1761 my $xint = Math::BigInt -> new($x -> bstr()); 1762 my $yint = Math::BigInt -> new($y -> bstr()); 1763 $xint -> bnok($yint); 1764 my $xrat = Math::BigRat -> new($xint); 1765 1766 $x -> {sign} = $xrat -> {sign}; 1767 $x -> {_n} = $xrat -> {_n}; 1768 $x -> {_d} = $xrat -> {_d}; 1769 1770 return $x; 1771} 1772 1773sub broot { 1774 # set up parameters 1775 my ($class, $x, $y, @r) = (ref($_[0]), @_); 1776 # objectify is costly, so avoid it 1777 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 1778 ($class, $x, $y, @r) = objectify(2, @_); 1779 } 1780 1781 # Convert $x into a Math::BigFloat. 1782 1783 my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d})); 1784 my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n})) -> bdiv($xd); 1785 $xflt -> {sign} = $x -> {sign}; 1786 1787 # Convert $y into a Math::BigFloat. 1788 1789 my $yd = Math::BigFloat -> new($LIB -> _str($y->{_d})); 1790 my $yflt = Math::BigFloat -> new($LIB -> _str($y->{_n})) -> bdiv($yd); 1791 $yflt -> {sign} = $y -> {sign}; 1792 1793 # Compute the root and convert back to a Math::BigRat. 1794 1795 $xflt -> broot($yflt, @r); 1796 my $xtmp = Math::BigRat -> new($xflt -> bsstr()); 1797 1798 $x -> {sign} = $xtmp -> {sign}; 1799 $x -> {_n} = $xtmp -> {_n}; 1800 $x -> {_d} = $xtmp -> {_d}; 1801 1802 return $x; 1803} 1804 1805sub bmodpow { 1806 # set up parameters 1807 my ($class, $x, $y, $m, @r) = (ref($_[0]), @_); 1808 # objectify is costly, so avoid it 1809 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 1810 ($class, $x, $y, $m, @r) = objectify(3, @_); 1811 } 1812 1813 # Convert $x, $y, and $m into Math::BigInt objects. 1814 1815 my $xint = Math::BigInt -> new($x -> copy() -> bint()); 1816 my $yint = Math::BigInt -> new($y -> copy() -> bint()); 1817 my $mint = Math::BigInt -> new($m -> copy() -> bint()); 1818 1819 $xint -> bmodpow($yint, $mint, @r); 1820 my $xtmp = Math::BigRat -> new($xint -> bsstr()); 1821 1822 $x -> {sign} = $xtmp -> {sign}; 1823 $x -> {_n} = $xtmp -> {_n}; 1824 $x -> {_d} = $xtmp -> {_d}; 1825 return $x; 1826} 1827 1828sub bmodinv { 1829 # set up parameters 1830 my ($class, $x, $y, @r) = (ref($_[0]), @_); 1831 # objectify is costly, so avoid it 1832 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 1833 ($class, $x, $y, @r) = objectify(2, @_); 1834 } 1835 1836 # Convert $x and $y into Math::BigInt objects. 1837 1838 my $xint = Math::BigInt -> new($x -> copy() -> bint()); 1839 my $yint = Math::BigInt -> new($y -> copy() -> bint()); 1840 1841 $xint -> bmodinv($yint, @r); 1842 my $xtmp = Math::BigRat -> new($xint -> bsstr()); 1843 1844 $x -> {sign} = $xtmp -> {sign}; 1845 $x -> {_n} = $xtmp -> {_n}; 1846 $x -> {_d} = $xtmp -> {_d}; 1847 return $x; 1848} 1849 1850sub bsqrt { 1851 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 1852 1853 return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0 1854 return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf 1855 return $x->round(@r) if $x->is_zero() || $x->is_one(); 1856 1857 my $n = $x -> {_n}; 1858 my $d = $x -> {_d}; 1859 1860 # Look for an exact solution. For the numerator and the denominator, take 1861 # the square root and square it and see if we got the original value. If we 1862 # did, for both the numerator and the denominator, we have an exact 1863 # solution. 1864 1865 { 1866 my $nsqrt = $LIB -> _sqrt($LIB -> _copy($n)); 1867 my $n2 = $LIB -> _mul($LIB -> _copy($nsqrt), $nsqrt); 1868 if ($LIB -> _acmp($n, $n2) == 0) { 1869 my $dsqrt = $LIB -> _sqrt($LIB -> _copy($d)); 1870 my $d2 = $LIB -> _mul($LIB -> _copy($dsqrt), $dsqrt); 1871 if ($LIB -> _acmp($d, $d2) == 0) { 1872 $x -> {_n} = $nsqrt; 1873 $x -> {_d} = $dsqrt; 1874 return $x->round(@r); 1875 } 1876 } 1877 } 1878 1879 local $Math::BigFloat::upgrade = undef; 1880 local $Math::BigFloat::downgrade = undef; 1881 local $Math::BigFloat::precision = undef; 1882 local $Math::BigFloat::accuracy = undef; 1883 local $Math::BigInt::upgrade = undef; 1884 local $Math::BigInt::precision = undef; 1885 local $Math::BigInt::accuracy = undef; 1886 1887 my $xn = Math::BigFloat -> new($LIB -> _str($n)); 1888 my $xd = Math::BigFloat -> new($LIB -> _str($d)); 1889 1890 my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> bsqrt() -> bsstr()); 1891 1892 $x -> {sign} = $xtmp -> {sign}; 1893 $x -> {_n} = $xtmp -> {_n}; 1894 $x -> {_d} = $xtmp -> {_d}; 1895 1896 $x->round(@r); 1897} 1898 1899sub blsft { 1900 my ($class, $x, $y, $b) = objectify(2, @_); 1901 1902 $b = 2 if !defined $b; 1903 $b = $class -> new($b) unless ref($b) && $b -> isa($class); 1904 1905 return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan(); 1906 1907 # shift by a negative amount? 1908 return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/; 1909 1910 $x -> bmul($b -> bpow($y)); 1911} 1912 1913sub brsft { 1914 my ($class, $x, $y, $b) = objectify(2, @_); 1915 1916 $b = 2 if !defined $b; 1917 $b = $class -> new($b) unless ref($b) && $b -> isa($class); 1918 1919 return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan(); 1920 1921 # shift by a negative amount? 1922 return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/; 1923 1924 # the following call to bdiv() will return either quotient (scalar context) 1925 # or quotient and remainder (list context). 1926 $x -> bdiv($b -> bpow($y)); 1927} 1928 1929############################################################################### 1930# Bitwise methods 1931############################################################################### 1932 1933# Bitwise left shift. 1934 1935sub bblsft { 1936 # We don't call objectify(), because the bitwise methods should not 1937 # upgrade/downgrade, even when upgrading/downgrading is enabled. 1938 1939 my ($class, $x, $y, @r) = ref($_[0]) ? (ref($_[0]), @_) : @_; 1940 1941 my $xint = Math::BigInt -> bblsft($x, $y, @r); 1942 1943 # Temporarily disable downgrading. 1944 1945 my $dng = $class -> downgrade(); 1946 $class -> downgrade(undef); 1947 1948 # Convert to our class without downgrading. 1949 1950 my $xrat = $class -> new($xint); 1951 1952 # Reset downgrading. 1953 1954 $class -> downgrade($dng); 1955 1956 # If we are called as a class method, the first operand might not be an 1957 # object of this class, so check. 1958 1959 if (defined(blessed($x)) && $x -> isa(__PACKAGE__)) { 1960 $x -> {sign} = $xrat -> {sign}; 1961 $x -> {_n} = $xrat -> {_n}; 1962 $x -> {_d} = $xrat -> {_d}; 1963 } else { 1964 $x = $xrat; 1965 } 1966 1967 # Now we might downgrade. 1968 1969 return $downgrade -> new($x) if defined($downgrade); 1970 $x -> round(@r); 1971} 1972 1973# Bitwise right shift. 1974 1975sub bbrsft { 1976 # We don't call objectify(), because the bitwise methods should not 1977 # upgrade/downgrade, even when upgrading/downgrading is enabled. 1978 1979 my ($class, $x, $y, @r) = ref($_[0]) ? (ref($_[0]), @_) : @_; 1980 1981 my $xint = Math::BigInt -> bbrsft($x, $y, @r); 1982 1983 # Temporarily disable downgrading. 1984 1985 my $dng = $class -> downgrade(); 1986 $class -> downgrade(undef); 1987 1988 # Convert to our class without downgrading. 1989 1990 my $xrat = $class -> new($xint); 1991 1992 # Reset downgrading. 1993 1994 $class -> downgrade($dng); 1995 1996 # If we are called as a class method, the first operand might not be an 1997 # object of this class, so check. 1998 1999 if (defined(blessed($x)) && $x -> isa(__PACKAGE__)) { 2000 $x -> {sign} = $xrat -> {sign}; 2001 $x -> {_n} = $xrat -> {_n}; 2002 $x -> {_d} = $xrat -> {_d}; 2003 } else { 2004 $x = $xrat; 2005 } 2006 2007 # Now we might downgrade. 2008 2009 return $downgrade -> new($x) if defined($downgrade); 2010 $x -> round(@r); 2011} 2012 2013sub band { 2014 my $x = shift; 2015 my $xref = ref($x); 2016 my $class = $xref || $x; 2017 2018 croak 'band() is an instance method, not a class method' unless $xref; 2019 croak 'Not enough arguments for band()' if @_ < 1; 2020 2021 my $y = shift; 2022 $y = $class -> new($y) unless ref($y); 2023 2024 my @r = @_; 2025 2026 my $xint = $x -> as_int(); # to Math::BigInt 2027 my $yint = $y -> as_int(); # to Math::BigInt 2028 2029 $xint = $xint -> band($yint); 2030 2031 my $xrat = $class -> new($xint); # back to Math::BigRat 2032 $x -> {sign} = $xrat -> {sign}; 2033 $x -> {_n} = $xrat -> {_n}; 2034 $x -> {_d} = $xrat -> {_d}; 2035 2036 return $x -> round(@r); 2037} 2038 2039sub bior { 2040 my $x = shift; 2041 my $xref = ref($x); 2042 my $class = $xref || $x; 2043 2044 croak 'bior() is an instance method, not a class method' unless $xref; 2045 croak 'Not enough arguments for bior()' if @_ < 1; 2046 2047 my $y = shift; 2048 $y = $class -> new($y) unless ref($y); 2049 2050 my @r = @_; 2051 2052 my $xint = $x -> as_int(); # to Math::BigInt 2053 my $yint = $y -> as_int(); # to Math::BigInt 2054 2055 $xint = $xint -> bior($yint); 2056 2057 my $xrat = $class -> new($xint); # back to Math::BigRat 2058 $x -> {sign} = $xrat -> {sign}; 2059 $x -> {_n} = $xrat -> {_n}; 2060 $x -> {_d} = $xrat -> {_d}; 2061 2062 return $x -> round(@r); 2063} 2064 2065sub bxor { 2066 my $x = shift; 2067 my $xref = ref($x); 2068 my $class = $xref || $x; 2069 2070 croak 'bxor() is an instance method, not a class method' unless $xref; 2071 croak 'Not enough arguments for bxor()' if @_ < 1; 2072 2073 my $y = shift; 2074 $y = $class -> new($y) unless ref($y); 2075 2076 my @r = @_; 2077 2078 my $xint = $x -> as_int(); # to Math::BigInt 2079 my $yint = $y -> as_int(); # to Math::BigInt 2080 2081 $xint = $xint -> bxor($yint); 2082 2083 my $xrat = $class -> new($xint); # back to Math::BigRat 2084 $x -> {sign} = $xrat -> {sign}; 2085 $x -> {_n} = $xrat -> {_n}; 2086 $x -> {_d} = $xrat -> {_d}; 2087 2088 return $x -> round(@r); 2089} 2090 2091sub bnot { 2092 my $x = shift; 2093 my $xref = ref($x); 2094 my $class = $xref || $x; 2095 2096 croak 'bnot() is an instance method, not a class method' unless $xref; 2097 2098 my @r = @_; 2099 2100 my $xint = $x -> as_int(); # to Math::BigInt 2101 $xint = $xint -> bnot(); 2102 2103 my $xrat = $class -> new($xint); # back to Math::BigRat 2104 $x -> {sign} = $xrat -> {sign}; 2105 $x -> {_n} = $xrat -> {_n}; 2106 $x -> {_d} = $xrat -> {_d}; 2107 2108 return $x -> round(@r); 2109} 2110 2111############################################################################## 2112# round 2113 2114sub round { 2115 my $x = shift; 2116 return $downgrade -> new($x) if defined($downgrade) && 2117 ($x -> is_int() || $x -> is_inf() || $x -> is_nan()); 2118 $x; 2119} 2120 2121sub bround { 2122 my $x = shift; 2123 return $downgrade -> new($x) if defined($downgrade) && 2124 ($x -> is_int() || $x -> is_inf() || $x -> is_nan()); 2125 $x; 2126} 2127 2128sub bfround { 2129 my $x = shift; 2130 return $downgrade -> new($x) if defined($downgrade) && 2131 ($x -> is_int() || $x -> is_inf() || $x -> is_nan()); 2132 $x; 2133} 2134 2135############################################################################## 2136# comparing 2137 2138sub bcmp { 2139 # compare two signed numbers 2140 2141 # set up parameters 2142 my ($class, $x, $y) = (ref($_[0]), @_); 2143 2144 # objectify is costly, so avoid it 2145 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 2146 ($class, $x, $y) = objectify(2, @_); 2147 } 2148 2149 if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { 2150 # $x is NaN and/or $y is NaN 2151 return if $x->{sign} eq $nan || $y->{sign} eq $nan; 2152 # $x and $y are both either +inf or -inf 2153 return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; 2154 # $x = +inf and $y < +inf 2155 return +1 if $x->{sign} eq '+inf'; 2156 # $x = -inf and $y > -inf 2157 return -1 if $x->{sign} eq '-inf'; 2158 # $x < +inf and $y = +inf 2159 return -1 if $y->{sign} eq '+inf'; 2160 # $x > -inf and $y = -inf 2161 return +1; 2162 } 2163 2164 # $x >= 0 and $y < 0 2165 return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; 2166 # $x < 0 and $y >= 0 2167 return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; 2168 2169 # At this point, we know that $x and $y have the same sign. 2170 2171 # shortcut 2172 my $xz = $LIB->_is_zero($x->{_n}); 2173 my $yz = $LIB->_is_zero($y->{_n}); 2174 return 0 if $xz && $yz; # 0 <=> 0 2175 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y 2176 return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0 2177 2178 my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d}); 2179 my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d}); 2180 2181 my $cmp = $LIB->_acmp($t, $u); # signs are equal 2182 $cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse 2183 $cmp; 2184} 2185 2186sub bacmp { 2187 # compare two numbers (as unsigned) 2188 2189 # set up parameters 2190 my ($class, $x, $y) = (ref($_[0]), @_); 2191 # objectify is costly, so avoid it 2192 if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { 2193 ($class, $x, $y) = objectify(2, @_); 2194 } 2195 2196 if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { 2197 # handle +-inf and NaN 2198 return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); 2199 return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; 2200 return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; 2201 return -1; 2202 } 2203 2204 my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d}); 2205 my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d}); 2206 $LIB->_acmp($t, $u); # ignore signs 2207} 2208 2209sub beq { 2210 my $self = shift; 2211 my $selfref = ref $self; 2212 #my $class = $selfref || $self; 2213 2214 croak 'beq() is an instance method, not a class method' unless $selfref; 2215 croak 'Wrong number of arguments for beq()' unless @_ == 1; 2216 2217 my $cmp = $self -> bcmp(shift); 2218 return defined($cmp) && ! $cmp; 2219} 2220 2221sub bne { 2222 my $self = shift; 2223 my $selfref = ref $self; 2224 #my $class = $selfref || $self; 2225 2226 croak 'bne() is an instance method, not a class method' unless $selfref; 2227 croak 'Wrong number of arguments for bne()' unless @_ == 1; 2228 2229 my $cmp = $self -> bcmp(shift); 2230 return defined($cmp) && ! $cmp ? '' : 1; 2231} 2232 2233sub blt { 2234 my $self = shift; 2235 my $selfref = ref $self; 2236 #my $class = $selfref || $self; 2237 2238 croak 'blt() is an instance method, not a class method' unless $selfref; 2239 croak 'Wrong number of arguments for blt()' unless @_ == 1; 2240 2241 my $cmp = $self -> bcmp(shift); 2242 return defined($cmp) && $cmp < 0; 2243} 2244 2245sub ble { 2246 my $self = shift; 2247 my $selfref = ref $self; 2248 #my $class = $selfref || $self; 2249 2250 croak 'ble() is an instance method, not a class method' unless $selfref; 2251 croak 'Wrong number of arguments for ble()' unless @_ == 1; 2252 2253 my $cmp = $self -> bcmp(shift); 2254 return defined($cmp) && $cmp <= 0; 2255} 2256 2257sub bgt { 2258 my $self = shift; 2259 my $selfref = ref $self; 2260 #my $class = $selfref || $self; 2261 2262 croak 'bgt() is an instance method, not a class method' unless $selfref; 2263 croak 'Wrong number of arguments for bgt()' unless @_ == 1; 2264 2265 my $cmp = $self -> bcmp(shift); 2266 return defined($cmp) && $cmp > 0; 2267} 2268 2269sub bge { 2270 my $self = shift; 2271 my $selfref = ref $self; 2272 #my $class = $selfref || $self; 2273 2274 croak 'bge() is an instance method, not a class method' 2275 unless $selfref; 2276 croak 'Wrong number of arguments for bge()' unless @_ == 1; 2277 2278 my $cmp = $self -> bcmp(shift); 2279 return defined($cmp) && $cmp >= 0; 2280} 2281 2282############################################################################## 2283# output conversion 2284 2285sub numify { 2286 # convert 17/8 => float (aka 2.125) 2287 my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 2288 2289 # Non-finite number. 2290 2291 if ($x -> is_nan()) { 2292 require Math::Complex; 2293 my $inf = $Math::Complex::Inf; 2294 return $inf - $inf; 2295 } 2296 2297 if ($x -> is_inf()) { 2298 require Math::Complex; 2299 my $inf = $Math::Complex::Inf; 2300 return $x -> is_negative() ? -$inf : $inf; 2301 } 2302 2303 # Finite number. 2304 2305 my $abs = $LIB->_is_one($x->{_d}) 2306 ? $LIB->_num($x->{_n}) 2307 : Math::BigFloat -> new($LIB->_str($x->{_n})) 2308 -> bdiv($LIB->_str($x->{_d})) 2309 -> bstr(); 2310 return $x->{sign} eq '-' ? 0 - $abs : 0 + $abs; 2311} 2312 2313sub as_int { 2314 my ($class, $x) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 2315 2316 return $x -> copy() if $x -> isa("Math::BigInt"); 2317 2318 # Disable upgrading and downgrading. 2319 2320 require Math::BigInt; 2321 my $upg = Math::BigInt -> upgrade(); 2322 my $dng = Math::BigInt -> downgrade(); 2323 Math::BigInt -> upgrade(undef); 2324 Math::BigInt -> downgrade(undef); 2325 2326 # Copy the value. 2327 2328 my $y; 2329 if ($x -> is_inf()) { 2330 $y = Math::BigInt -> binf($x->sign()); 2331 } elsif ($x -> is_nan()) { 2332 $y = Math::BigInt -> bnan(); 2333 } else { 2334 my $int = $LIB -> _div($LIB -> _copy($x->{_n}), $x->{_d}); # 22/7 => 3 2335 $y = Math::BigInt -> new($LIB -> _str($int)); 2336 $y = $y -> bneg() if $x -> is_neg(); 2337 } 2338 2339 # Copy the remaining instance variables. 2340 2341 ($y->{accuracy}, $y->{precision}) = ($x->{accuracy}, $x->{precision}); 2342 2343 # Restore upgrading and downgrading. 2344 2345 Math::BigInt -> upgrade($upg); 2346 Math::BigInt -> downgrade($dng); 2347 2348 return $y; 2349} 2350 2351sub as_rat { 2352 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 2353 carp "Rounding is not supported for ", (caller(0))[3], "()" if @r; 2354 2355 return $x -> copy() if $x -> isa("Math::BigRat"); 2356 2357 # Disable upgrading and downgrading. 2358 2359 my $upg = Math::BigRat -> upgrade(); 2360 my $dng = Math::BigRat -> downgrade(); 2361 Math::BigRat -> upgrade(undef); 2362 Math::BigRat -> downgrade(undef); 2363 2364 # Copy the value. 2365 2366 my $y = Math::BigRat -> new($x); 2367 2368 # Copy the remaining instance variables. 2369 2370 ($y->{accuracy}, $y->{precision}) = ($x->{accuracy}, $x->{precision}); 2371 2372 # Restore upgrading and downgrading 2373 2374 Math::BigRat -> upgrade($upg); 2375 Math::BigRat -> downgrade($dng); 2376 2377 return $y; 2378} 2379 2380sub as_float { 2381 my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); 2382 2383 return $x -> copy() if $x -> isa("Math::BigFloat"); 2384 2385 # Disable upgrading and downgrading. 2386 2387 require Math::BigFloat; 2388 my $upg = Math::BigFloat -> upgrade(); 2389 my $dng = Math::BigFloat -> downgrade(); 2390 Math::BigFloat -> upgrade(undef); 2391 Math::BigFloat -> downgrade(undef); 2392 2393 # Copy the value. 2394 2395 my $y; 2396 if ($x -> is_inf()) { 2397 $y = Math::BigFloat -> binf($x->sign()); 2398 } elsif ($x -> is_nan()) { 2399 $y = Math::BigFloat -> bnan(); 2400 } else { 2401 $y = Math::BigFloat -> new($LIB -> _str($x->{_n})); 2402 $y -> {sign} = $x -> {sign}; 2403 unless ($LIB -> _is_one($x->{_d})) { 2404 my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d})); 2405 $y -> bdiv($xd, @r); 2406 } 2407 } 2408 2409 # Copy the remaining instance variables. 2410 2411 ($y->{accuracy}, $y->{precision}) = ($x->{accuracy}, $x->{precision}); 2412 2413 # Restore upgrading and downgrading. 2414 2415 Math::BigFloat -> upgrade($upg); 2416 Math::BigFloat -> downgrade($dng); 2417 2418 return $y; 2419} 2420 2421sub to_hex { 2422 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 2423 2424 # Inf and NaN 2425 2426 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 2427 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 2428 return 'inf'; # +inf 2429 } 2430 2431 return $nan unless $x->is_int(); 2432 2433 my $str = $LIB->_to_hex($x->{_n}); 2434 return $x->{sign} eq "-" ? "-$str" : $str; 2435} 2436 2437sub to_oct { 2438 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 2439 2440 # Inf and NaN 2441 2442 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 2443 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 2444 return 'inf'; # +inf 2445 } 2446 2447 return $nan unless $x->is_int(); 2448 2449 my $str = $LIB->_to_oct($x->{_n}); 2450 return $x->{sign} eq "-" ? "-$str" : $str; 2451} 2452 2453sub to_bin { 2454 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 2455 2456 # Inf and NaN 2457 2458 if ($x->{sign} ne '+' && $x->{sign} ne '-') { 2459 return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN 2460 return 'inf'; # +inf 2461 } 2462 2463 return $nan unless $x->is_int(); 2464 2465 my $str = $LIB->_to_bin($x->{_n}); 2466 return $x->{sign} eq "-" ? "-$str" : $str; 2467} 2468 2469sub as_bin { 2470 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 2471 2472 return $x unless $x->is_int(); 2473 2474 my $s = $x->{sign}; 2475 $s = '' if $s eq '+'; 2476 $s . $LIB->_as_bin($x->{_n}); 2477} 2478 2479sub as_hex { 2480 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 2481 2482 return $x unless $x->is_int(); 2483 2484 my $s = $x->{sign}; $s = '' if $s eq '+'; 2485 $s . $LIB->_as_hex($x->{_n}); 2486} 2487 2488sub as_oct { 2489 my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); 2490 2491 return $x unless $x->is_int(); 2492 2493 my $s = $x->{sign}; $s = '' if $s eq '+'; 2494 $s . $LIB->_as_oct($x->{_n}); 2495} 2496 2497############################################################################## 2498 2499# Create a Math::BigRat from a decimal string. This is an equivalent to 2500# from_hex(), from_oct(), and from_bin(). It is like new() except that it does 2501# not accept anything but a string representing a finite decimal number. 2502 2503sub from_dec { 2504 my $self = shift; 2505 my $selfref = ref $self; 2506 my $class = $selfref || $self; 2507 2508 # Make "require" work. 2509 2510 $class -> import() if $IMPORT == 0; 2511 2512 # Don't modify constant (read-only) objects. 2513 2514 return $self if $selfref && $self->modify('from_dec'); 2515 2516 my $str = shift; 2517 my @r = @_; 2518 2519 # If called as a class method, initialize a new object. 2520 2521 $self = bless {}, $class unless $selfref; 2522 2523 if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) { 2524 my ($mant_sgn, $mant_abs, $expo_sgn, $expo_abs) = @parts; 2525 $self->{sign} = $mant_sgn; 2526 $self->{_n} = $mant_abs; 2527 if ($expo_sgn eq "+") { 2528 $self->{_n} = $LIB -> _lsft($self->{_n}, $expo_abs, 10); 2529 $self->{_d} = $LIB -> _one(); 2530 } else { 2531 $self->{_d} = $LIB -> _1ex($mant_abs); 2532 } 2533 2534 my $gcd = $LIB -> _gcd($LIB -> _copy($self->{_n}), $self->{_d}); 2535 if (!$LIB -> _is_one($gcd)) { 2536 $self -> {_n} = $LIB -> _div($self->{_n}, $gcd); 2537 $self -> {_d} = $LIB -> _div($self->{_d}, $gcd); 2538 } 2539 2540 return $downgrade -> new($self -> bstr(), @r) 2541 if defined($downgrade) && $self -> is_int(); 2542 return $self; 2543 } 2544 2545 return $self -> bnan(@r); 2546} 2547 2548sub from_hex { 2549 my $class = shift; 2550 2551 # The relationship should probably go the otherway, i.e, that new() calls 2552 # from_hex(). Fixme! 2553 my ($x, @r) = @_; 2554 $x =~ s|^\s*(?:0?[Xx]_*)?|0x|; 2555 $class->new($x, @r); 2556} 2557 2558sub from_bin { 2559 my $class = shift; 2560 2561 # The relationship should probably go the otherway, i.e, that new() calls 2562 # from_bin(). Fixme! 2563 my ($x, @r) = @_; 2564 $x =~ s|^\s*(?:0?[Bb]_*)?|0b|; 2565 $class->new($x, @r); 2566} 2567 2568sub from_oct { 2569 my $class = shift; 2570 2571 # Why is this different from from_hex() and from_bin()? Fixme! 2572 my @parts; 2573 for my $c (@_) { 2574 push @parts, Math::BigInt->from_oct($c); 2575 } 2576 $class->new (@parts); 2577} 2578 2579############################################################################## 2580# import 2581 2582sub import { 2583 my $class = shift; 2584 $IMPORT++; # remember we did import() 2585 my @a; # unrecognized arguments 2586 2587 my @import = (); 2588 2589 while (@_) { 2590 my $param = shift; 2591 2592 # Enable overloading of constants. 2593 2594 if ($param eq ':constant') { 2595 overload::constant 2596 2597 integer => sub { 2598 $class -> new(shift); 2599 }, 2600 2601 float => sub { 2602 $class -> new(shift); 2603 }, 2604 2605 binary => sub { 2606 # E.g., a literal 0377 shall result in an object whose value 2607 # is decimal 255, but new("0377") returns decimal 377. 2608 return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; 2609 $class -> new(shift); 2610 }; 2611 next; 2612 } 2613 2614 # Upgrading. 2615 2616 if ($param eq 'upgrade') { 2617 $class -> upgrade(shift); 2618 next; 2619 } 2620 2621 # Downgrading. 2622 2623 if ($param eq 'downgrade') { 2624 $class -> downgrade(shift); 2625 next; 2626 } 2627 2628 # Accuracy. 2629 2630 if ($param eq 'accuracy') { 2631 $class -> accuracy(shift); 2632 next; 2633 } 2634 2635 # Precision. 2636 2637 if ($param eq 'precision') { 2638 $class -> precision(shift); 2639 next; 2640 } 2641 2642 # Rounding mode. 2643 2644 if ($param eq 'round_mode') { 2645 $class -> round_mode(shift); 2646 next; 2647 } 2648 2649 # Fall-back accuracy. 2650 2651 if ($param eq 'div_scale') { 2652 $class -> div_scale(shift); 2653 next; 2654 } 2655 2656 # Backend library. 2657 2658 if ($param =~ /^(lib|try|only)\z/) { 2659 push @import, $param; 2660 push @import, shift() if @_; 2661 next; 2662 } 2663 2664 if ($param eq 'with') { 2665 # alternative class for our private parts() 2666 # XXX: no longer supported 2667 # $LIB = shift() || 'Calc'; 2668 # carp "'with' is no longer supported, use 'lib', 'try', or 'only'"; 2669 shift; 2670 next; 2671 } 2672 2673 # Unrecognized parameter. 2674 2675 push @a, $param; 2676 } 2677 2678 Math::BigInt -> import(@import); 2679 2680 # find out which library was actually loaded 2681 $LIB = Math::BigInt -> config("lib"); 2682 2683 $class -> SUPER::import(@a); # for subclasses 2684 $class -> export_to_level(1, $class, @a) if @a; # need this, too 2685} 2686 26871; 2688 2689__END__ 2690 2691=pod 2692 2693=head1 NAME 2694 2695Math::BigRat - arbitrary size rational number math package 2696 2697=head1 SYNOPSIS 2698 2699 use Math::BigRat; 2700 2701 my $x = Math::BigRat->new('3/7'); $x += '5/9'; 2702 2703 print $x->bstr(), "\n"; 2704 print $x ** 2, "\n"; 2705 2706 my $y = Math::BigRat->new('inf'); 2707 print "$y ", ($y->is_inf ? 'is' : 'is not'), " infinity\n"; 2708 2709 my $z = Math::BigRat->new(144); $z->bsqrt(); 2710 2711=head1 DESCRIPTION 2712 2713Math::BigRat complements Math::BigInt and Math::BigFloat by providing support 2714for arbitrary big rational numbers. 2715 2716=head2 MATH LIBRARY 2717 2718You can change the underlying module that does the low-level 2719math operations by using: 2720 2721 use Math::BigRat try => 'GMP'; 2722 2723Note: This needs Math::BigInt::GMP installed. 2724 2725The following would first try to find Math::BigInt::Foo, then 2726Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: 2727 2728 use Math::BigRat try => 'Foo,Math::BigInt::Bar'; 2729 2730If you want to get warned when the fallback occurs, replace "try" with "lib": 2731 2732 use Math::BigRat lib => 'Foo,Math::BigInt::Bar'; 2733 2734If you want the code to die instead, replace "try" with "only": 2735 2736 use Math::BigRat only => 'Foo,Math::BigInt::Bar'; 2737 2738=head1 METHODS 2739 2740Any methods not listed here are derived from Math::BigFloat (or 2741Math::BigInt), so make sure you check these two modules for further 2742information. 2743 2744=over 2745 2746=item new() 2747 2748 $x = Math::BigRat->new('1/3'); 2749 2750Create a new Math::BigRat object. Input can come in various forms: 2751 2752 $x = Math::BigRat->new(123); # scalars 2753 $x = Math::BigRat->new('inf'); # infinity 2754 $x = Math::BigRat->new('123.3'); # float 2755 $x = Math::BigRat->new('1/3'); # simple string 2756 $x = Math::BigRat->new('1 / 3'); # spaced 2757 $x = Math::BigRat->new('1 / 0.1'); # w/ floats 2758 $x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt 2759 $x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat 2760 $x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite 2761 2762 # You can also give D and N as different objects: 2763 $x = Math::BigRat->new( 2764 Math::BigInt->new(-123), 2765 Math::BigInt->new(7), 2766 ); # => -123/7 2767 2768=item numerator() 2769 2770 $n = $x->numerator(); 2771 2772Returns a copy of the numerator (the part above the line) as signed BigInt. 2773 2774=item denominator() 2775 2776 $d = $x->denominator(); 2777 2778Returns a copy of the denominator (the part under the line) as positive BigInt. 2779 2780=item parts() 2781 2782 ($n, $d) = $x->parts(); 2783 2784Return a list consisting of (signed) numerator and (unsigned) denominator as 2785BigInts. 2786 2787=item dparts() 2788 2789Returns the integer part and the fraction part. 2790 2791=item fparts() 2792 2793Returns the smallest possible numerator and denominator so that the numerator 2794divided by the denominator gives back the original value. For finite numbers, 2795both values are integers. Mnemonic: fraction. 2796 2797=item numify() 2798 2799 my $y = $x->numify(); 2800 2801Returns the object as a scalar. This will lose some data if the object 2802cannot be represented by a normal Perl scalar (integer or float), so 2803use L</as_int()> or L</as_float()> instead. 2804 2805This routine is automatically used whenever a scalar is required: 2806 2807 my $x = Math::BigRat->new('3/1'); 2808 @array = (0, 1, 2, 3); 2809 $y = $array[$x]; # set $y to 3 2810 2811=item as_int() 2812 2813=item as_number() 2814 2815 $x = Math::BigRat->new('13/7'); 2816 print $x->as_int(), "\n"; # '1' 2817 2818Returns a copy of the object as BigInt, truncated to an integer. 2819 2820C<as_number()> is an alias for C<as_int()>. 2821 2822=item as_float() 2823 2824 $x = Math::BigRat->new('13/7'); 2825 print $x->as_float(), "\n"; # '1' 2826 2827 $x = Math::BigRat->new('2/3'); 2828 print $x->as_float(5), "\n"; # '0.66667' 2829 2830Returns a copy of the object as BigFloat, preserving the 2831accuracy as wanted, or the default of 40 digits. 2832 2833This method was added in v0.22 of Math::BigRat (April 2008). 2834 2835=item as_hex() 2836 2837 $x = Math::BigRat->new('13'); 2838 print $x->as_hex(), "\n"; # '0xd' 2839 2840Returns the BigRat as hexadecimal string. Works only for integers. 2841 2842=item as_bin() 2843 2844 $x = Math::BigRat->new('13'); 2845 print $x->as_bin(), "\n"; # '0x1101' 2846 2847Returns the BigRat as binary string. Works only for integers. 2848 2849=item as_oct() 2850 2851 $x = Math::BigRat->new('13'); 2852 print $x->as_oct(), "\n"; # '015' 2853 2854Returns the BigRat as octal string. Works only for integers. 2855 2856=item from_hex() 2857 2858 my $h = Math::BigRat->from_hex('0x10'); 2859 2860Create a BigRat from a hexadecimal number in string form. 2861 2862=item from_oct() 2863 2864 my $o = Math::BigRat->from_oct('020'); 2865 2866Create a BigRat from an octal number in string form. 2867 2868=item from_bin() 2869 2870 my $b = Math::BigRat->from_bin('0b10000000'); 2871 2872Create a BigRat from an binary number in string form. 2873 2874=item bnan() 2875 2876 $x = Math::BigRat->bnan(); 2877 2878Creates a new BigRat object representing NaN (Not A Number). 2879If used on an object, it will set it to NaN: 2880 2881 $x->bnan(); 2882 2883=item bzero() 2884 2885 $x = Math::BigRat->bzero(); 2886 2887Creates a new BigRat object representing zero. 2888If used on an object, it will set it to zero: 2889 2890 $x->bzero(); 2891 2892=item binf() 2893 2894 $x = Math::BigRat->binf($sign); 2895 2896Creates a new BigRat object representing infinity. The optional argument is 2897either '-' or '+', indicating whether you want infinity or minus infinity. 2898If used on an object, it will set it to infinity: 2899 2900 $x->binf(); 2901 $x->binf('-'); 2902 2903=item bone() 2904 2905 $x = Math::BigRat->bone($sign); 2906 2907Creates a new BigRat object representing one. The optional argument is 2908either '-' or '+', indicating whether you want one or minus one. 2909If used on an object, it will set it to one: 2910 2911 $x->bone(); # +1 2912 $x->bone('-'); # -1 2913 2914=item length() 2915 2916 $len = $x->length(); 2917 2918Return the length of $x in digits for integer values. 2919 2920=item digit() 2921 2922 print Math::BigRat->new('123/1')->digit(1); # 1 2923 print Math::BigRat->new('123/1')->digit(-1); # 3 2924 2925Return the N'ths digit from X when X is an integer value. 2926 2927=item bnorm() 2928 2929 $x->bnorm(); 2930 2931Reduce the number to the shortest form. This routine is called 2932automatically whenever it is needed. 2933 2934=item bfac() 2935 2936 $x->bfac(); 2937 2938Calculates the factorial of $x. For instance: 2939 2940 print Math::BigRat->new('3/1')->bfac(), "\n"; # 1*2*3 2941 print Math::BigRat->new('5/1')->bfac(), "\n"; # 1*2*3*4*5 2942 2943Works currently only for integers. 2944 2945=item bround()/round()/bfround() 2946 2947Are not yet implemented. 2948 2949=item bmod() 2950 2951 $x->bmod($y); 2952 2953Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the 2954result is identical to the remainder after floored division (F-division). If, 2955in addition, both $x and $y are integers, the result is identical to the result 2956from Perl's % operator. 2957 2958=item bmodinv() 2959 2960 $x->bmodinv($mod); # modular multiplicative inverse 2961 2962Returns the multiplicative inverse of C<$x> modulo C<$mod>. If 2963 2964 $y = $x -> copy() -> bmodinv($mod) 2965 2966then C<$y> is the number closest to zero, and with the same sign as C<$mod>, 2967satisfying 2968 2969 ($x * $y) % $mod = 1 % $mod 2970 2971If C<$x> and C<$y> are non-zero, they must be relative primes, i.e., 2972C<bgcd($y, $mod)==1>. 'C<NaN>' is returned when no modular multiplicative 2973inverse exists. 2974 2975=item bmodpow() 2976 2977 $num->bmodpow($exp,$mod); # modular exponentiation 2978 # ($num**$exp % $mod) 2979 2980Returns the value of C<$num> taken to the power C<$exp> in the modulus 2981C<$mod> using binary exponentiation. C<bmodpow> is far superior to 2982writing 2983 2984 $num ** $exp % $mod 2985 2986because it is much faster - it reduces internal variables into 2987the modulus whenever possible, so it operates on smaller numbers. 2988 2989C<bmodpow> also supports negative exponents. 2990 2991 bmodpow($num, -1, $mod) 2992 2993is exactly equivalent to 2994 2995 bmodinv($num, $mod) 2996 2997=item bneg() 2998 2999 $x->bneg(); 3000 3001Used to negate the object in-place. 3002 3003=item is_one() 3004 3005 print "$x is 1\n" if $x->is_one(); 3006 3007Return true if $x is exactly one, otherwise false. 3008 3009=item is_zero() 3010 3011 print "$x is 0\n" if $x->is_zero(); 3012 3013Return true if $x is exactly zero, otherwise false. 3014 3015=item is_pos()/is_positive() 3016 3017 print "$x is >= 0\n" if $x->is_positive(); 3018 3019Return true if $x is positive (greater than or equal to zero), otherwise 3020false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't. 3021 3022C<is_positive()> is an alias for C<is_pos()>. 3023 3024=item is_neg()/is_negative() 3025 3026 print "$x is < 0\n" if $x->is_negative(); 3027 3028Return true if $x is negative (smaller than zero), otherwise false. Please 3029note that '-inf' is also negative, while 'NaN' and '+inf' aren't. 3030 3031C<is_negative()> is an alias for C<is_neg()>. 3032 3033=item is_int() 3034 3035 print "$x is an integer\n" if $x->is_int(); 3036 3037Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise 3038false. Please note that '-inf', 'inf' and 'NaN' aren't integer. 3039 3040=item is_odd() 3041 3042 print "$x is odd\n" if $x->is_odd(); 3043 3044Return true if $x is odd, otherwise false. 3045 3046=item is_even() 3047 3048 print "$x is even\n" if $x->is_even(); 3049 3050Return true if $x is even, otherwise false. 3051 3052=item bceil() 3053 3054 $x->bceil(); 3055 3056Set $x to the next bigger integer value (e.g. truncate the number to integer 3057and then increment it by one). 3058 3059=item bfloor() 3060 3061 $x->bfloor(); 3062 3063Truncate $x to an integer value. 3064 3065=item bint() 3066 3067 $x->bint(); 3068 3069Round $x towards zero. 3070 3071=item bsqrt() 3072 3073 $x->bsqrt(); 3074 3075Calculate the square root of $x. 3076 3077=item broot() 3078 3079 $x->broot($n); 3080 3081Calculate the N'th root of $x. 3082 3083=item badd() 3084 3085 $x->badd($y); 3086 3087Adds $y to $x and returns the result. 3088 3089=item bmul() 3090 3091 $x->bmul($y); 3092 3093Multiplies $y to $x and returns the result. 3094 3095=item bsub() 3096 3097 $x->bsub($y); 3098 3099Subtracts $y from $x and returns the result. 3100 3101=item bdiv() 3102 3103 $q = $x->bdiv($y); 3104 ($q, $r) = $x->bdiv($y); 3105 3106In scalar context, divides $x by $y and returns the result. In list context, 3107does floored division (F-division), returning an integer $q and a remainder $r 3108so that $x = $q * $y + $r. The remainer (modulo) is equal to what is returned 3109by C<< $x->bmod($y) >>. 3110 3111=item binv() 3112 3113 $x->binv(); 3114 3115Inverse of $x. 3116 3117=item bdec() 3118 3119 $x->bdec(); 3120 3121Decrements $x by 1 and returns the result. 3122 3123=item binc() 3124 3125 $x->binc(); 3126 3127Increments $x by 1 and returns the result. 3128 3129=item copy() 3130 3131 my $z = $x->copy(); 3132 3133Makes a deep copy of the object. 3134 3135Please see the documentation in L<Math::BigInt> for further details. 3136 3137=item bstr()/bsstr() 3138 3139 my $x = Math::BigRat->new('8/4'); 3140 print $x->bstr(), "\n"; # prints 1/2 3141 print $x->bsstr(), "\n"; # prints 1/2 3142 3143Return a string representing this object. 3144 3145=item bcmp() 3146 3147 $x->bcmp($y); 3148 3149Compares $x with $y and takes the sign into account. 3150Returns -1, 0, 1 or undef. 3151 3152=item bacmp() 3153 3154 $x->bacmp($y); 3155 3156Compares $x with $y while ignoring their sign. Returns -1, 0, 1 or undef. 3157 3158=item beq() 3159 3160 $x -> beq($y); 3161 3162Returns true if and only if $x is equal to $y, and false otherwise. 3163 3164=item bne() 3165 3166 $x -> bne($y); 3167 3168Returns true if and only if $x is not equal to $y, and false otherwise. 3169 3170=item blt() 3171 3172 $x -> blt($y); 3173 3174Returns true if and only if $x is equal to $y, and false otherwise. 3175 3176=item ble() 3177 3178 $x -> ble($y); 3179 3180Returns true if and only if $x is less than or equal to $y, and false 3181otherwise. 3182 3183=item bgt() 3184 3185 $x -> bgt($y); 3186 3187Returns true if and only if $x is greater than $y, and false otherwise. 3188 3189=item bge() 3190 3191 $x -> bge($y); 3192 3193Returns true if and only if $x is greater than or equal to $y, and false 3194otherwise. 3195 3196=item blsft()/brsft() 3197 3198Used to shift numbers left/right. 3199 3200Please see the documentation in L<Math::BigInt> for further details. 3201 3202=item band() 3203 3204 $x->band($y); # bitwise and 3205 3206=item bior() 3207 3208 $x->bior($y); # bitwise inclusive or 3209 3210=item bxor() 3211 3212 $x->bxor($y); # bitwise exclusive or 3213 3214=item bnot() 3215 3216 $x->bnot(); # bitwise not (two's complement) 3217 3218=item bpow() 3219 3220 $x->bpow($y); 3221 3222Compute $x ** $y. 3223 3224Please see the documentation in L<Math::BigInt> for further details. 3225 3226=item blog() 3227 3228 $x->blog($base, $accuracy); # logarithm of x to the base $base 3229 3230If C<$base> is not defined, Euler's number (e) is used: 3231 3232 print $x->blog(undef, 100); # log(x) to 100 digits 3233 3234=item bexp() 3235 3236 $x->bexp($accuracy); # calculate e ** X 3237 3238Calculates two integers A and B so that A/B is equal to C<e ** $x>, where C<e> is 3239Euler's number. 3240 3241This method was added in v0.20 of Math::BigRat (May 2007). 3242 3243See also C<blog()>. 3244 3245=item bnok() 3246 3247 $x->bnok($y); # x over y (binomial coefficient n over k) 3248 3249Calculates the binomial coefficient n over k, also called the "choose" 3250function. The result is equivalent to: 3251 3252 ( n ) n! 3253 | - | = ------- 3254 ( k ) k!(n-k)! 3255 3256This method was added in v0.20 of Math::BigRat (May 2007). 3257 3258=item config() 3259 3260 Math::BigRat->config("trap_nan" => 1); # set 3261 $accu = Math::BigRat->config("accuracy"); # get 3262 3263Set or get configuration parameter values. Read-only parameters are marked as 3264RO. Read-write parameters are marked as RW. The following parameters are 3265supported. 3266 3267 Parameter RO/RW Description 3268 Example 3269 ============================================================ 3270 lib RO Name of the math backend library 3271 Math::BigInt::Calc 3272 lib_version RO Version of the math backend library 3273 0.30 3274 class RO The class of config you just called 3275 Math::BigRat 3276 version RO version number of the class you used 3277 0.10 3278 upgrade RW To which class numbers are upgraded 3279 undef 3280 downgrade RW To which class numbers are downgraded 3281 undef 3282 precision RW Global precision 3283 undef 3284 accuracy RW Global accuracy 3285 undef 3286 round_mode RW Global round mode 3287 even 3288 div_scale RW Fallback accuracy for div, sqrt etc. 3289 40 3290 trap_nan RW Trap NaNs 3291 undef 3292 trap_inf RW Trap +inf/-inf 3293 undef 3294 3295=back 3296 3297=head1 NUMERIC LITERALS 3298 3299After C<use Math::BigRat ':constant'> all numeric literals in the given scope 3300are converted to C<Math::BigRat> objects. This conversion happens at compile 3301time. Every non-integer is convert to a NaN. 3302 3303For example, 3304 3305 perl -MMath::BigRat=:constant -le 'print 2**150' 3306 3307prints the exact value of C<2**150>. Note that without conversion of constants 3308to objects the expression C<2**150> is calculated using Perl scalars, which 3309leads to an inaccurate result. 3310 3311Please note that strings are not affected, so that 3312 3313 use Math::BigRat qw/:constant/; 3314 3315 $x = "1234567890123456789012345678901234567890" 3316 + "123456789123456789"; 3317 3318does give you what you expect. You need an explicit Math::BigRat->new() around 3319at least one of the operands. You should also quote large constants to prevent 3320loss of precision: 3321 3322 use Math::BigRat; 3323 3324 $x = Math::BigRat->new("1234567889123456789123456789123456789"); 3325 3326Without the quotes Perl first converts the large number to a floating point 3327constant at compile time, and then converts the result to a Math::BigRat object 3328at run time, which results in an inaccurate result. 3329 3330=head2 Hexadecimal, octal, and binary floating point literals 3331 3332Perl (and this module) accepts hexadecimal, octal, and binary floating point 3333literals, but use them with care with Perl versions before v5.32.0, because some 3334versions of Perl silently give the wrong result. Below are some examples of 3335different ways to write the number decimal 314. 3336 3337Hexadecimal floating point literals: 3338 3339 0x1.3ap+8 0X1.3AP+8 3340 0x1.3ap8 0X1.3AP8 3341 0x13a0p-4 0X13A0P-4 3342 3343Octal floating point literals (with "0" prefix): 3344 3345 01.164p+8 01.164P+8 3346 01.164p8 01.164P8 3347 011640p-4 011640P-4 3348 3349Octal floating point literals (with "0o" prefix) (requires v5.34.0): 3350 3351 0o1.164p+8 0O1.164P+8 3352 0o1.164p8 0O1.164P8 3353 0o11640p-4 0O11640P-4 3354 3355Binary floating point literals: 3356 3357 0b1.0011101p+8 0B1.0011101P+8 3358 0b1.0011101p8 0B1.0011101P8 3359 0b10011101000p-2 0B10011101000P-2 3360 3361=head1 BUGS 3362 3363Please report any bugs or feature requests to 3364C<bug-math-bigint at rt.cpan.org>, or through the web interface at 3365L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt> (requires login). 3366We will be notified, and then you'll automatically be notified of progress on 3367your bug as I make changes. 3368 3369=head1 SUPPORT 3370 3371You can find documentation for this module with the perldoc command. 3372 3373 perldoc Math::BigInt 3374 3375You can also look for information at: 3376 3377=over 4 3378 3379=item * GitHub 3380 3381L<https://github.com/pjacklam/p5-Math-BigInt> 3382 3383=item * RT: CPAN's request tracker 3384 3385L<https://rt.cpan.org/Dist/Display.html?Name=Math-BigInt> 3386 3387=item * MetaCPAN 3388 3389L<https://metacpan.org/release/Math-BigInt> 3390 3391=item * CPAN Testers Matrix 3392 3393L<http://matrix.cpantesters.org/?dist=Math-BigInt> 3394 3395=back 3396 3397=head1 LICENSE 3398 3399This program is free software; you may redistribute it and/or modify it under 3400the same terms as Perl itself. 3401 3402=head1 SEE ALSO 3403 3404L<Math::BigInt> and L<Math::BigFloat> as well as the backend libraries 3405L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>, 3406L<Math::BigInt::GMPz>, and L<Math::BigInt::BitVect>. 3407 3408The pragmas L<bigint>, L<bigfloat>, and L<bigrat> might also be of interest. In 3409addition there is the L<bignum> pragma which does upgrading and downgrading. 3410 3411=head1 AUTHORS 3412 3413=over 4 3414 3415=item * 3416 3417Tels L<http://bloodgate.com/> 2001-2009. 3418 3419=item * 3420 3421Maintained by Peter John Acklam <pjacklam@gmail.com> 2011- 3422 3423=back 3424 3425=cut 3426