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