+++ /dev/null
-
-#
-# "Tax the rat farms." - Lord Vetinari
-#
-
-# The following hash values are used:
-# sign : +,-,NaN,+inf,-inf
-# _d : denominator
-# _n : numeraotr (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;
-
-# anythig older is untested, and unlikely to work
-use 5.006;
-use strict;
-
-use Math::BigFloat;
-use vars qw($VERSION @ISA $upgrade $downgrade
- $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);
-
-@ISA = qw(Math::BigFloat);
-
-$VERSION = '0.26';
-$VERSION = eval $VERSION;
-
-use overload; # inherit overload from Math::BigFloat
-
-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(@_);
- }
-
-##############################################################################
-
-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});
- }
- $self;
- }
-
-sub new
- {
- # create a Math::BigRat
- my $class = shift;
-
- my ($n,$d) = @_;
-
- my $self = { }; bless $self,$class;
-
- # input like (BigInt) or (BigFloat):
- if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
- {
- if ($n->isa('Math::BigFloat'))
- {
- $self->_new_from_float($n);
- }
- if ($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};
- }
- if ($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/1 => 12/10)
- }
-
- # input like (BigInt,BigInt) or (BigLite,BigLite):
- 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
- {
- require Carp;
- 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
- {
- require Carp;
- Carp::croak(ref($d) . " is not a recognized object format for Math::BigRat->new");
- }
- return $self->bnorm(); # normalize (120/1 => 12/10)
- }
- 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 =~ /\s*\/\s*/)
- {
- return $class->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
- return $class->bnan() if $n =~ /\/\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 (wierd 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();
- }
- 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';
- return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
- }
- }
- $self->bnorm();
- }
-
-sub copy
- {
- # if two arguments, the first one is the class to "swallow" subclasses
- my ($c,$x) = @_;
-
- if (scalar @_ == 1)
- {
- $x = $_[0];
- $c = ref($x);
- }
- return unless ref($x); # only for objects
-
- my $self = bless {}, $c;
-
- $self->{sign} = $x->{sign};
- $self->{_d} = $MBI->_copy($x->{_d});
- $self->{_n} = $MBI->_copy($x->{_n});
- $self->{_a} = $x->{_a} if defined $x->{_a};
- $self->{_p} = $x->{_p} if defined $x->{_p};
- $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} = $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}) )
- {
- require Carp; Carp::croak ("n did not pass the self-check ($c) in bnorm()");
- }
- if ( my $c = $MBI->_check($x->{_d}) )
- {
- require Carp; 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 dont 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)
- {
- require Carp;
- 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)
- {
- require Carp;
- 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 $self->_div_inf($x,$y)
- if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
-
- # x== 0 # also: or y == 1 or y == -1
- 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()->round(@r);
- $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 $self->_div_inf($x,$y)
- if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
-
- return $x if $x->is_zero(); # 0 / 7 = 0, mod 0
-
- # compute $x - $y * floor($x/$y), keeping the sign of $x
-
- # copy x to u, make it positive and then do a normal division ($u/$y)
- my $u = bless { sign => '+' }, $self;
- $u->{_n} = $MBI->_mul( $MBI->_copy($x->{_n}), $y->{_d} );
- $u->{_d} = $MBI->_mul( $MBI->_copy($x->{_d}), $y->{_n} );
-
- # compute floor(u)
- if (! $MBI->_is_one($u->{_d}))
- {
- $u->{_n} = $MBI->_div($u->{_n},$u->{_d}); # 22/7 => 3/1 w/ truncate
- # no need to set $u->{_d} to 1, since below we set it to $y->{_d} anyway
- }
-
- # now compute $y * $u
- $u->{_d} = $MBI->_copy($y->{_d}); # 1 * $y->{_d}, see floor above
- $u->{_n} = $MBI->_mul($u->{_n},$y->{_n});
-
- my $xsign = $x->{sign}; $x->{sign} = '+'; # remember sign and make x positive
- # compute $x - $u
- $x->bsub($u);
- $x->{sign} = $xsign; # put sign back
-
- $x->bnorm()->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
- {
- # 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,@_);
- }
-
- # blog(1,Y) => 0
- return $x->bzero() if $x->is_one() && $y->{sign} eq '+';
-
- # $x <= 0 => NaN
- return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+';
-
- if ($x->is_int() && $y->is_int())
- {
- return $self->new($x->as_number()->blog($y->as_number(),@r));
- }
-
- # do it with floats
- $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@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 optimze 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->{sign} = $x->{sign};
- $u->{value} = $MBI->_div( $MBI->_copy($x->{_n}), $x->{_d}); # 22/7 => 3
- $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__
-
-=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 L<as_int()> or L<as_float()> 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<as_number()> is an alias for C<as_int()>.
-
-=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 digitis 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()
-
- use Math::BigRat;
- my $x = Math::BigRat->new('7/4');
- my $y = Math::BigRat->new('4/3');
- print $x->bmod($y);
-
-Set $x to the remainder of the division of $x by $y.
-
-=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_positive()> is an alias for C<is_pos()>.
-
-=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_negative()> is an alias for C<is_neg()>.
-
-=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()/bmul()/bsub()/bdiv()/bdec()/binc()
-
-Please see the documentation in L<Math::BigInt>.
-
-=head2 copy()
-
- my $z = $x->copy();
-
-Makes a deep copy of the object.
-
-Please see the documentation in L<Math::BigInt> 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 representating this object.
-
-=head2 bacmp()/bcmp()
-
-Used to compare numbers.
-
-Please see the documentation in L<Math::BigInt> for further details.
-
-=head2 blsft()/brsft()
-
-Used to shift numbers left/right.
-
-Please see the documentation in L<Math::BigInt> for further details.
-
-=head2 bpow()
-
- $x->bpow($y);
-
-Compute $x ** $y.
-
-Please see the documentation in L<Math::BigInt> 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<e ** $x>, where C<e> is
-Euler's number.
-
-This method was added in v0.20 of Math::BigRat (May 2007).
-
-See also L<blog()>.
-
-=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<RW> above, anything else is
-read-only.
-
-=head2 objectify()
-
-This is an internal routine that turns scalars into objects.
-
-=head1 BUGS
-
-Some things are not yet implemented, or only implemented half-way:
-
-=over 2
-
-=item inf handling (partial)
-
-=item NaN handling (partial)
-
-=item rounding (not implemented except for bceil/bfloor)
-
-=item $x ** $y where $y is not an integer
-
-=item bmod(), blog(), bmodinv() and bmodpow() (partial)
-
-=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<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
-L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
-
-See L<http://search.cpan.org/search?dist=bignum> for a way to use
-Math::BigRat.
-
-The package at L<http://search.cpan.org/search?dist=Math%3A%3ABigRat>
-may contain more documentation and examples as well as testcases.
-
-=head1 AUTHORS
-
-(C) by Tels L<http://bloodgate.com/> 2001 - 2009.
-
-Currently maintained by Jonathan "Duke" Leto <jonathan@leto.net> L<http://leto.net>
-
-=cut
https://perl5.git.perl.org / perl5.git / blobdiff