# # "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; # anything older is untested, and unlikely to work use 5.006; use strict; use warnings; use Carp (); use Math::BigFloat; our ($VERSION, @ISA, $upgrade, $downgrade, $accuracy, $precision, $round_mode, $div_scale, $_trap_nan, $_trap_inf); @ISA = qw(Math::BigFloat); $VERSION = '0.260802'; $VERSION = eval $VERSION; # Inherit overload from Math::BigFloat, but disable the bitwise ops that don't # make much sense for rationals unless they're truncated or something first. use overload map { my $op = $_; ($op => sub { Carp::croak("bitwise operation $op not supported in Math::BigRat"); }); } qw(& | ^ ~ << >> &= |= ^= <<= >>=); 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 MBF has a different $MBI variable than we, because MBF 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_int = \&as_number; *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 package we are using for our private parts, defaults to: # Math::BigInt->config()->{lib} my $MBI = '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(@_); } ############################################################################## # If $x is a Math::BigRat object and $f is a Math::BigFloat object, then # # $x -> _new_from_float($f) # # converts $x into a Math::BigRat with the value of $f. sub _new_from_float { # turn a single float input into a rational number (like '0.1') my ($self,$f) = @_; return $self->bnan() if $f->is_nan(); return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/; $self->{_n} = $MBI->_copy($f->{_m}); # mantissa $self->{_d} = $MBI->_one(); $self->{sign} = $f->{sign} || '+'; if ($f->{_es} eq '-') { # something like Math::BigRat->new('0.1'); # 1 / 1 => 1/10 $MBI->_lsft($self->{_d}, $f->{_e} ,10); } else { # something like Math::BigRat->new('10'); # 1 / 1 => 10/1 $MBI->_lsft($self->{_n}, $f->{_e} ,10) unless $MBI->_is_zero($f->{_e}); } return $self -> bnorm(); } # If $x is a Math::BigRat object and $i is a Math::BigInt object, then # # $x -> _new_from_int($i) # # converts $x into a Math::BigRat with the value of $i. sub _new_from_int { my ($self, $i) = @_; return $self -> bnan() if $i -> is_nan(); return $self -> binf($i -> sign()) if $i -> is_inf(); $self -> {_n} = $MBI -> _copy($i -> {value}); $self -> {_d} = $MBI -> _one(); $self -> {sign} = $i -> {sign}; return $self; } sub new { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; # Get numerator and denominator. my ($n, $d) = @_; # If called as a class method, initialize a new object. $self = bless {}, $class unless $selfref; # Input like $class->new($n), where there is no denominator, and where $n # is a Math::BigInt or Math::BigFloat. if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat'))) { if ($n->isa('Math::BigFloat')) { $self->_new_from_float($n); } elsif ($n->isa('Math::BigInt')) { # TODO: trap NaN, inf $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N $self->{_d} = $MBI->_one(); # d => 1 $self->{sign} = $n->{sign}; } elsif ($n->isa('Math::BigInt::Lite')) { # TODO: trap NaN, inf $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0; $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = N $self->{_d} = $MBI->_one(); # d => 1 } return $self->bnorm(); # normalize (120/100 => 6/5) } # Input like $class->new($n, $d) where $n and $d both are Math::BigInt # objects or Math::BigInt::Lite objects. if (ref($d) && ref($n)) { # do N first (for $self->{sign}): if ($n->isa('Math::BigInt')) { # TODO: trap NaN, inf $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N $self->{sign} = $n->{sign}; } elsif ($n->isa('Math::BigInt::Lite')) { # TODO: trap NaN, inf $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0; $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = $n } else { Carp::croak(ref($n) . " is not a recognized object format for" . " Math::BigRat->new"); } # now D: if ($d->isa('Math::BigInt')) { # TODO: trap NaN, inf $self->{_d} = $MBI->_copy($d->{value}); # "mantissa" = D # +/+ or -/- => +, +/- or -/+ => - $self->{sign} = $d->{sign} ne $self->{sign} ? '-' : '+'; } elsif ($d->isa('Math::BigInt::Lite')) { # TODO: trap NaN, inf $self->{_d} = $MBI->_new(abs($$d)); # "mantissa" = D my $ds = '+'; $ds = '-' if $$d < 0; # +/+ or -/- => +, +/- or -/+ => - $self->{sign} = $ds ne $self->{sign} ? '-' : '+'; } else { Carp::croak(ref($d) . " is not a recognized object format for" . " Math::BigRat->new"); } return $self->bnorm(); # normalize (120/100 => 6/5) } return $n->copy() if ref $n; # already a BigRat if (!defined $n) { $self->{_n} = $MBI->_zero(); # undef => 0 $self->{_d} = $MBI->_one(); $self->{sign} = '+'; return $self; } # string input with / delimiter if ($n =~ m|\s*/\s*|) { return $class->bnan() if $n =~ m|/.*/|; # 1/2/3 isn't valid return $class->bnan() if $n =~ m|/\s*$|; # 1/ isn't valid ($n, $d) = split (/\//, $n); # try as BigFloats first if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/)) { local $Math::BigFloat::accuracy = undef; local $Math::BigFloat::precision = undef; # one of them looks like a float my $nf = Math::BigFloat->new($n, undef, undef); $self->{sign} = '+'; return $self->bnan() if $nf->is_nan(); $self->{_n} = $MBI->_copy($nf->{_m}); # get mantissa # now correct $self->{_n} due to $n my $f = Math::BigFloat->new($d, undef, undef); return $self->bnan() if $f->is_nan(); $self->{_d} = $MBI->_copy($f->{_m}); # calculate the difference between nE and dE my $diff_e = $nf->exponent()->bsub($f->exponent); if ($diff_e->is_negative()) { # < 0: mul d with it $MBI->_lsft($self->{_d}, $MBI->_new($diff_e->babs()), 10); } elsif (!$diff_e->is_zero()) { # > 0: mul n with it $MBI->_lsft($self->{_n}, $MBI->_new($diff_e), 10); } } else { # both d and n look like (big)ints $self->{sign} = '+'; # no sign => '+' $self->{_n} = undef; $self->{_d} = undef; if ($n =~ /^([+-]?)0*([0-9]+)\z/) { # first part ok? $self->{sign} = $1 || '+'; # no sign => '+' $self->{_n} = $MBI->_new($2 || 0); } if ($d =~ /^([+-]?)0*([0-9]+)\z/) { # second part ok? $self->{sign} =~ tr/+-/-+/ if ($1 || '') eq '-'; # negate if second part neg. $self->{_d} = $MBI->_new($2 || 0); } if (!defined $self->{_n} || !defined $self->{_d}) { $d = Math::BigInt->new($d, undef, undef) unless ref $d; $n = Math::BigInt->new($n, undef, undef) unless ref $n; if ($n->{sign} =~ /^[+-]$/ && $d->{sign} =~ /^[+-]$/) { # both parts are ok as integers (weird things like ' 1e0' $self->{_n} = $MBI->_copy($n->{value}); $self->{_d} = $MBI->_copy($d->{value}); $self->{sign} = $n->{sign}; $self->{sign} =~ tr/+-/-+/ if $d->{sign} eq '-'; # -1/-2 => 1/2 return $self->bnorm(); } $self->{sign} = '+'; # a default sign return $self->bnan() if $n->is_nan() || $d->is_nan(); # handle inf cases: if ($n->is_inf() || $d->is_inf()) { if ($n->is_inf()) { return $self->bnan() if $d->is_inf(); # both are inf => NaN my $s = '+'; # '+inf/+123' or '-inf/-123' $s = '-' if substr($n->{sign}, 0, 1) ne $d->{sign}; # +-inf/123 => +-inf return $self->binf($s); } # 123/inf => 0 return $self->bzero(); } } } return $self->bnorm(); } # simple string input if (($n =~ /[\.eE]/) && $n !~ /^0x/) { # looks like a float, quacks like a float, so probably is a float $self->{sign} = 'NaN'; local $Math::BigFloat::accuracy = undef; local $Math::BigFloat::precision = undef; $self->_new_from_float(Math::BigFloat->new($n, undef, undef)); } else { # for simple forms, use $MBI directly if ($n =~ /^([+-]?)0*([0-9]+)\z/) { $self->{sign} = $1 || '+'; $self->{_n} = $MBI->_new($2 || 0); $self->{_d} = $MBI->_one(); } elsif ($n =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { my $sgn = $1 || '+'; $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() $self->binf($sgn); } else { my $n = Math::BigInt->new($n, undef, undef); $self->{_n} = $MBI->_copy($n->{value}); $self->{_d} = $MBI->_one(); $self->{sign} = $n->{sign}; return $self->bnan() if $self->{sign} eq 'NaN'; } } $self->bnorm(); } 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} = $MBI->_copy($self->{_d}); $copy->{_n} = $MBI->_copy($self->{_n}); $copy->{_a} = $self->{_a} if defined $self->{_a}; $copy->{_p} = $self->{_p} if defined $self->{_p}; $copy; } ############################################################################## 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} = $MBI; $cfg; } ############################################################################## sub bstr { my ($self,$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 . $MBI->_str($x->{_n}) if $MBI->_is_one($x->{_d}); $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d}); } sub bsstr { my ($self,$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 . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d}); } sub bnorm { # reduce the number to the shortest form my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); # Both parts must be objects of whatever we are using today. if (my $c = $MBI->_check($x->{_n})) { Carp::croak("n did not pass the self-check ($c) in bnorm()"); } if (my $c = $MBI->_check($x->{_d})) { Carp::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 ($MBI->_is_zero($x->{_n})) { $x->{sign} = '+'; # never leave a -0 $x->{_d} = $MBI->_one() unless $MBI->_is_one($x->{_d}); return $x; } return $x if $MBI->_is_one($x->{_d}); # no need to reduce # reduce other numbers my $gcd = $MBI->_copy($x->{_n}); $gcd = $MBI->_gcd($gcd,$x->{_d}); if (!$MBI->_is_one($gcd)) { $x->{_n} = $MBI->_div($x->{_n},$gcd); $x->{_d} = $MBI->_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 ($self,$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 '+' && $MBI->_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} = $MBI->_zero() unless defined $self->{_d}; $self->{_n} = $MBI->_zero() unless defined $self->{_n}; Carp::croak ("Tried to set $self to NaN in $class\::_bnan()"); } $self->{_n} = $MBI->_zero(); $self->{_d} = $MBI->_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} = $MBI->_zero() unless defined $self->{_d}; $self->{_n} = $MBI->_zero() unless defined $self->{_n}; Carp::croak ("Tried to set $self to inf in $class\::_binf()"); } $self->{_n} = $MBI->_zero(); $self->{_d} = $MBI->_zero(); } sub _bone { # used by parent class bone() to initialize number to +1/-1 my $self = shift; $self->{_n} = $MBI->_one(); $self->{_d} = $MBI->_one(); } sub _bzero { # used by parent class bzero() to initialize number to 0 my $self = shift; $self->{_n} = $MBI->_zero(); $self->{_d} = $MBI->_one(); } ############################################################################## # mul/add/div etc sub badd { # add two rational numbers # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$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} = $MBI->_mul($x->{_n}, $y->{_d}); # 7 * 4 my $m = $MBI->_mul($MBI->_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} = $MBI->_mul($x->{_d}, $y->{_d}); # normalize result, and possible round $x->bnorm()->round(@r); } sub bsub { # subtract two rational numbers # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } # flip sign of $x, call badd(), then flip sign of result $x->{sign} =~ tr/+-/-+/ unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0 $x->badd($y,@r); # does norm and round $x->{sign} =~ tr/+-/-+/ unless $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); # not -0 $x; } sub bmul { # multiply two rational numbers # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$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,$self->bzero()) : $x if $x->is_zero(); # XXX TODO: # 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. # 1 2 1 * 2 2 1 # - * - = ----- = - = - # 4 3 4 * 3 12 6 $x->{_n} = $MBI->_mul($x->{_n}, $y->{_n}); $x->{_d} = $MBI->_mul($x->{_d}, $y->{_d}); # compute new sign $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; $x->bnorm()->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 ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$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(), $self -> 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 = $self -> 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 = $self -> 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,$self->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. # 1 1 1 3 # - / - == - * - # 4 3 4 1 $x->{_n} = $MBI->_mul($x->{_n}, $y->{_d}); $x->{_d} = $MBI->_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 ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$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 ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf if ($x->{sign} eq '-') { $x->{_n} = $MBI->_add($x->{_n}, $x->{_d}); # -5/2 => -7/2 } else { if ($MBI->_acmp($x->{_n},$x->{_d}) < 0) # n < d? { # 1/3 -- => -2/3 $x->{_n} = $MBI->_sub($MBI->_copy($x->{_d}), $x->{_n}); $x->{sign} = '-'; } else { $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # 5/2 => 3/2 } } $x->bnorm()->round(@r); } sub binc { # increment value (add 1) my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf if ($x->{sign} eq '-') { if ($MBI->_acmp($x->{_n},$x->{_d}) < 0) { # -1/3 ++ => 2/3 (overflow at 0) $x->{_n} = $MBI->_sub($MBI->_copy($x->{_d}), $x->{_n}); $x->{sign} = '+'; } else { $x->{_n} = $MBI->_sub($x->{_n}, $x->{_d}); # -5/2 => -3/2 } } else { $x->{_n} = $MBI->_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 ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't $MBI->_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 ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_n}); 0; } sub is_one { # return true if arg (BRAT or num_str) is +1 or -1 if signis given my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); my $sign = $_[2] || ''; $sign = '+' if $sign ne '-'; return 1 if ($x->{sign} eq $sign && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d})); 0; } sub is_odd { # return true if arg (BFLOAT or num_str) is odd or false if even my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't ($MBI->_is_one($x->{_d}) && $MBI->_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 ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't return 1 if ($MBI->_is_one($x->{_d}) # x/3 is never && $MBI->_is_even($x->{_n})); # but 4/1 is 0; } ############################################################################## # parts() and friends sub numerator { my ($self,$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($MBI->_str($x->{_n})); $n->{sign} = $x->{sign}; $n; } sub denominator { my ($self,$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($MBI->_str($x->{_d})); } sub parts { my ($self,$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($MBI->_str($x->{_n})); $n->{sign} = $x->{sign}; my $d = $c->new($MBI->_str($x->{_d})); ($n,$d); } sub length { my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $nan unless $x->is_int(); $MBI->_len($x->{_n}); # length(-123/1) => length(123) } sub digit { my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0],$_[1]) : objectify(1,@_); return $nan unless $x->is_int(); $MBI->_digit($x->{_n},$n || 0); # digit(-123/1,2) => digit(123,2) } ############################################################################## # special calc routines sub bceil { my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0 $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate $x->{_d} = $MBI->_one(); # d => 1 $x->{_n} = $MBI->_inc($x->{_n}) if $x->{sign} eq '+'; # +22/7 => 4/1 $x->{sign} = '+' if $MBI->_is_zero($x->{_n}); # -0 => 0 $x; } sub bfloor { my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x if $x->{sign} !~ /^[+-]$/ || # not for NaN, inf $MBI->_is_one($x->{_d}); # 22/1 => 22, 0/1 => 0 $x->{_n} = $MBI->_div($x->{_n},$x->{_d}); # 22/7 => 3/1 w/ truncate $x->{_d} = $MBI->_one(); # d => 1 $x->{_n} = $MBI->_inc($x->{_n}) if $x->{sign} eq '-'; # -22/7 => -4/1 $x; } sub bfac { my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); # if $x is not an integer if (($x->{sign} ne '+') || (!$MBI->_is_one($x->{_d}))) { return $x->bnan(); } $x->{_n} = $MBI->_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 ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; return $x->bone(@r) if $y->is_zero(); return $x->round(@r) if $x->is_one() || $y->is_one(); if ($x->{sign} eq '-' && $MBI->_is_one($x->{_n}) && $MBI->_is_one($x->{_d})) { # if $x == -1 and odd/even y => +1/-1 return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r); # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; } # 1 ** -y => 1 / (1 ** |y|) # so do test for negative $y after above's clause return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0) # shortcut if y == 1/N (is then sqrt() respective broot()) if ($MBI->_is_one($y->{_n})) { return $x->bsqrt(@r) if $MBI->_is_two($y->{_d}); # 1/2 => sqrt return $x->broot($MBI->_str($y->{_d}),@r); # 1/N => root(N) } # shortcut y/1 (and/or x/1) if ($MBI->_is_one($y->{_d})) { # shortcut for x/1 and y/1 if ($MBI->_is_one($x->{_d})) { $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # x/1 ** y/1 => (x ** y)/1 if ($y->{sign} eq '-') { # 0.2 ** -3 => 1/(0.2 ** 3) ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap } # correct sign; + ** + => + if ($x->{sign} eq '-') { # - * - => +, - * - * - => - $x->{sign} = '+' if $MBI->_is_even($y->{_n}); } return $x->round(@r); } # x/z ** y/1 $x->{_n} = $MBI->_pow($x->{_n},$y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y $x->{_d} = $MBI->_pow($x->{_d},$y->{_n}); if ($y->{sign} eq '-') { # 0.2 ** -3 => 1/(0.2 ** 3) ($x->{_n},$x->{_d}) = ($x->{_d},$x->{_n}); # swap } # correct sign; + ** + => + if ($x->{sign} eq '-') { # - * - => +, - * - * - => - $x->{sign} = '+' if $MBI->_is_even($y->{_n}); } return $x->round(@r); } # print STDERR "# $x $y\n"; # otherwise: # n/d n ______________ # a/b = -\/ (a/b) ** d # (a/b) ** n == (a ** n) / (b ** n) $MBI->_pow($x->{_n}, $y->{_n}); $MBI->_pow($x->{_d}, $y->{_n}); return $x->broot($MBI->_str($y->{_d}),@r); # n/d => root(n) } 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. # 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. # set up parameters my ($self,$x,$base,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$base,@r) = objectify(1,$class,@_); } 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 = $self -> 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. # Do it with Math::BigFloats and convert back to Math::BigRat. $base = $base -> _as_float() if defined $base; $x -> _new_from_float($x -> _as_float() -> blog($base, @r)); } sub bexp { # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,$class,@_); } 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] = $self->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} = $MBI->_new("90933395208605785401971970164779391644753259799242"); $x->{_d} = $MBI->_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 = $MBI->_new("90933395208605785401971970164779391644753259799242"); my $F = $MBI->_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 = $MBI->_mul($A, $F); $A = $MBI->_inc($A); # increment f $F = $MBI->_inc($F); } # compute $B as factorial of $steps (this is faster than doing it manually) my $B = $MBI->_fac($MBI->_new($steps)); # print "A ", $MBI->_str($A), "\nB ", $MBI->_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 ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,$class,@_); } # do it with floats $x->_new_from_float($x->_as_float()->bnok(Math::BigFloat->new("$y"),@r)); } sub _float_from_part { my $x = shift; my $f = Math::BigFloat->bzero(); $f->{_m} = $MBI->_copy($x); $f->{_e} = $MBI->_zero(); $f; } sub _as_float { my $x = shift; local $Math::BigFloat::upgrade = undef; local $Math::BigFloat::accuracy = undef; local $Math::BigFloat::precision = undef; # 22/7 => 3.142857143.. my $a = $x->accuracy() || 0; if ($a != 0 || !$MBI->_is_one($x->{_d})) { # n/d return scalar Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n}))->bdiv($MBI->_str($x->{_d}), $x->accuracy()); } # just n Math::BigFloat->new($x->{sign} . $MBI->_str($x->{_n})); } sub broot { # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } if ($x->is_int() && $y->is_int()) { return $self->new($x->as_number()->broot($y->as_number(),@r)); } # do it with floats $x->_new_from_float($x->_as_float()->broot($y->_as_float(),@r))->bnorm()->bround(@r); } sub bmodpow { # set up parameters my ($self,$x,$y,$m,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,$m,@r) = objectify(3,@_); } # $x or $y or $m are NaN or +-inf => NaN return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $m->{sign} !~ /^[+-]$/; if ($x->is_int() && $y->is_int() && $m->is_int()) { return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r)); } warn ("bmodpow() not fully implemented"); $x->bnan(); } sub bmodinv { # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } # $x or $y are NaN or +-inf => NaN return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/; if ($x->is_int() && $y->is_int()) { return $self->new($x->as_number()->bmodinv($y->as_number(),@r)); } warn ("bmodinv() not fully implemented"); $x->bnan(); } sub bsqrt { my ($self,$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(); 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; $x->{_n} = _float_from_part($x->{_n})->bsqrt(); $x->{_d} = _float_from_part($x->{_d})->bsqrt(); # XXX TODO: we probably can optimize this: # if sqrt(D) was not integer if ($x->{_d}->{_es} ne '+') { $x->{_n}->blsft($x->{_d}->exponent()->babs(),10); # 7.1/4.51 => 7.1/45.1 $x->{_d} = $MBI->_copy($x->{_d}->{_m}); # 7.1/45.1 => 71/45.1 } # if sqrt(N) was not integer if ($x->{_n}->{_es} ne '+') { $x->{_d}->blsft($x->{_n}->exponent()->babs(),10); # 71/45.1 => 710/45.1 $x->{_n} = $MBI->_copy($x->{_n}->{_m}); # 710/45.1 => 710/451 } # convert parts to $MBI again $x->{_n} = $MBI->_lsft($MBI->_copy($x->{_n}->{_m}), $x->{_n}->{_e}, 10) if ref($x->{_n}) ne $MBI && ref($x->{_n}) ne 'ARRAY'; $x->{_d} = $MBI->_lsft($MBI->_copy($x->{_d}->{_m}), $x->{_d}->{_e}, 10) if ref($x->{_d}) ne $MBI && ref($x->{_d}) ne 'ARRAY'; $x->bnorm()->round(@r); } sub blsft { my ($self,$x,$y,$b,@r) = objectify(3,@_); $b = 2 unless defined $b; $b = $self->new($b) unless ref ($b); $x->bmul($b->copy()->bpow($y), @r); $x; } sub brsft { my ($self,$x,$y,$b,@r) = objectify(3,@_); $b = 2 unless defined $b; $b = $self->new($b) unless ref ($b); $x->bdiv($b->copy()->bpow($y), @r); $x; } ############################################################################## # round sub round { $_[0]; } sub bround { $_[0]; } sub bfround { $_[0]; } ############################################################################## # comparing sub bcmp { # compare two signed numbers # set up parameters my ($self,$x,$y) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$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} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; return +1 if $x->{sign} eq '+inf'; return -1 if $x->{sign} eq '-inf'; return -1 if $y->{sign} eq '+inf'; return +1; } # check sign for speed first return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0 # shortcut my $xz = $MBI->_is_zero($x->{_n}); my $yz = $MBI->_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 = $MBI->_mul($MBI->_copy($x->{_n}), $y->{_d}); my $u = $MBI->_mul($MBI->_copy($y->{_n}), $x->{_d}); my $cmp = $MBI->_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 ($self,$x,$y) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y) = objectify(2,$class,@_); } 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 = $MBI->_mul($MBI->_copy($x->{_n}), $y->{_d}); my $u = $MBI->_mul($MBI->_copy($y->{_n}), $x->{_d}); $MBI->_acmp($t,$u); # ignore signs } ############################################################################## # output conversation sub numify { # convert 17/8 => float (aka 2.125) my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, NaN, etc # N/1 => N my $neg = ''; $neg = '-' if $x->{sign} eq '-'; return $neg . $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d}); $x->_as_float()->numify() + 0.0; } sub as_number { 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} = $MBI->_div($MBI->_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 ($self,$x,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it ($self,$x,@r) = objectify(1,$class,@_) unless ref $_[0]; # NaN, inf etc return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/; my $u = Math::BigFloat->bzero(); $u->{sign} = $x->{sign}; # n $u->{_m} = $MBI->_copy($x->{_n}); $u->{_e} = $MBI->_zero(); $u->bdiv($MBI->_str($x->{_d}), @r); # return $u $u; } sub as_bin { my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $x unless $x->is_int(); my $s = $x->{sign}; $s = '' if $s eq '+'; $s . $MBI->_as_bin($x->{_n}); } sub as_hex { my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $x unless $x->is_int(); my $s = $x->{sign}; $s = '' if $s eq '+'; $s . $MBI->_as_hex($x->{_n}); } sub as_oct { my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $x unless $x->is_int(); my $s = $x->{sign}; $s = '' if $s eq '+'; $s . $MBI->_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 $self = 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 { $self->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 #$MBI = $_[$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 ''; # MBI already loaded, so feed it our lib arguments Math::BigInt->import(@import); $MBI = Math::BigFloat->config()->{lib}; # register us with MBI to get notified of future lib changes Math::BigInt::_register_callback($self, sub { $MBI = $_[0]; }); # any non :constant stuff is handled by our parent, Exporter (loaded # by Math::BigFloat, even if @_ is empty, to give it a chance $self->SUPER::import(@a); # for subclasses $self->export_to_level(1,$self,@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. =head2 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 =head2 numerator() $n = $x->numerator(); Returns a copy of the numerator (the part above the line) as signed BigInt. =head2 denominator() $d = $x->denominator(); Returns a copy of the denominator (the part under the line) as positive BigInt. =head2 parts() ($n,$d) = $x->parts(); Return a list consisting of (signed) numerator and (unsigned) denominator as BigInts. =head2 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 Las_number()> 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 =head2 as_int()/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 is an alias for C. =head2 as_float() $x = Math::BigRat->new('13/7'); print $x->as_float(),"\n"; # '1' $x = Math::BigRat->new('2/3'); print $x->as_float(5),"\n"; # '0.66667' Returns a copy of the object as BigFloat, preserving the accuracy as wanted, or the default of 40 digits. This method was added in v0.22 of Math::BigRat (April 2008). =head2 as_hex() $x = Math::BigRat->new('13'); print $x->as_hex(),"\n"; # '0xd' Returns the BigRat as hexadecimal string. Works only for integers. =head2 as_bin() $x = Math::BigRat->new('13'); print $x->as_bin(),"\n"; # '0x1101' Returns the BigRat as binary string. Works only for integers. =head2 as_oct() $x = Math::BigRat->new('13'); print $x->as_oct(),"\n"; # '015' Returns the BigRat as octal string. Works only for integers. =head2 from_hex()/from_bin()/from_oct() my $h = Math::BigRat->from_hex('0x10'); my $b = Math::BigRat->from_bin('0b10000000'); my $o = Math::BigRat->from_oct('020'); Create a BigRat from an hexadecimal, binary or octal number in string form. =head2 length() $len = $x->length(); Return the length of $x in digits for integer values. =head2 digit() print Math::BigRat->new('123/1')->digit(1); # 1 print Math::BigRat->new('123/1')->digit(-1); # 3 Return the N'ths digit from X when X is an integer value. =head2 bnorm() $x->bnorm(); Reduce the number to the shortest form. This routine is called automatically whenever it is needed. =head2 bfac() $x->bfac(); Calculates the factorial of $x. For instance: print Math::BigRat->new('3/1')->bfac(),"\n"; # 1*2*3 print Math::BigRat->new('5/1')->bfac(),"\n"; # 1*2*3*4*5 Works currently only for integers. =head2 bround()/round()/bfround() Are not yet implemented. =head2 bmod() $x->bmod($y); Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the result is identical to the remainder after floored division (F-division). If, in addition, both $x and $y are integers, the result is identical to the result from Perl's % operator. =head2 bneg() $x->bneg(); Used to negate the object in-place. =head2 is_one() print "$x is 1\n" if $x->is_one(); Return true if $x is exactly one, otherwise false. =head2 is_zero() print "$x is 0\n" if $x->is_zero(); Return true if $x is exactly zero, otherwise false. =head2 is_pos()/is_positive() print "$x is >= 0\n" if $x->is_positive(); Return true if $x is positive (greater than or equal to zero), otherwise false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't. C is an alias for C. =head2 is_neg()/is_negative() print "$x is < 0\n" if $x->is_negative(); Return true if $x is negative (smaller than zero), otherwise false. Please note that '-inf' is also negative, while 'NaN' and '+inf' aren't. C is an alias for C. =head2 is_int() print "$x is an integer\n" if $x->is_int(); Return true if $x has a denominator of 1 (e.g. no fraction parts), otherwise false. Please note that '-inf', 'inf' and 'NaN' aren't integer. =head2 is_odd() print "$x is odd\n" if $x->is_odd(); Return true if $x is odd, otherwise false. =head2 is_even() print "$x is even\n" if $x->is_even(); Return true if $x is even, otherwise false. =head2 bceil() $x->bceil(); Set $x to the next bigger integer value (e.g. truncate the number to integer and then increment it by one). =head2 bfloor() $x->bfloor(); Truncate $x to an integer value. =head2 bsqrt() $x->bsqrt(); Calculate the square root of $x. =head2 broot() $x->broot($n); Calculate the N'th root of $x. =head2 badd() $x->badd($y); Adds $y to $x and returns the result. =head2 bmul() $x->bmul($y); Multiplies $y to $x and returns the result. =head2 bsub() $x->bsub($y); Subtracts $y from $x and returns the result. =head2 bdiv() $q = $x->bdiv($y); ($q, $r) = $x->bdiv($y); In scalar context, divides $x by $y and returns the result. In list context, does floored division (F-division), returning an integer $q and a remainder $r so that $x = $q * $y + $r. The remainer (modulo) is equal to what is returned by C<$x->bmod($y)>. =head2 bdec() $x->bdec(); Decrements $x by 1 and returns the result. =head2 binc() $x->binc(); Increments $x by 1 and returns the result. =head2 copy() my $z = $x->copy(); Makes a deep copy of the object. Please see the documentation in L for further details. =head2 bstr()/bsstr() my $x = Math::BigInt->new('8/4'); print $x->bstr(),"\n"; # prints 1/2 print $x->bsstr(),"\n"; # prints 1/2 Return a string representing this object. =head2 bacmp()/bcmp() Used to compare numbers. Please see the documentation in L for further details. =head2 blsft()/brsft() Used to shift numbers left/right. Please see the documentation in L for further details. =head2 bpow() $x->bpow($y); Compute $x ** $y. Please see the documentation in L for further details. =head2 bexp() $x->bexp($accuracy); # calculate e ** X Calculates two integers A and B so that A/B is equal to C, where C is Euler's number. This method was added in v0.20 of Math::BigRat (May 2007). See also C. =head2 bnok() $x->bnok($y); # x over y (binomial coefficient n over k) Calculates the binomial coefficient n over k, also called the "choose" function. The result is equivalent to: ( n ) n! | - | = ------- ( k ) k!(n-k)! This method was added in v0.20 of Math::BigRat (May 2007). =head2 config() use Data::Dumper; print Dumper ( Math::BigRat->config() ); print Math::BigRat->config()->{lib},"\n"; Returns a hash containing the configuration, e.g. the version number, lib loaded etc. The following hash keys are currently filled in with the appropriate information. key RO/RW Description Example ============================================================ lib RO Name of the Math library Math::BigInt::Calc lib_version RO Version of 'lib' 0.30 class RO The class of config you just called Math::BigRat version RO version number of the class you used 0.10 upgrade RW To which class numbers are upgraded undef downgrade RW To which class numbers are downgraded undef precision RW Global precision undef accuracy RW Global accuracy undef round_mode RW Global round mode even div_scale RW Fallback accuracy for div 40 trap_nan RW Trap creation of NaN (undef = no) undef trap_inf RW Trap creation of +inf/-inf (undef = no) undef By passing a reference to a hash you may set the configuration values. This works only for values that a marked with a C above, anything else is read-only. =head2 objectify() This is an internal routine that turns scalars into objects. =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L (requires login). We will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Math::BigRat You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =item * CPAN Testers Matrix L =item * The Bignum mailing list =over 4 =item * Post to mailing list C =item * View mailing list L =item * Subscribe/Unsubscribe L =back =back =head1 LICENSE This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L and L as well as the backends L, L, and L. =head1 AUTHORS (C) by Tels L 2001 - 2009. Currently maintained by Peter John Acklam . =cut