diff options
author | Steve Hay <steve.m.hay@googlemail.com> | 2016-06-28 08:54:25 +0100 |
---|---|---|
committer | Steve Hay <steve.m.hay@googlemail.com> | 2016-06-28 08:54:25 +0100 |
commit | 6320cdc08f146d42140872a5124e166084f2b766 (patch) | |
tree | 3cca0842b65624560d32e58b693d94594bb4947a /cpan | |
parent | 28c06467080d6e1c05bb3a420c5fc24e8f46396e (diff) | |
download | perl-6320cdc08f146d42140872a5124e166084f2b766.tar.gz |
Upgrade Math::BigRat from version 0.260802 to 0.260804
(This removes the blead customization, which is now incorporated with minor
changes.)
Diffstat (limited to 'cpan')
-rw-r--r-- | cpan/Math-BigRat/lib/Math/BigRat.pm | 3401 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/big_ap.t | 79 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/bigfltrt.t | 2 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/biglog.t | 42 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/bigrat.t | 30 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/bigratpm.t | 2 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/bigratup.t | 4 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/bigroot.t | 2 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/bitwise.t | 45 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/hang.t | 4 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/requirer.t | 2 | ||||
-rw-r--r-- | cpan/Math-BigRat/t/trap.t | 131 |
12 files changed, 2149 insertions, 1595 deletions
diff --git a/cpan/Math-BigRat/lib/Math/BigRat.pm b/cpan/Math-BigRat/lib/Math/BigRat.pm index 95c2927a86..8f7795a6d6 100644 --- a/cpan/Math-BigRat/lib/Math/BigRat.pm +++ b/cpan/Math-BigRat/lib/Math/BigRat.pm @@ -12,7 +12,6 @@ package Math::BigRat; -# anything older is untested, and unlikely to work use 5.006; use strict; use warnings; @@ -21,24 +20,184 @@ 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'; +our $VERSION = '0.260804'; $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. +our @ISA = qw(Math::BigFloat); + +our ($accuracy, $precision, $round_mode, $div_scale, + $upgrade, $downgrade, $_trap_nan, $_trap_inf); use overload - map { - my $op = $_; - ($op => sub { - Carp::croak("bitwise operation $op not supported in Math::BigRat"); - }); - } qw(& | ^ ~ << >> &= |= ^= <<= >>=); + + # overload key: with_assign + + '+' => sub { $_[0] -> copy() -> badd($_[1]); }, + + '-' => sub { my $c = $_[0] -> copy; + $_[2] ? $c -> bneg() -> badd( $_[1]) + : $c -> bsub($_[1]); }, + + '*' => sub { $_[0] -> copy() -> bmul($_[1]); }, + + '/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0]) + : $_[0] -> copy() -> bdiv($_[1]); }, + + + '%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0]) + : $_[0] -> copy() -> bmod($_[1]); }, + + '**' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0]) + : $_[0] -> copy() -> bpow($_[1]); }, + + '<<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0]) + : $_[0] -> copy() -> blsft($_[1]); }, + + '>>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0]) + : $_[0] -> copy() -> brsft($_[1]); }, + + # overload key: assign + + '+=' => sub { $_[0]->badd($_[1]); }, + + '-=' => sub { $_[0]->bsub($_[1]); }, + + '*=' => sub { $_[0]->bmul($_[1]); }, + + '/=' => sub { scalar $_[0]->bdiv($_[1]); }, + + '%=' => sub { $_[0]->bmod($_[1]); }, + + '**=' => sub { $_[0]->bpow($_[1]); }, + + + '<<=' => sub { $_[0]->blsft($_[1]); }, + + '>>=' => sub { $_[0]->brsft($_[1]); }, + +# 'x=' => sub { }, + +# '.=' => sub { }, + + # overload key: num_comparison + + '<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0]) + : $_[0] -> blt($_[1]); }, + + '<=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0]) + : $_[0] -> ble($_[1]); }, + + '>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0]) + : $_[0] -> bgt($_[1]); }, + + '>=' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0]) + : $_[0] -> bge($_[1]); }, + + '==' => sub { $_[0] -> beq($_[1]); }, + + '!=' => sub { $_[0] -> bne($_[1]); }, + + # overload key: 3way_comparison + + '<=>' => sub { my $cmp = $_[0] -> bcmp($_[1]); + defined($cmp) && $_[2] ? -$cmp : $cmp; }, + + 'cmp' => sub { $_[2] ? "$_[1]" cmp $_[0] -> bstr() + : $_[0] -> bstr() cmp "$_[1]"; }, + + # overload key: str_comparison + +# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0]) +# : $_[0] -> bstrlt($_[1]); }, +# +# 'le' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0]) +# : $_[0] -> bstrle($_[1]); }, +# +# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0]) +# : $_[0] -> bstrgt($_[1]); }, +# +# 'ge' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0]) +# : $_[0] -> bstrge($_[1]); }, +# +# 'eq' => sub { $_[0] -> bstreq($_[1]); }, +# +# 'ne' => sub { $_[0] -> bstrne($_[1]); }, + + # overload key: binary + + '&' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0]) + : $_[0] -> copy() -> band($_[1]); }, + + '&=' => sub { $_[0] -> band($_[1]); }, + + '|' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0]) + : $_[0] -> copy() -> bior($_[1]); }, + + '|=' => sub { $_[0] -> bior($_[1]); }, + + '^' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0]) + : $_[0] -> copy() -> bxor($_[1]); }, + + '^=' => sub { $_[0] -> bxor($_[1]); }, + +# '&.' => sub { }, + +# '&.=' => sub { }, + +# '|.' => sub { }, + +# '|.=' => sub { }, + +# '^.' => sub { }, + +# '^.=' => sub { }, + + # overload key: unary + + 'neg' => sub { $_[0] -> copy() -> bneg(); }, + +# '!' => sub { }, + + '~' => sub { $_[0] -> copy() -> bnot(); }, + +# '~.' => sub { }, + + # overload key: mutators + + '++' => sub { $_[0] -> binc() }, + + '--' => sub { $_[0] -> bdec() }, + + # overload key: func + + 'atan2' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0]) + : $_[0] -> copy() -> batan2($_[1]); }, + + 'cos' => sub { $_[0] -> copy() -> bcos(); }, + + 'sin' => sub { $_[0] -> copy() -> bsin(); }, + + 'exp' => sub { $_[0] -> copy() -> bexp($_[1]); }, + + 'abs' => sub { $_[0] -> copy() -> babs(); }, + + 'log' => sub { $_[0] -> copy() -> blog(); }, + + 'sqrt' => sub { $_[0] -> copy() -> bsqrt(); }, + + 'int' => sub { $_[0] -> copy() -> bint(); }, + + # overload key: conversion + + 'bool' => sub { $_[0] -> is_zero() ? '' : 1; }, + + '""' => sub { $_[0] -> bstr(); }, + + '0+' => sub { $_[0] -> numify(); }, + + '=' => sub { $_[0]->copy(); }, + + ; BEGIN { *objectify = \&Math::BigInt::objectify; # inherit this from BigInt @@ -56,11 +215,11 @@ BEGIN { ############################################################################## # Global constants and flags. Access these only via the accessor methods! -$accuracy = $precision = undef; +$accuracy = $precision = undef; $round_mode = 'even'; -$div_scale = 40; -$upgrade = undef; -$downgrade = undef; +$div_scale = 40; +$upgrade = undef; +$downgrade = undef; # These are internally, and not to be used from the outside at all! @@ -69,267 +228,298 @@ $_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'; +#my $class = 'Math::BigRat'; sub isa { - return 0 if $_[1] =~ /^Math::Big(Int|Float)/; # we aren't + 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) = @_; +sub new { + my $proto = shift; + my $protoref = ref $proto; + my $class = $protoref || $proto; - return $self->bnan() if $f->is_nan(); - return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/; + # Check the way we are called. - $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); + if ($protoref) { + Carp::croak("new() is a class method, not an instance method"); } - else - { - # something like Math::BigRat->new('10'); - # 1 / 1 => 10/1 - $MBI->_lsft($self->{_n}, $f->{_e} ,10) unless - $MBI->_is_zero($f->{_e}); + + if (@_ < 1) { + #Carp::carp("Using new() with no argument is deprecated;", + # " use bzero() or new(0) instead"); + return $class -> bzero(); } - 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. + if (@_ > 2) { + Carp::carp("Superfluous arguments to new() ignored."); + } -sub _new_from_int { - my ($self, $i) = @_; + # Get numerator and denominator. If any of the arguments is undefined, + # return zero. - return $self -> bnan() if $i -> is_nan(); - return $self -> binf($i -> sign()) if $i -> is_inf(); + my ($n, $d) = @_; - $self -> {_n} = $MBI -> _copy($i -> {value}); - $self -> {_d} = $MBI -> _one(); - $self -> {sign} = $i -> {sign}; - return $self; -} + if (@_ == 1 && !defined $n || + @_ == 2 && (!defined $n || !defined $d)) + { + #Carp::carp("Use of uninitialized value in new()"); + return $class -> bzero(); + } -sub new { - my $self = shift; - my $selfref = ref $self; - my $class = $selfref || $self; + # Initialize a new object. - # Get numerator and denominator. + my $self = bless {}, $class; - my ($n, $d) = @_; + # One or two input arguments may be given. First handle the numerator $n. - # If called as a class method, initialize a new object. + if (ref($n)) { + $n = Math::BigFloat -> new($n, undef, undef) + unless ($n -> isa('Math::BigRat') || + $n -> isa('Math::BigInt') || + $n -> isa('Math::BigFloat')); + } else { + if (defined $d) { + # If the denominator is defined, the numerator is not a string + # fraction, e.g., "355/113". + $n = Math::BigFloat -> new($n, undef, undef); + } else { + # If the denominator is undefined, the numerator might be a string + # fraction, e.g., "355/113". + if ($n =~ m| ^ \s* (\S+) \s* / \s* (\S+) \s* $ |x) { + $n = Math::BigFloat -> new($1, undef, undef); + $d = Math::BigFloat -> new($2, undef, undef); + } else { + $n = Math::BigFloat -> new($n, undef, undef); + } + } + } - $self = bless {}, $class unless $selfref; + # At this point $n is an object and $d is either an object or undefined. An + # undefined $d means that $d was not specified by the caller (not that $d + # was specified as an undefined value). - # Input like $class->new($n), where there is no denominator, and where $n - # is a Math::BigInt or Math::BigFloat. + unless (defined $d) { + #return $n -> copy($n) if $n -> isa('Math::BigRat'); + return $class -> copy($n) if $n -> isa('Math::BigRat'); + return $class -> bnan() if $n -> is_nan(); + return $class -> binf($n -> sign()) if $n -> is_inf(); - if ((!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}; + if ($n -> isa('Math::BigInt')) { + $self -> {_n} = $MBI -> _new($n -> copy() -> babs() -> bstr()); + $self -> {_d} = $MBI -> _one(); + $self -> {sign} = $n -> sign(); + return $self; } - 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 + + if ($n -> isa('Math::BigFloat')) { + my $m = $n -> mantissa() -> babs(); + my $e = $n -> exponent(); + $self -> {_n} = $MBI -> _new($m -> bstr()); + $self -> {_d} = $MBI -> _one(); + + if ($e > 0) { + $self -> {_n} = $MBI -> _lsft($self -> {_n}, + $MBI -> _new($e -> bstr()), 10); + } elsif ($e < 0) { + $self -> {_d} = $MBI -> _lsft($self -> {_d}, + $MBI -> _new(-$e -> bstr()), 10); + + my $gcd = $MBI -> _gcd($MBI -> _copy($self -> {_n}), $self -> {_d}); + if (!$MBI -> _is_one($gcd)) { + $self -> {_n} = $MBI -> _div($self->{_n}, $gcd); + $self -> {_d} = $MBI -> _div($self->{_d}, $gcd); + } + } + + $self -> {sign} = $n -> sign(); + return $self; } - return $self->bnorm(); # normalize (120/100 => 6/5) + + die "I don't know how to handle this"; # should never get here } - # 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)) { + # At the point we know that both $n and $d are defined. We know that $n is + # an object, but $d might still be a scalar. Now handle $d. - # 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"); - } + $d = Math::BigFloat -> new($d, undef, undef) + unless ref($d) && ($d -> isa('Math::BigRat') || + $d -> isa('Math::BigInt') || + $d -> isa('Math::BigFloat')); - # 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"); - } + # At this point both $n and $d are objects. + + return $class -> bnan() if $n -> is_nan() || $d -> is_nan(); - return $self->bnorm(); # normalize (120/100 => 6/5) + # At this point neither $n nor $d is a NaN. + + if ($n -> is_zero()) { + return $class -> bnan() if $d -> is_zero(); # 0/0 = NaN + return $class -> bzero(); } - return $n->copy() if ref $n; # already a BigRat + return $class -> binf($d -> sign()) if $d -> is_zero(); + + # At this point, neither $n nor $d is a NaN or a zero. - if (!defined $n) { - $self->{_n} = $MBI->_zero(); # undef => 0 - $self->{_d} = $MBI->_one(); - $self->{sign} = '+'; - return $self; + if ($d < 0) { # make sure denominator is positive + $n -> bneg(); + $d -> bneg(); } - # 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 ($n -> is_inf()) { + return $class -> bnan() if $d -> is_inf(); # Inf/Inf = NaN + return $class -> binf($n -> sign()); + } - 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); - } + # At this point $n is finite. - 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(); - } + return $class -> bzero() if $d -> is_inf(); + return $class -> binf($d -> sign()) if $d -> is_zero(); - $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(); - } - } - } + # At this point both $n and $d are finite and non-zero. - return $self->bnorm(); + if ($n < 0) { + $n -> bneg(); + $self -> {sign} = '-'; + } else { + $self -> {sign} = '+'; } - # 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(); + if ($n -> isa('Math::BigRat')) { + + if ($d -> isa('Math::BigRat')) { + + # At this point both $n and $d is a Math::BigRat. + + # p r p * s (p / gcd(p, r)) * (s / gcd(s, q)) + # - / - = ----- = --------------------------------- + # q s q * r (q / gcd(s, q)) * (r / gcd(p, r)) + + my $p = $n -> {_n}; + my $q = $n -> {_d}; + my $r = $d -> {_n}; + my $s = $d -> {_d}; + my $gcd_pr = $MBI -> _gcd($MBI -> _copy($p), $r); + my $gcd_sq = $MBI -> _gcd($MBI -> _copy($s), $q); + $self -> {_n} = $MBI -> _mul($MBI -> _div($MBI -> _copy($p), $gcd_pr), + $MBI -> _div($MBI -> _copy($s), $gcd_sq)); + $self -> {_d} = $MBI -> _mul($MBI -> _div($MBI -> _copy($q), $gcd_sq), + $MBI -> _div($MBI -> _copy($r), $gcd_pr)); + + return $self; # no need for $self -> bnorm() here } - elsif ($n =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { - my $sgn = $1 || '+'; - $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() - $self->binf($sgn); + + # At this point, $n is a Math::BigRat and $d is a Math::Big(Int|Float). + + my $p = $n -> {_n}; + my $q = $n -> {_d}; + my $m = $d -> mantissa(); + my $e = $d -> exponent(); + + # / p + # | ------------ if e > 0 + # | q * m * 10^e + # | + # p | p + # - / (m * 10^e) = | ----- if e == 0 + # q | q * m + # | + # | p * 10^-e + # | -------- if e < 0 + # \ q * m + + $self -> {_n} = $MBI -> _copy($p); + $self -> {_d} = $MBI -> _mul($MBI -> _copy($q), $m); + if ($e > 0) { + $self -> {_d} = $MBI -> _lsft($self -> {_d}, $e, 10); + } elsif ($e < 0) { + $self -> {_n} = $MBI -> _lsft($self -> {_n}, -$e, 10); } - 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 -> bnorm(); + + } else { + + if ($d -> isa('Math::BigRat')) { + + # At this point $n is a Math::Big(Int|Float) and $d is a + # Math::BigRat. + + my $m = $n -> mantissa(); + my $e = $n -> exponent(); + my $p = $d -> {_n}; + my $q = $d -> {_d}; + + # / q * m * 10^e + # | ------------ if e > 0 + # | p + # | + # p | m * q + # (m * 10^e) / - = | ----- if e == 0 + # q | p + # | + # | q * m + # | --------- if e < 0 + # \ p * 10^-e + + $self -> {_n} = $MBI -> _mul($MBI -> _copy($q), $m); + $self -> {_d} = $MBI -> _copy($p); + if ($e > 0) { + $self -> {_n} = $MBI -> _lsft($self -> {_n}, $e, 10); + } elsif ($e < 0) { + $self -> {_d} = $MBI -> _lsft($self -> {_d}, -$e, 10); + } + return $self -> bnorm(); + + } else { + + # At this point $n and $d are both a Math::Big(Int|Float) + + my $m1 = $n -> mantissa(); + my $e1 = $n -> exponent(); + my $m2 = $d -> mantissa(); + my $e2 = $d -> exponent(); + + # / + # | m1 * 10^(e1 - e2) + # | ----------------- if e1 > e2 + # | m2 + # | + # m1 * 10^e1 | m1 + # ---------- = | -- if e1 = e2 + # m2 * 10^e2 | m2 + # | + # | m1 + # | ----------------- if e1 < e2 + # | m2 * 10^(e2 - e1) + # \ + + $self -> {_n} = $MBI -> _new($m1 -> bstr()); + $self -> {_d} = $MBI -> _new($m2 -> bstr()); + my $ediff = $e1 - $e2; + if ($ediff > 0) { + $self -> {_n} = $MBI -> _lsft($self -> {_n}, + $MBI -> _new($ediff -> bstr()), + 10); + } elsif ($ediff < 0) { + $self -> {_d} = $MBI -> _lsft($self -> {_d}, + $MBI -> _new(-$ediff -> bstr()), + 10); + } + + return $self -> bnorm(); } } - $self->bnorm(); + return $self; } sub copy { @@ -349,313 +539,376 @@ sub copy { $copy->{_a} = $self->{_a} if defined $self->{_a}; $copy->{_p} = $self->{_p} if defined $self->{_p}; - $copy; + #($copy, $copy->{_a}, $copy->{_p}) + # = $copy->_find_round_parameters(@_); + + return $copy; +} + +sub bnan { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + $self = bless {}, $class unless $selfref; + + if ($_trap_nan) { + Carp::croak ("Tried to set a variable to NaN in $class->bnan()"); + } + + $self -> {sign} = $nan; + $self -> {_n} = $MBI -> _zero(); + $self -> {_d} = $MBI -> _one(); + + ($self, $self->{_a}, $self->{_p}) + = $self->_find_round_parameters(@_); + + return $self; +} + +sub binf { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + $self = bless {}, $class unless $selfref; + + my $sign = shift(); + $sign = defined($sign) && substr($sign, 0, 1) eq '-' ? '-inf' : '+inf'; + + if ($_trap_inf) { + Carp::croak ("Tried to set a variable to +-inf in $class->binf()"); + } + + $self -> {sign} = $sign; + $self -> {_n} = $MBI -> _zero(); + $self -> {_d} = $MBI -> _one(); + + ($self, $self->{_a}, $self->{_p}) + = $self->_find_round_parameters(@_); + + return $self; +} + +sub bone { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + $self = bless {}, $class unless $selfref; + + my $sign = shift(); + $sign = '+' unless defined($sign) && $sign eq '-'; + + $self -> {sign} = $sign; + $self -> {_n} = $MBI -> _one(); + $self -> {_d} = $MBI -> _one(); + + ($self, $self->{_a}, $self->{_p}) + = $self->_find_round_parameters(@_); + + return $self; +} + +sub bzero { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + $self = bless {}, $class unless $selfref; + + $self -> {sign} = '+'; + $self -> {_n} = $MBI -> _zero(); + $self -> {_d} = $MBI -> _one(); + + ($self, $self->{_a}, $self->{_p}) + = $self->_find_round_parameters(@_); + + return $self; } ############################################################################## -sub config - { - # return (later set?) configuration data as hash ref - my $class = shift || 'Math::BigRat'; +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]}; + if (@_ == 1 && ref($_[0]) ne 'HASH') { + my $cfg = $class->SUPER::config(); + return $cfg->{$_[0]}; } - my $cfg = $class->SUPER::config(@_); + 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; - } + # 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,@_); +sub bstr { + my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc - { - my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf - return $s; + 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' + 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}); - } + 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,@_); +sub bsstr { + my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc - { - my $s = $x->{sign}; $s =~ s/^\+//; # +inf => inf - return $s; + 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}); - } + 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,@_); +sub bnorm { + # reduce the number to the shortest form + my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - # Both parts must be objects of whatever we are using today. - if (my $c = $MBI->_check($x->{_n})) - { + # 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})) - { + 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} !~ /^[+-]$/; + # 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; + # 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}); + return $x if $MBI->_is_one($x->{_d}); # no need to reduce - if (!$MBI->_is_one($gcd)) - { - $x->{_n} = $MBI->_div($x->{_n},$gcd); - $x->{_d} = $MBI->_div($x->{_d},$gcd); + # Compute the GCD. + my $gcd = $MBI->_gcd($MBI->_copy($x->{_n}), $x->{_d}); + if (!$MBI->_is_one($gcd)) { + $x->{_n} = $MBI->_div($x->{_n}, $gcd); + $x->{_d} = $MBI->_div($x->{_d}, $gcd); } - $x; - } + + $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,@_); +sub bneg { + # (BRAT or num_str) return BRAT + # negate number or make a negated number from string + my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - return $x if $x->modify('bneg'); + 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; - } + # 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; +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()"); + 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(); - } + $self->{_n} = $MBI->_zero(); + $self->{_d} = $MBI->_zero(); +} -sub _binf - { - # used by parent class bone() to initialize number to +inf/-inf - my $self = shift; +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()"); + 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(); - } + $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 +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,@_); + # set up parameters + my ($class, $x, $y, @r) = (ref($_[0]), @_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, @r) = objectify(2, @_); } - # +inf + +inf => +inf, -inf + -inf => -inf - return $x->binf(substr($x->{sign},0,1)) - if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; + # +inf + +inf => +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} !~ /^[+-]$/); + # +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 + # 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 + # 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 + # and bnorm() will then take care of the rest - # 5 * 3 - $x->{_n} = $MBI->_mul($x->{_n}, $y->{_d}); + # 5 * 3 + $x->{_n} = $MBI->_mul($x->{_n}, $y->{_d}); - # 7 * 4 - my $m = $MBI->_mul($MBI->_copy($y->{_n}), $x->{_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}); + # 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}); + # 4 * 3 + $x->{_d} = $MBI->_mul($x->{_d}, $y->{_d}); - # normalize result, and possible round - $x->bnorm()->round(@r); - } + # normalize result, and possible round + $x->bnorm()->round(@r); +} -sub bsub - { - # subtract two rational numbers +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,@_); + # set up parameters + my ($class, $x, $y, @r) = (ref($_[0]), @_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, @r) = objectify(2, @_); } - # flip sign of $x, call badd(), then flip sign of result - $x->{sign} =~ tr/+-/-+/ - unless $x->{sign} eq '+' && $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,@_); + # 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 ($class, $x, $y, @r) = (ref($_[0]), @_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, @r) = objectify(2, @_); } - return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'); + 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('-'); + # 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(); + # x== 0 # also: or y == 1 or y == -1 + return wantarray ? ($x, $class->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. + # 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 + # 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}); + $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} ? '+' : '-'; + # compute new sign + $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; - $x->bnorm()->round(@r); - } + $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) +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,@_); + # set up parameters + my ($class, $x, $y, @r) = (ref($_[0]), @_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, @r) = objectify(2, @_); } - return $x if $x->modify('bdiv'); + return $x if $x->modify('bdiv'); - my $wantarray = wantarray; # call only once + 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(); + return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan(); } # Divide by zero and modulo zero. This is handled the same way as in @@ -681,7 +934,7 @@ sub bdiv if ($x -> is_inf()) { my ($quo, $rem); - $rem = $self -> bnan() if $wantarray; + $rem = $class -> bnan() if $wantarray; if ($y -> is_inf()) { $quo = $x -> bnan(); } else { @@ -691,78 +944,76 @@ sub bdiv 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,@_); + # Denominator (divisor) is +/-inf. This is handled the same way as in + # Math::BigFloat -> bdiv(). See the comments in the code implementing that + # method. + + if ($y -> is_inf()) { + my ($quo, $rem); + if ($wantarray) { + if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { + $rem = $x -> copy(); + $quo = $x -> bzero(); + } else { + $rem = $class -> binf($y -> {sign}); + $quo = $x -> bone('-'); + } + return ($quo, $rem); + } else { + if ($y -> is_inf()) { + if ($x -> is_nan() || $x -> is_inf()) { + return $x -> bnan(); + } else { + return $x -> bzero(); + } + } + } } - return $x if $x->modify('bmod'); + # At this point, both the numerator and denominator are finite numbers, and + # the denominator (divisor) is non-zero. + + # x == 0? + return wantarray ? ($x, $class->bzero()) : $x if $x->is_zero(); + + # XXX TODO: list context, upgrade + # According to Knuth, this can be optimized by doing gcd twice (for d and n) + # and reducing in one step. This would save us the bnorm() at the end. + + # 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 ($class, $x, $y, @r) = (ref($_[0]), @_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, @r) = objectify(2, @_); + } + + return $x if $x->modify('bmod'); # At least one argument is NaN. This is handled the same way as in # Math::BigInt -> bmod(). @@ -795,938 +1046,1031 @@ sub bmod } } - # At this point, both the numerator and denominator are finite numbers, and - # the denominator (divisor) is non-zero. + # 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 + 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. + # 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); - } + $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,@_); +sub bdec { + # decrement value (subtract 1) + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf + 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 - } + 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); - } + $x->bnorm()->round(@r); +} -sub binc - { - # increment value (add 1) - my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); +sub binc { + # increment value (add 1) + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); - return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf + 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 + 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); - } + $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; - } +sub is_int { + # return true if arg (BRAT or num_str) is an integer + my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); + + return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't + $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 ($class, $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 ($class, $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 ($class, $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 ($class, $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,@_); +sub numerator { + my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); - # NaN, inf, -inf - return Math::BigInt->new($x->{sign}) if ($x->{sign} !~ /^[+-]$/); + # 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; - } + 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,@_); +sub denominator { + my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); - # NaN - return Math::BigInt->new($x->{sign}) if $x->{sign} eq 'NaN'; - # inf, -inf - return Math::BigInt->bone() if $x->{sign} !~ /^[+-]$/; + # 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})); - } + Math::BigInt->new($MBI->_str($x->{_d})); +} -sub parts - { - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); +sub parts { + my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); - my $c = 'Math::BigInt'; + 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'; + 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); - } + 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,@_); +sub length { + my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - return $nan unless $x->is_int(); - $MBI->_len($x->{_n}); # length(-123/1) => length(123) - } + 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,@_); +sub digit { + my ($class, $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) - } + 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(); +sub bceil { + my ($class, $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 $x->{sign} eq '-' && $MBI->_is_zero($x->{_n}); # -0 => 0 + $x; +} + +sub bfloor { + my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + + return $x if ($x->{sign} !~ /^[+-]$/ || # not for NaN, inf + $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 bint { + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_); + + return $x if ($x->{sign} !~ /^[+-]$/ || # +/-inf or NaN + $MBI -> _is_one($x->{_d})); # already an integer + + $x->{_n} = $MBI->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate + $x->{_d} = $MBI->_one(); # d => 1 + $x->{sign} = '+' if $x->{sign} eq '-' && $MBI -> _is_zero($x->{_n}); + return $x; +} + +sub bfac { + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); + + # if $x is not an integer + if (($x->{sign} ne '+') || (!$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); - } + $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) +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,@_); + # set up parameters + my ($class, $x, $y, @r) = (ref($_[0]), @_); + + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, @r) = objectify(2, @_); } - return $x if $x->{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(); + 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; + 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 + # 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) + 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 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 + # 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 $x->{sign} eq '-' && $MBI->_is_even($y->{_n}); + } + return $x->round(@r); } - # correct sign; + ** + => + - if ($x->{sign} eq '-') - { - # - * - => +, - * - * - => - - $x->{sign} = '+' if $MBI->_is_even($y->{_n}); + + # 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 } - 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); + # correct sign; + ** + => + + + $x->{sign} = '+' if $x->{sign} eq '-' && $MBI->_is_even($y->{_n}); + return $x->round(@r); } -# print STDERR "# $x $y\n"; + # print STDERR "# $x $y\n"; - # otherwise: + # otherwise: - # n/d n ______________ - # a/b = -\/ (a/b) ** d + # 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}); + # (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) - } + 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. +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. + # 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]),@_); + # set up parameters + my ($class, $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,@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $base, @r) = objectify(1, @_); } - return $x if $x->modify('blog'); - - # Handle all exception cases and all trivial cases. I have used Wolfram Alpha - # (http://www.wolframalpha.com) as the reference for these cases. - - return $x -> bnan() if $x -> is_nan(); - - if (defined $base) { - $base = $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 if $x->modify('blog'); - return $x->binf(@r) if $x->{sign} eq '+inf'; - return $x->bzero(@r) if $x->{sign} eq '-inf'; + # Handle all exception cases and all trivial cases. I have used Wolfram Alpha + # (http://www.wolframalpha.com) as the reference for these cases. - # we need to limit the accuracy to protect against overflow - my $fallback = 0; - my ($scale,@params); - ($x,@params) = $x->_find_round_parameters(@r); + return $x -> bnan() if $x -> is_nan(); + + if (defined $base) { + $base = $class -> new($base) unless ref $base; + if ($base -> is_nan() || $base -> is_one()) { + return $x -> bnan(); + } elsif ($base -> is_inf() || $base -> is_zero()) { + return $x -> bnan() if $x -> is_inf() || $x -> is_zero(); + return $x -> bzero(); + } elsif ($base -> is_negative()) { # -inf < base < 0 + return $x -> bzero() if $x -> is_one(); # x = 1 + return $x -> bone() if $x == $base; # x = base + return $x -> bnan(); # otherwise + } + return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf + } - # also takes care of the "error in _find_round_parameters?" case - return $x if $x->{sign} eq 'NaN'; + # We now know that the base is either undefined or positive and finite. - # 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 + 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); } - 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 + + # At this point we are done handling all exception cases and trivial cases. + + $base = Math::BigFloat -> new($base) if defined $base; + + my $xn = Math::BigFloat -> new($MBI -> _str($x->{_n})); + my $xd = Math::BigFloat -> new($MBI -> _str($x->{_d})); + + my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> blog($base, @r) -> bsstr()); + + $x -> {sign} = $xtmp -> {sign}; + $x -> {_n} = $xtmp -> {_n}; + $x -> {_d} = $xtmp -> {_d}; + + return $x; +} + +sub bexp { + # set up parameters + my ($class, $x, $y, @r) = (ref($_[0]), @_); + + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, @r) = objectify(2, @_); } - return $x->bone(@params) if $x->is_zero(); + return $x->binf(@r) if $x->{sign} eq '+inf'; + return $x->bzero(@r) if $x->{sign} eq '-inf'; - # 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 + # we need to limit the accuracy to protect against overflow + my $fallback = 0; + my ($scale, @params); + ($x, @params) = $x->_find_round_parameters(@r); - 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} = '+'; + # also takes care of the "error in _find_round_parameters?" case + return $x if $x->{sign} eq 'NaN'; + + # no rounding at all, so must use fallback + if (scalar @params == 0) { + # simulate old behaviour + $params[0] = $class->div_scale(); # and round to it as accuracy + $params[1] = undef; # P = undef + $scale = $params[0]+4; # at least four more for proper round + $params[2] = $r[2]; # round mode by caller or undef + $fallback = 1; # to clear a/p afterwards + } else { + # the 4 below is empirical, and there might be cases where it's not enough... + $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } - 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} = '+'; + + 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); + # $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 + } } - 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}; } - if ($fallback) - { - # clear a/p after round, since user did not request it - delete $x->{_a}; delete $x->{_p}; + + $x; +} + +sub bnok { + # set up parameters + my ($class, $x, $y, @r) = (ref($_[0]), @_); + + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, @r) = objectify(2, @_); } - $x; - } + my $xint = Math::BigInt -> new($x -> bint() -> bsstr()); + my $yint = Math::BigInt -> new($y -> bint() -> bsstr()); + $xint -> bnok($yint); -sub bnok - { - # set up parameters - my ($self,$x,$y,@r) = (ref($_[0]),@_); + $x -> {sign} = $xint -> {sign}; + $x -> {_n} = $xint -> {_n}; + $x -> {_d} = $xint -> {_d}; - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) - { - ($self,$x,$y,@r) = objectify(2,$class,@_); + return $x; +} + +sub broot { + # set up parameters + my ($class, $x, $y, @r) = (ref($_[0]), @_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, @r) = objectify(2, @_); } - # do it with floats - $x->_new_from_float($x->_as_float()->bnok(Math::BigFloat->new("$y"),@r)); - } + # Convert $x into a Math::BigFloat. -sub _float_from_part - { - my $x = shift; + my $xd = Math::BigFloat -> new($MBI -> _str($x->{_d})); + my $xflt = Math::BigFloat -> new($MBI -> _str($x->{_n})) -> bdiv($xd); + $xflt -> {sign} = $x -> {sign}; - my $f = Math::BigFloat->bzero(); - $f->{_m} = $MBI->_copy($x); - $f->{_e} = $MBI->_zero(); + # Convert $y into a Math::BigFloat. - $f; - } + my $yd = Math::BigFloat -> new($MBI -> _str($y->{_d})); + my $yflt = Math::BigFloat -> new($MBI -> _str($y->{_n})) -> bdiv($yd); + $yflt -> {sign} = $y -> {sign}; -sub _as_float - { - my $x = shift; + # Compute the root and convert back to a Math::BigRat. - local $Math::BigFloat::upgrade = undef; - local $Math::BigFloat::accuracy = undef; - local $Math::BigFloat::precision = undef; - # 22/7 => 3.142857143.. + $xflt -> broot($yflt, @r); + my $xtmp = Math::BigRat -> new($xflt -> bsstr()); - 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,@_); - } + $x -> {sign} = $xtmp -> {sign}; + $x -> {_n} = $xtmp -> {_n}; + $x -> {_d} = $xtmp -> {_d}; - if ($x->is_int() && $y->is_int()) - { - return $self->new($x->as_number()->broot($y->as_number(),@r)); + return $x; +} + +sub bmodpow { + # set up parameters + my ($class, $x, $y, $m, @r) = (ref($_[0]), @_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, $m, @r) = objectify(3, @_); } - # do it with floats - $x->_new_from_float($x->_as_float()->broot($y->_as_float(),@r))->bnorm()->bround(@r); - } + # Convert $x, $y, and $m into Math::BigInt objects. -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,@_); - } + my $xint = Math::BigInt -> new($x -> copy() -> bint()); + my $yint = Math::BigInt -> new($y -> copy() -> bint()); + my $mint = Math::BigInt -> new($m -> copy() -> bint()); - # $x or $y or $m are NaN or +-inf => NaN - return $x->bnan() - if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || - $m->{sign} !~ /^[+-]$/; + $xint -> bmodpow($y, $m, @r); + my $xtmp = Math::BigRat -> new($xint -> bsstr()); - if ($x->is_int() && $y->is_int() && $m->is_int()) - { - return $self->new($x->as_number()->bmodpow($y->as_number(),$m,@r)); + $x -> {sign} = $xtmp -> {sign}; + $x -> {_n} = $xtmp -> {_n}; + $x -> {_d} = $xtmp -> {_d}; + return $x; +} + +sub bmodinv { + # set up parameters + my ($class, $x, $y, @r) = (ref($_[0]), @_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y, @r) = objectify(2, @_); } - warn ("bmodpow() not fully implemented"); - $x->bnan(); - } + # Convert $x and $y into Math::BigInt objects. -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,@_); - } + my $xint = Math::BigInt -> new($x -> copy() -> bint()); + my $yint = Math::BigInt -> new($y -> copy() -> bint()); - # $x or $y are NaN or +-inf => NaN - return $x->bnan() - if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/; + $xint -> bmodinv($y, @r); + my $xtmp = Math::BigRat -> new($xint -> bsstr()); - if ($x->is_int() && $y->is_int()) - { - return $self->new($x->as_number()->bmodinv($y->as_number(),@r)); - } + $x -> {sign} = $xtmp -> {sign}; + $x -> {_n} = $xtmp -> {_n}; + $x -> {_d} = $xtmp -> {_d}; + return $x; +} - warn ("bmodinv() not fully implemented"); - $x->bnan(); - } +sub bsqrt { + my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_); -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(); - 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; - local $Math::BigFloat::upgrade = undef; - local $Math::BigFloat::downgrade = undef; - local $Math::BigFloat::precision = undef; - local $Math::BigFloat::accuracy = undef; - local $Math::BigInt::upgrade = undef; - local $Math::BigInt::precision = undef; - local $Math::BigInt::accuracy = undef; + my $xn = Math::BigFloat -> new($MBI -> _str($x->{_n})); + my $xd = Math::BigFloat -> new($MBI -> _str($x->{_d})); - $x->{_n} = _float_from_part($x->{_n})->bsqrt(); - $x->{_d} = _float_from_part($x->{_d})->bsqrt(); + my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> bsqrt() -> bsstr()); - # XXX TODO: we probably can optimize this: + $x -> {sign} = $xtmp -> {sign}; + $x -> {_n} = $xtmp -> {_n}; + $x -> {_d} = $xtmp -> {_d}; - # 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 - } + $x->round(@r); +} + +sub blsft { + my ($class, $x, $y, $b, @r) = objectify(2, @_); - # 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'; + $b = 2 if !defined $b; + $b = $class -> new($b) unless ref($b) && $b -> isa($class); - $x->bnorm()->round(@r); - } + return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan(); + + # shift by a negative amount? + return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/; + + $x -> bmul($b -> bpow($y)); +} + +sub brsft { + my ($class, $x, $y, $b, @r) = objectify(2, @_); + + $b = 2 if !defined $b; + $b = $class -> new($b) unless ref($b) && $b -> isa($class); + + return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan(); + + # shift by a negative amount? + return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/; + + # the following call to bdiv() will return either quotient (scalar context) + # or quotient and remainder (list context). + $x -> bdiv($b -> bpow($y)); +} -sub blsft - { - my ($self,$x,$y,$b,@r) = objectify(3,@_); +sub band { + my $x = shift; + my $xref = ref($x); + my $class = $xref || $x; - $b = 2 unless defined $b; - $b = $self->new($b) unless ref ($b); - $x->bmul($b->copy()->bpow($y), @r); - $x; - } + Carp::croak 'band() is an instance method, not a class method' unless $xref; + Carp::croak 'Not enough arguments for band()' if @_ < 1; -sub brsft - { - my ($self,$x,$y,$b,@r) = objectify(3,@_); + my $y = shift; + $y = $class -> new($y) unless ref($y); - $b = 2 unless defined $b; - $b = $self->new($b) unless ref ($b); - $x->bdiv($b->copy()->bpow($y), @r); - $x; - } + my @r = @_; + + my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt + $xtmp -> band($y); + $xtmp = $class -> new($xtmp); # back to Math::BigRat + + $x -> {sign} = $xtmp -> {sign}; + $x -> {_n} = $xtmp -> {_n}; + $x -> {_d} = $xtmp -> {_d}; + + return $x -> round(@r); +} + +sub bior { + my $x = shift; + my $xref = ref($x); + my $class = $xref || $x; + + Carp::croak 'bior() is an instance method, not a class method' unless $xref; + Carp::croak 'Not enough arguments for bior()' if @_ < 1; + + my $y = shift; + $y = $class -> new($y) unless ref($y); + + my @r = @_; + + my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt + $xtmp -> bior($y); + $xtmp = $class -> new($xtmp); # back to Math::BigRat + + $x -> {sign} = $xtmp -> {sign}; + $x -> {_n} = $xtmp -> {_n}; + $x -> {_d} = $xtmp -> {_d}; + + return $x -> round(@r); +} + +sub bxor { + my $x = shift; + my $xref = ref($x); + my $class = $xref || $x; + + Carp::croak 'bxor() is an instance method, not a class method' unless $xref; + Carp::croak 'Not enough arguments for bxor()' if @_ < 1; + + my $y = shift; + $y = $class -> new($y) unless ref($y); + + my @r = @_; + + my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt + $xtmp -> bxor($y); + $xtmp = $class -> new($xtmp); # back to Math::BigRat + + $x -> {sign} = $xtmp -> {sign}; + $x -> {_n} = $xtmp -> {_n}; + $x -> {_d} = $xtmp -> {_d}; + + return $x -> round(@r); +} + +sub bnot { + my $x = shift; + my $xref = ref($x); + my $class = $xref || $x; + + Carp::croak 'bnot() is an instance method, not a class method' unless $xref; + + my @r = @_; + + my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt + $xtmp -> bnot(); + $xtmp = $class -> new($xtmp); # back to Math::BigRat + + $x -> {sign} = $xtmp -> {sign}; + $x -> {_n} = $xtmp -> {_n}; + $x -> {_d} = $xtmp -> {_d}; + + return $x -> round(@r); +} ############################################################################## # round -sub round - { - $_[0]; - } +sub round { + $_[0]; +} -sub bround - { - $_[0]; - } +sub bround { + $_[0]; +} -sub bfround - { - $_[0]; - } +sub bfround { + $_[0]; +} ############################################################################## # comparing -sub bcmp - { - # compare two signed numbers +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,@_); + # set up parameters + my ($class, $x, $y) = (ref($_[0]), @_); + + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y) = objectify(2, @_); } - if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) - { - # handle +-inf and NaN - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - return 0 if $x->{sign} 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; + if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { + # $x is NaN and/or $y is NaN + return undef if $x->{sign} eq $nan || $y->{sign} eq $nan; + # $x and $y are both either +inf or -inf + return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; + # $x = +inf and $y < +inf + return +1 if $x->{sign} eq '+inf'; + # $x = -inf and $y > -inf + return -1 if $x->{sign} eq '-inf'; + # $x < +inf and $y = +inf + return -1 if $y->{sign} eq '+inf'; + # $x > -inf and $y = -inf + return +1; } - # 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,@_); + + # $x >= 0 and $y < 0 + return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; + # $x < 0 and $y >= 0 + return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; + + # At this point, we know that $x and $y have the same sign. + + # shortcut + my $xz = $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 ($class, $x, $y) = (ref($_[0]), @_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { + ($class, $x, $y) = objectify(2, @_); } - if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) - { - # handle +-inf and NaN - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; - return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; - return -1; + 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 - } + 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 +} + +sub beq { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + Carp::croak 'beq() is an instance method, not a class method' unless $selfref; + Carp::croak 'Wrong number of arguments for beq()' unless @_ == 1; + + my $cmp = $self -> bcmp(shift); + return defined($cmp) && ! $cmp; +} + +sub bne { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + Carp::croak 'bne() is an instance method, not a class method' unless $selfref; + Carp::croak 'Wrong number of arguments for bne()' unless @_ == 1; + + my $cmp = $self -> bcmp(shift); + return defined($cmp) && ! $cmp ? '' : 1; +} + +sub blt { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + Carp::croak 'blt() is an instance method, not a class method' unless $selfref; + Carp::croak 'Wrong number of arguments for blt()' unless @_ == 1; + + my $cmp = $self -> bcmp(shift); + return defined($cmp) && $cmp < 0; +} + +sub ble { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + Carp::croak 'ble() is an instance method, not a class method' unless $selfref; + Carp::croak 'Wrong number of arguments for ble()' unless @_ == 1; + + my $cmp = $self -> bcmp(shift); + return defined($cmp) && $cmp <= 0; +} + +sub bgt { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + Carp::croak 'bgt() is an instance method, not a class method' unless $selfref; + Carp::croak 'Wrong number of arguments for bgt()' unless @_ == 1; + + my $cmp = $self -> bcmp(shift); + return defined($cmp) && $cmp > 0; +} + +sub bge { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + Carp::croak 'bge() is an instance method, not a class method' + unless $selfref; + Carp::croak 'Wrong number of arguments for bge()' unless @_ == 1; + + my $cmp = $self -> bcmp(shift); + return defined($cmp) && $cmp >= 0; +} ############################################################################## -# output conversation +# output conversion -sub numify - { - # convert 17/8 => float (aka 2.125) - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); +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 + # Non-finite number. - # N/1 => N - my $neg = ''; $neg = '-' if $x->{sign} eq '-'; - return $neg . $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d}); + return $x->bstr() if $x->{sign} !~ /^[+-]$/; - $x->_as_float()->numify() + 0.0; - } + # Finite number. -sub as_number - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + my $abs = $MBI->_is_one($x->{_d}) + ? $MBI->_num($x->{_n}) + : Math::BigFloat -> new($MBI->_str($x->{_n})) + -> bdiv($MBI->_str($x->{_d})) + -> bstr(); + return $x->{sign} eq '-' ? 0 - $abs : 0 + $abs; +} - # NaN, inf etc - return Math::BigInt->new($x->{sign}) if $x->{sign} !~ /^[+-]$/; +sub as_number { + my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - 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; - } + # NaN, inf etc + return Math::BigInt->new($x->{sign}) if $x->{sign} !~ /^[+-]$/; -sub as_float - { - # return N/D as Math::BigFloat + 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; +} - # set up parameters - my ($self,$x,@r) = (ref($_[0]),@_); - # objectify is costly, so avoid it - ($self,$x,@r) = objectify(1,$class,@_) unless ref $_[0]; +sub as_float { + # return N/D as Math::BigFloat - # NaN, inf etc - return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/; + # set up parameters + my ($class, $x, @r) = (ref($_[0]), @_); + # objectify is costly, so avoid it + ($class, $x, @r) = objectify(1, @_) unless ref $_[0]; - 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; - } + # NaN, inf etc + return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/; -sub as_bin - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + my $xd = Math::BigFloat -> new($MBI -> _str($x->{_d})); + my $xflt = Math::BigFloat -> new($MBI -> _str($x->{_n})); + $xflt -> {sign} = $x -> {sign}; + $xflt -> bdiv($xd, @r); - return $x unless $x->is_int(); + return $xflt; +} + +sub as_bin { + my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - my $s = $x->{sign}; $s = '' if $s eq '+'; - $s . $MBI->_as_bin($x->{_n}); - } + return $x unless $x->is_int(); -sub as_hex - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + my $s = $x->{sign}; + $s = '' if $s eq '+'; + $s . $MBI->_as_bin($x->{_n}); +} - return $x unless $x->is_int(); +sub as_hex { + my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - my $s = $x->{sign}; $s = '' if $s eq '+'; - $s . $MBI->_as_hex($x->{_n}); - } + return $x unless $x->is_int(); -sub as_oct - { - my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + my $s = $x->{sign}; $s = '' if $s eq '+'; + $s . $MBI->_as_hex($x->{_n}); +} - return $x unless $x->is_int(); +sub as_oct { + my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - my $s = $x->{sign}; $s = '' if $s eq '+'; - $s . $MBI->_as_oct($x->{_n}); - } + 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; +sub from_hex { + my $class = shift; - $class->new(@_); - } + $class->new(@_); +} -sub from_bin - { - my $class = shift; +sub from_bin { + my $class = shift; - $class->new(@_); - } + $class->new(@_); +} -sub from_oct - { - my $class = shift; +sub from_oct { + my $class = shift; - my @parts; - for my $c (@_) - { - push @parts, Math::BigInt->from_oct($c); + my @parts; + for my $c (@_) { + push @parts, Math::BigInt->from_oct($c); } - $class->new (@parts); - } + $class->new (@parts); +} ############################################################################## # import -sub import - { - my $self = shift; - my $l = scalar @_; - my $lib = ''; my @a; - my $try = 'try'; +sub import { + my $class = shift; + my $l = scalar @_; + my $lib = ''; my @a; + my $try = 'try'; - for (my $i = 0; $i < $l ; $i++) - { - if ($_[$i] eq ':constant') - { - # this rest causes overlord er load to step in - overload::constant float => sub { $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]; - } + for (my $i = 0; $i < $l ; $i++) { + if ($_[$i] eq ':constant') { + # this rest causes overlord er load to step in + overload::constant float => sub { $class->new(shift); }; + } + # elsif ($_[$i] eq 'upgrade') + # { + # # this causes upgrading + # $upgrade = $_[$i+1]; # or undef to disable + # $i++; + # } + elsif ($_[$i] eq 'downgrade') { + # this causes downgrading + $downgrade = $_[$i+1]; # or undef to disable + $i++; + } elsif ($_[$i] =~ /^(lib|try|only)\z/) { + $lib = $_[$i+1] || ''; # default Calc + $try = $1; # lib, try or only + $i++; + } elsif ($_[$i] eq 'with') { + # this argument is no longer used + #$MBI = $_[$i+1] || 'Math::BigInt::Calc'; # default Math::BigInt::Calc + $i++; + } else { + push @a, $_[$i]; + } } - require Math::BigInt; + 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); + # 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 ''; + my @import = ('objectify'); + push @import, $try => $lib if $lib ne ''; - # MBI already loaded, so feed it our lib arguments - Math::BigInt->import(@import); + # MBI already loaded, so feed it our lib arguments + Math::BigInt->import(@import); - $MBI = Math::BigFloat->config()->{lib}; + $MBI = Math::BigFloat->config()->{lib}; - # register us with MBI to get notified of future lib changes - Math::BigInt::_register_callback($self, sub { $MBI = $_[0]; }); + # register us with MBI to get notified of future lib changes + Math::BigInt::_register_callback($class, 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 - } + # any non :constant stuff is handled by our parent, Exporter (loaded + # by Math::BigFloat, even if @_ is empty, to give it a chance + $class->SUPER::import(@a); # for subclasses + $class->export_to_level(1, $class, @a); # need this, too +} 1; @@ -1740,17 +2084,17 @@ Math::BigRat - Arbitrary big rational numbers =head1 SYNOPSIS - use Math::BigRat; + use Math::BigRat; - my $x = Math::BigRat->new('3/7'); $x += '5/9'; + my $x = Math::BigRat->new('3/7'); $x += '5/9'; - print $x->bstr(),"\n"; - print $x ** 2,"\n"; + 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 $y = Math::BigRat->new('inf'); + print "$y ", ($y->is_inf ? 'is' : 'is not'), " infinity\n"; - my $z = Math::BigRat->new(144); $z->bsqrt(); + my $z = Math::BigRat->new(144); $z->bsqrt(); =head1 DESCRIPTION @@ -1762,24 +2106,22 @@ for arbitrary big rational numbers. You can change the underlying module that does the low-level math operations by using: - use Math::BigRat try => 'GMP'; + 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'; + use Math::BigRat try => 'Foo,Math::BigInt::Bar'; -If you want to get warned when the fallback occurs, replace "try" with -"lib": +If you want to get warned when the fallback occurs, replace "try" with "lib": - use Math::BigRat lib => 'Foo,Math::BigInt::Bar'; + use Math::BigRat lib => 'Foo,Math::BigInt::Bar'; -If you want the code to die instead, replace "try" with -"only": +If you want the code to die instead, replace "try" with "only": - use Math::BigRat only => 'Foo,Math::BigInt::Bar'; + use Math::BigRat only => 'Foo,Math::BigInt::Bar'; =head1 METHODS @@ -1787,316 +2129,481 @@ 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() +=over + +=item new() - $x = Math::BigRat->new('1/3'); + $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 + $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 + # 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() +=item numerator() - $n = $x->numerator(); + $n = $x->numerator(); Returns a copy of the numerator (the part above the line) as signed BigInt. -=head2 denominator() +=item denominator() - $d = $x->denominator(); + $d = $x->denominator(); Returns a copy of the denominator (the part under the line) as positive BigInt. -=head2 parts() +=item parts() - ($n,$d) = $x->parts(); + ($n, $d) = $x->parts(); Return a list consisting of (signed) numerator and (unsigned) denominator as BigInts. -=head2 numify() +=item numify() - my $y = $x->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()|/as_int()E<sol>as_number()> or L</as_float()> instead. +use L<as_int()|/"as_int()/as_number()"> 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 + my $x = Math::BigRat->new('3/1'); + @array = (0, 1, 2, 3); + $y = $array[$x]; # set $y to 3 -=head2 as_int()/as_number() +=item as_int()/as_number() - $x = Math::BigRat->new('13/7'); - print $x->as_int(),"\n"; # '1' + $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() +=item as_float() - $x = Math::BigRat->new('13/7'); - print $x->as_float(),"\n"; # '1' + $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' + $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() +=item as_hex() - $x = Math::BigRat->new('13'); - print $x->as_hex(),"\n"; # '0xd' + $x = Math::BigRat->new('13'); + print $x->as_hex(), "\n"; # '0xd' Returns the BigRat as hexadecimal string. Works only for integers. -=head2 as_bin() +=item as_bin() - $x = Math::BigRat->new('13'); - print $x->as_bin(),"\n"; # '0x1101' + $x = Math::BigRat->new('13'); + print $x->as_bin(), "\n"; # '0x1101' Returns the BigRat as binary string. Works only for integers. -=head2 as_oct() +=item as_oct() - $x = Math::BigRat->new('13'); - print $x->as_oct(),"\n"; # '015' + $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() +=item from_hex() + + my $h = Math::BigRat->from_hex('0x10'); + +Create a BigRat from a hexadecimal number in string form. + +=item from_oct() + + my $o = Math::BigRat->from_oct('020'); - 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 octal number in string form. -Create a BigRat from an hexadecimal, binary or octal number -in string form. +=item from_bin() -=head2 length() + my $b = Math::BigRat->from_bin('0b10000000'); - $len = $x->length(); +Create a BigRat from an binary number in string form. + +=item bnan() + + $x = Math::BigRat->bnan(); + +Creates a new BigRat object representing NaN (Not A Number). +If used on an object, it will set it to NaN: + + $x->bnan(); + +=item bzero() + + $x = Math::BigRat->bzero(); + +Creates a new BigRat object representing zero. +If used on an object, it will set it to zero: + + $x->bzero(); + +=item binf() + + $x = Math::BigRat->binf($sign); + +Creates a new BigRat object representing infinity. The optional argument is +either '-' or '+', indicating whether you want infinity or minus infinity. +If used on an object, it will set it to infinity: + + $x->binf(); + $x->binf('-'); + +=item bone() + + $x = Math::BigRat->bone($sign); + +Creates a new BigRat object representing one. The optional argument is +either '-' or '+', indicating whether you want one or minus one. +If used on an object, it will set it to one: + + $x->bone(); # +1 + $x->bone('-'); # -1 + +=item length() + + $len = $x->length(); Return the length of $x in digits for integer values. -=head2 digit() +=item digit() - print Math::BigRat->new('123/1')->digit(1); # 1 - print Math::BigRat->new('123/1')->digit(-1); # 3 + 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() +=item bnorm() - $x->bnorm(); + $x->bnorm(); Reduce the number to the shortest form. This routine is called automatically whenever it is needed. -=head2 bfac() +=item bfac() - $x->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 + 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() +=item bround()/round()/bfround() Are not yet implemented. -=head2 bmod() +=item bmod() - $x->bmod($y); + $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() +=item bmodinv() + + $x->bmodinv($mod); # modular multiplicative inverse - $x->bneg(); +Returns the multiplicative inverse of C<$x> modulo C<$mod>. If + + $y = $x -> copy() -> bmodinv($mod) + +then C<$y> is the number closest to zero, and with the same sign as C<$mod>, +satisfying + + ($x * $y) % $mod = 1 % $mod + +If C<$x> and C<$y> are non-zero, they must be relative primes, i.e., +C<bgcd($y, $mod)==1>. 'C<NaN>' is returned when no modular multiplicative +inverse exists. + +=item bmodpow() + + $num->bmodpow($exp,$mod); # modular exponentiation + # ($num**$exp % $mod) + +Returns the value of C<$num> taken to the power C<$exp> in the modulus +C<$mod> using binary exponentiation. C<bmodpow> is far superior to +writing + + $num ** $exp % $mod + +because it is much faster - it reduces internal variables into +the modulus whenever possible, so it operates on smaller numbers. + +C<bmodpow> also supports negative exponents. + + bmodpow($num, -1, $mod) + +is exactly equivalent to + + bmodinv($num, $mod) + +=item bneg() + + $x->bneg(); Used to negate the object in-place. -=head2 is_one() +=item is_one() - print "$x is 1\n" if $x->is_one(); + print "$x is 1\n" if $x->is_one(); Return true if $x is exactly one, otherwise false. -=head2 is_zero() +=item is_zero() - print "$x is 0\n" if $x->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() +=item is_pos()/is_positive() - print "$x is >= 0\n" if $x->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() +=item is_neg()/is_negative() - print "$x is < 0\n" if $x->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() +=item is_int() - print "$x is an integer\n" if $x->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() +=item is_odd() - print "$x is odd\n" if $x->is_odd(); + print "$x is odd\n" if $x->is_odd(); Return true if $x is odd, otherwise false. -=head2 is_even() +=item is_even() - print "$x is even\n" if $x->is_even(); + print "$x is even\n" if $x->is_even(); Return true if $x is even, otherwise false. -=head2 bceil() +=item bceil() - $x->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() +=item bfloor() - $x->bfloor(); + $x->bfloor(); Truncate $x to an integer value. -=head2 bsqrt() +=item bint() + + $x->bint(); + +Round $x towards zero. + +=item bsqrt() - $x->bsqrt(); + $x->bsqrt(); Calculate the square root of $x. -=head2 broot() +=item broot() - $x->broot($n); + $x->broot($n); Calculate the N'th root of $x. -=head2 badd() +=item badd() - $x->badd($y); + $x->badd($y); Adds $y to $x and returns the result. -=head2 bmul() +=item bmul() - $x->bmul($y); + $x->bmul($y); Multiplies $y to $x and returns the result. -=head2 bsub() +=item bsub() - $x->bsub($y); + $x->bsub($y); Subtracts $y from $x and returns the result. -=head2 bdiv() +=item bdiv() - $q = $x->bdiv($y); - ($q, $r) = $x->bdiv($y); + $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() +=item bdec() - $x->bdec(); + $x->bdec(); Decrements $x by 1 and returns the result. -=head2 binc() +=item binc() - $x->binc(); + $x->binc(); Increments $x by 1 and returns the result. -=head2 copy() +=item copy() - my $z = $x->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() +=item bstr()/bsstr() - my $x = Math::BigInt->new('8/4'); - print $x->bstr(),"\n"; # prints 1/2 - print $x->bsstr(),"\n"; # prints 1/2 + my $x = Math::BigRat->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() +=item bcmp() -Used to compare numbers. + $x->bcmp($y); -Please see the documentation in L<Math::BigInt> for further details. +Compares $x with $y and takes the sign into account. +Returns -1, 0, 1 or undef. + +=item bacmp() + + $x->bacmp($y); + +Compares $x with $y while ignoring their sign. Returns -1, 0, 1 or undef. + +=item beq() + + $x -> beq($y); + +Returns true if and only if $x is equal to $y, and false otherwise. + +=item bne() + + $x -> bne($y); + +Returns true if and only if $x is not equal to $y, and false otherwise. + +=item blt() + + $x -> blt($y); + +Returns true if and only if $x is equal to $y, and false otherwise. + +=item ble() + + $x -> ble($y); + +Returns true if and only if $x is less than or equal to $y, and false +otherwise. + +=item bgt() + + $x -> bgt($y); -=head2 blsft()/brsft() +Returns true if and only if $x is greater than $y, and false otherwise. + +=item bge() + + $x -> bge($y); + +Returns true if and only if $x is greater than or equal to $y, and false +otherwise. + +=item blsft()/brsft() Used to shift numbers left/right. Please see the documentation in L<Math::BigInt> for further details. -=head2 bpow() +=item band() + + $x->band($y); # bitwise and + +=item bior() + + $x->bior($y); # bitwise inclusive or + +=item bxor() + + $x->bxor($y); # bitwise exclusive or - $x->bpow($y); +=item bnot() + + $x->bnot(); # bitwise not (two's complement) + +=item bpow() + + $x->bpow($y); Compute $x ** $y. Please see the documentation in L<Math::BigInt> for further details. -=head2 bexp() +=item blog() + + $x->blog($base, $accuracy); # logarithm of x to the base $base + +If C<$base> is not defined, Euler's number (e) is used: - $x->bexp($accuracy); # calculate e ** X + print $x->blog(undef, 100); # log(x) to 100 digits + +=item 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. @@ -2105,65 +2612,63 @@ This method was added in v0.20 of Math::BigRat (May 2007). See also C<blog()>. -=head2 bnok() +=item bnok() - $x->bnok($y); # x over y (binomial coefficient n over k) + $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)! + ( n ) n! + | - | = ------- + ( k ) k!(n-k)! This method was added in v0.20 of Math::BigRat (May 2007). -=head2 config() +=item config() - use Data::Dumper; + use Data::Dumper; - print Dumper ( Math::BigRat->config() ); - print Math::BigRat->config()->{lib},"\n"; + 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 + 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. +=back =head1 BUGS diff --git a/cpan/Math-BigRat/t/big_ap.t b/cpan/Math-BigRat/t/big_ap.t index 3b45058120..1ac46e5d9f 100644 --- a/cpan/Math-BigRat/t/big_ap.t +++ b/cpan/Math-BigRat/t/big_ap.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl # Test that accuracy() and precision() in BigInt/BigFloat do not disturb # the rounding force in BigRat. @@ -12,61 +12,65 @@ use Math::BigInt; use Math::BigFloat; use Math::BigRat; -my $proper = Math::BigRat->new('12345678901234567890/2'); -my $proper_inc = Math::BigRat->new('12345678901234567890/2')->binc(); -my $proper_dec = Math::BigRat->new('12345678901234567890/2')->bdec(); -my $proper_int = Math::BigInt->new('12345678901234567890'); -my $proper_float = Math::BigFloat->new('12345678901234567890'); -my $proper2 = Math::BigRat->new('12345678901234567890'); +my $proper = Math::BigRat -> new('12345678901234567890/2'); +my $proper_inc = Math::BigRat -> new('12345678901234567890/2') -> binc(); +my $proper_dec = Math::BigRat -> new('12345678901234567890/2') -> bdec(); +my $proper_int = Math::BigInt -> new('12345678901234567890'); +my $proper_float = Math::BigFloat -> new('12345678901234567890'); +my $proper2 = Math::BigRat -> new('12345678901234567890'); -print "# Start\n"; - -Math::BigInt->accuracy(3); -Math::BigFloat->accuracy(5); +Math::BigInt -> accuracy(3); +Math::BigFloat -> accuracy(5); my ($x, $y, $z); ############################################################################## # new() -$z = Math::BigRat->new('12345678901234567890/2'); -is($z, $proper); +note "Test new()"; -$z = Math::BigRat->new('1234567890123456789E1'); -is($z, $proper2); +$z = Math::BigRat->new("12345678901234567890/2"); +is($z, $proper, q|Math::BigRat->new("12345678901234567890/2")|); -$z = Math::BigRat->new('12345678901234567890/1E0'); -is($z, $proper2); +$z = Math::BigRat->new("1234567890123456789E1"); +is($z, $proper2, q|Math::BigRat->new("1234567890123456789E1")|); -$z = Math::BigRat->new('1234567890123456789e1/1'); -is($z, $proper2); +$z = Math::BigRat->new("12345678901234567890/1E0"); +is($z, $proper2, q|Math::BigRat->new("12345678901234567890/1E0")|); -$z = Math::BigRat->new('1234567890123456789e1/1E0'); -is($z, $proper2); +$z = Math::BigRat->new("1234567890123456789e1/1"); +is($z, $proper2, q|Math::BigRat->new("1234567890123456789e1/1")|); + +$z = Math::BigRat->new("1234567890123456789e1/1E0"); +is($z, $proper2, q|Math::BigRat->new("1234567890123456789e1/1E0")|); $z = Math::BigRat->new($proper_int); -is($z, $proper2); +is($z, $proper2, qq|Math::BigRat->new("$proper_int")|); $z = Math::BigRat->new($proper_float); -is($z, $proper2); +is($z, $proper2, qq|Math::BigRat->new("$proper_float")|); ############################################################################## # bdiv -$x = Math::BigRat->new('12345678901234567890'); -$y = Math::BigRat->new('2'); +note "Test bdiv()"; + +$x = Math::BigRat->new("12345678901234567890"); +$y = Math::BigRat->new("2"); $z = $x->copy->bdiv($y); is($z, $proper); ############################################################################## # bmul +note "Test bmul()"; + $x = Math::BigRat->new("$proper"); -$y = Math::BigRat->new('1'); +$y = Math::BigRat->new("1"); $z = $x->copy->bmul($y); is($z, $proper); -$z = Math::BigRat->new('12345678901234567890/1E0'); +$z = Math::BigRat->new("12345678901234567890/1E0"); is($z, $proper2); $z = Math::BigRat->new($proper_int); @@ -78,29 +82,40 @@ is($z, $proper2); ############################################################################## # bdiv -$x = Math::BigRat->new('12345678901234567890'); -$y = Math::BigRat->new('2'); +note "Test bdiv()"; + +$x = Math::BigRat->new("12345678901234567890"); +$y = Math::BigRat->new("2"); $z = $x->copy->bdiv($y); is($z, $proper); ############################################################################## # bmul +note "Test bmul()"; + $x = Math::BigRat->new("$proper"); -$y = Math::BigRat->new('1'); +$y = Math::BigRat->new("1"); $z = $x->copy->bmul($y); is($z, $proper); $x = Math::BigRat->new("$proper"); -$y = Math::BigRat->new('2'); +$y = Math::BigRat->new("2"); $z = $x->copy->bmul($y); is($z, $proper2); ############################################################################## -# binc/bdec +# binc + +note "Test binc()"; $x = $proper->copy()->binc(); is($x, $proper_inc); +############################################################################## +# binc + +note "Test bdec()"; + $x = $proper->copy()->bdec(); is($x, $proper_dec); diff --git a/cpan/Math-BigRat/t/bigfltrt.t b/cpan/Math-BigRat/t/bigfltrt.t index 3c46000b71..4f36bde3ea 100644 --- a/cpan/Math-BigRat/t/bigfltrt.t +++ b/cpan/Math-BigRat/t/bigfltrt.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl use strict; use warnings; diff --git a/cpan/Math-BigRat/t/biglog.t b/cpan/Math-BigRat/t/biglog.t index 9d729af776..44f5962cad 100644 --- a/cpan/Math-BigRat/t/biglog.t +++ b/cpan/Math-BigRat/t/biglog.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl # Test blog function (and bpow, since it uses blog), as well as bexp(). @@ -22,53 +22,51 @@ my $cl = "Math::BigRat"; ############################################################################# # test exp($n) -is ($cl->new(1)->bexp()->as_int(), '2', "bexp(1)"); -is ($cl->new(2)->bexp()->as_int(), '7',"bexp(2)"); -is ($cl->new(3)->bexp()->as_int(), '20', "bexp(3)"); +is($cl->new(1)->bexp()->as_int(), '2', qq|$cl->new(1)->bexp()->as_int()|); +is($cl->new(2)->bexp()->as_int(), '7', qq|$cl->new(1)->bexp()->as_int()|); +is($cl->new(3)->bexp()->as_int(), '20', qq|$cl->new(1)->bexp()->as_int()|); # rounding not implemented yet #is ($cl->new(3)->bexp(10), '20', "bexp(3,10)"); # $x < 0 => NaN -ok ($cl->new(-2)->blog(), 'NaN'); -ok ($cl->new(-1)->blog(), 'NaN'); -ok ($cl->new(-10)->blog(), 'NaN'); -ok ($cl->new(-2,2)->blog(), 'NaN'); +is($cl->new(-2)->blog(), 'NaN', qq|$cl->new(-2)->blog()|); +is($cl->new(-1)->blog(), 'NaN', qq|$cl->new(-1)->blog()|); +is($cl->new(-10)->blog(), 'NaN', qq|$cl->new(-10)->blog()|); +is($cl->new(-2,2)->blog(), 'NaN', qq|$cl->new(-2,2)->blog()|); ############################################################################# # test bexp() with cached results -is ($cl->new(1)->bexp(), +is($cl->new(1)->bexp(), '90933395208605785401971970164779391644753259799242' . '/' . '33452526613163807108170062053440751665152000000000', 'bexp(1)'); -is ($cl->new(2)->bexp(1,40), $cl->new(1)->bexp(1,45)->bpow(2,40), 'bexp(2)'); +is($cl->new(2)->bexp(1,40), $cl->new(1)->bexp(1,45)->bpow(2,40), 'bexp(2)'); -is ($cl->new("12.5")->bexp(1,61), $cl->new(1)->bexp(1,65)->bpow(12.5,61), 'bexp(12.5)'); +is($cl->new("12.5")->bexp(1,61), $cl->new(1)->bexp(1,65)->bpow(12.5,61), 'bexp(12.5)'); ############################################################################# # test bexp() with big values (non-cached) -is ($cl->new(1)->bexp(1,100)->as_float(100), +is($cl->new(1)->bexp(1,100)->as_float(100), '2.718281828459045235360287471352662497757247093699959574966967627724076630353547594571382178525166427', 'bexp(100)'); -is ($cl->new("12.5")->bexp(1,91), $cl->new(1)->bexp(1,95)->bpow(12.5,91), +is($cl->new("12.5")->bexp(1,91), $cl->new(1)->bexp(1,95)->bpow(12.5,91), 'bexp(12.5) to 91 digits'); ############################################################################# # some integer results -is ($cl->new(2)->bpow(32)->blog(2), '32', "2 ** 32"); -is ($cl->new(3)->bpow(32)->blog(3), '32', "3 ** 32"); -is ($cl->new(2)->bpow(65)->blog(2), '65', "2 ** 65"); -my $x = Math::BigInt->new( '777' ) ** 256; +is($cl->new(2)->bpow(32)->blog(2), '32', "2 ** 32"); +is($cl->new(3)->bpow(32)->blog(3), '32', "3 ** 32"); +is($cl->new(2)->bpow(65)->blog(2), '65', "2 ** 65"); + +my $x = Math::BigInt->new( '777' ) ** 256; my $base = Math::BigInt->new( '12345678901234' ); -is ($x->copy()->blog($base), 56, 'blog(777**256, 12345678901234)'); +is($x->copy()->blog($base), 56, 'blog(777**256, 12345678901234)'); $x = Math::BigInt->new( '777' ) ** 777; $base = Math::BigInt->new( '777' ); -is ($x->copy()->blog($base), 777, 'blog(777**777, 777)'); - -# all done -1; +is($x->copy()->blog($base), 777, 'blog(777**777, 777)'); diff --git a/cpan/Math-BigRat/t/bigrat.t b/cpan/Math-BigRat/t/bigrat.t index 7ca3be3672..fec6afd568 100644 --- a/cpan/Math-BigRat/t/bigrat.t +++ b/cpan/Math-BigRat/t/bigrat.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl use strict; use warnings; @@ -27,7 +27,7 @@ is($x->isa('Math::BigInt'), 0); ############################################################################## # new and bnorm() -foreach my $func (qw/new bnorm/) { +foreach my $func (qw/ new bnorm /) { $x = $mbr->$func(1234); is($x, 1234, qq|\$x = $mbr->$func(1234)|); @@ -108,50 +108,50 @@ foreach my $func (qw/new bnorm/) { my $n = 'numerator'; my $d = 'denominator'; -$x = $mbr->new('-0'); +$x = $mbr->new('-0'); is($x, '0'); - is($x->$n(), '0'); +is($x->$n(), '0'); is($x->$d(), '1'); -$x = $mbr->new('NaN'); +$x = $mbr->new('NaN'); is($x, 'NaN'); is($x->$n(), 'NaN'); is($x->$d(), 'NaN'); -$x = $mbr->new('-NaN'); +$x = $mbr->new('-NaN'); is($x, 'NaN'); is($x->$n(), 'NaN'); is($x->$d(), 'NaN'); -$x = $mbr->new('-1r4'); +$x = $mbr->new('-1r4'); is($x, 'NaN'); is($x->$n(), 'NaN'); is($x->$d(), 'NaN'); -$x = $mbr->new('+inf'); +$x = $mbr->new('+inf'); is($x, 'inf'); is($x->$n(), 'inf'); is($x->$d(), '1'); -$x = $mbr->new('-inf'); +$x = $mbr->new('-inf'); is($x, '-inf'); is($x->$n(), '-inf'); is($x->$d(), '1'); -$x = $mbr->new('123a4'); +$x = $mbr->new('123a4'); is($x, 'NaN'); is($x->$n(), 'NaN'); is($x->$d(), 'NaN'); # wrong inputs -$x = $mbr->new('1e2e2'); +$x = $mbr->new('1e2e2'); is($x, 'NaN'); is($x->$n(), 'NaN'); is($x->$d(), 'NaN'); -$x = $mbr->new('1+2+2'); +$x = $mbr->new('1+2+2'); is($x, 'NaN'); is($x->$n(), 'NaN'); is($x->$d(), 'NaN'); # failed due to BigFloat bug -$x = $mbr->new('1.2.2'); +$x = $mbr->new('1.2.2'); is($x, 'NaN'); is($x->$n(), 'NaN'); is($x->$d(), 'NaN'); @@ -276,8 +276,8 @@ is($x, '4'); $x = $mbr->new('3/4')->bsqrt(); is($x, - '1732050807568877293527446341505872366943/' - .'2000000000000000000000000000000000000000'); + '4330127018922193233818615853764680917357/' . + '5000000000000000000000000000000000000000'); ############################################################################## # bpow diff --git a/cpan/Math-BigRat/t/bigratpm.t b/cpan/Math-BigRat/t/bigratpm.t index 24f95ee1d9..a5bb9471e5 100644 --- a/cpan/Math-BigRat/t/bigratpm.t +++ b/cpan/Math-BigRat/t/bigratpm.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl use strict; use warnings; diff --git a/cpan/Math-BigRat/t/bigratup.t b/cpan/Math-BigRat/t/bigratup.t index 46d68f34cc..f424486a52 100644 --- a/cpan/Math-BigRat/t/bigratup.t +++ b/cpan/Math-BigRat/t/bigratup.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl # Test whether $Math::BigInt::upgrade breaks our neck @@ -33,7 +33,7 @@ is($x->bsqrt(), '3', 'bsqrt(144/16)'); $x = $rat->new('1/3'); is($x->bsqrt(), - '1000000000000000000000000000000000000000/1732050807568877293527446341505872366943', + '1443375672974064411272871951254893639119/2500000000000000000000000000000000000000', 'bsqrt(1/3)'); # all tests successful diff --git a/cpan/Math-BigRat/t/bigroot.t b/cpan/Math-BigRat/t/bigroot.t index 8a895598e9..5be7faa48d 100644 --- a/cpan/Math-BigRat/t/bigroot.t +++ b/cpan/Math-BigRat/t/bigroot.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl # Test broot function (and bsqrt() function, since it is used by broot()). diff --git a/cpan/Math-BigRat/t/bitwise.t b/cpan/Math-BigRat/t/bitwise.t index a23c5dcf52..6bd499fa51 100644 --- a/cpan/Math-BigRat/t/bitwise.t +++ b/cpan/Math-BigRat/t/bitwise.t @@ -3,19 +3,40 @@ use strict; use warnings; -use Test::More tests => 22; +use Test::More tests => 2602; -use Math::BigRat; +my @classes = ('Math::BigRat'); -my $x = Math::BigRat->new('3/7'); +# We should test all the following operators: +# +# & | ^ << >> &= |= ^= <<= >>= +# +# as well as the corresponding methods +# +# band bior bxor blsft brsft -for my $op (qw(& | ^ << >> &= |= ^= <<= >>=)) { - my $test = "\$y = \$x $op 42"; - ok(!eval "my \$y = \$x $op 42; 1", $test); - like($@, qr/^bitwise operation \Q$op\E not supported in Math::BigRat/, - $test); -} +for my $class (@classes) { + use_ok($class); + + for my $op (qw( & | ^ )) { + for (my $xscalar = 0 ; $xscalar <= 8 ; $xscalar += 0.5) { + for (my $yscalar = 0 ; $yscalar <= 8 ; $yscalar += 0.5) { + + my $xint = int $xscalar; + my $yint = int $yscalar; -my $test = "\$y = ~\$x"; -ok(!eval "my \$y = ~\$x; 1", $test); -like($@, qr/^bitwise operation ~ not supported in Math::BigRat/, $test); + my $x = $class -> new("$xscalar"); + my $y = $class -> new("$yscalar"); + + my $test = "$x $op $y"; + my $expected = eval "$xscalar $op $yscalar"; + my $got = eval "\$x $op \$y"; + + is($@, '', 'is $@ empty'); + isa_ok($got, $class, $test); + is($got, $expected, + "$x $op $y = $xint $op $yint = $expected"); + } + } + } +} diff --git a/cpan/Math-BigRat/t/hang.t b/cpan/Math-BigRat/t/hang.t index 6de22e6033..21b9304cbd 100644 --- a/cpan/Math-BigRat/t/hang.t +++ b/cpan/Math-BigRat/t/hang.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl # test for bug #34584: hang in exp(1/2) @@ -11,7 +11,7 @@ use Math::BigRat; my $result = Math::BigRat->new('1/2')->bexp(); -is("$result", "9535900335500879457687887524133067574481/5783815921445270815783609372070483523265", +is("$result", "824360635350064073424325393907081785827/500000000000000000000000000000000000000", "exp(1/2) worked"); ############################################################################## diff --git a/cpan/Math-BigRat/t/requirer.t b/cpan/Math-BigRat/t/requirer.t index eba2f6622e..6788783a29 100644 --- a/cpan/Math-BigRat/t/requirer.t +++ b/cpan/Math-BigRat/t/requirer.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!perl # check that simple requiring BigRat works diff --git a/cpan/Math-BigRat/t/trap.t b/cpan/Math-BigRat/t/trap.t index a26da9f72f..0daef7afe8 100644 --- a/cpan/Math-BigRat/t/trap.t +++ b/cpan/Math-BigRat/t/trap.t @@ -1,6 +1,6 @@ -#!/usr/bin/perl +#!perl -# test that config ( trap_nan => 1, trap_inf => 1) really works/dies +# test that config( trap_nan => 1, trap_inf => 1) really works/dies use strict; use warnings; @@ -10,67 +10,82 @@ use Test::More tests => 29; use Math::BigRat; my $mbi = 'Math::BigRat'; -my ($cfg,$x); - -foreach my $class ($mbi) - { - # can do and defaults are okay? - can_ok ($class, 'config'); - is ($class->config()->{trap_nan}, 0); - is ($class->config()->{trap_inf}, 0); - - # can set? - $cfg = $class->config( trap_nan => 1 ); is ($cfg->{trap_nan},1); - - # can set via hash ref? - $cfg = $class->config( { trap_nan => 1 } ); is ($cfg->{trap_nan},1); - - # also test that new() still works normally - eval ("\$x = \$class->new('42'); \$x->bnan();"); - like ($@, qr/^Tried to set/); - is ($x,42); # after new() never modified - - # can reset? - $cfg = $class->config( trap_nan => 0 ); is ($cfg->{trap_nan},0); - - # can set? - $cfg = $class->config( trap_inf => 1 ); is ($cfg->{trap_inf},1); - eval ("\$x = \$class->new('4711'); \$x->binf();"); - like ($@, qr/^Tried to set/); - is ($x,4711); # after new() never modified - - # +$x/0 => +inf - eval ("\$x = \$class->new('4711'); \$x->bdiv(0);"); - like ($@, qr/^Tried to set/); - is ($x,4711); # after new() never modified - - # -$x/0 => -inf - eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);"); - like ($@, qr/^Tried to set/); - is ($x,-815); # after new() never modified - - $cfg = $class->config( trap_nan => 1 ); - # 0/0 => NaN - eval ("\$x = \$class->new('0'); \$x->bdiv(0);"); - like ($@, qr/^Tried to set/); - is ($x,0); # after new() never modified - } +my ($cfg, $x); + +foreach my $class ($mbi) { + + # can do and defaults are okay? + can_ok($class, 'config'); + is($class->config()->{trap_nan}, 0, qq|$class->config()->{trap_nan}|); + is($class->config()->{trap_inf}, 0, qq|$class->config()->{trap_inf}|); + + # can set? + $cfg = $class->config( trap_nan => 1 ); + is($cfg->{trap_nan}, 1, q|$cfg->{trap_nan}|); + + # can set via hash ref? + $cfg = $class->config( { trap_nan => 1 } ); + is($cfg->{trap_nan}, 1, q|$cfg->{trap_nan}|); + + # also test that new() still works normally + eval("\$x = $class->new('42'); \$x->bnan();"); + like($@, qr/^Tried to set/, "\$x = $class->new('42'); \$x->bnan();"); + # after new() never modified + is($x, 42, "\$x = $class->new('42'); \$x->bnan();"); + + # can reset? + $cfg = $class->config( trap_nan => 0 ); + is($cfg->{trap_nan}, 0, q|$cfg->{trap_nan}|); + + # can set? + $cfg = $class->config( trap_inf => 1 ); + is($cfg->{trap_inf}, 1, q|$cfg->{trap_inf}|); + eval("\$x = $class->new('4711'); \$x->binf();"); + like($@, qr/^Tried to set/, "\$x = $class->new('4711'); \$x->binf();"); + # after new() never modified + is($x, 4711, "\$x = $class->new('4711'); \$x->binf();"); + + # +$x/0 => +inf + eval("\$x =\$class->new('4711'); \$x->bdiv(0);"); + like($@, qr/^Tried to set/, "\$x =\$class->new('4711'); \$x->bdiv(0);"); + # after new() never modified + is($x, 4711, "\$x =\$class->new('4711'); \$x->bdiv(0);"); + + # -$x/0 => -inf + eval("\$x = $class->new('-0815'); \$x->bdiv(0);"); + like($@, qr/^Tried to set/, "\$x = $class->new('-0815'); \$x->bdiv(0);"); + # after new() never modified + is($x, -815, "\$x = $class->new('-0815'); \$x->bdiv(0);"); + + $cfg = $class->config( trap_nan => 1 ); + # 0/0 => NaN + eval("\$x = $class->new('0'); \$x->bdiv(0);"); + like($@, qr/^Tried to set/, "\$x = $class->new('0'); \$x->bdiv(0);"); + # after new() never modified + is($x, 0, "\$x = $class->new('0'); \$x->bdiv(0);"); +} ############################################################################## # BigRat -$cfg = Math::BigRat->config( trap_nan => 1 ); +Math::BigRat->config(trap_nan => 1, + trap_inf => 1); -for my $trap (qw/0.1a +inf inf -inf/) - { - my $x = Math::BigRat->new('7/4'); +for my $trap (qw/ 0.1a +inf inf -inf /) { + my $x = Math::BigRat->new('7/4'); - eval ("\$x = \$mbi->new('$trap');"); - is ($x,'7/4'); # never modified since it dies - eval ("\$x = \$mbi->new('$trap');"); - is ($x,'7/4'); # never modified since it dies - eval ("\$x = \$mbi->new('$trap/7');"); - is ($x,'7/4'); # never modified since it dies - } + note(""); # this is just for some space in the output + + # In each of the cases below, $x is not modified, because the code dies. + + eval("\$x = $mbi->new('$trap');"); + is($x, '7/4', "\$x = $mbi->new('$trap');"); + + eval("\$x = $mbi->new('$trap');"); + is($x, '7/4', "\$x = $mbi->new('$trap');"); + + eval("\$x = $mbi->new('$trap/7');"); + is($x, '7/4', "\$x = $mbi->new('$trap/7');"); +} # all tests done |