#
# "Tax the rat farms." - Lord Vetinari
#
# The following hash values are used:
# sign : +,-,NaN,+inf,-inf
# _d : denominator
# _n : numerator (value = _n/_d)
# _a : accuracy
# _p : precision
# You should not look at the innards of a BigRat - use the methods for this.
package Math::BigRat;
use 5.006;
use strict;
use warnings;
use Carp qw< carp croak >;
use Math::BigFloat 1.999718;
our $VERSION = '0.2614';
our @ISA = qw(Math::BigFloat);
our ($accuracy, $precision, $round_mode, $div_scale,
$upgrade, $downgrade, $_trap_nan, $_trap_inf);
use overload
# overload key: with_assign
'+' => sub { $_[0] -> copy() -> badd($_[1]); },
'-' => sub { my $c = $_[0] -> copy;
$_[2] ? $c -> bneg() -> badd( $_[1])
: $c -> bsub($_[1]); },
'*' => sub { $_[0] -> copy() -> bmul($_[1]); },
'/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0])
: $_[0] -> copy() -> bdiv($_[1]); },
'%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0])
: $_[0] -> copy() -> bmod($_[1]); },
'**' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0])
: $_[0] -> copy() -> bpow($_[1]); },
'<<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0])
: $_[0] -> copy() -> blsft($_[1]); },
'>>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0])
: $_[0] -> copy() -> brsft($_[1]); },
# overload key: assign
'+=' => sub { $_[0]->badd($_[1]); },
'-=' => sub { $_[0]->bsub($_[1]); },
'*=' => sub { $_[0]->bmul($_[1]); },
'/=' => sub { scalar $_[0]->bdiv($_[1]); },
'%=' => sub { $_[0]->bmod($_[1]); },
'**=' => sub { $_[0]->bpow($_[1]); },
'<<=' => sub { $_[0]->blsft($_[1]); },
'>>=' => sub { $_[0]->brsft($_[1]); },
# 'x=' => sub { },
# '.=' => sub { },
# overload key: num_comparison
'<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0])
: $_[0] -> blt($_[1]); },
'<=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0])
: $_[0] -> ble($_[1]); },
'>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0])
: $_[0] -> bgt($_[1]); },
'>=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0])
: $_[0] -> bge($_[1]); },
'==' => sub { $_[0] -> beq($_[1]); },
'!=' => sub { $_[0] -> bne($_[1]); },
# overload key: 3way_comparison
'<=>' => sub { my $cmp = $_[0] -> bcmp($_[1]);
defined($cmp) && $_[2] ? -$cmp : $cmp; },
'cmp' => sub { $_[2] ? "$_[1]" cmp $_[0] -> bstr()
: $_[0] -> bstr() cmp "$_[1]"; },
# overload key: str_comparison
# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0])
# : $_[0] -> bstrlt($_[1]); },
#
# 'le' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0])
# : $_[0] -> bstrle($_[1]); },
#
# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0])
# : $_[0] -> bstrgt($_[1]); },
#
# 'ge' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0])
# : $_[0] -> bstrge($_[1]); },
#
# 'eq' => sub { $_[0] -> bstreq($_[1]); },
#
# 'ne' => sub { $_[0] -> bstrne($_[1]); },
# overload key: binary
'&' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0])
: $_[0] -> copy() -> band($_[1]); },
'&=' => sub { $_[0] -> band($_[1]); },
'|' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0])
: $_[0] -> copy() -> bior($_[1]); },
'|=' => sub { $_[0] -> bior($_[1]); },
'^' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0])
: $_[0] -> copy() -> bxor($_[1]); },
'^=' => sub { $_[0] -> bxor($_[1]); },
# '&.' => sub { },
# '&.=' => sub { },
# '|.' => sub { },
# '|.=' => sub { },
# '^.' => sub { },
# '^.=' => sub { },
# overload key: unary
'neg' => sub { $_[0] -> copy() -> bneg(); },
# '!' => sub { },
'~' => sub { $_[0] -> copy() -> bnot(); },
# '~.' => sub { },
# overload key: mutators
'++' => sub { $_[0] -> binc() },
'--' => sub { $_[0] -> bdec() },
# overload key: func
'atan2' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0])
: $_[0] -> copy() -> batan2($_[1]); },
'cos' => sub { $_[0] -> copy() -> bcos(); },
'sin' => sub { $_[0] -> copy() -> bsin(); },
'exp' => sub { $_[0] -> copy() -> bexp($_[1]); },
'abs' => sub { $_[0] -> copy() -> babs(); },
'log' => sub { $_[0] -> copy() -> blog(); },
'sqrt' => sub { $_[0] -> copy() -> bsqrt(); },
'int' => sub { $_[0] -> copy() -> bint(); },
# overload key: conversion
'bool' => sub { $_[0] -> is_zero() ? '' : 1; },
'""' => sub { $_[0] -> bstr(); },
'0+' => sub { $_[0] -> numify(); },
'=' => sub { $_[0]->copy(); },
;
BEGIN {
*objectify = \&Math::BigInt::objectify; # inherit this from BigInt
*AUTOLOAD = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD
# We inherit these from BigFloat because currently it is not possible that
# Math::BigFloat has a different $LIB variable than we, because
# Math::BigFloat also uses Math::BigInt::config->('lib') (there is always
# only one library loaded)
*_e_add = \&Math::BigFloat::_e_add;
*_e_sub = \&Math::BigFloat::_e_sub;
*as_number = \&as_int;
*is_pos = \&is_positive;
*is_neg = \&is_negative;
}
##############################################################################
# Global constants and flags. Access these only via the accessor methods!
$accuracy = $precision = undef;
$round_mode = 'even';
$div_scale = 40;
$upgrade = undef;
$downgrade = undef;
# These are internally, and not to be used from the outside at all!
$_trap_nan = 0; # are NaNs ok? set w/ config()
$_trap_inf = 0; # are infs ok? set w/ config()
# the math backend library
my $LIB = 'Math::BigInt::Calc';
my $nan = 'NaN';
#my $class = 'Math::BigRat';
sub isa {
return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't
UNIVERSAL::isa(@_);
}
##############################################################################
sub new {
my $proto = shift;
my $protoref = ref $proto;
my $class = $protoref || $proto;
# Check the way we are called.
if ($protoref) {
croak("new() is a class method, not an instance method");
}
if (@_ < 1) {
#carp("Using new() with no argument is deprecated;",
# " use bzero() or new(0) instead");
return $class -> bzero();
}
if (@_ > 2) {
carp("Superfluous arguments to new() ignored.");
}
# Get numerator and denominator. If any of the arguments is undefined,
# return zero.
my ($n, $d) = @_;
if (@_ == 1 && !defined $n ||
@_ == 2 && (!defined $n || !defined $d))
{
#carp("Use of uninitialized value in new()");
return $class -> bzero();
}
# Initialize a new object.
my $self = bless {}, $class;
# One or two input arguments may be given. First handle the numerator $n.
if (ref($n)) {
$n = Math::BigFloat -> new($n, undef, undef)
unless ($n -> isa('Math::BigRat') ||
$n -> isa('Math::BigInt') ||
$n -> isa('Math::BigFloat'));
} else {
if (defined $d) {
# If the denominator is defined, the numerator is not a string
# fraction, e.g., "355/113".
$n = Math::BigFloat -> new($n, undef, undef);
} else {
# If the denominator is undefined, the numerator might be a string
# fraction, e.g., "355/113".
if ($n =~ m| ^ \s* (\S+) \s* / \s* (\S+) \s* $ |x) {
$n = Math::BigFloat -> new($1, undef, undef);
$d = Math::BigFloat -> new($2, undef, undef);
} else {
$n = Math::BigFloat -> new($n, undef, undef);
}
}
}
# At this point $n is an object and $d is either an object or undefined. An
# undefined $d means that $d was not specified by the caller (not that $d
# was specified as an undefined value).
unless (defined $d) {
#return $n -> copy($n) if $n -> isa('Math::BigRat');
return $class -> copy($n) if $n -> isa('Math::BigRat');
return $class -> bnan() if $n -> is_nan();
return $class -> binf($n -> sign()) if $n -> is_inf();
if ($n -> isa('Math::BigInt')) {
$self -> {_n} = $LIB -> _new($n -> copy() -> babs() -> bstr());
$self -> {_d} = $LIB -> _one();
$self -> {sign} = $n -> sign();
return $self;
}
if ($n -> isa('Math::BigFloat')) {
my $m = $n -> mantissa() -> babs();
my $e = $n -> exponent();
$self -> {_n} = $LIB -> _new($m -> bstr());
$self -> {_d} = $LIB -> _one();
if ($e > 0) {
$self -> {_n} = $LIB -> _lsft($self -> {_n},
$LIB -> _new($e -> bstr()), 10);
} elsif ($e < 0) {
$self -> {_d} = $LIB -> _lsft($self -> {_d},
$LIB -> _new(-$e -> bstr()), 10);
my $gcd = $LIB -> _gcd($LIB -> _copy($self -> {_n}), $self -> {_d});
if (!$LIB -> _is_one($gcd)) {
$self -> {_n} = $LIB -> _div($self->{_n}, $gcd);
$self -> {_d} = $LIB -> _div($self->{_d}, $gcd);
}
}
$self -> {sign} = $n -> sign();
return $self;
}
die "I don't know how to handle this"; # should never get here
}
# At the point we know that both $n and $d are defined. We know that $n is
# an object, but $d might still be a scalar. Now handle $d.
$d = Math::BigFloat -> new($d, undef, undef)
unless ref($d) && ($d -> isa('Math::BigRat') ||
$d -> isa('Math::BigInt') ||
$d -> isa('Math::BigFloat'));
# At this point both $n and $d are objects.
return $class -> bnan() if $n -> is_nan() || $d -> is_nan();
# At this point neither $n nor $d is a NaN.
if ($n -> is_zero()) {
return $class -> bnan() if $d -> is_zero(); # 0/0 = NaN
return $class -> bzero();
}
return $class -> binf($d -> sign()) if $d -> is_zero();
# At this point, neither $n nor $d is a NaN or a zero.
if ($d < 0) { # make sure denominator is positive
$n -> bneg();
$d -> bneg();
}
if ($n -> is_inf()) {
return $class -> bnan() if $d -> is_inf(); # Inf/Inf = NaN
return $class -> binf($n -> sign());
}
# At this point $n is finite.
return $class -> bzero() if $d -> is_inf();
return $class -> binf($d -> sign()) if $d -> is_zero();
# At this point both $n and $d are finite and non-zero.
if ($n < 0) {
$n -> bneg();
$self -> {sign} = '-';
} else {
$self -> {sign} = '+';
}
if ($n -> isa('Math::BigRat')) {
if ($d -> isa('Math::BigRat')) {
# At this point both $n and $d is a Math::BigRat.
# p r p * s (p / gcd(p, r)) * (s / gcd(s, q))
# - / - = ----- = ---------------------------------
# q s q * r (q / gcd(s, q)) * (r / gcd(p, r))
my $p = $n -> {_n};
my $q = $n -> {_d};
my $r = $d -> {_n};
my $s = $d -> {_d};
my $gcd_pr = $LIB -> _gcd($LIB -> _copy($p), $r);
my $gcd_sq = $LIB -> _gcd($LIB -> _copy($s), $q);
$self -> {_n} = $LIB -> _mul($LIB -> _div($LIB -> _copy($p), $gcd_pr),
$LIB -> _div($LIB -> _copy($s), $gcd_sq));
$self -> {_d} = $LIB -> _mul($LIB -> _div($LIB -> _copy($q), $gcd_sq),
$LIB -> _div($LIB -> _copy($r), $gcd_pr));
return $self; # no need for $self -> bnorm() here
}
# At this point, $n is a Math::BigRat and $d is a Math::Big(Int|Float).
my $p = $n -> {_n};
my $q = $n -> {_d};
my $m = $d -> mantissa();
my $e = $d -> exponent();
# / p
# | ------------ if e > 0
# | q * m * 10^e
# |
# p | p
# - / (m * 10^e) = | ----- if e == 0
# q | q * m
# |
# | p * 10^-e
# | -------- if e < 0
# \ q * m
$self -> {_n} = $LIB -> _copy($p);
$self -> {_d} = $LIB -> _mul($LIB -> _copy($q), $m);
if ($e > 0) {
$self -> {_d} = $LIB -> _lsft($self -> {_d}, $e, 10);
} elsif ($e < 0) {
$self -> {_n} = $LIB -> _lsft($self -> {_n}, -$e, 10);
}
return $self -> bnorm();
} else {
if ($d -> isa('Math::BigRat')) {
# At this point $n is a Math::Big(Int|Float) and $d is a
# Math::BigRat.
my $m = $n -> mantissa();
my $e = $n -> exponent();
my $p = $d -> {_n};
my $q = $d -> {_d};
# / q * m * 10^e
# | ------------ if e > 0
# | p
# |
# p | m * q
# (m * 10^e) / - = | ----- if e == 0
# q | p
# |
# | q * m
# | --------- if e < 0
# \ p * 10^-e
$self -> {_n} = $LIB -> _mul($LIB -> _copy($q), $m);
$self -> {_d} = $LIB -> _copy($p);
if ($e > 0) {
$self -> {_n} = $LIB -> _lsft($self -> {_n}, $e, 10);
} elsif ($e < 0) {
$self -> {_d} = $LIB -> _lsft($self -> {_d}, -$e, 10);
}
return $self -> bnorm();
} else {
# At this point $n and $d are both a Math::Big(Int|Float)
my $m1 = $n -> mantissa();
my $e1 = $n -> exponent();
my $m2 = $d -> mantissa();
my $e2 = $d -> exponent();
# /
# | m1 * 10^(e1 - e2)
# | ----------------- if e1 > e2
# | m2
# |
# m1 * 10^e1 | m1
# ---------- = | -- if e1 = e2
# m2 * 10^e2 | m2
# |
# | m1
# | ----------------- if e1 < e2
# | m2 * 10^(e2 - e1)
# \
$self -> {_n} = $LIB -> _new($m1 -> bstr());
$self -> {_d} = $LIB -> _new($m2 -> bstr());
my $ediff = $e1 - $e2;
if ($ediff > 0) {
$self -> {_n} = $LIB -> _lsft($self -> {_n},
$LIB -> _new($ediff -> bstr()),
10);
} elsif ($ediff < 0) {
$self -> {_d} = $LIB -> _lsft($self -> {_d},
$LIB -> _new(-$ediff -> bstr()),
10);
}
return $self -> bnorm();
}
}
return $self;
}
sub copy {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
# If called as a class method, the object to copy is the next argument.
$self = shift() unless $selfref;
my $copy = bless {}, $class;
$copy->{sign} = $self->{sign};
$copy->{_d} = $LIB->_copy($self->{_d});
$copy->{_n} = $LIB->_copy($self->{_n});
$copy->{_a} = $self->{_a} if defined $self->{_a};
$copy->{_p} = $self->{_p} if defined $self->{_p};
#($copy, $copy->{_a}, $copy->{_p})
# = $copy->_find_round_parameters(@_);
return $copy;
}
sub bnan {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
$self = bless {}, $class unless $selfref;
if ($_trap_nan) {
croak ("Tried to set a variable to NaN in $class->bnan()");
}
$self -> {sign} = $nan;
$self -> {_n} = $LIB -> _zero();
$self -> {_d} = $LIB -> _one();
($self, $self->{_a}, $self->{_p})
= $self->_find_round_parameters(@_);
return $self;
}
sub binf {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
$self = bless {}, $class unless $selfref;
my $sign = shift();
$sign = defined($sign) && substr($sign, 0, 1) eq '-' ? '-inf' : '+inf';
if ($_trap_inf) {
croak ("Tried to set a variable to +-inf in $class->binf()");
}
$self -> {sign} = $sign;
$self -> {_n} = $LIB -> _zero();
$self -> {_d} = $LIB -> _one();
($self, $self->{_a}, $self->{_p})
= $self->_find_round_parameters(@_);
return $self;
}
sub bone {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
$self = bless {}, $class unless $selfref;
my $sign = shift();
$sign = '+' unless defined($sign) && $sign eq '-';
$self -> {sign} = $sign;
$self -> {_n} = $LIB -> _one();
$self -> {_d} = $LIB -> _one();
($self, $self->{_a}, $self->{_p})
= $self->_find_round_parameters(@_);
return $self;
}
sub bzero {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
$self = bless {}, $class unless $selfref;
$self -> {sign} = '+';
$self -> {_n} = $LIB -> _zero();
$self -> {_d} = $LIB -> _one();
($self, $self->{_a}, $self->{_p})
= $self->_find_round_parameters(@_);
return $self;
}
##############################################################################
sub config {
# return (later set?) configuration data as hash ref
my $class = shift() || 'Math::BigRat';
if (@_ == 1 && ref($_[0]) ne 'HASH') {
my $cfg = $class->SUPER::config();
return $cfg->{$_[0]};
}
my $cfg = $class->SUPER::config(@_);
# now we need only to override the ones that are different from our parent
$cfg->{class} = $class;
$cfg->{with} = $LIB;
$cfg;
}
##############################################################################
sub bstr {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
if ($x->{sign} !~ /^[+-]$/) { # inf, NaN etc
my $s = $x->{sign};
$s =~ s/^\+//; # +inf => inf
return $s;
}
my $s = '';
$s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2'
return $s . $LIB->_str($x->{_n}) if $LIB->_is_one($x->{_d});
$s . $LIB->_str($x->{_n}) . '/' . $LIB->_str($x->{_d});
}
sub bsstr {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
if ($x->{sign} !~ /^[+-]$/) { # inf, NaN etc
my $s = $x->{sign};
$s =~ s/^\+//; # +inf => inf
return $s;
}
my $s = '';
$s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
$s . $LIB->_str($x->{_n}) . '/' . $LIB->_str($x->{_d});
}
sub bnorm {
# reduce the number to the shortest form
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
# Both parts must be objects of whatever we are using today.
if (my $c = $LIB->_check($x->{_n})) {
croak("n did not pass the self-check ($c) in bnorm()");
}
if (my $c = $LIB->_check($x->{_d})) {
croak("d did not pass the self-check ($c) in bnorm()");
}
# no normalize for NaN, inf etc.
return $x if $x->{sign} !~ /^[+-]$/;
# normalize zeros to 0/1
if ($LIB->_is_zero($x->{_n})) {
$x->{sign} = '+'; # never leave a -0
$x->{_d} = $LIB->_one() unless $LIB->_is_one($x->{_d});
return $x;
}
return $x if $LIB->_is_one($x->{_d}); # no need to reduce
# Compute the GCD.
my $gcd = $LIB->_gcd($LIB->_copy($x->{_n}), $x->{_d});
if (!$LIB->_is_one($gcd)) {
$x->{_n} = $LIB->_div($x->{_n}, $gcd);
$x->{_d} = $LIB->_div($x->{_d}, $gcd);
}
$x;
}
##############################################################################
# sign manipulation
sub bneg {
# (BRAT or num_str) return BRAT
# negate number or make a negated number from string
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return $x if $x->modify('bneg');
# for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
$x->{sign} =~ tr/+-/-+/
unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_n}));
$x;
}
##############################################################################
# special values
sub _bnan {
# used by parent class bnan() to initialize number to NaN
my $self = shift;
if ($_trap_nan) {
my $class = ref($self);
# "$self" below will stringify the object, this blows up if $self is a
# partial object (happens under trap_nan), so fix it beforehand
$self->{_d} = $LIB->_zero() unless defined $self->{_d};
$self->{_n} = $LIB->_zero() unless defined $self->{_n};
croak ("Tried to set $self to NaN in $class\::_bnan()");
}
$self->{_n} = $LIB->_zero();
$self->{_d} = $LIB->_zero();
}
sub _binf {
# used by parent class bone() to initialize number to +inf/-inf
my $self = shift;
if ($_trap_inf) {
my $class = ref($self);
# "$self" below will stringify the object, this blows up if $self is a
# partial object (happens under trap_nan), so fix it beforehand
$self->{_d} = $LIB->_zero() unless defined $self->{_d};
$self->{_n} = $LIB->_zero() unless defined $self->{_n};
croak ("Tried to set $self to inf in $class\::_binf()");
}
$self->{_n} = $LIB->_zero();
$self->{_d} = $LIB->_zero();
}
sub _bone {
# used by parent class bone() to initialize number to +1/-1
my $self = shift;
$self->{_n} = $LIB->_one();
$self->{_d} = $LIB->_one();
}
sub _bzero {
# used by parent class bzero() to initialize number to 0
my $self = shift;
$self->{_n} = $LIB->_zero();
$self->{_d} = $LIB->_one();
}
##############################################################################
# mul/add/div etc
sub badd {
# add two rational numbers
# set up parameters
my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, @r) = objectify(2, @_);
}
# +inf + +inf => +inf, -inf + -inf => -inf
return $x->binf(substr($x->{sign}, 0, 1))
if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
# +inf + -inf or -inf + +inf => NaN
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
# 1 1 gcd(3, 4) = 1 1*3 + 1*4 7
# - + - = --------- = --
# 4 3 4*3 12
# we do not compute the gcd() here, but simple do:
# 5 7 5*3 + 7*4 43
# - + - = --------- = --
# 4 3 4*3 12
# and bnorm() will then take care of the rest
# 5 * 3
$x->{_n} = $LIB->_mul($x->{_n}, $y->{_d});
# 7 * 4
my $m = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
# 5 * 3 + 7 * 4
($x->{_n}, $x->{sign}) = _e_add($x->{_n}, $m, $x->{sign}, $y->{sign});
# 4 * 3
$x->{_d} = $LIB->_mul($x->{_d}, $y->{_d});
# normalize result, and possible round
$x->bnorm()->round(@r);
}
sub bsub {
# subtract two rational numbers
# set up parameters
my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, @r) = objectify(2, @_);
}
# flip sign of $x, call badd(), then flip sign of result
$x->{sign} =~ tr/+-/-+/
unless $x->{sign} eq '+' && $LIB->_is_zero($x->{_n}); # not -0
$x->badd($y, @r); # does norm and round
$x->{sign} =~ tr/+-/-+/
unless $x->{sign} eq '+' && $LIB->_is_zero($x->{_n}); # not -0
$x;
}
sub bmul {
# multiply two rational numbers
# set up parameters
my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, @r) = objectify(2, @_);
}
return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN';
# inf handling
if ($x->{sign} =~ /^[+-]inf$/ || $y->{sign} =~ /^[+-]inf$/) {
return $x->bnan() if $x->is_zero() || $y->is_zero();
# result will always be +-inf:
# +inf * +/+inf => +inf, -inf * -/-inf => +inf
# +inf * -/-inf => -inf, -inf * +/+inf => -inf
return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
return $x->binf('-');
}
# x == 0 # also: or y == 1 or y == -1
return wantarray ? ($x, $class->bzero()) : $x if $x -> is_zero();
if ($y -> is_zero()) {
$x -> bzero();
return wantarray ? ($x, $class->bzero()) : $x;
}
# According to Knuth, this can be optimized by doing gcd twice (for d
# and n) and reducing in one step. This saves us a bnorm() at the end.
#
# p s p * s (p / gcd(p, r)) * (s / gcd(s, q))
# - * - = ----- = ---------------------------------
# q r q * r (q / gcd(s, q)) * (r / gcd(p, r))
my $gcd_pr = $LIB -> _gcd($LIB -> _copy($x->{_n}), $y->{_d});
my $gcd_sq = $LIB -> _gcd($LIB -> _copy($y->{_n}), $x->{_d});
$x->{_n} = $LIB -> _mul(scalar $LIB -> _div($x->{_n}, $gcd_pr),
scalar $LIB -> _div($LIB -> _copy($y->{_n}),
$gcd_sq));
$x->{_d} = $LIB -> _mul(scalar $LIB -> _div($x->{_d}, $gcd_sq),
scalar $LIB -> _div($LIB -> _copy($y->{_d}),
$gcd_pr));
# compute new sign
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
$x->round(@r);
}
sub bdiv {
# (dividend: BRAT or num_str, divisor: BRAT or num_str) return
# (BRAT, BRAT) (quo, rem) or BRAT (only rem)
# set up parameters
my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, @r) = objectify(2, @_);
}
return $x if $x->modify('bdiv');
my $wantarray = wantarray; # call only once
# At least one argument is NaN. This is handled the same way as in
# Math::BigInt -> bdiv(). See the comments in the code implementing that
# method.
if ($x -> is_nan() || $y -> is_nan()) {
return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan();
}
# Divide by zero and modulo zero. This is handled the same way as in
# Math::BigInt -> bdiv(). See the comments in the code implementing that
# method.
if ($y -> is_zero()) {
my ($quo, $rem);
if ($wantarray) {
$rem = $x -> copy();
}
if ($x -> is_zero()) {
$quo = $x -> bnan();
} else {
$quo = $x -> binf($x -> {sign});
}
return $wantarray ? ($quo, $rem) : $quo;
}
# Numerator (dividend) is +/-inf. This is handled the same way as in
# Math::BigInt -> bdiv(). See the comments in the code implementing that
# method.
if ($x -> is_inf()) {
my ($quo, $rem);
$rem = $class -> bnan() if $wantarray;
if ($y -> is_inf()) {
$quo = $x -> bnan();
} else {
my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
$quo = $x -> binf($sign);
}
return $wantarray ? ($quo, $rem) : $quo;
}
# Denominator (divisor) is +/-inf. This is handled the same way as in
# Math::BigFloat -> bdiv(). See the comments in the code implementing that
# method.
if ($y -> is_inf()) {
my ($quo, $rem);
if ($wantarray) {
if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
$rem = $x -> copy();
$quo = $x -> bzero();
} else {
$rem = $class -> binf($y -> {sign});
$quo = $x -> bone('-');
}
return ($quo, $rem);
} else {
if ($y -> is_inf()) {
if ($x -> is_nan() || $x -> is_inf()) {
return $x -> bnan();
} else {
return $x -> bzero();
}
}
}
}
# At this point, both the numerator and denominator are finite numbers, and
# the denominator (divisor) is non-zero.
# x == 0?
return wantarray ? ($x, $class->bzero()) : $x if $x->is_zero();
# XXX TODO: list context, upgrade
# According to Knuth, this can be optimized by doing gcd twice (for d and n)
# and reducing in one step. This would save us the bnorm() at the end.
#
# p r p * s (p / gcd(p, r)) * (s / gcd(s, q))
# - / - = ----- = ---------------------------------
# q s q * r (q / gcd(s, q)) * (r / gcd(p, r))
$x->{_n} = $LIB->_mul($x->{_n}, $y->{_d});
$x->{_d} = $LIB->_mul($x->{_d}, $y->{_n});
# compute new sign
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
$x -> bnorm();
if (wantarray) {
my $rem = $x -> copy();
$x -> bfloor();
$x -> round(@r);
$rem -> bsub($x -> copy()) -> bmul($y);
return $x, $rem;
} else {
$x -> round(@r);
return $x;
}
}
sub bmod {
# compute "remainder" (in Perl way) of $x / $y
# set up parameters
my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, @r) = objectify(2, @_);
}
return $x if $x->modify('bmod');
# At least one argument is NaN. This is handled the same way as in
# Math::BigInt -> bmod().
if ($x -> is_nan() || $y -> is_nan()) {
return $x -> bnan();
}
# Modulo zero. This is handled the same way as in Math::BigInt -> bmod().
if ($y -> is_zero()) {
return $x;
}
# Numerator (dividend) is +/-inf. This is handled the same way as in
# Math::BigInt -> bmod().
if ($x -> is_inf()) {
return $x -> bnan();
}
# Denominator (divisor) is +/-inf. This is handled the same way as in
# Math::BigInt -> bmod().
if ($y -> is_inf()) {
if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
return $x;
} else {
return $x -> binf($y -> sign());
}
}
# At this point, both the numerator and denominator are finite numbers, and
# the denominator (divisor) is non-zero.
return $x if $x->is_zero(); # 0 / 7 = 0, mod 0
# Compute $x - $y * floor($x/$y). This can probably be optimized by working
# on a lower level.
$x -> bsub($x -> copy() -> bdiv($y) -> bfloor() -> bmul($y));
return $x -> round(@r);
}
##############################################################################
# bdec/binc
sub bdec {
# decrement value (subtract 1)
my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
if ($x->{sign} eq '-') {
$x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # -5/2 => -7/2
} else {
if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) # n < d?
{
# 1/3 -- => -2/3
$x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n});
$x->{sign} = '-';
} else {
$x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2
}
}
$x->bnorm()->round(@r);
}
sub binc {
# increment value (add 1)
my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
if ($x->{sign} eq '-') {
if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) {
# -1/3 ++ => 2/3 (overflow at 0)
$x->{_n} = $LIB->_sub($LIB->_copy($x->{_d}), $x->{_n});
$x->{sign} = '+';
} else {
$x->{_n} = $LIB->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2
}
} else {
$x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # 5/2 => 7/2
}
$x->bnorm()->round(@r);
}
##############################################################################
# is_foo methods (the rest is inherited)
sub is_int {
# return true if arg (BRAT or num_str) is an integer
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
$LIB->_is_one($x->{_d}); # x/y && y != 1 => no integer
0;
}
sub is_zero {
# return true if arg (BRAT or num_str) is zero
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return 1 if $x->{sign} eq '+' && $LIB->_is_zero($x->{_n});
0;
}
sub is_one {
# return true if arg (BRAT or num_str) is +1 or -1 if signis given
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
croak "too many arguments for is_one()" if @_ > 2;
my $sign = $_[1] || '';
$sign = '+' if $sign ne '-';
return 1 if ($x->{sign} eq $sign &&
$LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d}));
0;
}
sub is_odd {
# return true if arg (BFLOAT or num_str) is odd or false if even
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
($LIB->_is_one($x->{_d}) && $LIB->_is_odd($x->{_n})); # x/2 is not, but 3/1
0;
}
sub is_even {
# return true if arg (BINT or num_str) is even or false if odd
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
return 1 if ($LIB->_is_one($x->{_d}) # x/3 is never
&& $LIB->_is_even($x->{_n})); # but 4/1 is
0;
}
##############################################################################
# parts() and friends
sub numerator {
my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
# NaN, inf, -inf
return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/);
my $n = Math::BigInt->new($LIB->_str($x->{_n}));
$n->{sign} = $x->{sign};
$n;
}
sub denominator {
my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
# NaN
return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN';
# inf, -inf
return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/;
Math::BigInt->new($LIB->_str($x->{_d}));
}
sub parts {
my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
my $c = 'Math::BigInt';
return ($c->bnan(), $c->bnan()) if $x->{sign} eq 'NaN';
return ($c->binf(), $c->binf()) if $x->{sign} eq '+inf';
return ($c->binf('-'), $c->binf()) if $x->{sign} eq '-inf';
my $n = $c->new($LIB->_str($x->{_n}));
$n->{sign} = $x->{sign};
my $d = $c->new($LIB->_str($x->{_d}));
($n, $d);
}
sub length {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return $nan unless $x->is_int();
$LIB->_len($x->{_n}); # length(-123/1) => length(123)
}
sub digit {
my ($class, $x, $n) = ref($_[0]) ? (undef, $_[0], $_[1]) : objectify(1, @_);
return $nan unless $x->is_int();
$LIB->_digit($x->{_n}, $n || 0); # digit(-123/1, 2) => digit(123, 2)
}
##############################################################################
# special calc routines
sub bceil {
my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
return $x if ($x->{sign} !~ /^[+-]$/ || # not for NaN, inf
$LIB->_is_one($x->{_d})); # 22/1 => 22, 0/1 => 0
$x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
$x->{_d} = $LIB->_one(); # d => 1
$x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '+'; # +22/7 => 4/1
$x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_zero($x->{_n}); # -0 => 0
$x;
}
sub bfloor {
my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
return $x if ($x->{sign} !~ /^[+-]$/ || # not for NaN, inf
$LIB->_is_one($x->{_d})); # 22/1 => 22, 0/1 => 0
$x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
$x->{_d} = $LIB->_one(); # d => 1
$x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '-'; # -22/7 => -4/1
$x;
}
sub bint {
my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
return $x if ($x->{sign} !~ /^[+-]$/ || # +/-inf or NaN
$LIB -> _is_one($x->{_d})); # already an integer
$x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
$x->{_d} = $LIB->_one(); # d => 1
$x->{sign} = '+' if $x->{sign} eq '-' && $LIB -> _is_zero($x->{_n});
return $x;
}
sub bfac {
my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
# if $x is not an integer
if (($x->{sign} ne '+') || (!$LIB->_is_one($x->{_d}))) {
return $x->bnan();
}
$x->{_n} = $LIB->_fac($x->{_n});
# since _d is 1, we don't need to reduce/norm the result
$x->round(@r);
}
sub bpow {
# power ($x ** $y)
# set up parameters
my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, @r) = objectify(2, @_);
}
# $x and/or $y is a NaN
return $x->bnan() if $x->is_nan() || $y->is_nan();
# $x and/or $y is a +/-Inf
if ($x->is_inf("-")) {
return $x->bzero() if $y->is_negative();
return $x->bnan() if $y->is_zero();
return $x if $y->is_odd();
return $x->bneg();
} elsif ($x->is_inf("+")) {
return $x->bzero() if $y->is_negative();
return $x->bnan() if $y->is_zero();
return $x;
} elsif ($y->is_inf("-")) {
return $x->bnan() if $x -> is_one("-");
return $x->binf("+") if $x > -1 && $x < 1;
return $x->bone() if $x -> is_one("+");
return $x->bzero();
} elsif ($y->is_inf("+")) {
return $x->bnan() if $x -> is_one("-");
return $x->bzero() if $x > -1 && $x < 1;
return $x->bone() if $x -> is_one("+");
return $x->binf("+");
}
if ($x->is_zero()) {
return $x->binf() if $y->is_negative();
return $x->bone("+") if $y->is_zero();
return $x;
} elsif ($x->is_one()) {
return $x->round(@r) if $y->is_odd(); # x is -1, y is odd => -1
return $x->babs()->round(@r); # x is -1, y is even => 1
} elsif ($y->is_zero()) {
return $x->bone(@r); # x^0 and x != 0 => 1
} elsif ($y->is_one()) {
return $x->round(@r); # x^1 => x
}
# we don't support complex numbers, so return NaN
return $x->bnan() if $x->is_negative() && !$y->is_int();
# (a/b)^-(c/d) = (b/a)^(c/d)
($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}) if $y->is_negative();
unless ($LIB->_is_one($y->{_n})) {
$x->{_n} = $LIB->_pow($x->{_n}, $y->{_n});
$x->{_d} = $LIB->_pow($x->{_d}, $y->{_n});
$x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_even($y->{_n});
}
unless ($LIB->_is_one($y->{_d})) {
return $x->bsqrt(@r) if $LIB->_is_two($y->{_d}); # 1/2 => sqrt
return $x->broot($LIB->_str($y->{_d}), @r); # 1/N => root(N)
}
return $x->round(@r);
}
sub blog {
# Return the logarithm of the operand. If a second operand is defined, that
# value is used as the base, otherwise the base is assumed to be Euler's
# constant.
my ($class, $x, $base, @r);
# Don't objectify the base, since an undefined base, as in $x->blog() or
# $x->blog(undef) signals that the base is Euler's number.
if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
# E.g., Math::BigFloat->blog(256, 2)
($class, $x, $base, @r) =
defined $_[2] ? objectify(2, @_) : objectify(1, @_);
} else {
# E.g., Math::BigFloat::blog(256, 2) or $x->blog(2)
($class, $x, $base, @r) =
defined $_[1] ? objectify(2, @_) : objectify(1, @_);
}
return $x if $x->modify('blog');
# Handle all exception cases and all trivial cases. I have used Wolfram Alpha
# (http://www.wolframalpha.com) as the reference for these cases.
return $x -> bnan() if $x -> is_nan();
if (defined $base) {
$base = $class -> new($base) unless ref $base;
if ($base -> is_nan() || $base -> is_one()) {
return $x -> bnan();
} elsif ($base -> is_inf() || $base -> is_zero()) {
return $x -> bnan() if $x -> is_inf() || $x -> is_zero();
return $x -> bzero();
} elsif ($base -> is_negative()) { # -inf < base < 0
return $x -> bzero() if $x -> is_one(); # x = 1
return $x -> bone() if $x == $base; # x = base
return $x -> bnan(); # otherwise
}
return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf
}
# We now know that the base is either undefined or positive and finite.
if ($x -> is_inf()) { # x = +/-inf
my $sign = defined $base && $base < 1 ? '-' : '+';
return $x -> binf($sign);
} elsif ($x -> is_neg()) { # -inf < x < 0
return $x -> bnan();
} elsif ($x -> is_one()) { # x = 1
return $x -> bzero();
} elsif ($x -> is_zero()) { # x = 0
my $sign = defined $base && $base < 1 ? '+' : '-';
return $x -> binf($sign);
}
# At this point we are done handling all exception cases and trivial cases.
$base = Math::BigFloat -> new($base) if defined $base;
my $xn = Math::BigFloat -> new($LIB -> _str($x->{_n}));
my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> blog($base, @r) -> bsstr());
$x -> {sign} = $xtmp -> {sign};
$x -> {_n} = $xtmp -> {_n};
$x -> {_d} = $xtmp -> {_d};
return $x;
}
sub bexp {
# set up parameters
my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, @r) = objectify(1, @_);
}
return $x->binf(@r) if $x->{sign} eq '+inf';
return $x->bzero(@r) if $x->{sign} eq '-inf';
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
my ($scale, @params);
($x, @params) = $x->_find_round_parameters(@r);
# also takes care of the "error in _find_round_parameters?" case
return $x if $x->{sign} eq 'NaN';
# no rounding at all, so must use fallback
if (scalar @params == 0) {
# simulate old behaviour
$params[0] = $class->div_scale(); # and round to it as accuracy
$params[1] = undef; # P = undef
$scale = $params[0]+4; # at least four more for proper round
$params[2] = $r[2]; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
} else {
# the 4 below is empirical, and there might be cases where it's not enough...
$scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
}
return $x->bone(@params) if $x->is_zero();
# See the comments in Math::BigFloat on how this algorithm works.
# Basically we calculate A and B (where B is faculty(N)) so that A/B = e
my $x_org = $x->copy();
if ($scale <= 75) {
# set $x directly from a cached string form
$x->{_n} =
$LIB->_new("90933395208605785401971970164779391644753259799242");
$x->{_d} =
$LIB->_new("33452526613163807108170062053440751665152000000000");
$x->{sign} = '+';
} else {
# compute A and B so that e = A / B.
# After some terms we end up with this, so we use it as a starting point:
my $A = $LIB->_new("90933395208605785401971970164779391644753259799242");
my $F = $LIB->_new(42); my $step = 42;
# Compute how many steps we need to take to get $A and $B sufficiently big
my $steps = Math::BigFloat::_len_to_steps($scale - 4);
# print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
while ($step++ <= $steps) {
# calculate $a * $f + 1
$A = $LIB->_mul($A, $F);
$A = $LIB->_inc($A);
# increment f
$F = $LIB->_inc($F);
}
# compute $B as factorial of $steps (this is faster than doing it manually)
my $B = $LIB->_fac($LIB->_new($steps));
# print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n";
$x->{_n} = $A;
$x->{_d} = $B;
$x->{sign} = '+';
}
# $x contains now an estimate of e, with some surplus digits, so we can round
if (!$x_org->is_one()) {
# raise $x to the wanted power and round it in one step:
$x->bpow($x_org, @params);
} else {
# else just round the already computed result
delete $x->{_a}; delete $x->{_p};
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
$x->bround($params[0], $params[2]); # then round accordingly
} else {
$x->bfround($params[1], $params[2]); # then round accordingly
}
}
if ($fallback) {
# clear a/p after round, since user did not request it
delete $x->{_a}; delete $x->{_p};
}
$x;
}
sub bnok {
# set up parameters
my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, @r) = objectify(2, @_);
}
my $xint = Math::BigInt -> new($x -> bint() -> bsstr());
my $yint = Math::BigInt -> new($y -> bint() -> bsstr());
$xint -> bnok($yint);
$x -> {sign} = $xint -> {sign};
$x -> {_n} = $xint -> {_n};
$x -> {_d} = $xint -> {_d};
return $x;
}
sub broot {
# set up parameters
my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, @r) = objectify(2, @_);
}
# Convert $x into a Math::BigFloat.
my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n})) -> bdiv($xd);
$xflt -> {sign} = $x -> {sign};
# Convert $y into a Math::BigFloat.
my $yd = Math::BigFloat -> new($LIB -> _str($y->{_d}));
my $yflt = Math::BigFloat -> new($LIB -> _str($y->{_n})) -> bdiv($yd);
$yflt -> {sign} = $y -> {sign};
# Compute the root and convert back to a Math::BigRat.
$xflt -> broot($yflt, @r);
my $xtmp = Math::BigRat -> new($xflt -> bsstr());
$x -> {sign} = $xtmp -> {sign};
$x -> {_n} = $xtmp -> {_n};
$x -> {_d} = $xtmp -> {_d};
return $x;
}
sub bmodpow {
# set up parameters
my ($class, $x, $y, $m, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, $m, @r) = objectify(3, @_);
}
# Convert $x, $y, and $m into Math::BigInt objects.
my $xint = Math::BigInt -> new($x -> copy() -> bint());
my $yint = Math::BigInt -> new($y -> copy() -> bint());
my $mint = Math::BigInt -> new($m -> copy() -> bint());
$xint -> bmodpow($y, $m, @r);
my $xtmp = Math::BigRat -> new($xint -> bsstr());
$x -> {sign} = $xtmp -> {sign};
$x -> {_n} = $xtmp -> {_n};
$x -> {_d} = $xtmp -> {_d};
return $x;
}
sub bmodinv {
# set up parameters
my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y, @r) = objectify(2, @_);
}
# Convert $x and $y into Math::BigInt objects.
my $xint = Math::BigInt -> new($x -> copy() -> bint());
my $yint = Math::BigInt -> new($y -> copy() -> bint());
$xint -> bmodinv($y, @r);
my $xtmp = Math::BigRat -> new($xint -> bsstr());
$x -> {sign} = $xtmp -> {sign};
$x -> {_n} = $xtmp -> {_n};
$x -> {_d} = $xtmp -> {_d};
return $x;
}
sub bsqrt {
my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
return $x->round(@r) if $x->is_zero() || $x->is_one();
my $n = $x -> {_n};
my $d = $x -> {_d};
# Look for an exact solution. For the numerator and the denominator, take
# the square root and square it and see if we got the original value. If we
# did, for both the numerator and the denominator, we have an exact
# solution.
{
my $nsqrt = $LIB -> _sqrt($LIB -> _copy($n));
my $n2 = $LIB -> _mul($LIB -> _copy($nsqrt), $nsqrt);
if ($LIB -> _acmp($n, $n2) == 0) {
my $dsqrt = $LIB -> _sqrt($LIB -> _copy($d));
my $d2 = $LIB -> _mul($LIB -> _copy($dsqrt), $dsqrt);
if ($LIB -> _acmp($d, $d2) == 0) {
$x -> {_n} = $nsqrt;
$x -> {_d} = $dsqrt;
return $x->round(@r);
}
}
}
local $Math::BigFloat::upgrade = undef;
local $Math::BigFloat::downgrade = undef;
local $Math::BigFloat::precision = undef;
local $Math::BigFloat::accuracy = undef;
local $Math::BigInt::upgrade = undef;
local $Math::BigInt::precision = undef;
local $Math::BigInt::accuracy = undef;
my $xn = Math::BigFloat -> new($LIB -> _str($n));
my $xd = Math::BigFloat -> new($LIB -> _str($d));
my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> bsqrt() -> bsstr());
$x -> {sign} = $xtmp -> {sign};
$x -> {_n} = $xtmp -> {_n};
$x -> {_d} = $xtmp -> {_d};
$x->round(@r);
}
sub blsft {
my ($class, $x, $y, $b, @r) = objectify(2, @_);
$b = 2 if !defined $b;
$b = $class -> new($b) unless ref($b) && $b -> isa($class);
return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();
# shift by a negative amount?
return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
$x -> bmul($b -> bpow($y));
}
sub brsft {
my ($class, $x, $y, $b, @r) = objectify(2, @_);
$b = 2 if !defined $b;
$b = $class -> new($b) unless ref($b) && $b -> isa($class);
return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();
# shift by a negative amount?
return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
# the following call to bdiv() will return either quotient (scalar context)
# or quotient and remainder (list context).
$x -> bdiv($b -> bpow($y));
}
sub band {
my $x = shift;
my $xref = ref($x);
my $class = $xref || $x;
croak 'band() is an instance method, not a class method' unless $xref;
croak 'Not enough arguments for band()' if @_ < 1;
my $y = shift;
$y = $class -> new($y) unless ref($y);
my @r = @_;
my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
$xtmp -> band($y);
$xtmp = $class -> new($xtmp); # back to Math::BigRat
$x -> {sign} = $xtmp -> {sign};
$x -> {_n} = $xtmp -> {_n};
$x -> {_d} = $xtmp -> {_d};
return $x -> round(@r);
}
sub bior {
my $x = shift;
my $xref = ref($x);
my $class = $xref || $x;
croak 'bior() is an instance method, not a class method' unless $xref;
croak 'Not enough arguments for bior()' if @_ < 1;
my $y = shift;
$y = $class -> new($y) unless ref($y);
my @r = @_;
my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
$xtmp -> bior($y);
$xtmp = $class -> new($xtmp); # back to Math::BigRat
$x -> {sign} = $xtmp -> {sign};
$x -> {_n} = $xtmp -> {_n};
$x -> {_d} = $xtmp -> {_d};
return $x -> round(@r);
}
sub bxor {
my $x = shift;
my $xref = ref($x);
my $class = $xref || $x;
croak 'bxor() is an instance method, not a class method' unless $xref;
croak 'Not enough arguments for bxor()' if @_ < 1;
my $y = shift;
$y = $class -> new($y) unless ref($y);
my @r = @_;
my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
$xtmp -> bxor($y);
$xtmp = $class -> new($xtmp); # back to Math::BigRat
$x -> {sign} = $xtmp -> {sign};
$x -> {_n} = $xtmp -> {_n};
$x -> {_d} = $xtmp -> {_d};
return $x -> round(@r);
}
sub bnot {
my $x = shift;
my $xref = ref($x);
my $class = $xref || $x;
croak 'bnot() is an instance method, not a class method' unless $xref;
my @r = @_;
my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
$xtmp -> bnot();
$xtmp = $class -> new($xtmp); # back to Math::BigRat
$x -> {sign} = $xtmp -> {sign};
$x -> {_n} = $xtmp -> {_n};
$x -> {_d} = $xtmp -> {_d};
return $x -> round(@r);
}
##############################################################################
# round
sub round {
$_[0];
}
sub bround {
$_[0];
}
sub bfround {
$_[0];
}
##############################################################################
# comparing
sub bcmp {
# compare two signed numbers
# set up parameters
my ($class, $x, $y) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y) = objectify(2, @_);
}
if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
# $x is NaN and/or $y is NaN
return undef if $x->{sign} eq $nan || $y->{sign} eq $nan;
# $x and $y are both either +inf or -inf
return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
# $x = +inf and $y < +inf
return +1 if $x->{sign} eq '+inf';
# $x = -inf and $y > -inf
return -1 if $x->{sign} eq '-inf';
# $x < +inf and $y = +inf
return -1 if $y->{sign} eq '+inf';
# $x > -inf and $y = -inf
return +1;
}
# $x >= 0 and $y < 0
return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';
# $x < 0 and $y >= 0
return -1 if $x->{sign} eq '-' && $y->{sign} eq '+';
# At this point, we know that $x and $y have the same sign.
# shortcut
my $xz = $LIB->_is_zero($x->{_n});
my $yz = $LIB->_is_zero($y->{_n});
return 0 if $xz && $yz; # 0 <=> 0
return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d});
my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
my $cmp = $LIB->_acmp($t, $u); # signs are equal
$cmp = -$cmp if $x->{sign} eq '-'; # both are '-' => reverse
$cmp;
}
sub bacmp {
# compare two numbers (as unsigned)
# set up parameters
my ($class, $x, $y) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
($class, $x, $y) = objectify(2, @_);
}
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
# handle +-inf and NaN
return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
return -1;
}
my $t = $LIB->_mul($LIB->_copy($x->{_n}), $y->{_d});
my $u = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
$LIB->_acmp($t, $u); # ignore signs
}
sub beq {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
croak 'beq() is an instance method, not a class method' unless $selfref;
croak 'Wrong number of arguments for beq()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && ! $cmp;
}
sub bne {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
croak 'bne() is an instance method, not a class method' unless $selfref;
croak 'Wrong number of arguments for bne()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && ! $cmp ? '' : 1;
}
sub blt {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
croak 'blt() is an instance method, not a class method' unless $selfref;
croak 'Wrong number of arguments for blt()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp < 0;
}
sub ble {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
croak 'ble() is an instance method, not a class method' unless $selfref;
croak 'Wrong number of arguments for ble()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp <= 0;
}
sub bgt {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
croak 'bgt() is an instance method, not a class method' unless $selfref;
croak 'Wrong number of arguments for bgt()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp > 0;
}
sub bge {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
croak 'bge() is an instance method, not a class method'
unless $selfref;
croak 'Wrong number of arguments for bge()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp >= 0;
}
##############################################################################
# output conversion
sub numify {
# convert 17/8 => float (aka 2.125)
my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
# Non-finite number.
return $x->bstr() if $x->{sign} !~ /^[+-]$/;
# Finite number.
my $abs = $LIB->_is_one($x->{_d})
? $LIB->_num($x->{_n})
: Math::BigFloat -> new($LIB->_str($x->{_n}))
-> bdiv($LIB->_str($x->{_d}))
-> bstr();
return $x->{sign} eq '-' ? 0 - $abs : 0 + $abs;
}
sub as_int {
my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
# NaN, inf etc
return Math::BigInt->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;
my $u = Math::BigInt->bzero();
$u->{value} = $LIB->_div($LIB->_copy($x->{_n}), $x->{_d}); # 22/7 => 3
$u->bneg if $x->{sign} eq '-'; # no negative zero
$u;
}
sub as_float {
# return N/D as Math::BigFloat
# set up parameters
my ($class, $x, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
($class, $x, @r) = objectify(1, @_) unless ref $_[0];
# NaN, inf etc
return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;
my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n}));
$xflt -> {sign} = $x -> {sign};
$xflt -> bdiv($xd, @r);
return $xflt;
}
sub as_bin {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return $x unless $x->is_int();
my $s = $x->{sign};
$s = '' if $s eq '+';
$s . $LIB->_as_bin($x->{_n});
}
sub as_hex {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return $x unless $x->is_int();
my $s = $x->{sign}; $s = '' if $s eq '+';
$s . $LIB->_as_hex($x->{_n});
}
sub as_oct {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return $x unless $x->is_int();
my $s = $x->{sign}; $s = '' if $s eq '+';
$s . $LIB->_as_oct($x->{_n});
}
##############################################################################
sub from_hex {
my $class = shift;
$class->new(@_);
}
sub from_bin {
my $class = shift;
$class->new(@_);
}
sub from_oct {
my $class = shift;
my @parts;
for my $c (@_) {
push @parts, Math::BigInt->from_oct($c);
}
$class->new (@parts);
}
##############################################################################
# import
sub import {
my $class = shift;
my $l = scalar @_;
my $lib = ''; my @a;
my $try = 'try';
for (my $i = 0; $i < $l ; $i++) {
if ($_[$i] eq ':constant') {
# this rest causes overlord er load to step in
overload::constant float => sub { $class->new(shift); };
}
# elsif ($_[$i] eq 'upgrade')
# {
# # this causes upgrading
# $upgrade = $_[$i+1]; # or undef to disable
# $i++;
# }
elsif ($_[$i] eq 'downgrade') {
# this causes downgrading
$downgrade = $_[$i+1]; # or undef to disable
$i++;
} elsif ($_[$i] =~ /^(lib|try|only)\z/) {
$lib = $_[$i+1] || ''; # default Calc
$try = $1; # lib, try or only
$i++;
} elsif ($_[$i] eq 'with') {
# this argument is no longer used
#$LIB = $_[$i+1] || 'Math::BigInt::Calc'; # default Math::BigInt::Calc
$i++;
} else {
push @a, $_[$i];
}
}
require Math::BigInt;
# let use Math::BigInt lib => 'GMP'; use Math::BigRat; still have GMP
if ($lib ne '') {
my @c = split /\s*,\s*/, $lib;
foreach (@c) {
$_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
}
$lib = join(",", @c);
}
my @import = ('objectify');
push @import, $try => $lib if $lib ne '';
# LIB already loaded, so feed it our lib arguments
Math::BigInt->import(@import);
$LIB = Math::BigFloat->config("lib");
# register us with LIB to get notified of future lib changes
Math::BigInt::_register_callback($class, sub { $LIB = $_[0]; });
# any non :constant stuff is handled by Exporter (loaded by parent class)
# even if @_ is empty, to give it a chance
$class->SUPER::import(@a); # for subclasses
$class->export_to_level(1, $class, @a); # need this, too
}
1;
__END__
=pod
=head1 NAME
Math::BigRat - Arbitrary big rational numbers
=head1 SYNOPSIS
use Math::BigRat;
my $x = Math::BigRat->new('3/7'); $x += '5/9';
print $x->bstr(), "\n";
print $x ** 2, "\n";
my $y = Math::BigRat->new('inf');
print "$y ", ($y->is_inf ? 'is' : 'is not'), " infinity\n";
my $z = Math::BigRat->new(144); $z->bsqrt();
=head1 DESCRIPTION
Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
for arbitrary big rational numbers.
=head2 MATH LIBRARY
You can change the underlying module that does the low-level
math operations by using:
use Math::BigRat try => 'GMP';
Note: This needs Math::BigInt::GMP installed.
The following would first try to find Math::BigInt::Foo, then
Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
use Math::BigRat try => 'Foo,Math::BigInt::Bar';
If you want to get warned when the fallback occurs, replace "try" with "lib":
use Math::BigRat lib => 'Foo,Math::BigInt::Bar';
If you want the code to die instead, replace "try" with "only":
use Math::BigRat only => 'Foo,Math::BigInt::Bar';
=head1 METHODS
Any methods not listed here are derived from Math::BigFloat (or
Math::BigInt), so make sure you check these two modules for further
information.
=over
=item new()
$x = Math::BigRat->new('1/3');
Create a new Math::BigRat object. Input can come in various forms:
$x = Math::BigRat->new(123); # scalars
$x = Math::BigRat->new('inf'); # infinity
$x = Math::BigRat->new('123.3'); # float
$x = Math::BigRat->new('1/3'); # simple string
$x = Math::BigRat->new('1 / 3'); # spaced
$x = Math::BigRat->new('1 / 0.1'); # w/ floats
$x = Math::BigRat->new(Math::BigInt->new(3)); # BigInt
$x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
$x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
# You can also give D and N as different objects:
$x = Math::BigRat->new(
Math::BigInt->new(-123),
Math::BigInt->new(7),
); # => -123/7
=item numerator()
$n = $x->numerator();
Returns a copy of the numerator (the part above the line) as signed BigInt.
=item denominator()
$d = $x->denominator();
Returns a copy of the denominator (the part under the line) as positive BigInt.
=item parts()
($n, $d) = $x->parts();
Return a list consisting of (signed) numerator and (unsigned) denominator as
BigInts.
=item numify()
my $y = $x->numify();
Returns the object as a scalar. This will lose some data if the object
cannot be represented by a normal Perl scalar (integer or float), so
use L or L instead.
This routine is automatically used whenever a scalar is required:
my $x = Math::BigRat->new('3/1');
@array = (0, 1, 2, 3);
$y = $array[$x]; # set $y to 3
=item as_int()
=item as_number()
$x = Math::BigRat->new('13/7');
print $x->as_int(), "\n"; # '1'
Returns a copy of the object as BigInt, truncated to an integer.
C