summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Math
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2020-04-11 03:09:12 +0000
committerNorbert Preining <norbert@preining.info>2020-04-11 03:09:12 +0000
commitc2697fc286a1e2c94fd9968b76be6f4a6d2114cd (patch)
tree1dc2cfb07cb032740483dd8be7c74aff66b70352 /systems/texlive/tlnet/tlpkg/tlperl/lib/Math
parent25111608e6aa05042b0c6f83009262e1973d7a45 (diff)
CTAN sync 202004110309
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Math')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm823
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm1123
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm15
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm394
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm2
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm428
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Trace.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat.pm254
9 files changed, 1610 insertions, 1433 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm
index b716b88a34..8a92b5818d 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm
@@ -6,9 +6,9 @@ package Math::BigFloat;
# The following hash values are used internally:
# sign : "+", "-", "+inf", "-inf", or "NaN" if not a number
-# _m : mantissa ($CALC object)
+# _m : mantissa ($LIB thingy)
# _es : sign of _e
-# _e : exponent ($CALC object)
+# _e : exponent ($LIB thingy)
# _a : accuracy
# _p : precision
@@ -16,12 +16,11 @@ use 5.006001;
use strict;
use warnings;
-use Carp ();
+use Carp qw< carp croak >;
use Math::BigInt ();
-our $VERSION = '1.999811';
+our $VERSION = '1.999816';
-require Exporter;
our @ISA = qw/Math::BigInt/;
our @EXPORT_OK = qw/bpi/;
@@ -72,7 +71,6 @@ use overload
'**=' => sub { $_[0]->bpow($_[1]); },
-
'<<=' => sub { $_[0]->blsft($_[1]); },
'>>=' => sub { $_[0]->brsft($_[1]); },
@@ -218,7 +216,7 @@ $upgrade = undef;
$downgrade = undef;
# the package we are using for our private parts, defaults to:
# Math::BigInt->config('lib')
-my $MBI = 'Math::BigInt::Calc';
+my $LIB = 'Math::BigInt::Calc';
# are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config()
$_trap_nan = 0;
@@ -281,11 +279,11 @@ sub AUTOLOAD {
if (!_method_alias($name)) {
if (!defined $name) {
# delayed load of Carp and avoid recursion
- Carp::croak("$c: Can't call a method without name");
+ croak("$c: Can't call a method without name");
}
if (!_method_hand_up($name)) {
# delayed load of Carp and avoid recursion
- Carp::croak("Can't call $c\-\>$name, not a valid method");
+ croak("Can't call $c\-\>$name, not a valid method");
}
# try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
$name =~ s/^f/b/;
@@ -320,8 +318,6 @@ sub AUTOLOAD {
sub _method_hand_up { exists $hand_ups{$_[0]||''}; }
}
-sub DEBUG () { 0; }
-
sub isa {
my ($self, $class) = @_;
return if $class =~ /^Math::BigInt/; # we aren't one of these
@@ -332,16 +328,22 @@ sub config {
# return (later set?) configuration data as hash ref
my $class = shift || 'Math::BigFloat';
+ # Getter/accessor.
+
if (@_ == 1 && ref($_[0]) ne 'HASH') {
- my $cfg = $class->SUPER::config();
- return $cfg->{$_[0]};
+ my $param = shift;
+ return $class if $param eq 'class';
+ return $LIB if $param eq 'with';
+ return $class->SUPER::config($param);
}
+ # Setter.
+
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->{with} = $LIB;
$cfg;
}
@@ -364,7 +366,7 @@ sub new {
# avoid numify-calls by not using || on $wanted!
unless (defined $wanted) {
- #Carp::carp("Use of uninitialized value in new");
+ #carp("Use of uninitialized value in new");
return $self->bzero(@r);
}
@@ -390,7 +392,7 @@ sub new {
# shortcut for bigints and its subclasses
if ((ref($wanted)) && $wanted -> can("as_number")) {
$self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy
- $self->{_e} = $MBI->_zero();
+ $self->{_e} = $LIB->_zero();
$self->{_es} = '+';
$self->{sign} = $wanted->sign();
return $self->bnorm();
@@ -434,10 +436,10 @@ sub new {
# Shortcut for simple forms like '12' that have no trailing zeros.
if ($wanted =~ /^([+-]?)0*([1-9][0-9]*[1-9])$/) {
- $self->{_e} = $MBI -> _zero();
+ $self->{_e} = $LIB -> _zero();
$self->{_es} = '+';
$self->{sign} = $1 || '+';
- $self->{_m} = $MBI -> _new($2);
+ $self->{_m} = $LIB -> _new($2);
if (!$downgrade) {
$self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
return $self;
@@ -447,26 +449,26 @@ sub new {
my ($mis, $miv, $mfv, $es, $ev) = Math::BigInt::_split($wanted);
if (!ref $mis) {
if ($_trap_nan) {
- Carp::croak("$wanted is not a number initialized to $class");
+ croak("$wanted is not a number initialized to $class");
}
return $downgrade->bnan() if $downgrade;
- $self->{_e} = $MBI->_zero();
+ $self->{_e} = $LIB->_zero();
$self->{_es} = '+';
- $self->{_m} = $MBI->_zero();
+ $self->{_m} = $LIB->_zero();
$self->{sign} = $nan;
} else {
# make integer from mantissa by adjusting exp, then convert to int
- $self->{_e} = $MBI->_new($$ev); # exponent
+ $self->{_e} = $LIB->_new($$ev); # exponent
$self->{_es} = $$es || '+';
my $mantissa = "$$miv$$mfv"; # create mant.
$mantissa =~ s/^0+(\d)/$1/; # strip leading zeros
- $self->{_m} = $MBI->_new($mantissa); # create mant.
+ $self->{_m} = $LIB->_new($mantissa); # create mant.
# 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5
if (CORE::length($$mfv) != 0) {
- my $len = $MBI->_new(CORE::length($$mfv));
+ my $len = $LIB->_new(CORE::length($$mfv));
($self->{_e}, $self->{_es}) =
_e_sub($self->{_e}, $len, $self->{_es}, '+');
}
@@ -478,9 +480,9 @@ sub new {
my $zeros = 0;
$zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/;
if ($zeros != 0) {
- my $z = $MBI->_new($zeros);
+ my $z = $LIB->_new($zeros);
# turn '120e2' into '12e3'
- $self->{_m} = $MBI->_rsft($self->{_m}, $z, 10);
+ $self->{_m} = $LIB->_rsft($self->{_m}, $z, 10);
($self->{_e}, $self->{_es}) =
_e_add($self->{_e}, $z, $self->{_es}, '+');
}
@@ -489,8 +491,8 @@ sub new {
# for something like 0Ey, set y to 0, and -0 => +0
# Check $$miv for being '0' and $$mfv eq '', because otherwise _m could not
- # have become 0. That's faster than to call $MBI->_is_zero().
- $self->{sign} = '+', $self->{_e} = $MBI->_zero()
+ # have become 0. That's faster than to call $LIB->_is_zero().
+ $self->{sign} = '+', $self->{_e} = $LIB->_zero()
if $$miv eq '0' and $$mfv eq '';
if (!$downgrade) {
@@ -502,8 +504,8 @@ sub new {
# if downgrade, inf, NaN or integers go down
if ($downgrade && $self->{_es} eq '+') {
- if ($MBI->_is_zero($self->{_e})) {
- return $downgrade->new($$mis . $MBI->_str($self->{_m}));
+ if ($LIB->_is_zero($self->{_e})) {
+ return $downgrade->new($$mis . $LIB->_str($self->{_m}));
}
return $downgrade->new($self->bsstr());
}
@@ -587,7 +589,7 @@ sub from_hex {
}
$self -> {sign} = $s_sign;
- $self -> {_m} = $MBI -> _from_hex('0x' . $s_value);
+ $self -> {_m} = $LIB -> _from_hex('0x' . $s_value);
if ($two_expon > 0) {
my $factor = $class -> new("2") -> bpow($two_expon);
@@ -675,7 +677,7 @@ sub from_oct {
}
$self -> {sign} = $s_sign;
- $self -> {_m} = $MBI -> _from_oct($s_value);
+ $self -> {_m} = $LIB -> _from_oct($s_value);
if ($two_expon > 0) {
my $factor = $class -> new("2") -> bpow($two_expon);
@@ -763,7 +765,7 @@ sub from_bin {
}
$self -> {sign} = $s_sign;
- $self -> {_m} = $MBI -> _from_bin('0b' . $s_value);
+ $self -> {_m} = $LIB -> _from_bin('0b' . $s_value);
if ($two_expon > 0) {
my $factor = $class -> new("2") -> bpow($two_expon);
@@ -783,7 +785,7 @@ sub bzero {
# create/assign '+0'
if (@_ == 0) {
- #Carp::carp("Using bone() as a function is deprecated;",
+ #carp("Using bone() as a function is deprecated;",
# " use bone() as a method instead");
unshift @_, __PACKAGE__;
}
@@ -798,20 +800,23 @@ sub bzero {
$self = bless {}, $class unless $selfref;
$self -> {sign} = '+';
- $self -> {_m} = $MBI -> _zero();
+ $self -> {_m} = $LIB -> _zero();
$self -> {_es} = '+';
- $self -> {_e} = $MBI -> _zero();
+ $self -> {_e} = $LIB -> _zero();
- if (@_ > 0) {
- if (@_ > 3) {
- # call like: $x->bzero($a, $p, $r, $y);
- ($self, $self->{_a}, $self->{_p}) = $self->_find_round_parameters(@_);
- } else {
- # call like: $x->bzero($a, $p, $r);
- $self->{_a} = $_[0]
- if !defined $self->{_a} || (defined $_[0] && $_[0] > $self->{_a});
- $self->{_p} = $_[1]
- if !defined $self->{_p} || (defined $_[1] && $_[1] > $self->{_p});
+ # If rounding parameters are given as arguments, use them. If no rounding
+ # parameters are given, and if called as a class method initialize the new
+ # instance with the class variables.
+
+ if (@_) {
+ croak "can't specify both accuracy and precision"
+ if @_ >= 2 && defined $_[0] && defined $_[1];
+ $self->{_a} = $_[0];
+ $self->{_p} = $_[1];
+ } else {
+ unless($selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
}
}
@@ -822,7 +827,7 @@ sub bone {
# Create or assign '+1' (or -1 if given sign '-').
if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) {
- #Carp::carp("Using bone() as a function is deprecated;",
+ #carp("Using bone() as a function is deprecated;",
# " use bone() as a method instead");
unshift @_, __PACKAGE__;
}
@@ -840,20 +845,23 @@ sub bone {
$self = bless {}, $class unless $selfref;
$self -> {sign} = $sign;
- $self -> {_m} = $MBI -> _one();
+ $self -> {_m} = $LIB -> _one();
$self -> {_es} = '+';
- $self -> {_e} = $MBI -> _zero();
+ $self -> {_e} = $LIB -> _zero();
- if (@_ > 0) {
- if (@_ > 3) {
- # call like: $x->bone($sign, $a, $p, $r, $y, ...);
- ($self, $self->{_a}, $self->{_p}) = $self->_find_round_parameters(@_);
- } else {
- # call like: $x->bone($sign, $a, $p, $r);
- $self->{_a} = $_[0]
- if ((!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
- $self->{_p} = $_[1]
- if ((!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p}));
+ # If rounding parameters are given as arguments, use them. If no rounding
+ # parameters are given, and if called as a class method initialize the new
+ # instance with the class variables.
+
+ if (@_) {
+ croak "can't specify both accuracy and precision"
+ if @_ >= 2 && defined $_[0] && defined $_[1];
+ $self->{_a} = $_[0];
+ $self->{_p} = $_[1];
+ } else {
+ unless($selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
}
}
@@ -866,7 +874,7 @@ sub binf {
if (@_ == 0 || (defined($_[0]) && !ref($_[0]) &&
$_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/))
{
- #Carp::carp("Using binf() as a function is deprecated;",
+ #carp("Using binf() as a function is deprecated;",
# " use binf() as a method instead");
unshift @_, __PACKAGE__;
}
@@ -878,7 +886,7 @@ sub binf {
{
no strict 'refs';
if (${"${class}::_trap_inf"}) {
- Carp::croak("Tried to create +-inf in $class->binf()");
+ croak("Tried to create +-inf in $class->binf()");
}
}
@@ -891,9 +899,25 @@ sub binf {
$self = bless {}, $class unless $selfref;
$self -> {sign} = $sign . 'inf';
- $self -> {_m} = $MBI -> _zero();
+ $self -> {_m} = $LIB -> _zero();
$self -> {_es} = '+';
- $self -> {_e} = $MBI -> _zero();
+ $self -> {_e} = $LIB -> _zero();
+
+ # If rounding parameters are given as arguments, use them. If no rounding
+ # parameters are given, and if called as a class method initialize the new
+ # instance with the class variables.
+
+ if (@_) {
+ croak "can't specify both accuracy and precision"
+ if @_ >= 2 && defined $_[0] && defined $_[1];
+ $self->{_a} = $_[0];
+ $self->{_p} = $_[1];
+ } else {
+ unless($selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
+ }
+ }
return $self;
}
@@ -902,7 +926,7 @@ sub bnan {
# create/assign a 'NaN'
if (@_ == 0) {
- #Carp::carp("Using bnan() as a function is deprecated;",
+ #carp("Using bnan() as a function is deprecated;",
# " use bnan() as a method instead");
unshift @_, __PACKAGE__;
}
@@ -914,7 +938,7 @@ sub bnan {
{
no strict 'refs';
if (${"${class}::_trap_nan"}) {
- Carp::croak("Tried to create NaN in $class->bnan()");
+ croak("Tried to create NaN in $class->bnan()");
}
}
@@ -924,9 +948,25 @@ sub bnan {
$self = bless {}, $class unless $selfref;
$self -> {sign} = $nan;
- $self -> {_m} = $MBI -> _zero();
+ $self -> {_m} = $LIB -> _zero();
$self -> {_es} = '+';
- $self -> {_e} = $MBI -> _zero();
+ $self -> {_e} = $LIB -> _zero();
+
+ # If rounding parameters are given as arguments, use them. If no rounding
+ # parameters are given, and if called as a class method initialize the new
+ # instance with the class variables.
+
+ if (@_) {
+ croak "can't specify both accuracy and precision"
+ if @_ >= 2 && defined $_[0] && defined $_[1];
+ $self->{_a} = $_[0];
+ $self->{_p} = $_[1];
+ } else {
+ unless($selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
+ }
+ }
return $self;
}
@@ -1032,13 +1072,12 @@ EOF
my $digits = substr($all_digits, 0, $nchrs);
- # Find out whether we should round up or down. Since pi is a
- # transcendental number, we only have to look at one digit after the
- # last digit we want.
+ # Find out whether we should round up or down. Rounding is easy, since
+ # pi is trancendental. With directed rounding, it doesn't matter what
+ # the following digits are. With rounding to nearest, we only have to
+ # look at one extra digit.
- if ($rmode eq '+inf') {
- $round_up = 1;
- } elsif ($rmode eq 'trunc' || $rmode eq 'zero' || $rmode eq '-inf') {
+ if ($rmode eq 'trunc') {
$round_up = 0;
} else {
my $next_digit = substr($all_digits, $nchrs, 1);
@@ -1072,7 +1111,7 @@ EOF
# Math::BigFloat, so use Brent-Salamin (aka AGM or Gauss-Legendre).
# Use a few more digits in the intermediate computations.
- my $nextra = 8;
+ $n += 8;
$HALF = $class -> new($HALF) unless ref($HALF);
my ($an, $bn, $tn, $pn) = ($class -> bone, $HALF -> copy() -> bsqrt($n),
@@ -1118,8 +1157,8 @@ sub copy {
$copy->{sign} = $self->{sign};
$copy->{_es} = $self->{_es};
- $copy->{_m} = $MBI->_copy($self->{_m});
- $copy->{_e} = $MBI->_copy($self->{_e});
+ $copy->{_m} = $LIB->_copy($self->{_m});
+ $copy->{_e} = $LIB->_copy($self->{_e});
$copy->{_a} = $self->{_a} if exists $self->{_a};
$copy->{_p} = $self->{_p} if exists $self->{_p};
@@ -1142,13 +1181,13 @@ sub as_number {
return Math::BigInt->binf($x->sign()) if $x->is_inf();
return Math::BigInt->bnan() if $x->is_nan();
- my $z = $MBI->_copy($x->{_m});
+ my $z = $LIB->_copy($x->{_m});
if ($x->{_es} eq '-') { # < 0
- $z = $MBI->_rsft($z, $x->{_e}, 10);
- } elsif (! $MBI->_is_zero($x->{_e})) { # > 0
- $z = $MBI->_lsft($z, $x->{_e}, 10);
+ $z = $LIB->_rsft($z, $x->{_e}, 10);
+ } elsif (! $LIB->_is_zero($x->{_e})) { # > 0
+ $z = $LIB->_lsft($z, $x->{_e}, 10);
}
- $z = Math::BigInt->new($x->{sign} . $MBI->_str($z));
+ $z = Math::BigInt->new($x->{sign} . $LIB->_str($z));
$z;
}
@@ -1160,7 +1199,7 @@ sub is_zero {
# return true if arg (BFLOAT or num_str) is zero
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
- ($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})) ? 1 : 0;
+ ($x->{sign} eq '+' && $LIB->_is_zero($x->{_m})) ? 1 : 0;
}
sub is_one {
@@ -1170,8 +1209,8 @@ sub is_one {
$sign = '+' if !defined $sign || $sign ne '-';
($x->{sign} eq $sign &&
- $MBI->_is_zero($x->{_e}) &&
- $MBI->_is_one($x->{_m})) ? 1 : 0;
+ $LIB->_is_zero($x->{_e}) &&
+ $LIB->_is_one($x->{_m})) ? 1 : 0;
}
sub is_odd {
@@ -1179,8 +1218,8 @@ sub is_odd {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
(($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
- ($MBI->_is_zero($x->{_e})) &&
- ($MBI->_is_odd($x->{_m}))) ? 1 : 0;
+ ($LIB->_is_zero($x->{_e})) &&
+ ($LIB->_is_odd($x->{_m}))) ? 1 : 0;
}
sub is_even {
@@ -1189,7 +1228,7 @@ sub is_even {
(($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
($x->{_es} eq '+') && # 123.45 isn't
- ($MBI->_is_even($x->{_m}))) ? 1 : 0; # but 1200 is
+ ($LIB->_is_even($x->{_m}))) ? 1 : 0; # but 1200 is
}
sub is_int {
@@ -1252,8 +1291,8 @@ sub bcmp {
# integer of arbitrary value, the exponents must be normalized by the length
# of the mantissas before we can compare them.
- my $mxl = $MBI->_len($x->{_m});
- my $myl = $MBI->_len($y->{_m});
+ my $mxl = $LIB->_len($x->{_m});
+ my $myl = $LIB->_len($y->{_m});
# If the mantissas have the same length, there is no point in normalizing the
# exponents by the length of the mantissas, so treat that as a special case.
@@ -1271,7 +1310,7 @@ sub bcmp {
# Then handle the case where the exponents have the same sign.
else {
- $cmp = $MBI->_acmp($x->{_e}, $y->{_e});
+ $cmp = $LIB->_acmp($x->{_e}, $y->{_e});
$cmp = -$cmp if $x->{_es} eq '-';
}
@@ -1298,17 +1337,17 @@ sub bcmp {
# need to do anything special.
if ($y->{_es} eq '+') {
- $ex = $MBI->_copy($x->{_e});
- $ey = $MBI->_copy($y->{_e});
+ $ex = $LIB->_copy($x->{_e});
+ $ey = $LIB->_copy($y->{_e});
}
# If the exponent of x is >= 0 and the exponent of y is < 0, add the
# absolute value of the exponent of y to both.
else {
- $ex = $MBI->_copy($x->{_e});
- $ex = $MBI->_add($ex, $y->{_e}); # ex + |ey|
- $ey = $MBI->_zero(); # -ex + |ey| = 0
+ $ex = $LIB->_copy($x->{_e});
+ $ex = $LIB->_add($ex, $y->{_e}); # ex + |ey|
+ $ey = $LIB->_zero(); # -ex + |ey| = 0
}
} else {
@@ -1317,29 +1356,29 @@ sub bcmp {
# absolute value of the exponent of x to both.
if ($y->{_es} eq '+') {
- $ex = $MBI->_zero(); # -ex + |ex| = 0
- $ey = $MBI->_copy($y->{_e});
- $ey = $MBI->_add($ey, $x->{_e}); # ey + |ex|
+ $ex = $LIB->_zero(); # -ex + |ex| = 0
+ $ey = $LIB->_copy($y->{_e});
+ $ey = $LIB->_add($ey, $x->{_e}); # ey + |ex|
}
# If the exponent of x is < 0 and the exponent of y is < 0, add the
# absolute values of both exponents to both exponents.
else {
- $ex = $MBI->_copy($y->{_e}); # -ex + |ey| + |ex| = |ey|
- $ey = $MBI->_copy($x->{_e}); # -ey + |ex| + |ey| = |ex|
+ $ex = $LIB->_copy($y->{_e}); # -ex + |ey| + |ex| = |ey|
+ $ey = $LIB->_copy($x->{_e}); # -ey + |ex| + |ey| = |ex|
}
}
# Now we can normalize the exponents by adding lengths of the mantissas.
- $ex = $MBI->_add($ex, $MBI->_new($mxl));
- $ey = $MBI->_add($ey, $MBI->_new($myl));
+ $ex = $LIB->_add($ex, $LIB->_new($mxl));
+ $ey = $LIB->_add($ey, $LIB->_new($myl));
# We're done if the exponents are different.
- $cmp = $MBI->_acmp($ex, $ey);
+ $cmp = $LIB->_acmp($ex, $ey);
$cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123
return $cmp if $cmp;
@@ -1351,12 +1390,12 @@ sub bcmp {
my $my = $y->{_m};
if ($mxl > $myl) {
- $my = $MBI->_lsft($MBI->_copy($my), $MBI->_new($mxl - $myl), 10);
+ $my = $LIB->_lsft($LIB->_copy($my), $LIB->_new($mxl - $myl), 10);
} elsif ($mxl < $myl) {
- $mx = $MBI->_lsft($MBI->_copy($mx), $MBI->_new($myl - $mxl), 10);
+ $mx = $LIB->_lsft($LIB->_copy($mx), $LIB->_new($myl - $mxl), 10);
}
- $cmp = $MBI->_acmp($mx, $my);
+ $cmp = $LIB->_acmp($mx, $my);
$cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123
return $cmp;
@@ -1392,14 +1431,14 @@ sub bacmp {
return 1 if $yz && !$xz; # +x <=> 0
# adjust so that exponents are equal
- my $lxm = $MBI->_len($x->{_m});
- my $lym = $MBI->_len($y->{_m});
+ my $lxm = $LIB->_len($x->{_m});
+ my $lym = $LIB->_len($y->{_m});
my ($xes, $yes) = (1, 1);
$xes = -1 if $x->{_es} ne '+';
$yes = -1 if $y->{_es} ne '+';
# the numify somewhat limits our length, but makes it much faster
- my $lx = $lxm + $xes * $MBI->_num($x->{_e});
- my $ly = $lym + $yes * $MBI->_num($y->{_e});
+ my $lx = $lxm + $xes * $LIB->_num($x->{_e});
+ my $ly = $lym + $yes * $LIB->_num($y->{_e});
my $l = $lx - $ly;
return $l <=> 0 if $l != 0;
@@ -1409,13 +1448,13 @@ sub bacmp {
my $xm = $x->{_m}; # not yet copy it
my $ym = $y->{_m};
if ($diff > 0) {
- $ym = $MBI->_copy($y->{_m});
- $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10);
+ $ym = $LIB->_copy($y->{_m});
+ $ym = $LIB->_lsft($ym, $LIB->_new($diff), 10);
} elsif ($diff < 0) {
- $xm = $MBI->_copy($x->{_m});
- $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10);
+ $xm = $LIB->_copy($x->{_m});
+ $xm = $LIB->_lsft($xm, $LIB->_new(-$diff), 10);
}
- $MBI->_acmp($xm, $ym);
+ $LIB->_acmp($xm, $ym);
}
###############################################################################
@@ -1430,7 +1469,7 @@ sub 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->{_m}));
+ $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_m}));
$x;
}
@@ -1440,26 +1479,26 @@ sub bnorm {
return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $zeros = $MBI->_zeros($x->{_m}); # correct for trailing zeros
+ my $zeros = $LIB->_zeros($x->{_m}); # correct for trailing zeros
if ($zeros != 0) {
- my $z = $MBI->_new($zeros);
- $x->{_m} = $MBI->_rsft($x->{_m}, $z, 10);
+ my $z = $LIB->_new($zeros);
+ $x->{_m} = $LIB->_rsft($x->{_m}, $z, 10);
if ($x->{_es} eq '-') {
- if ($MBI->_acmp($x->{_e}, $z) >= 0) {
- $x->{_e} = $MBI->_sub($x->{_e}, $z);
- $x->{_es} = '+' if $MBI->_is_zero($x->{_e});
+ if ($LIB->_acmp($x->{_e}, $z) >= 0) {
+ $x->{_e} = $LIB->_sub($x->{_e}, $z);
+ $x->{_es} = '+' if $LIB->_is_zero($x->{_e});
} else {
- $x->{_e} = $MBI->_sub($MBI->_copy($z), $x->{_e});
+ $x->{_e} = $LIB->_sub($LIB->_copy($z), $x->{_e});
$x->{_es} = '+';
}
} else {
- $x->{_e} = $MBI->_add($x->{_e}, $z);
+ $x->{_e} = $LIB->_add($x->{_e}, $z);
}
} else {
# $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing
# zeros). So, for something like 0Ey, set y to 1, and -0 => +0
- $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $MBI->_one()
- if $MBI->_is_zero($x->{_m});
+ $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $LIB->_one()
+ if $LIB->_is_zero($x->{_m});
}
$x;
@@ -1475,22 +1514,22 @@ sub binc {
return $x->badd($class->bone(), @r); # digits after dot
}
- if (!$MBI->_is_zero($x->{_e})) # _e == 0 for NaN, inf, -inf
+ if (!$LIB->_is_zero($x->{_e})) # _e == 0 for NaN, inf, -inf
{
# 1e2 => 100, so after the shift below _m has a '0' as last digit
- $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100
- $x->{_e} = $MBI->_zero(); # normalize
+ $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100
+ $x->{_e} = $LIB->_zero(); # normalize
$x->{_es} = '+';
# we know that the last digit of $x will be '1' or '9', depending on the
# sign
}
# now $x->{_e} == 0
if ($x->{sign} eq '+') {
- $x->{_m} = $MBI->_inc($x->{_m});
+ $x->{_m} = $LIB->_inc($x->{_m});
return $x->bnorm()->bround(@r);
} elsif ($x->{sign} eq '-') {
- $x->{_m} = $MBI->_dec($x->{_m});
- $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0
+ $x->{_m} = $LIB->_dec($x->{_m});
+ $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0
return $x->bnorm()->bround(@r);
}
# inf, nan handling etc
@@ -1507,23 +1546,23 @@ sub bdec {
return $x->badd($class->bone('-'), @r); # digits after dot
}
- if (!$MBI->_is_zero($x->{_e})) {
- $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100
- $x->{_e} = $MBI->_zero(); # normalize
+ if (!$LIB->_is_zero($x->{_e})) {
+ $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100
+ $x->{_e} = $LIB->_zero(); # normalize
$x->{_es} = '+';
}
# now $x->{_e} == 0
my $zero = $x->is_zero();
# <= 0
if (($x->{sign} eq '-') || $zero) {
- $x->{_m} = $MBI->_inc($x->{_m});
+ $x->{_m} = $LIB->_inc($x->{_m});
$x->{sign} = '-' if $zero; # 0 => 1 => -1
- $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0
+ $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0
return $x->bnorm()->round(@r);
}
# > 0
elsif ($x->{sign} eq '+') {
- $x->{_m} = $MBI->_dec($x->{_m});
+ $x->{_m} = $LIB->_dec($x->{_m});
return $x->bnorm()->round(@r);
}
# inf, nan handling etc
@@ -1568,37 +1607,37 @@ sub badd {
if ($x->is_zero()) # 0+y
{
# make copy, clobbering up x (modify in place!)
- $x->{_e} = $MBI->_copy($y->{_e});
+ $x->{_e} = $LIB->_copy($y->{_e});
$x->{_es} = $y->{_es};
- $x->{_m} = $MBI->_copy($y->{_m});
+ $x->{_m} = $LIB->_copy($y->{_m});
$x->{sign} = $y->{sign} || $nan;
return $x->round(@r);
}
# take lower of the two e's and adapt m1 to it to match m2
my $e = $y->{_e};
- $e = $MBI->_zero() if !defined $e; # if no BFLOAT?
- $e = $MBI->_copy($e); # make copy (didn't do it yet)
+ $e = $LIB->_zero() if !defined $e; # if no BFLOAT?
+ $e = $LIB->_copy($e); # make copy (didn't do it yet)
my $es;
($e, $es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es});
- my $add = $MBI->_copy($y->{_m});
+ my $add = $LIB->_copy($y->{_m});
if ($es eq '-') # < 0
{
- $x->{_m} = $MBI->_lsft($x->{_m}, $e, 10);
+ $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
- } elsif (!$MBI->_is_zero($e)) # > 0
+ } elsif (!$LIB->_is_zero($e)) # > 0
{
- $add = $MBI->_lsft($add, $e, 10);
+ $add = $LIB->_lsft($add, $e, 10);
}
# else: both e are the same, so just leave them
if ($x->{sign} eq $y->{sign}) {
# add
- $x->{_m} = $MBI->_add($x->{_m}, $add);
+ $x->{_m} = $LIB->_add($x->{_m}, $add);
} else {
($x->{_m}, $x->{sign}) =
_e_add($x->{_m}, $add, $x->{sign}, $y->{sign});
@@ -1672,7 +1711,7 @@ sub bmul {
((!$x->isa($class)) || (!$y->isa($class)));
# aEb * cEd = (a*c)E(b+d)
- $x->{_m} = $MBI->_mul($x->{_m}, $y->{_m});
+ $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m});
($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
$r[3] = $y; # no push!
@@ -1709,7 +1748,7 @@ sub bmuladd {
((!$x->isa($class)) || (!$y->isa($class)));
# aEb * cEd = (a*c)E(b+d)
- $x->{_m} = $MBI->_mul($x->{_m}, $y->{_m});
+ $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m});
($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
$r[3] = $y; # no push!
@@ -1722,28 +1761,28 @@ sub bmuladd {
# take lower of the two e's and adapt m1 to it to match m2
my $e = $z->{_e};
- $e = $MBI->_zero() if !defined $e; # if no BFLOAT?
- $e = $MBI->_copy($e); # make copy (didn't do it yet)
+ $e = $LIB->_zero() if !defined $e; # if no BFLOAT?
+ $e = $LIB->_copy($e); # make copy (didn't do it yet)
my $es;
($e, $es) = _e_sub($e, $x->{_e}, $z->{_es} || '+', $x->{_es});
- my $add = $MBI->_copy($z->{_m});
+ my $add = $LIB->_copy($z->{_m});
if ($es eq '-') # < 0
{
- $x->{_m} = $MBI->_lsft($x->{_m}, $e, 10);
+ $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
- } elsif (!$MBI->_is_zero($e)) # > 0
+ } elsif (!$LIB->_is_zero($e)) # > 0
{
- $add = $MBI->_lsft($add, $e, 10);
+ $add = $LIB->_lsft($add, $e, 10);
}
# else: both e are the same, so just leave them
if ($x->{sign} eq $z->{sign}) {
# add
- $x->{_m} = $MBI->_add($x->{_m}, $add);
+ $x->{_m} = $LIB->_add($x->{_m}, $add);
} else {
($x->{_m}, $x->{sign}) =
_e_add($x->{_m}, $add, $x->{sign}, $z->{sign});
@@ -1870,14 +1909,14 @@ sub bdiv {
$y = $class->new($y) unless $y->isa('Math::BigFloat');
- my $lx = $MBI -> _len($x->{_m}); my $ly = $MBI -> _len($y->{_m});
+ my $lx = $LIB -> _len($x->{_m}); my $ly = $LIB -> _len($y->{_m});
$scale = $lx if $lx > $scale;
$scale = $ly if $ly > $scale;
my $diff = $ly - $lx;
$scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx!
# check that $y is not 1 nor -1 and cache the result:
- my $y_not_one = !($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m}));
+ my $y_not_one = !($LIB->_is_zero($y->{_e}) && $LIB->_is_one($y->{_m}));
# flipping the sign of $y will also flip the sign of $x for the special
# case of $x->bsub($x); so we can catch it below:
@@ -1906,13 +1945,13 @@ sub bdiv {
# calculate the result to $scale digits and then round it
# a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
- $x->{_m} = $MBI->_lsft($x->{_m}, $MBI->_new($scale), 10);
- $x->{_m} = $MBI->_div($x->{_m}, $y->{_m}); # a/c
+ $x->{_m} = $LIB->_lsft($x->{_m}, $LIB->_new($scale), 10);
+ $x->{_m} = $LIB->_div($x->{_m}, $y->{_m}); # a/c
# correct exponent of $x
($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
# correct for 10**scale
- ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+');
+ ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $LIB->_new($scale), $x->{_es}, '+');
$x->bnorm(); # remove trailing 0's
}
} # end else $x != $y
@@ -1990,7 +2029,7 @@ sub bmod {
return $x->bzero() if $x->is_zero()
|| ($x->is_int() &&
# check that $y == +1 or $y == -1:
- ($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m})));
+ ($LIB->_is_zero($y->{_e}) && $LIB->_is_one($y->{_m})));
my $cmp = $x->bacmp($y); # equal or $x < $y?
if ($cmp == 0) { # $x == $y => result 0
@@ -2005,19 +2044,19 @@ sub bmod {
return $x -> round($a, $p, $r);
}
- my $ym = $MBI->_copy($y->{_m});
+ my $ym = $LIB->_copy($y->{_m});
# 2e1 => 20
- $ym = $MBI->_lsft($ym, $y->{_e}, 10)
- if $y->{_es} eq '+' && !$MBI->_is_zero($y->{_e});
+ $ym = $LIB->_lsft($ym, $y->{_e}, 10)
+ if $y->{_es} eq '+' && !$LIB->_is_zero($y->{_e});
# if $y has digits after dot
my $shifty = 0; # correct _e of $x by this
if ($y->{_es} eq '-') # has digits after dot
{
# 123 % 2.5 => 1230 % 25 => 5 => 0.5
- $shifty = $MBI->_num($y->{_e}); # no more digits after dot
- $x->{_m} = $MBI->_lsft($x->{_m}, $y->{_e}, 10); # 123 => 1230, $y->{_m} is already 25
+ $shifty = $LIB->_num($y->{_e}); # no more digits after dot
+ $x->{_m} = $LIB->_lsft($x->{_m}, $y->{_e}, 10); # 123 => 1230, $y->{_m} is already 25
}
# $ym is now mantissa of $y based on exponent 0
@@ -2025,24 +2064,24 @@ sub bmod {
if ($x->{_es} eq '-') # has digits after dot
{
# 123.4 % 20 => 1234 % 200
- $shiftx = $MBI->_num($x->{_e}); # no more digits after dot
- $ym = $MBI->_lsft($ym, $x->{_e}, 10); # 123 => 1230
+ $shiftx = $LIB->_num($x->{_e}); # no more digits after dot
+ $ym = $LIB->_lsft($ym, $x->{_e}, 10); # 123 => 1230
}
# 123e1 % 20 => 1230 % 20
- if ($x->{_es} eq '+' && !$MBI->_is_zero($x->{_e})) {
- $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # es => '+' here
+ if ($x->{_es} eq '+' && !$LIB->_is_zero($x->{_e})) {
+ $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # es => '+' here
}
- $x->{_e} = $MBI->_new($shiftx);
+ $x->{_e} = $LIB->_new($shiftx);
$x->{_es} = '+';
$x->{_es} = '-' if $shiftx != 0 || $shifty != 0;
- $x->{_e} = $MBI->_add($x->{_e}, $MBI->_new($shifty)) if $shifty != 0;
+ $x->{_e} = $LIB->_add($x->{_e}, $LIB->_new($shifty)) if $shifty != 0;
# now mantissas are equalized, exponent of $x is adjusted, so calc result
- $x->{_m} = $MBI->_mod($x->{_m}, $ym);
+ $x->{_m} = $LIB->_mod($x->{_m}, $ym);
- $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0
+ $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0
$x->bnorm();
if ($neg != 0 && ! $x -> is_zero()) # one of them negative => correct in place
@@ -2051,7 +2090,7 @@ sub bmod {
$x->{_m} = $r->{_m};
$x->{_e} = $r->{_e};
$x->{_es} = $r->{_es};
- $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0
+ $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0
$x->bnorm();
}
@@ -2062,7 +2101,7 @@ sub bmodpow {
# takes a very large number to a very large exponent in a given very
# large modulus, quickly, thanks to binary exponentiation. Supports
# negative exponents.
- my ($class, $num, $exp, $mod, @r) = objectify(3, @_);
+ my ($class, $num, $exp, $mod) = objectify(3, @_);
return $num if $num->modify('bmodpow');
@@ -2101,8 +2140,33 @@ sub bpow {
return $x if $x->modify('bpow');
- return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
- return $x if $x->{sign} =~ /^[+-]inf$/;
+ # $x and/or $y is a NaN
+ return $x->bnan() if $x->is_nan() || $y->is_nan();
+
+ # $x and/or $y is a +/-Inf
+ if ($x->is_inf("-")) {
+ return $x->bzero() if $y->is_negative();
+ return $x->bnan() if $y->is_zero();
+ return $x if $y->is_odd();
+ return $x->bneg();
+ } elsif ($x->is_inf("+")) {
+ return $x->bzero() if $y->is_negative();
+ return $x->bnan() if $y->is_zero();
+ return $x;
+ } elsif ($y->is_inf("-")) {
+ return $x->bnan() if $x -> is_one("-");
+ return $x->binf("+") if $x > -1 && $x < 1;
+ return $x->bone() if $x -> is_one("+");
+ return $x->bzero();
+ } elsif ($y->is_inf("+")) {
+ return $x->bnan() if $x -> is_one("-");
+ return $x->bzero() if $x > -1 && $x < 1;
+ return $x->bone() if $x -> is_one("+");
+ return $x->binf("+");
+ }
+
+ # we don't support complex numbers, so return NaN
+ return $x->bnan() if $x->is_negative() && !$y->is_int();
# cache the result of is_zero
my $y_is_zero = $y->is_zero();
@@ -2110,14 +2174,13 @@ sub bpow {
return $x if $x->is_one() || $y->is_one();
my $x_is_zero = $x->is_zero();
- return $x->_pow($y, $a, $p, $r) if !$x_is_zero && !$y->is_int(); # non-integer power
+ return $x->_pow($y, $a, $p, $r) if !$x_is_zero && !$y->is_int();
my $y1 = $y->as_number()->{value}; # make MBI part
- # if ($x == -1)
- if ($x->{sign} eq '-' && $MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e})) {
+ if ($x->is_one("-")) {
# if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1
- return $MBI->_is_odd($y1) ? $x : $x->babs(1);
+ return $LIB->_is_odd($y1) ? $x : $x->babs(1);
}
if ($x_is_zero) {
return $x if $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0)
@@ -2126,11 +2189,11 @@ sub bpow {
}
my $new_sign = '+';
- $new_sign = $MBI->_is_odd($y1) ? '-' : '+' if $x->{sign} ne '+';
+ $new_sign = $LIB->_is_odd($y1) ? '-' : '+' if $x->{sign} ne '+';
# calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
- $x->{_m} = $MBI->_pow($x->{_m}, $y1);
- $x->{_e} = $MBI->_mul ($x->{_e}, $y1);
+ $x->{_m} = $LIB->_pow($x->{_m}, $y1);
+ $x->{_e} = $LIB->_mul ($x->{_e}, $y1);
$x->{sign} = $new_sign;
$x->bnorm();
@@ -2267,32 +2330,33 @@ sub blog {
# first. This is very fast, and in case the real result was found, we can
# stop right here.
if (defined $base && $base->is_int() && $x->is_int()) {
- my $i = $MBI->_copy($x->{_m});
- $i = $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e});
- my $int = Math::BigInt->bzero();
- $int->{value} = $i;
- $int->blog($base->as_number());
- # if ($exact)
- if ($base->as_number()->bpow($int) == $x) {
- # found result, return it
- $x->{_m} = $int->{value};
- $x->{_e} = $MBI->_zero();
- $x->{_es} = '+';
- $x->bnorm();
+ my $xint = Math::BigInt -> new($x -> bdstr());
+ my $bint = Math::BigInt -> new($base -> bdstr());
+ $xint->blog($bint);
+
+ # if we found the exact result, we're done
+ if ($bint -> bpow($xint) == $x) {
+ my $xflt = Math::BigFloat -> new($xint -> bdstr());
+ $x->{sign} = $xflt->{sign};
+ $x->{_m} = $xflt->{_m};
+ $x->{_es} = $xflt->{_es};
+ $x->{_e} = $xflt->{_e};
$done = 1;
}
}
if ($done == 0) {
- # base is undef, so base should be e (Euler's number), so first calculate the
- # log to base e (using reduction by 10 (and probably 2)):
- $class->_log_10($x, $scale);
+ # First calculate the log to base e (using reduction by 10 and possibly
+ # also by 2):
+ $x->_log_10($scale);
# and if a different base was requested, convert it
if (defined $base) {
- $base = Math::BigFloat->new($base) unless $base->isa('Math::BigFloat');
- # not ln, but some other base (don't modify $base)
- $x->bdiv($base->copy()->blog(undef, $scale), $scale);
+ $base = Math::BigFloat->new($base)
+ unless $base->isa('Math::BigFloat');
+ # log_b(x) = ln(x) / ln(b), so compute ln(b)
+ my $base_log_e = $base->copy()->_log_10($scale);
+ $x->bdiv($base_log_e, $scale);
}
}
@@ -2340,7 +2404,8 @@ sub bexp {
$params[2] = $r; # 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...
+ # 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
}
@@ -2410,21 +2475,23 @@ sub bexp {
# -- + -- + -- + -- + -- + --- + --- + ---- = -----
# 1 1 2 6 24 120 720 5040 5040
- # Note that we cannot simple reduce 13700/5040 to 685/252, but must keep A and B!
+ # Note that we cannot simply reduce 13700/5040 to 685/252, but must keep
+ # the numerator and the denominator!
if ($scale <= 75) {
# set $x directly from a cached string form
- $x->{_m} = $MBI->_new(
- "27182818284590452353602874713526624977572470936999595749669676277240766303535476");
+ $x->{_m} = $LIB->_new("2718281828459045235360287471352662497757" .
+ "2470936999595749669676277240766303535476");
$x->{sign} = '+';
$x->{_es} = '-';
- $x->{_e} = $MBI->_new(79);
+ $x->{_e} = $LIB->_new(79);
} 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 $A = $LIB->_new("9093339520860578540197197" .
+ "0164779391644753259799242");
+ my $F = $LIB->_new(42);
my $step = 42;
# Compute how many steps we need to take to get $A and $B sufficiently big
@@ -2432,24 +2499,24 @@ sub bexp {
# 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);
+ $A = $LIB->_mul($A, $F);
+ $A = $LIB->_inc($A);
# increment f
- $F = $MBI->_inc($F);
+ $F = $LIB->_inc($F);
}
# compute $B as factorial of $steps (this is faster than doing it manually)
- my $B = $MBI->_fac($MBI->_new($steps));
+ my $B = $LIB->_fac($LIB->_new($steps));
- # print "A ", $MBI->_str($A), "\nB ", $MBI->_str($B), "\n";
+ # print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n";
# compute A/B with $scale digits in the result (truncate, not round)
- $A = $MBI->_lsft($A, $MBI->_new($scale), 10);
- $A = $MBI->_div($A, $B);
+ $A = $LIB->_lsft($A, $LIB->_new($scale), 10);
+ $A = $LIB->_div($A, $B);
$x->{_m} = $A;
$x->{sign} = '+';
$x->{_es} = '-';
- $x->{_e} = $MBI->_new($scale);
+ $x->{_e} = $LIB->_new($scale);
}
# $x contains now an estimate of e, with some surplus digits, so we can round
@@ -2502,16 +2569,20 @@ sub bnok {
return $x if $x->modify('bnok');
return $x->bnan() if $x->is_nan() || $y->is_nan();
- return $x->binf() if $x->is_inf();
+ return $x->bnan() if (($x->is_finite() && !$x->is_int()) ||
+ ($y->is_finite() && !$y->is_int()));
- my $u = $x->as_int();
- $u->bnok($y->as_int());
+ my $xint = Math::BigInt -> new($x -> bsstr());
+ my $yint = Math::BigInt -> new($y -> bsstr());
+ $xint -> bnok($yint);
+ my $xflt = Math::BigFloat -> new($xint);
- $x->{_m} = $u->{value};
- $x->{_e} = $MBI->_zero();
- $x->{_es} = '+';
- $x->{sign} = '+';
- $x->bnorm(@r);
+ $x->{_m} = $xflt->{_m};
+ $x->{_e} = $xflt->{_e};
+ $x->{_es} = $xflt->{_es};
+ $x->{sign} = $xflt->{sign};
+
+ return $x;
}
sub bsin {
@@ -2558,7 +2629,6 @@ sub bsin {
# need to disable $upgrade in BigInt, to avoid deep recursion
local $Math::BigInt::upgrade = undef;
- my $last = 0;
my $over = $x * $x; # X ^ 2
my $x2 = $over->copy(); # X ^ 2; difference between terms
$over->bmul($x); # X ^ 3 as starting value
@@ -2648,7 +2718,6 @@ sub bcos {
# need to disable $upgrade in BigInt, to avoid deep recursion
local $Math::BigInt::upgrade = undef;
- my $last = 0;
my $over = $x * $x; # X ^ 2
my $x2 = $over->copy(); # X ^ 2; difference between terms
my $sign = 1; # start with -=
@@ -2730,7 +2799,7 @@ sub batan {
$self->{_es} = $pi->{_es};
# -y => -PI/2, +y => PI/2
$self->{sign} = substr($self->{sign}, 0, 1); # "+inf" => "+"
- $self -> {_m} = $MBI->_div($self->{_m}, $MBI->_new(2));
+ $self -> {_m} = $LIB->_div($self->{_m}, $LIB->_new(2));
return $self;
}
@@ -2752,25 +2821,24 @@ sub batan {
# 1 or -1 => PI/4
# inlined is_one() && is_one('-')
- if ($MBI->_is_one($self->{_m}) && $MBI->_is_zero($self->{_e})) {
+ if ($LIB->_is_one($self->{_m}) && $LIB->_is_zero($self->{_e})) {
my $pi = $class->bpi($scale - 3);
# modify $self in place
$self->{_m} = $pi->{_m};
$self->{_e} = $pi->{_e};
$self->{_es} = $pi->{_es};
# leave the sign of $self alone (+1 => +PI/4, -1 => -PI/4)
- $self->{_m} = $MBI->_div($self->{_m}, $MBI->_new(4));
+ $self->{_m} = $LIB->_div($self->{_m}, $LIB->_new(4));
return $self;
}
# This series is only valid if -1 < x < 1, so for other x we need to
# calculate PI/2 - atan(1/x):
- my $one = $MBI->_new(1);
my $pi = undef;
if ($self->bacmp($self->copy()->bone) >= 0) {
# calculate PI/2
$pi = $class->bpi($scale - 3);
- $pi->{_m} = $MBI->_div($pi->{_m}, $MBI->_new(2));
+ $pi->{_m} = $LIB->_div($pi->{_m}, $LIB->_new(2));
# calculate 1/$self:
my $self_copy = $self->copy();
# modify $self in place
@@ -2779,7 +2847,7 @@ sub batan {
}
my $fmul = 1;
- foreach my $k (0 .. int($scale / 20)) {
+ foreach (0 .. int($scale / 20)) {
$fmul *= 2;
$self->bdiv($self->copy()->bmul($self)->binc->bsqrt($scale + 4)->binc, $scale + 4);
}
@@ -2796,7 +2864,6 @@ sub batan {
# Need to disable $upgrade in BigInt, to avoid deep recursion.
local $Math::BigInt::upgrade = undef;
- my $last = 0;
my $over = $self * $self; # X ^ 2
my $self2 = $over->copy(); # X ^ 2; difference between terms
$over->bmul($self); # X ^ 3 as starting value
@@ -2992,8 +3059,8 @@ sub bsqrt {
# need to disable $upgrade in BigInt, to avoid deep recursion
local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI
- my $i = $MBI->_copy($x->{_m});
- $i = $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e});
+ my $i = $LIB->_copy($x->{_m});
+ $i = $LIB->_lsft($i, $x->{_e}, 10) unless $LIB->_is_zero($x->{_e});
my $xas = Math::BigInt->bzero();
$xas->{value} = $i;
@@ -3005,7 +3072,7 @@ sub bsqrt {
{
# exact result, copy result over to keep $x
$x->{_m} = $gs->{value};
- $x->{_e} = $MBI->_zero();
+ $x->{_e} = $LIB->_zero();
$x->{_es} = '+';
$x->bnorm();
# shortcut to not run through _find_round_parameters again
@@ -3030,9 +3097,9 @@ sub bsqrt {
# result of sqrt(input) by 10. Rounding afterwards returns the real result.
# The following steps will transform 123.456 (in $x) into 123456 (in $y1)
- my $y1 = $MBI->_copy($x->{_m});
+ my $y1 = $LIB->_copy($x->{_m});
- my $length = $MBI->_len($y1);
+ my $length = $LIB->_len($y1);
# Now calculate how many digits the result of sqrt(y1) would have
my $digits = int($length / 2);
@@ -3053,19 +3120,19 @@ sub bsqrt {
# steps of 10. The length of $x does not count, since an even or odd number
# of digits before the dot is not changed by adding an even number of digits
# after the dot (the result is still odd or even digits long).
- $s2++ if $MBI->_is_odd($x->{_e});
+ $s2++ if $LIB->_is_odd($x->{_e});
- $y1 = $MBI->_lsft($y1, $MBI->_new($s2), 10);
+ $y1 = $LIB->_lsft($y1, $LIB->_new($s2), 10);
# now take the square root and truncate to integer
- $y1 = $MBI->_sqrt($y1);
+ $y1 = $LIB->_sqrt($y1);
# By "shifting" $y1 right (by creating a negative _e) we calculate the final
# result, which is than later rounded to the desired scale.
# calculate how many zeros $x had after the '.' (or before it, depending
# on sign of $dat, the result should have half as many:
- my $dat = $MBI->_num($x->{_e});
+ my $dat = $LIB->_num($x->{_e});
$dat = -$dat if $x->{_es} eq '-';
$dat += $length;
@@ -3077,13 +3144,13 @@ sub bsqrt {
} else {
$dat = int(($dat)/2);
}
- $dat -= $MBI->_len($y1);
+ $dat -= $LIB->_len($y1);
if ($dat < 0) {
$dat = abs($dat);
- $x->{_e} = $MBI->_new($dat);
+ $x->{_e} = $LIB->_new($dat);
$x->{_es} = '-';
} else {
- $x->{_e} = $MBI->_new($dat);
+ $x->{_e} = $LIB->_new($dat);
$x->{_es} = '+';
}
$x->{_m} = $y1;
@@ -3163,7 +3230,7 @@ sub broot {
my $is_two = 0;
if ($y->isa('Math::BigFloat')) {
- $is_two = ($y->{sign} eq '+' && $MBI->_is_two($y->{_m}) && $MBI->_is_zero($y->{_e}));
+ $is_two = ($y->{sign} eq '+' && $LIB->_is_two($y->{_m}) && $LIB->_is_zero($y->{_e}));
} else {
$is_two = ($y == 2);
}
@@ -3184,8 +3251,8 @@ sub broot {
my $done = 0; # not yet
if ($y->is_int() && $x->is_int()) {
- my $i = $MBI->_copy($x->{_m});
- $i = $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e});
+ my $i = $LIB->_copy($x->{_m});
+ $i = $LIB->_lsft($i, $x->{_e}, 10) unless $LIB->_is_zero($x->{_e});
my $int = Math::BigInt->bzero();
$int->{value} = $i;
$int->broot($y->as_number());
@@ -3193,7 +3260,7 @@ sub broot {
if ($int->copy()->bpow($y) == $x) {
# found result, return it
$x->{_m} = $int->{value};
- $x->{_e} = $MBI->_zero();
+ $x->{_e} = $LIB->_zero();
$x->{_es} = '+';
$x->bnorm();
$done = 1;
@@ -3240,12 +3307,12 @@ sub bfac {
if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
($x->{_es} ne '+')); # digits after dot?
- if (! $MBI->_is_zero($x->{_e})) {
- $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
- $x->{_e} = $MBI->_zero(); # normalize
+ if (! $LIB->_is_zero($x->{_e})) {
+ $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
+ $x->{_e} = $LIB->_zero(); # normalize
$x->{_es} = '+';
}
- $x->{_m} = $MBI->_fac($x->{_m}); # calculate factorial
+ $x->{_m} = $LIB->_fac($x->{_m}); # calculate factorial
$x->bnorm()->round(@r); # norm again and round result
}
@@ -3264,15 +3331,15 @@ sub bdfac {
if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
($x->{_es} ne '+')); # digits after dot?
- Carp::croak("bdfac() requires a newer version of the $MBI library.")
- unless $MBI->can('_dfac');
+ croak("bdfac() requires a newer version of the $LIB library.")
+ unless $LIB->can('_dfac');
- if (! $MBI->_is_zero($x->{_e})) {
- $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
- $x->{_e} = $MBI->_zero(); # normalize
+ if (! $LIB->_is_zero($x->{_e})) {
+ $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
+ $x->{_e} = $LIB->_zero(); # normalize
$x->{_es} = '+';
}
- $x->{_m} = $MBI->_dfac($x->{_m}); # calculate factorial
+ $x->{_m} = $LIB->_dfac($x->{_m}); # calculate factorial
$x->bnorm()->round(@r); # norm again and round result
}
@@ -3337,8 +3404,8 @@ sub band {
my $xref = ref($x);
my $class = $xref || $x;
- Carp::croak 'band() is an instance method, not a class method' unless $xref;
- Carp::croak 'Not enough arguments for band()' if @_ < 1;
+ croak 'band() is an instance method, not a class method' unless $xref;
+ croak 'Not enough arguments for band()' if @_ < 1;
return if $x -> modify('band');
@@ -3364,8 +3431,8 @@ sub bior {
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;
+ croak 'bior() is an instance method, not a class method' unless $xref;
+ croak 'Not enough arguments for bior()' if @_ < 1;
return if $x -> modify('bior');
@@ -3391,8 +3458,8 @@ sub bxor {
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;
+ croak 'bxor() is an instance method, not a class method' unless $xref;
+ croak 'Not enough arguments for bxor()' if @_ < 1;
return if $x -> modify('bxor');
@@ -3418,7 +3485,7 @@ sub bnot {
my $xref = ref($x);
my $class = $xref || $x;
- Carp::croak 'bnot() is an instance method, not a class method' unless $xref;
+ croak 'bnot() is an instance method, not a class method' unless $xref;
return if $x -> modify('bnot');
@@ -3447,7 +3514,7 @@ sub bround {
$x = $class->new(shift) if !ref($x);
if (($_[0] || 0) < 0) {
- Carp::croak('bround() needs positive accuracy');
+ croak('bround() needs positive accuracy');
}
my ($scale, $mode) = $x->_scale_a(@_);
@@ -3466,7 +3533,7 @@ sub bround {
# 1: never round a 0
# 2: if we should keep more digits than the mantissa has, do nothing
- if ($x->is_zero() || $MBI->_len($x->{_m}) <= $scale) {
+ if ($x->is_zero() || $LIB->_len($x->{_m}) <= $scale) {
$x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale;
return $x;
}
@@ -3510,11 +3577,11 @@ sub bfround {
return $x if $x->{_es} eq '+'; # e >= 0 => nothing to round
$scale = -$scale; # positive for simplicity
- my $len = $MBI->_len($x->{_m}); # length of mantissa
+ my $len = $LIB->_len($x->{_m}); # length of mantissa
# the following poses a restriction on _e, but if _e is bigger than a
# scalar, you got other problems (memory etc) anyway
- my $dad = -(0+ ($x->{_es}.$MBI->_num($x->{_e}))); # digits after dot
+ my $dad = -(0+ ($x->{_es}.$LIB->_num($x->{_e}))); # digits after dot
my $zad = 0; # zeros after dot
$zad = $dad - $len if (-$dad < -$len); # for 0.00..00xxx style
@@ -3550,9 +3617,9 @@ sub bfround {
# 123 => 100 means length(123) = 3 - $scale (2) => 1
- my $dbt = $MBI->_len($x->{_m});
+ my $dbt = $LIB->_len($x->{_m});
# digits before dot
- my $dbd = $dbt + ($x->{_es} . $MBI->_num($x->{_e}));
+ my $dbd = $dbt + ($x->{_es} . $LIB->_num($x->{_e}));
# should be the same, so treat it as this
$scale = 1 if $scale == 0;
# shortcut if already integer
@@ -3586,10 +3653,10 @@ sub bfloor {
# if $x has digits after dot
if ($x->{_es} eq '-') {
- $x->{_m} = $MBI->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot
- $x->{_e} = $MBI->_zero(); # trunc/norm
+ $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot
+ $x->{_e} = $LIB->_zero(); # trunc/norm
$x->{_es} = '+'; # abs e
- $x->{_m} = $MBI->_inc($x->{_m}) if $x->{sign} eq '-'; # increment if negative
+ $x->{_m} = $LIB->_inc($x->{_m}) if $x->{sign} eq '-'; # increment if negative
}
$x->round($a, $p, $r);
}
@@ -3603,13 +3670,13 @@ sub bceil {
# if $x has digits after dot
if ($x->{_es} eq '-') {
- $x->{_m} = $MBI->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot
- $x->{_e} = $MBI->_zero(); # trunc/norm
+ $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot
+ $x->{_e} = $LIB->_zero(); # trunc/norm
$x->{_es} = '+'; # abs e
if ($x->{sign} eq '+') {
- $x->{_m} = $MBI->_inc($x->{_m}); # increment if positive
+ $x->{_m} = $LIB->_inc($x->{_m}); # increment if positive
} else {
- $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # avoid -0
+ $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # avoid -0
}
}
$x->round($a, $p, $r);
@@ -3624,10 +3691,10 @@ sub bint {
# if $x has digits after the decimal point
if ($x->{_es} eq '-') {
- $x->{_m} = $MBI->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot
- $x->{_e} = $MBI->_zero(); # truncate/normalize
+ $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot
+ $x->{_e} = $LIB->_zero(); # truncate/normalize
$x->{_es} = '+'; # abs e
- $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # avoid -0
+ $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # avoid -0
}
$x->round($a, $p, $r);
}
@@ -3698,13 +3765,13 @@ sub length {
my $class = ref($x) || $x;
$x = $class->new(shift) unless ref($x);
- return 1 if $MBI->_is_zero($x->{_m});
+ return 1 if $LIB->_is_zero($x->{_m});
- my $len = $MBI->_len($x->{_m});
- $len += $MBI->_num($x->{_e}) if $x->{_es} eq '+';
+ my $len = $LIB->_len($x->{_m});
+ $len += $LIB->_num($x->{_e}) if $x->{_es} eq '+';
if (wantarray()) {
my $t = 0;
- $t = $MBI->_num($x->{_e}) if $x->{_es} eq '-';
+ $t = $LIB->_num($x->{_e}) if $x->{_es} eq '-';
return ($len, $t);
}
$len;
@@ -3719,7 +3786,7 @@ sub mantissa {
$s =~ s/^[+]//;
return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
}
- my $m = Math::BigInt->new($MBI->_str($x->{_m}), undef, undef);
+ my $m = Math::BigInt->new($LIB->_str($x->{_m}), undef, undef);
$m->bneg() if $x->{sign} eq '-';
$m;
@@ -3734,7 +3801,7 @@ sub exponent {
$s =~ s/^[+-]//;
return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
}
- Math::BigInt->new($x->{_es} . $MBI->_str($x->{_e}), undef, undef);
+ Math::BigInt->new($x->{_es} . $LIB->_str($x->{_e}), undef, undef);
}
sub parts {
@@ -3749,16 +3816,16 @@ $se =~ s/^[-]//;
return ($class->new($s), $class->new($se)); # +inf => inf and -inf, +inf => inf
}
my $m = Math::BigInt->bzero();
- $m->{value} = $MBI->_copy($x->{_m});
+ $m->{value} = $LIB->_copy($x->{_m});
$m->bneg() if $x->{sign} eq '-';
- ($m, Math::BigInt->new($x->{_es} . $MBI->_num($x->{_e})));
+ ($m, Math::BigInt->new($x->{_es} . $LIB->_num($x->{_e})));
}
sub sparts {
my $self = shift;
my $class = ref $self;
- Carp::croak("sparts() is an instance method, not a class method")
+ croak("sparts() is an instance method, not a class method")
unless $class;
# Not-a-number.
@@ -3783,12 +3850,12 @@ sub sparts {
my $mant = $class -> bzero();
$mant -> {sign} = $self -> {sign};
- $mant -> {_m} = $MBI->_copy($self -> {_m});
+ $mant -> {_m} = $LIB->_copy($self -> {_m});
return $mant unless wantarray;
my $expo = $class -> bzero();
$expo -> {sign} = $self -> {_es};
- $expo -> {_m} = $MBI->_copy($self -> {_e});
+ $expo -> {_m} = $LIB->_copy($self -> {_e});
return ($mant, $expo);
}
@@ -3797,7 +3864,7 @@ sub nparts {
my $self = shift;
my $class = ref $self;
- Carp::croak("nparts() is an instance method, not a class method")
+ croak("nparts() is an instance method, not a class method")
unless $class;
# Not-a-number.
@@ -3843,7 +3910,7 @@ sub eparts {
my $self = shift;
my $class = ref $self;
- Carp::croak("eparts() is an instance method, not a class method")
+ croak("eparts() is an instance method, not a class method")
unless $class;
# Not-a-number and Infinity.
@@ -3866,7 +3933,7 @@ sub dparts {
my $self = shift;
my $class = ref $self;
- Carp::croak("dparts() is an instance method, not a class method")
+ croak("dparts() is an instance method, not a class method")
unless $class;
# Not-a-number and Infinity.
@@ -3884,10 +3951,10 @@ sub dparts {
# If the input has a fraction part.
if ($int->{_es} eq '-') {
- $int->{_m} = $MBI -> _rsft($int->{_m}, $int->{_e}, 10);
- $int->{_e} = $MBI -> _zero();
+ $int->{_m} = $LIB -> _rsft($int->{_m}, $int->{_e}, 10);
+ $int->{_e} = $LIB -> _zero();
$int->{_es} = '+';
- $int->{sign} = '+' if $MBI->_is_zero($int->{_m}); # avoid -0
+ $int->{sign} = '+' if $LIB->_is_zero($int->{_m}); # avoid -0
return $int unless wantarray;
$frc = $self -> copy() -> bsub($int);
@@ -3919,11 +3986,11 @@ my $cad = 0;
my $dot = '.';
# $x is zero?
- my $not_zero = !($x->{sign} eq '+' && $MBI->_is_zero($x->{_m}));
+ my $not_zero = !($x->{sign} eq '+' && $LIB->_is_zero($x->{_m}));
if ($not_zero) {
- $es = $MBI->_str($x->{_m});
+ $es = $LIB->_str($x->{_m});
$len = CORE::length($es);
- my $e = $MBI->_num($x->{_e});
+ my $e = $LIB->_num($x->{_e});
$e = -$e if $x->{_es} eq '-';
if ($e < 0) {
$dot = '';
@@ -3934,7 +4001,7 @@ my $dot = '.';
$cad = -($len+$r);
} else {
substr($es, $e, 0) = '.';
- $cad = $MBI->_num($x->{_e});
+ $cad = $LIB->_num($x->{_e});
$cad = -$cad if $x->{_es} eq '-';
}
} elsif ($e > 0) {
@@ -3970,7 +4037,7 @@ sub bdstr {
return 'inf'; # +inf
}
- my $mant = $MBI->_str($x->{_m});
+ my $mant = $LIB->_str($x->{_m});
my $expo = $x -> exponent();
my $str = $mant;
@@ -3997,7 +4064,7 @@ sub bsstr {
return 'inf'; # +inf
}
- my $str = $MBI->_str($x->{_m}) . 'e' . $x->{_es}. $MBI->_str($x->{_e});
+ my $str = $LIB->_str($x->{_m}) . 'e' . $x->{_es}. $LIB->_str($x->{_e});
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -4049,11 +4116,11 @@ sub to_hex {
return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex?
- my $z = $MBI->_copy($x->{_m});
- if (! $MBI->_is_zero($x->{_e})) { # > 0
- $z = $MBI->_lsft($z, $x->{_e}, 10);
+ my $z = $LIB->_copy($x->{_m});
+ if (! $LIB->_is_zero($x->{_e})) { # > 0
+ $z = $LIB->_lsft($z, $x->{_e}, 10);
}
- my $str = $MBI->_to_hex($z);
+ my $str = $LIB->_to_hex($z);
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -4067,11 +4134,11 @@ sub to_oct {
return $nan if $x->{_es} ne '+'; # how to do 1e-1 in octal?
- my $z = $MBI->_copy($x->{_m});
- if (! $MBI->_is_zero($x->{_e})) { # > 0
- $z = $MBI->_lsft($z, $x->{_e}, 10);
+ my $z = $LIB->_copy($x->{_m});
+ if (! $LIB->_is_zero($x->{_e})) { # > 0
+ $z = $LIB->_lsft($z, $x->{_e}, 10);
}
- my $str = $MBI->_to_oct($z);
+ my $str = $LIB->_to_oct($z);
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -4085,11 +4152,11 @@ sub to_bin {
return $nan if $x->{_es} ne '+'; # how to do 1e-1 in binary?
- my $z = $MBI->_copy($x->{_m});
- if (! $MBI->_is_zero($x->{_e})) { # > 0
- $z = $MBI->_lsft($z, $x->{_e}, 10);
+ my $z = $LIB->_copy($x->{_m});
+ if (! $LIB->_is_zero($x->{_e})) { # > 0
+ $z = $LIB->_lsft($z, $x->{_e}, 10);
}
- my $str = $MBI->_to_bin($z);
+ my $str = $LIB->_to_bin($z);
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -4103,11 +4170,11 @@ sub as_hex {
return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex?
- my $z = $MBI->_copy($x->{_m});
- if (! $MBI->_is_zero($x->{_e})) { # > 0
- $z = $MBI->_lsft($z, $x->{_e}, 10);
+ my $z = $LIB->_copy($x->{_m});
+ if (! $LIB->_is_zero($x->{_e})) { # > 0
+ $z = $LIB->_lsft($z, $x->{_e}, 10);
}
- my $str = $MBI->_as_hex($z);
+ my $str = $LIB->_as_hex($z);
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -4121,11 +4188,11 @@ sub as_oct {
return $nan if $x->{_es} ne '+'; # how to do 1e-1 in octal?
- my $z = $MBI->_copy($x->{_m});
- if (! $MBI->_is_zero($x->{_e})) { # > 0
- $z = $MBI->_lsft($z, $x->{_e}, 10);
+ my $z = $LIB->_copy($x->{_m});
+ if (! $LIB->_is_zero($x->{_e})) { # > 0
+ $z = $LIB->_lsft($z, $x->{_e}, 10);
}
- my $str = $MBI->_as_oct($z);
+ my $str = $LIB->_as_oct($z);
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -4139,11 +4206,11 @@ sub as_bin {
return $nan if $x->{_es} ne '+'; # how to do 1e-1 in binary?
- my $z = $MBI->_copy($x->{_m});
- if (! $MBI->_is_zero($x->{_e})) { # > 0
- $z = $MBI->_lsft($z, $x->{_e}, 10);
+ my $z = $LIB->_copy($x->{_m});
+ if (! $LIB->_is_zero($x->{_e})) { # > 0
+ $z = $LIB->_lsft($z, $x->{_e}, 10);
}
- my $str = $MBI->_as_bin($z);
+ my $str = $LIB->_as_bin($z);
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -4199,7 +4266,7 @@ my @a;
} elsif ($_[$i] eq 'with') {
# alternative class for our private parts()
# XXX: no longer supported
- # $MBI = $_[$i+1] || 'Math::BigInt';
+ # $LIB = $_[$i+1] || 'Math::BigInt';
$i++;
} else {
push @a, $_[$i];
@@ -4209,11 +4276,11 @@ my @a;
$lib =~ tr/a-zA-Z0-9,://cd; # restrict to sane characters
# let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
my $mbilib = eval { Math::BigInt->config('lib') };
- if ((defined $mbilib) && ($MBI eq 'Math::BigInt::Calc')) {
- # MBI already loaded
+ if ((defined $mbilib) && ($LIB eq 'Math::BigInt::Calc')) {
+ # $LIB already loaded
Math::BigInt->import($lib_kind, "$lib, $mbilib", 'objectify');
} else {
- # MBI not loaded, or with ne "Math::BigInt::Calc"
+ # $LIB not loaded, or with ne "Math::BigInt::Calc"
$lib .= ",$mbilib" if defined $mbilib;
$lib =~ s/^,//; # don't leave empty
@@ -4225,13 +4292,13 @@ my @a;
Math::BigInt->import($lib_kind => $lib, 'objectify');
}
if ($@) {
- Carp::croak("Couldn't load $lib: $! $@");
+ croak("Couldn't load $lib: $! $@");
}
# find out which one was actually loaded
- $MBI = Math::BigInt->config('lib');
+ $LIB = Math::BigInt->config('lib');
# register us with MBI to get notified of future lib changes
- Math::BigInt::_register_callback($class, sub { $MBI = $_[0]; });
+ Math::BigInt::_register_callback($class, sub { $LIB = $_[0]; });
$class->export_to_level(1, $class, @a); # export wanted functions
}
@@ -4268,7 +4335,8 @@ my $r = $d;
sub _log {
# internal log function to calculate ln() based on Taylor series.
# Modifies $x in place.
- my ($class, $x, $scale) = @_;
+ my ($x, $scale) = @_;
+ my $class = ref $x;
# in case of $x == 1, result is 0
return $x->bzero() if $x->is_one();
@@ -4290,7 +4358,7 @@ sub _log {
# ln (x) = 2 | --- + - * --- + - * --- + ... | x > 1/2
# |_ x 2 x^2 3 x^3 _|
- my ($limit, $v, $u, $below, $factor, $two, $next, $over, $f);
+ my ($limit, $v, $u, $below, $factor, $next, $over, $f);
$v = $x->copy(); $v->binc(); # v = x+1
$x->bdec(); $u = $x->copy(); # u = x-1; x = x-1
@@ -4304,6 +4372,7 @@ sub _log {
my $steps = 0;
$limit = $class->new("1E-". ($scale-1));
+
while (3 < 5) {
# we calculate the next term, and add it to the last
# when the next term is below our limit, it won't affect the outcome
@@ -4337,19 +4406,15 @@ sub _log {
$over *= $u;
$below *= $v;
$factor->badd($f);
- if (DEBUG) {
- $steps++;
- print "step $steps = $x\n" if $steps % 10 == 0;
- }
}
- print "took $steps steps\n" if DEBUG;
$x->bmul($f); # $x *= 2
}
sub _log_10 {
# Internal log function based on reducing input to the range of 0.1 .. 9.99
# and then "correcting" the result to the proper one. Modifies $x in place.
- my ($class, $x, $scale) = @_;
+ my ($x, $scale) = @_;
+ my $class = ref $x;
# Taking blog() from numbers greater than 10 takes a *very long* time, so we
# break the computation down into parts based on the observation that:
@@ -4365,16 +4430,18 @@ sub _log_10 {
# To get $x even closer to 1, we also divide by 2 and then use log(2) to
# correct for this. For instance if $x is 2.4, we use the formula:
- # blog(2.4 * 2) == blog (1.2) + blog(2)
+ # blog(2.4 * 2) == blog(1.2) + blog(2)
# and thus calculate only blog(1.2) and blog(2), which is faster in total
# than calculating blog(2.4).
# In addition, the values for blog(2) and blog(10) are cached.
- # Calculate nr of digits before dot:
- my $dbd = $MBI->_num($x->{_e});
+ # Calculate nr of digits before dot. x = 123, dbd = 3; x = 1.23, dbd = 1;
+ # x = 0.0123, dbd = -1; x = 0.000123, dbd = -3, etc.
+
+ my $dbd = $LIB->_num($x->{_e});
$dbd = -$dbd if $x->{_es} eq '-';
- $dbd += $MBI->_len($x->{_m});
+ $dbd += $LIB->_len($x->{_m});
# more than one digit (e.g. at least 10), but *not* exactly 10 to avoid
# infinite recursion
@@ -4383,7 +4450,10 @@ sub _log_10 {
# disable the shortcut for 10, since we need log(10) and this would recurse
# infinitely deep
- if ($x->{_es} eq '+' && $MBI->_is_one($x->{_e}) && $MBI->_is_one($x->{_m})) {
+ if ($x->{_es} eq '+' && # $x == 10
+ ($LIB->_is_one($x->{_e}) &&
+ $LIB->_is_one($x->{_m})))
+ {
$dbd = 0; # disable shortcut
# we can use the cached value in these cases
if ($scale <= $LOG_10_A) {
@@ -4394,7 +4464,9 @@ sub _log_10 {
# if we can't use the shortcut, we continue normally
} else {
# disable the shortcut for 2, since we maybe have it cached
- if (($MBI->_is_zero($x->{_e}) && $MBI->_is_two($x->{_m}))) {
+ if (($LIB->_is_zero($x->{_e}) && # $x == 2
+ $LIB->_is_two($x->{_m})))
+ {
$dbd = 0; # disable shortcut
# we can use the cached value in these cases
if ($scale <= $LOG_2_A) {
@@ -4407,8 +4479,11 @@ sub _log_10 {
}
# if $x = 0.1, we know the result must be 0-log(10)
- if ($calc != 0 && $x->{_es} eq '-' && $MBI->_is_one($x->{_e}) &&
- $MBI->_is_one($x->{_m})) {
+ if ($calc != 0 &&
+ ($x->{_es} eq '-' && # $x == 0.1
+ ($LIB->_is_one($x->{_e}) &&
+ $LIB->_is_one($x->{_m}))))
+ {
$dbd = 0; # disable shortcut
# we can use the cached value in these cases
if ($scale <= $LOG_10_A) {
@@ -4418,7 +4493,7 @@ sub _log_10 {
}
}
- return if $calc == 0; # already have the result
+ return $x if $calc == 0; # already have the result
# default: these correction factors are undef and thus not used
my $l_10; # value of ln(10) to A of $scale
@@ -4459,7 +4534,7 @@ sub _log_10 {
} else {
# else: slower, compute and cache result
$l_2 = $two->copy();
- $class->_log($l_2, $scale); # scale+4, actually
+ $l_2->_log($scale); # scale+4, actually
$LOG_2 = $l_2->copy(); # cache the result for later
# the copy() is for mul below
$LOG_2_A = $scale;
@@ -4467,7 +4542,7 @@ sub _log_10 {
# now calculate log(1.25):
$l_10 = $class->new('1.25');
- $class->_log($l_10, $scale); # scale+4, actually
+ $l_10->_log($scale); # scale+4, actually
# log(1.25) + log(2) + log(2) + log(2):
$l_10->badd($l_2);
@@ -4485,7 +4560,7 @@ sub _log_10 {
$dbd_sign = '-';
}
($x->{_e}, $x->{_es}) =
- _e_sub($x->{_e}, $MBI->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23
+ _e_sub($x->{_e}, $LIB->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23
}
@@ -4518,7 +4593,7 @@ sub _log_10 {
# also disable downgrade for this code path
local $Math::BigFloat::downgrade = undef;
$l_2 = $two->copy();
- $class->_log($l_2, $scale); # scale+4, actually
+ $l_2->_log($scale); # scale+4, actually
$LOG_2 = $l_2->copy(); # cache the result for later
# the copy() is for mul below
$LOG_2_A = $scale;
@@ -4528,7 +4603,7 @@ sub _log_10 {
undef $l_2;
}
- $class->_log($x, $scale); # need to do the "normal" way
+ $x->_log($scale); # need to do the "normal" way
$x->badd($l_10) if defined $l_10; # correct it by ln(10)
$x->badd($l_2) if defined $l_2; # and maybe by ln(2)
@@ -4538,39 +4613,39 @@ sub _log_10 {
sub _e_add {
# Internal helper sub to take two positive integers and their signs and
- # then add them. Input ($CALC, $CALC, ('+'|'-'), ('+'|'-')), output
- # ($CALC, ('+'|'-')).
+ # then add them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')), output
+ # ($LIB, ('+'|'-')).
my ($x, $y, $xs, $ys) = @_;
# if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
if ($xs eq $ys) {
- $x = $MBI->_add($x, $y); # +a + +b or -a + -b
+ $x = $LIB->_add($x, $y); # +a + +b or -a + -b
} else {
- my $a = $MBI->_acmp($x, $y);
+ my $a = $LIB->_acmp($x, $y);
if ($a == 0) {
# This does NOT modify $x in-place. TODO: Fix this?
- $x = $MBI->_zero(); # result is 0
+ $x = $LIB->_zero(); # result is 0
$xs = '+';
return ($x, $xs);
}
if ($a > 0) {
- $x = $MBI->_sub($x, $y); # abs sub
+ $x = $LIB->_sub($x, $y); # abs sub
} else { # a < 0
- $x = $MBI->_sub ($y, $x, 1); # abs sub
+ $x = $LIB->_sub ($y, $x, 1); # abs sub
$xs = $ys;
}
}
- $xs = '+' if $xs eq '-' && $MBI->_is_zero($x); # no "-0"
+ $xs = '+' if $xs eq '-' && $LIB->_is_zero($x); # no "-0"
return ($x, $xs);
}
sub _e_sub {
# Internal helper sub to take two positive integers and their signs and
- # then subtract them. Input ($CALC, $CALC, ('+'|'-'), ('+'|'-')),
- # output ($CALC, ('+'|'-'))
+ # then subtract them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')),
+ # output ($LIB, ('+'|'-'))
my ($x, $y, $xs, $ys) = @_;
# flip sign
@@ -4706,7 +4781,7 @@ Math::BigFloat - Arbitrary size floating point math package
Math::BigFloat->round_mode($m); # set global round mode, must be one of
# 'even', 'odd', '+inf', '-inf', 'zero',
# 'trunc', or 'common'
- Math::BigFloat->config(); # return hash with configuration
+ Math::BigFloat->config("lib"); # name of backend math library
# Constructor methods (when the class methods below are used as instance
# methods, the value is assigned the invocand)
@@ -4791,7 +4866,7 @@ Math::BigFloat - Arbitrary size floating point math package
$x->bcos(); # cosine
$x->batan(); # inverse tangent
$x->batan2($y); # two-argument inverse tangent
- $x->bsqrt(); # calculate square-root
+ $x->bsqrt(); # calculate square root
$x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root)
$x->bfac(); # factorial of $x (1*2*3*4*..$x)
@@ -5062,7 +5137,7 @@ This method was added in v1.87 of Math::BigInt (June 2007).
In scalar context, divides $x by $y and returns the result to the given or
default accuracy/precision. 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)>.
+$r. The remainer (modulo) is equal to what is returned by C<< $x->bmod($y) >>.
=item bmod()
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm
index 04dec98bc5..2fc069370a 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm
@@ -13,7 +13,7 @@ our ($accuracy, $precision, $round_mode, $div_scale);
our @ISA = qw(Exporter Math::BigFloat);
-our $VERSION = '0.49';
+our $VERSION = '0.51';
use overload; # inherit overload from Math::BigFloat
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm
index 9fd9bd02ba..a443cd4a5d 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm
@@ -11,17 +11,18 @@ package Math::BigInt;
# _a : accuracy
# _p : precision
-# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
+# Remember not to take shortcuts ala $xs = $x->{value}; $LIB->foo($xs); since
# underlying lib might change the reference!
use 5.006001;
use strict;
use warnings;
-use Carp ();
+use Carp qw< carp croak >;
-our $VERSION = '1.999811';
+our $VERSION = '1.999816';
+require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(objectify bgcd blcm);
@@ -79,7 +80,6 @@ use overload
'**=' => sub { $_[0]->bpow($_[1]); },
-
'<<=' => sub { $_[0]->blsft($_[1]); },
'>>=' => sub { $_[0]->brsft($_[1]); },
@@ -228,12 +228,11 @@ our $_trap_inf = 0; # are infs ok? set w/ config()
my $nan = 'NaN'; # constants for easier life
-my $CALC = 'Math::BigInt::Calc'; # module to do the low level math
+my $LIB = 'Math::BigInt::Calc'; # module to do the low level math
# default is Calc.pm
my $IMPORT = 0; # was import() called yet?
# used to make require work
my %WARN; # warn only once for low-level libs
-my %CAN; # cache for $CALC->can(...)
my %CALLBACKS; # callbacks to notify on lib loads
my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
@@ -277,7 +276,7 @@ sub round_mode {
if (defined $_[0]) {
my $m = shift;
if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/) {
- Carp::croak("Unknown round mode '$m'");
+ croak("Unknown round mode '$m'");
}
return ${"${class}::round_mode"} = $m;
}
@@ -315,7 +314,7 @@ sub div_scale {
my $class = ref($self) || $self || __PACKAGE__;
if (defined $_[0]) {
if ($_[0] < 0) {
- Carp::croak('div_scale must be greater than zero');
+ croak('div_scale must be greater than zero');
}
${"${class}::div_scale"} = $_[0];
}
@@ -332,42 +331,40 @@ sub accuracy {
my $class = ref($x) || $x || __PACKAGE__;
no strict 'refs';
- # need to set new value?
if (@_ > 0) {
my $a = shift;
- # convert objects to scalars to avoid deep recursion. If object doesn't
- # have numify(), then hopefully it will have overloading for int() and
- # boolean test without wandering into a deep recursion path...
- $a = $a->numify() if ref($a) && $a->can('numify');
-
if (defined $a) {
+ $a = $a->numify() if ref($a) && $a->can('numify');
# also croak on non-numerical
if (!$a || $a <= 0) {
- Carp::croak('Argument to accuracy must be greater than zero');
+ croak('Argument to accuracy must be greater than zero');
}
if (int($a) != $a) {
- Carp::croak('Argument to accuracy must be an integer');
+ croak('Argument to accuracy must be an integer');
}
}
+
if (ref($x)) {
- # $object->accuracy() or fallback to global
+ # Set instance variable.
$x->bround($a) if $a; # not for undef, 0
$x->{_a} = $a; # set/overwrite, even if not rounded
delete $x->{_p}; # clear P
+ # Why return class variable here? Fixme!
$a = ${"${class}::accuracy"} unless defined $a; # proper return value
} else {
+ # Set class variable.
${"${class}::accuracy"} = $a; # set global A
${"${class}::precision"} = undef; # clear global P
}
+
return $a; # shortcut
}
- my $a;
- # $object->accuracy() or fallback to global
- $a = $x->{_a} if ref($x);
- # but don't return global undef, when $x's accuracy is 0!
- $a = ${"${class}::accuracy"} if !defined $a;
- $a;
+ # Return instance variable.
+ return $x->{_a} if ref($x) && (defined $x->{_a} || defined $x->{_p});
+
+ # Return class variable.
+ return ${"${class}::accuracy"};
}
sub precision {
@@ -382,36 +379,38 @@ sub precision {
no strict 'refs';
if (@_ > 0) {
my $p = shift;
- # convert objects to scalars to avoid deep recursion. If object doesn't
- # have numify(), then hopefully it will have overloading for int() and
- # boolean test without wandering into a deep recursion path...
- $p = $p->numify() if ref($p) && $p->can('numify');
- if ((defined $p) && (int($p) != $p)) {
- Carp::croak('Argument to precision must be an integer');
+ if (defined $p) {
+ $p = $p->numify() if ref($p) && $p->can('numify');
+ if ($p != int $p) {
+ croak('Argument to precision must be an integer');
+ }
}
+
if (ref($x)) {
- # $object->precision() or fallback to global
+ # Set instance variable.
$x->bfround($p) if $p; # not for undef, 0
$x->{_p} = $p; # set/overwrite, even if not rounded
delete $x->{_a}; # clear A
+ # Why return class variable here? Fixme!
$p = ${"${class}::precision"} unless defined $p; # proper return value
} else {
+ # Set class variable.
${"${class}::precision"} = $p; # set global P
${"${class}::accuracy"} = undef; # clear global A
}
+
return $p; # shortcut
}
- my $p;
- # $object->precision() or fallback to global
- $p = $x->{_p} if ref($x);
- # but don't return global undef, when $x's precision is 0!
- $p = ${"${class}::precision"} if !defined $p;
- $p;
+ # Return instance variable.
+ return $x->{_p} if ref($x) && (defined $x->{_a} || defined $x->{_p});
+
+ # Return class variable.
+ return ${"${class}::precision"};
}
sub config {
- # return (or set) configuration data as hash ref
+ # return (or set) configuration data.
my $class = shift || __PACKAGE__;
no strict 'refs';
@@ -435,7 +434,7 @@ sub config {
delete $args->{$key};
}
if (keys %$args > 0) {
- Carp::croak("Illegal key(s) '", join("', '", keys %$args),
+ croak("Illegal key(s) '", join("', '", keys %$args),
"' passed to $class\->config()");
}
foreach my $key (keys %$set_args) {
@@ -451,8 +450,8 @@ sub config {
# now return actual configuration
my $cfg = {
- lib => $CALC,
- lib_version => ${"${CALC}::VERSION"},
+ lib => $LIB,
+ lib_version => ${"${LIB}::VERSION"},
class => $class,
trap_nan => ${"${class}::_trap_nan"},
trap_inf => ${"${class}::_trap_inf"},
@@ -548,14 +547,14 @@ sub new {
my ($wanted, $a, $p, $r) = @_;
- # Always return a new object, so it called as an instance method, copy the
+ # Always return a new object, so if called as an instance method, copy the
# invocand, and if called as a class method, initialize a new object.
$self = $selfref ? $self -> copy()
: bless {}, $class;
unless (defined $wanted) {
- #Carp::carp("Use of uninitialized value in new()");
+ #carp("Use of uninitialized value in new()");
return $self->bzero($a, $p, $r);
}
@@ -586,7 +585,7 @@ sub new {
my $sgn = $1;
my $abs = $2;
$self->{sign} = $sgn || '+';
- $self->{value} = $CALC->_new($abs);
+ $self->{value} = $LIB->_new($abs);
no strict 'refs';
if (defined($a) || defined($p)
@@ -636,9 +635,9 @@ sub new {
my ($mis, $miv, $mfv, $es, $ev) = _split($wanted);
if (!ref $mis) {
if ($_trap_nan) {
- Carp::croak("$wanted is not a number in $class");
+ croak("$wanted is not a number in $class");
}
- $self->{value} = $CALC->_zero();
+ $self->{value} = $LIB->_zero();
$self->{sign} = $nan;
return $self;
}
@@ -653,13 +652,13 @@ sub new {
# Make integer from mantissa by adjusting exponent, then convert to a
# Math::BigInt.
$self->{sign} = $$mis; # store sign
- $self->{value} = $CALC->_zero(); # for all the NaN cases
+ $self->{value} = $LIB->_zero(); # for all the NaN cases
my $e = int("$$es$$ev"); # exponent (avoid recursion)
if ($e > 0) {
my $diff = $e - CORE::length($$mfv);
if ($diff < 0) { # Not integer
if ($_trap_nan) {
- Carp::croak("$wanted not an integer in $class");
+ croak("$wanted not an integer in $class");
}
#print "NOI 1\n";
return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
@@ -675,7 +674,7 @@ sub new {
if ($$mfv ne '') { # e <= 0
# fraction and negative/zero E => NOI
if ($_trap_nan) {
- Carp::croak("$wanted not an integer in $class");
+ croak("$wanted not an integer in $class");
}
#print "NOI 2 \$\$mfv '$$mfv'\n";
return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
@@ -690,7 +689,7 @@ sub new {
if ($frac =~ /[^0]/) {
if ($_trap_nan) {
- Carp::croak("$wanted not an integer in $class");
+ croak("$wanted not an integer in $class");
}
#print "NOI 3\n";
return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
@@ -701,7 +700,7 @@ sub new {
unless ($self->{sign} eq $nan) {
$self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
- $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/;
+ $self->{value} = $LIB->_new($$miv) if $self->{sign} =~ /^[+-]$/;
}
# If any of the globals are set, use them to round, and store them inside
@@ -752,11 +751,11 @@ sub from_hex {
# The library method requires a prefix.
- $self->{value} = $CALC->_from_hex('0x' . $chrs);
+ $self->{value} = $LIB->_from_hex('0x' . $chrs);
# Place the sign.
- $self->{sign} = $sign eq '-' && ! $CALC->_is_zero($self->{value})
+ $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value})
? '-' : '+';
return $self;
@@ -807,11 +806,11 @@ sub from_oct {
# The library method requires a prefix.
- $self->{value} = $CALC->_from_oct('0' . $chrs);
+ $self->{value} = $LIB->_from_oct('0' . $chrs);
# Place the sign.
- $self->{sign} = $sign eq '-' && ! $CALC->_is_zero($self->{value})
+ $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value})
? '-' : '+';
return $self;
@@ -863,11 +862,11 @@ sub from_bin {
# The library method requires a prefix.
- $self->{value} = $CALC->_from_bin('0b' . $chrs);
+ $self->{value} = $LIB->_from_bin('0b' . $chrs);
# Place the sign.
- $self->{sign} = $sign eq '-' && ! $CALC->_is_zero($self->{value})
+ $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value})
? '-' : '+';
return $self;
@@ -877,6 +876,7 @@ sub from_bin {
# input is invalid.
return $self->bnan();
+
}
# Create a Math::BigInt from a byte string.
@@ -890,8 +890,8 @@ sub from_bytes {
return if $selfref && $self->modify('from_bytes');
- Carp::croak("from_bytes() requires a newer version of the $CALC library.")
- unless $CALC->can('_from_bytes');
+ croak("from_bytes() requires a newer version of the $LIB library.")
+ unless $LIB->can('_from_bytes');
my $str = shift;
@@ -899,15 +899,59 @@ sub from_bytes {
$self = $class -> bzero() unless $selfref;
$self -> {sign} = '+';
- $self -> {value} = $CALC -> _from_bytes($str);
+ $self -> {value} = $LIB -> _from_bytes($str);
return $self;
}
+sub from_base {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
+
+ # Don't modify constant (read-only) objects.
+
+ return if $selfref && $self->modify('from_base');
+
+ my $str = shift;
+
+ my $base = shift;
+ $base = $class->new($base) unless ref($base);
+
+ croak("the base must be a finite integer >= 2")
+ if $base < 2 || ! $base -> is_int();
+
+ # If called as a class method, initialize a new object.
+
+ $self = $class -> bzero() unless $selfref;
+
+ # If no collating sequence is given, pass some of the conversions to
+ # methods optimized for those cases.
+
+ if (! @_) {
+ return $self -> from_bin($str) if $base == 2;
+ return $self -> from_oct($str) if $base == 8;
+ return $self -> from_hex($str) if $base == 16;
+ if ($base == 10) {
+ my $tmp = $class -> new($str);
+ $self -> {value} = $tmp -> {value};
+ $self -> {sign} = '+';
+ }
+ }
+
+ croak("from_base() requires a newer version of the $LIB library.")
+ unless $LIB->can('_from_base');
+
+ $self -> {sign} = '+';
+ $self -> {value}
+ = $LIB->_from_base($str, $base -> {value}, @_ ? shift() : ());
+ return $self
+}
+
sub bzero {
# create/assign '+0'
if (@_ == 0) {
- #Carp::carp("Using bzero() as a function is deprecated;",
+ #carp("Using bzero() as a function is deprecated;",
# " use bzero() as a method instead");
unshift @_, __PACKAGE__;
}
@@ -925,18 +969,21 @@ sub bzero {
$self = bless {}, $class unless $selfref;
$self->{sign} = '+';
- $self->{value} = $CALC->_zero();
+ $self->{value} = $LIB->_zero();
- if (@_ > 0) {
- if (@_ > 3) {
- # call like: $x->bzero($a, $p, $r, $y, ...);
- ($self, $self->{_a}, $self->{_p}) = $self->_find_round_parameters(@_);
- } else {
- # call like: $x->bzero($a, $p, $r);
- $self->{_a} = $_[0]
- if !defined $self->{_a} || (defined $_[0] && $_[0] > $self->{_a});
- $self->{_p} = $_[1]
- if !defined $self->{_p} || (defined $_[1] && $_[1] > $self->{_p});
+ # If rounding parameters are given as arguments, use them. If no rounding
+ # parameters are given, and if called as a class method initialize the new
+ # instance with the class variables.
+
+ if (@_) {
+ croak "can't specify both accuracy and precision"
+ if @_ >= 2 && defined $_[0] && defined $_[1];
+ $self->{_a} = $_[0];
+ $self->{_p} = $_[1];
+ } else {
+ unless($selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
}
}
@@ -947,7 +994,7 @@ sub bone {
# Create or assign '+1' (or -1 if given sign '-').
if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) {
- #Carp::carp("Using bone() as a function is deprecated;",
+ #carp("Using bone() as a function is deprecated;",
# " use bone() as a method instead");
unshift @_, __PACKAGE__;
}
@@ -962,24 +1009,30 @@ sub bone {
return if $selfref && $self->modify('bone');
- my $sign = shift;
- $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+";
+ my $sign = '+'; # default
+ if (@_) {
+ $sign = shift;
+ $sign = $sign =~ /^\s*-/ ? "-" : "+";
+ }
$self = bless {}, $class unless $selfref;
$self->{sign} = $sign;
- $self->{value} = $CALC->_one();
+ $self->{value} = $LIB->_one();
- if (@_ > 0) {
- if (@_ > 3) {
- # call like: $x->bone($sign, $a, $p, $r, $y, ...);
- ($self, $self->{_a}, $self->{_p}) = $self->_find_round_parameters(@_);
- } else {
- # call like: $x->bone($sign, $a, $p, $r);
- $self->{_a} = $_[0]
- if !defined $self->{_a} || (defined $_[0] && $_[0] > $self->{_a});
- $self->{_p} = $_[1]
- if !defined $self->{_p} || (defined $_[1] && $_[1] > $self->{_p});
+ # If rounding parameters are given as arguments, use them. If no rounding
+ # parameters are given, and if called as a class method initialize the new
+ # instance with the class variables.
+
+ if (@_) {
+ croak "can't specify both accuracy and precision"
+ if @_ >= 2 && defined $_[0] && defined $_[1];
+ $self->{_a} = $_[0];
+ $self->{_p} = $_[1];
+ } else {
+ unless($selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
}
}
@@ -992,7 +1045,7 @@ sub binf {
if (@_ == 0 || (defined($_[0]) && !ref($_[0]) &&
$_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/))
{
- #Carp::carp("Using binf() as a function is deprecated;",
+ #carp("Using binf() as a function is deprecated;",
# " use binf() as a method instead");
unshift @_, __PACKAGE__;
}
@@ -1004,7 +1057,7 @@ sub binf {
{
no strict 'refs';
if (${"${class}::_trap_inf"}) {
- Carp::croak("Tried to create +-inf in $class->binf()");
+ croak("Tried to create +-inf in $class->binf()");
}
}
@@ -1020,7 +1073,23 @@ sub binf {
$self = bless {}, $class unless $selfref;
$self -> {sign} = $sign . 'inf';
- $self -> {value} = $CALC -> _zero();
+ $self -> {value} = $LIB -> _zero();
+
+ # If rounding parameters are given as arguments, use them. If no rounding
+ # parameters are given, and if called as a class method initialize the new
+ # instance with the class variables.
+
+ if (@_) {
+ croak "can't specify both accuracy and precision"
+ if @_ >= 2 && defined $_[0] && defined $_[1];
+ $self->{_a} = $_[0];
+ $self->{_p} = $_[1];
+ } else {
+ unless($selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
+ }
+ }
return $self;
}
@@ -1029,7 +1098,7 @@ sub bnan {
# create/assign a 'NaN'
if (@_ == 0) {
- #Carp::carp("Using bnan() as a function is deprecated;",
+ #carp("Using bnan() as a function is deprecated;",
# " use bnan() as a method instead");
unshift @_, __PACKAGE__;
}
@@ -1041,7 +1110,7 @@ sub bnan {
{
no strict 'refs';
if (${"${class}::_trap_nan"}) {
- Carp::croak("Tried to create NaN in $class->bnan()");
+ croak("Tried to create NaN in $class->bnan()");
}
}
@@ -1054,7 +1123,7 @@ sub bnan {
$self = bless {}, $class unless $selfref;
$self -> {sign} = $nan;
- $self -> {value} = $CALC -> _zero();
+ $self -> {value} = $LIB -> _zero();
return $self;
}
@@ -1088,7 +1157,7 @@ sub copy {
my $copy = bless {}, $class;
$copy->{sign} = $self->{sign};
- $copy->{value} = $CALC->_copy($self->{value});
+ $copy->{value} = $LIB->_copy($self->{value});
$copy->{_a} = $self->{_a} if exists $self->{_a};
$copy->{_p} = $self->{_p} if exists $self->{_p};
@@ -1111,7 +1180,7 @@ sub is_zero {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
- $CALC->_is_zero($x->{value});
+ $LIB->_is_zero($x->{value});
}
sub is_one {
@@ -1121,7 +1190,7 @@ sub is_one {
$sign = '+' if !defined $sign || $sign ne '-';
return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
- $CALC->_is_one($x->{value});
+ $LIB->_is_one($x->{value});
}
sub is_finite {
@@ -1170,7 +1239,7 @@ sub is_odd {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
- $CALC->_is_odd($x->{value});
+ $LIB->_is_odd($x->{value});
}
sub is_even {
@@ -1178,7 +1247,7 @@ sub is_even {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
- $CALC->_is_even($x->{value});
+ $LIB->_is_even($x->{value});
}
sub is_int {
@@ -1225,11 +1294,11 @@ sub bcmp {
# post-normalized compare for internal use (honors signs)
if ($x->{sign} eq '+') {
# $x and $y both > 0
- return $CALC->_acmp($x->{value}, $y->{value});
+ return $LIB->_acmp($x->{value}, $y->{value});
}
# $x && $y both < 0
- $CALC->_acmp($y->{value}, $x->{value}); # swapped acmp (lib returns 0, 1, -1)
+ $LIB->_acmp($y->{value}, $x->{value}); # swapped acmp (lib returns 0, 1, -1)
}
sub bacmp {
@@ -1252,16 +1321,15 @@ sub bacmp {
return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
return -1;
}
- $CALC->_acmp($x->{value}, $y->{value}); # lib does only 0, 1, -1
+ $LIB->_acmp($x->{value}, $y->{value}); # lib does only 0, 1, -1
}
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;
+ croak 'beq() is an instance method, not a class method' unless $selfref;
+ croak 'Wrong number of arguments for beq()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && ! $cmp;
@@ -1270,10 +1338,9 @@ sub beq {
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;
+ croak 'bne() is an instance method, not a class method' unless $selfref;
+ croak 'Wrong number of arguments for bne()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && ! $cmp ? '' : 1;
@@ -1282,10 +1349,9 @@ sub bne {
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;
+ croak 'blt() is an instance method, not a class method' unless $selfref;
+ croak 'Wrong number of arguments for blt()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp < 0;
@@ -1294,10 +1360,9 @@ sub blt {
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;
+ croak 'ble() is an instance method, not a class method' unless $selfref;
+ croak 'Wrong number of arguments for ble()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp <= 0;
@@ -1306,10 +1371,9 @@ sub ble {
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;
+ croak 'bgt() is an instance method, not a class method' unless $selfref;
+ croak 'Wrong number of arguments for bgt()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp > 0;
@@ -1318,11 +1382,10 @@ sub bgt {
sub bge {
my $self = shift;
my $selfref = ref $self;
- my $class = $selfref || $self;
- Carp::croak 'bge() is an instance method, not a class method'
+ croak 'bge() is an instance method, not a class method'
unless $selfref;
- Carp::croak 'Wrong number of arguments for bge()' unless @_ == 1;
+ croak 'Wrong number of arguments for bge()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp >= 0;
@@ -1340,7 +1403,7 @@ sub 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 '+' && $CALC->_is_zero($x->{value}));
+ $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{value}));
$x;
}
@@ -1380,11 +1443,11 @@ sub binc {
return $x if $x->modify('binc');
if ($x->{sign} eq '+') {
- $x->{value} = $CALC->_inc($x->{value});
+ $x->{value} = $LIB->_inc($x->{value});
return $x->round($a, $p, $r);
} elsif ($x->{sign} eq '-') {
- $x->{value} = $CALC->_dec($x->{value});
- $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
+ $x->{value} = $LIB->_dec($x->{value});
+ $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # -1 +1 => -0 => +0
return $x->round($a, $p, $r);
}
# inf, nan handling etc
@@ -1398,18 +1461,18 @@ sub bdec {
if ($x->{sign} eq '-') {
# x already < 0
- $x->{value} = $CALC->_inc($x->{value});
+ $x->{value} = $LIB->_inc($x->{value});
} else {
return $x->badd($class->bone('-'), @r)
unless $x->{sign} eq '+'; # inf or NaN
# >= 0
- if ($CALC->_is_zero($x->{value})) {
+ if ($LIB->_is_zero($x->{value})) {
# == 0
- $x->{value} = $CALC->_one();
+ $x->{value} = $LIB->_one();
$x->{sign} = '-'; # 0 => -1
} else {
# > 0
- $x->{value} = $CALC->_dec($x->{value});
+ $x->{value} = $LIB->_dec($x->{value});
}
}
$x->round(@r);
@@ -1420,9 +1483,9 @@ sub bdec {
# my $selfref = ref $self;
# my $class = $selfref || $self;
#
-# Carp::croak 'bstrcmp() is an instance method, not a class method'
+# croak 'bstrcmp() is an instance method, not a class method'
# unless $selfref;
-# Carp::croak 'Wrong number of arguments for bstrcmp()' unless @_ == 1;
+# croak 'Wrong number of arguments for bstrcmp()' unless @_ == 1;
#
# return $self -> bstr() CORE::cmp shift;
#}
@@ -1432,9 +1495,9 @@ sub bdec {
# my $selfref = ref $self;
# my $class = $selfref || $self;
#
-# Carp::croak 'bstreq() is an instance method, not a class method'
+# croak 'bstreq() is an instance method, not a class method'
# unless $selfref;
-# Carp::croak 'Wrong number of arguments for bstreq()' unless @_ == 1;
+# croak 'Wrong number of arguments for bstreq()' unless @_ == 1;
#
# my $cmp = $self -> bstrcmp(shift);
# return defined($cmp) && ! $cmp;
@@ -1445,9 +1508,9 @@ sub bdec {
# my $selfref = ref $self;
# my $class = $selfref || $self;
#
-# Carp::croak 'bstrne() is an instance method, not a class method'
+# croak 'bstrne() is an instance method, not a class method'
# unless $selfref;
-# Carp::croak 'Wrong number of arguments for bstrne()' unless @_ == 1;
+# croak 'Wrong number of arguments for bstrne()' unless @_ == 1;
#
# my $cmp = $self -> bstrcmp(shift);
# return defined($cmp) && ! $cmp ? '' : 1;
@@ -1458,9 +1521,9 @@ sub bdec {
# my $selfref = ref $self;
# my $class = $selfref || $self;
#
-# Carp::croak 'bstrlt() is an instance method, not a class method'
+# croak 'bstrlt() is an instance method, not a class method'
# unless $selfref;
-# Carp::croak 'Wrong number of arguments for bstrlt()' unless @_ == 1;
+# croak 'Wrong number of arguments for bstrlt()' unless @_ == 1;
#
# my $cmp = $self -> bstrcmp(shift);
# return defined($cmp) && $cmp < 0;
@@ -1471,9 +1534,9 @@ sub bdec {
# my $selfref = ref $self;
# my $class = $selfref || $self;
#
-# Carp::croak 'bstrle() is an instance method, not a class method'
+# croak 'bstrle() is an instance method, not a class method'
# unless $selfref;
-# Carp::croak 'Wrong number of arguments for bstrle()' unless @_ == 1;
+# croak 'Wrong number of arguments for bstrle()' unless @_ == 1;
#
# my $cmp = $self -> bstrcmp(shift);
# return defined($cmp) && $cmp <= 0;
@@ -1484,9 +1547,9 @@ sub bdec {
# my $selfref = ref $self;
# my $class = $selfref || $self;
#
-# Carp::croak 'bstrgt() is an instance method, not a class method'
+# croak 'bstrgt() is an instance method, not a class method'
# unless $selfref;
-# Carp::croak 'Wrong number of arguments for bstrgt()' unless @_ == 1;
+# croak 'Wrong number of arguments for bstrgt()' unless @_ == 1;
#
# my $cmp = $self -> bstrcmp(shift);
# return defined($cmp) && $cmp > 0;
@@ -1497,9 +1560,9 @@ sub bdec {
# my $selfref = ref $self;
# my $class = $selfref || $self;
#
-# Carp::croak 'bstrge() is an instance method, not a class method'
+# croak 'bstrge() is an instance method, not a class method'
# unless $selfref;
-# Carp::croak 'Wrong number of arguments for bstrge()' unless @_ == 1;
+# croak 'Wrong number of arguments for bstrge()' unless @_ == 1;
#
# my $cmp = $self -> bstrcmp(shift);
# return defined($cmp) && $cmp >= 0;
@@ -1540,19 +1603,19 @@ sub badd {
my ($sx, $sy) = ($x->{sign}, $y->{sign}); # get signs
if ($sx eq $sy) {
- $x->{value} = $CALC->_add($x->{value}, $y->{value}); # same sign, abs add
+ $x->{value} = $LIB->_add($x->{value}, $y->{value}); # same sign, abs add
} else {
- my $a = $CALC->_acmp ($y->{value}, $x->{value}); # absolute compare
+ my $a = $LIB->_acmp ($y->{value}, $x->{value}); # absolute compare
if ($a > 0) {
- $x->{value} = $CALC->_sub($y->{value}, $x->{value}, 1); # abs sub w/ swap
+ $x->{value} = $LIB->_sub($y->{value}, $x->{value}, 1); # abs sub w/ swap
$x->{sign} = $sy;
} elsif ($a == 0) {
# speedup, if equal, set result to 0
- $x->{value} = $CALC->_zero();
+ $x->{value} = $LIB->_zero();
$x->{sign} = '+';
} else # a < 0
{
- $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
+ $x->{value} = $LIB->_sub($x->{value}, $y->{value}); # abs sub
}
}
$x->round(@r);
@@ -1626,8 +1689,8 @@ sub bmul {
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
- $x->{value} = $CALC->_mul($x->{value}, $y->{value}); # do actual math
- $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
+ $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math
+ $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # no -0
$x->round(@r);
}
@@ -1669,25 +1732,25 @@ sub bmuladd {
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
- $x->{value} = $CALC->_mul($x->{value}, $y->{value}); # do actual math
- $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
+ $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math
+ $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # no -0
my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs
if ($sx eq $sz) {
- $x->{value} = $CALC->_add($x->{value}, $z->{value}); # same sign, abs add
+ $x->{value} = $LIB->_add($x->{value}, $z->{value}); # same sign, abs add
} else {
- my $a = $CALC->_acmp ($z->{value}, $x->{value}); # absolute compare
+ my $a = $LIB->_acmp ($z->{value}, $x->{value}); # absolute compare
if ($a > 0) {
- $x->{value} = $CALC->_sub($z->{value}, $x->{value}, 1); # abs sub w/ swap
+ $x->{value} = $LIB->_sub($z->{value}, $x->{value}, 1); # abs sub w/ swap
$x->{sign} = $sz;
} elsif ($a == 0) {
# speedup, if equal, set result to 0
- $x->{value} = $CALC->_zero();
+ $x->{value} = $LIB->_zero();
$x->{sign} = '+';
} else # a < 0
{
- $x->{value} = $CALC->_sub($x->{value}, $z->{value}); # abs sub
+ $x->{value} = $LIB->_sub($x->{value}, $z->{value}); # abs sub
}
}
$x->round(@r);
@@ -1824,10 +1887,10 @@ sub bdiv {
$x -> bone();
} else {
($x -> {value}, $rem -> {value}) =
- $CALC -> _div($x -> {value}, $y -> {value});
+ $LIB -> _div($x -> {value}, $y -> {value});
- if ($CALC -> _is_zero($rem -> {value})) {
- if ($xsign eq $ysign || $CALC -> _is_zero($x -> {value})) {
+ if ($LIB -> _is_zero($rem -> {value})) {
+ if ($xsign eq $ysign || $LIB -> _is_zero($x -> {value})) {
$x -> {sign} = '+';
} else {
$x -> {sign} = '-';
@@ -1849,7 +1912,7 @@ sub bdiv {
$x -> round(@r);
if ($wantarray) {
- unless ($CALC -> _is_zero($rem -> {value})) {
+ unless ($LIB -> _is_zero($rem -> {value})) {
if ($xsign ne $ysign) {
$rem = $y -> copy() -> babs() -> bsub($rem);
}
@@ -1989,16 +2052,16 @@ sub btdiv {
$x -> bone();
} else {
($x -> {value}, $rem -> {value}) =
- $CALC -> _div($x -> {value}, $y -> {value});
+ $LIB -> _div($x -> {value}, $y -> {value});
$x -> {sign} = $xsign eq $ysign ? '+' : '-';
- $x -> {sign} = '+' if $CALC -> _is_zero($x -> {value});
+ $x -> {sign} = '+' if $LIB -> _is_zero($x -> {value});
$x -> round(@r);
}
if (wantarray) {
$rem -> {sign} = $xsign;
- $rem -> {sign} = '+' if $CALC -> _is_zero($rem -> {value});
+ $rem -> {sign} = '+' if $LIB -> _is_zero($rem -> {value});
$rem -> {_a} = $x -> {_a};
$rem -> {_p} = $x -> {_p};
$rem -> round(@r);
@@ -2052,11 +2115,11 @@ sub bmod {
# Calc new sign and in case $y == +/- 1, return $x.
- $x -> {value} = $CALC -> _mod($x -> {value}, $y -> {value});
- if ($CALC -> _is_zero($x -> {value})) {
+ $x -> {value} = $LIB -> _mod($x -> {value}, $y -> {value});
+ if ($LIB -> _is_zero($x -> {value})) {
$x -> {sign} = '+'; # do not leave -0
} else {
- $x -> {value} = $CALC -> _sub($y -> {value}, $x -> {value}, 1) # $y-$x
+ $x -> {value} = $LIB -> _sub($y -> {value}, $x -> {value}, 1) # $y-$x
if ($x -> {sign} ne $y -> {sign});
$x -> {sign} = $y -> {sign};
}
@@ -2107,12 +2170,11 @@ sub btmod {
$r[3] = $y; # no push!
my $xsign = $x -> {sign};
- my $ysign = $y -> {sign};
- $x -> {value} = $CALC -> _mod($x -> {value}, $y -> {value});
+ $x -> {value} = $LIB -> _mod($x -> {value}, $y -> {value});
$x -> {sign} = $xsign;
- $x -> {sign} = '+' if $CALC -> _is_zero($x -> {value});
+ $x -> {sign} = '+' if $LIB -> _is_zero($x -> {value});
$x -> round(@r);
return $x;
}
@@ -2157,7 +2219,7 @@ sub bmodinv {
# $x = 0 is when $y = 1 or $y = -1, but that was covered above.
#
# Note that computing $x modulo $y here affects the value we'll feed to
- # $CALC->_modinv() below when $x and $y have opposite signs. E.g., if $x =
+ # $LIB->_modinv() below when $x and $y have opposite signs. E.g., if $x =
# 5 and $y = 7, those two values are fed to _modinv(), but if $x = -5 and
# $y = 7, the values fed to _modinv() are $x = 2 (= -5 % 7) and $y = 7.
# The value if $x is affected only when $x and $y have opposite signs.
@@ -2168,7 +2230,7 @@ sub bmodinv {
# Compute the modular multiplicative inverse of the absolute values. We'll
# correct for the signs of $x and $y later. Return NaN if no GCD is found.
- ($x->{value}, $x->{sign}) = $CALC->_modinv($x->{value}, $y->{value});
+ ($x->{value}, $x->{sign}) = $LIB->_modinv($x->{value}, $y->{value});
return $x->bnan() if !defined $x->{value};
# Library inconsistency workaround: _modinv() in Math::BigInt::GMP versions
@@ -2233,13 +2295,13 @@ sub bmodpow {
# value is zero, the output is also zero, regardless of the signs on 'a' and
# 'm'.
- my $value = $CALC->_modpow($num->{value}, $exp->{value}, $mod->{value});
+ my $value = $LIB->_modpow($num->{value}, $exp->{value}, $mod->{value});
my $sign = '+';
# If the resulting value is non-zero, we have four special cases, depending
# on the signs on 'a' and 'm'.
- unless ($CALC->_is_zero($value)) {
+ unless ($LIB->_is_zero($value)) {
# There is a negative sign on 'a' (= $num**$exp) only if the number we
# are exponentiating ($num) is negative and the exponent ($exp) is odd.
@@ -2261,8 +2323,8 @@ sub bmodpow {
else {
# Use copy of $mod since _sub() modifies the first argument.
- my $mod = $CALC->_copy($mod->{value});
- $value = $CALC->_sub($mod, $value);
+ my $mod = $LIB->_copy($mod->{value});
+ $value = $LIB->_sub($mod, $value);
$sign = '+';
}
@@ -2275,8 +2337,8 @@ sub bmodpow {
if ($mod->{sign} eq '-') {
# Use copy of $mod since _sub() modifies the first argument.
- my $mod = $CALC->_copy($mod->{value});
- $value = $CALC->_sub($mod, $value);
+ my $mod = $LIB->_copy($mod->{value});
+ $value = $LIB->_sub($mod, $value);
$sign = '-';
}
@@ -2309,52 +2371,29 @@ sub bpow {
return $x if $x->modify('bpow');
- return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
-
- # inf handling
- if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) {
- if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) {
- # +-inf ** +-inf
- return $x->bnan();
- }
- # +-inf ** Y
- if ($x->{sign} =~ /^[+-]inf/) {
- # +inf ** 0 => NaN
- return $x->bnan() if $y->is_zero();
- # -inf ** -1 => 1/inf => 0
- return $x->bzero() if $y->is_one('-') && $x->is_negative();
-
- # +inf ** Y => inf
- return $x if $x->{sign} eq '+inf';
-
- # -inf ** Y => -inf if Y is odd
- return $x if $y->is_odd();
- return $x->babs();
- }
- # X ** +-inf
-
- # 1 ** +inf => 1
- return $x if $x->is_one();
-
- # 0 ** inf => 0
- return $x if $x->is_zero() && $y->{sign} =~ /^[+]/;
-
- # 0 ** -inf => inf
- return $x->binf() if $x->is_zero();
-
- # -1 ** -inf => NaN
- return $x->bnan() if $x->is_one('-') && $y->{sign} =~ /^[-]/;
-
- # -X ** -inf => 0
- return $x->bzero() if $x->{sign} eq '-' && $y->{sign} =~ /^[-]/;
-
- # -1 ** inf => NaN
- return $x->bnan() if $x->{sign} eq '-';
-
- # X ** inf => inf
- return $x->binf() if $y->{sign} =~ /^[+]/;
- # X ** -inf => 0
+ # $x and/or $y is a NaN
+ return $x->bnan() if $x->is_nan() || $y->is_nan();
+
+ # $x and/or $y is a +/-Inf
+ if ($x->is_inf("-")) {
+ return $x->bzero() if $y->is_negative();
+ return $x->bnan() if $y->is_zero();
+ return $x if $y->is_odd();
+ return $x->bneg();
+ } elsif ($x->is_inf("+")) {
+ return $x->bzero() if $y->is_negative();
+ return $x->bnan() if $y->is_zero();
+ return $x;
+ } elsif ($y->is_inf("-")) {
+ return $x->bnan() if $x -> is_one("-");
+ return $x->binf("+") if $x -> is_zero();
+ return $x->bone() if $x -> is_one("+");
return $x->bzero();
+ } elsif ($y->is_inf("+")) {
+ return $x->bnan() if $x -> is_one("-");
+ return $x->bzero() if $x -> is_zero();
+ return $x->bone() if $x -> is_one("+");
+ return $x->binf("+");
}
return $upgrade->bpow($upgrade->new($x), $y, @r)
@@ -2369,14 +2408,14 @@ sub bpow {
# 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
return $x->binf()
- if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value});
+ if $y->{sign} eq '-' && $x->{sign} eq '+' && $LIB->_is_zero($x->{value});
# 1 ** -y => 1 / (1 ** |y|)
# so do test for negative $y after above's clause
- return $x->bnan() if $y->{sign} eq '-' && !$CALC->_is_one($x->{value});
+ return $x->bnan() if $y->{sign} eq '-' && !$LIB->_is_one($x->{value});
- $x->{value} = $CALC->_pow($x->{value}, $y->{value});
+ $x->{value} = $LIB->_pow($x->{value}, $y->{value});
$x->{sign} = $new_sign;
- $x->{sign} = '+' if $CALC->_is_zero($y->{value});
+ $x->{sign} = '+' if $LIB->_is_zero($y->{value});
$x->round(@r);
}
@@ -2444,7 +2483,7 @@ sub blog {
return $x;
}
- my ($rc, $exact) = $CALC->_log_int($x->{value}, $base->{value});
+ my ($rc, $exact) = $LIB->_log_int($x->{value}, $base->{value});
return $x->bnan() unless defined $rc; # not possible to take log?
$x->{value} = $rc;
$x->round(@r);
@@ -2482,74 +2521,85 @@ sub bexp {
}
sub bnok {
- # Calculate n over k (binomial coefficient or "choose" function) as integer.
- # set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
+ # Calculate n over k (binomial coefficient or "choose" function) as
+ # integer.
- # objectify is costly, so avoid it
+ # Set up parameters.
+ my ($self, $n, $k, @r) = (ref($_[0]), @_);
+
+ # Objectify is costly, so avoid it.
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
+ ($self, $n, $k, @r) = objectify(2, @_);
}
- return $x if $x->modify('bnok');
- return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN';
- return $x->binf() if $x->{sign} eq '+inf';
+ return $n if $n->modify('bnok');
- # k > n or k < 0 => 0
- my $cmp = $x->bacmp($y);
- return $x->bzero() if $cmp < 0 || substr($y->{sign}, 0, 1) eq "-";
-
- if ($CALC->can('_nok')) {
- $x->{value} = $CALC->_nok($x->{value}, $y->{value});
- } else {
- # ( 7 ) 7! 1*2*3*4 * 5*6*7 5 * 6 * 7 6 7
- # ( - ) = --------- = --------------- = --------- = 5 * - * -
- # ( 3 ) (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3
+ # All cases where at least one argument is NaN.
- my $n = $x -> {value};
- my $k = $y -> {value};
+ return $n->bnan() if $n->{sign} eq 'NaN' || $k->{sign} eq 'NaN';
- # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as
- # nok(n, n-k) to minimize the number if iterations in the loop.
+ # All cases where at least one argument is +/-inf.
- {
- my $twok = $CALC->_mul($CALC->_two(), $CALC->_copy($k));
- if ($CALC->_acmp($twok, $n) > 0) {
- $k = $CALC->_sub($CALC->_copy($n), $k);
+ if ($n -> is_inf()) {
+ if ($k -> is_inf()) { # bnok(+/-inf,+/-inf)
+ return $n -> bnan();
+ } elsif ($k -> is_neg()) { # bnok(+/-inf,k), k < 0
+ return $n -> bzero();
+ } elsif ($k -> is_zero()) { # bnok(+/-inf,k), k = 0
+ return $n -> bone();
+ } else {
+ if ($n -> is_inf("+")) { # bnok(+inf,k), 0 < k < +inf
+ return $n -> binf("+");
+ } else { # bnok(-inf,k), k > 0
+ my $sign = $k -> is_even() ? "+" : "-";
+ return $n -> binf($sign);
}
}
+ }
- if ($CALC->_is_zero($k)) {
- $n = $CALC->_one();
- } else {
+ elsif ($k -> is_inf()) { # bnok(n,+/-inf), -inf <= n <= inf
+ return $n -> bnan();
+ }
- # Make a copy of the original n, since we'll be modifying n
- # in-place.
+ # At this point, both n and k are real numbers.
- my $n_orig = $CALC->_copy($n);
+ my $sign = 1;
- $CALC->_sub($n, $k);
- $CALC->_inc($n);
+ if ($n >= 0) {
+ if ($k < 0 || $k > $n) {
+ return $n -> bzero();
+ }
+ } else {
- my $f = $CALC->_copy($n);
- $CALC->_inc($f);
+ if ($k >= 0) {
- my $d = $CALC->_two();
+ # n < 0 and k >= 0: bnok(n,k) = (-1)^k * bnok(-n+k-1,k)
- # while f <= n (the original n, that is) ...
+ $sign = (-1) ** $k;
+ $n -> bneg() -> badd($k) -> bdec();
- while ($CALC->_acmp($f, $n_orig) <= 0) {
- $CALC->_mul($n, $f);
- $CALC->_div($n, $d);
- $CALC->_inc($f);
- $CALC->_inc($d);
- }
- }
+ } elsif ($k <= $n) {
+
+ # n < 0 and k <= n: bnok(n,k) = (-1)^(n-k) * bnok(-k-1,n-k)
+
+ $sign = (-1) ** ($n - $k);
+ my $x0 = $n -> copy();
+ $n -> bone() -> badd($k) -> bneg();
+ $k = $k -> copy();
+ $k -> bneg() -> badd($x0);
- $x -> {value} = $n;
+ } else {
+
+ # n < 0 and n < k < 0:
+
+ return $n -> bzero();
+ }
}
- $x->round(@r);
+ $n->{value} = $LIB->_nok($n->{value}, $k->{value});
+ $n -> bneg() if $sign == -1;
+
+ $n->round(@r);
}
sub bsin {
@@ -2606,7 +2656,7 @@ sub batan {
# calculate the result and truncate it to integer
my $t = Math::BigFloat->new($x)->batan(@r);
- $x->{value} = $CALC->_new($x->as_int()->bstr());
+ $x->{value} = $LIB->_new($x->as_int()->bstr());
$x->round(@r);
}
@@ -2678,7 +2728,7 @@ sub bsqrt {
return $upgrade->bsqrt($x, @r) if defined $upgrade;
- $x->{value} = $CALC->_sqrt($x->{value});
+ $x->{value} = $LIB->_sqrt($x->{value});
$x->round(@r);
}
@@ -2706,7 +2756,7 @@ sub broot {
return $upgrade->new($x)->broot($upgrade->new($y), @r) if defined $upgrade;
- $x->{value} = $CALC->_root($x->{value}, $y->{value});
+ $x->{value} = $LIB->_root($x->{value}, $y->{value});
$x->round(@r);
}
@@ -2718,7 +2768,7 @@ sub bfac {
return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf
return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
- $x->{value} = $CALC->_fac($x->{value});
+ $x->{value} = $LIB->_fac($x->{value});
$x->round(@r);
}
@@ -2729,10 +2779,10 @@ sub bdfac {
return $x if $x->modify('bdfac') || $x->{sign} eq '+inf'; # inf => inf
return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
- Carp::croak("bdfac() requires a newer version of the $CALC library.")
- unless $CALC->can('_dfac');
+ croak("bdfac() requires a newer version of the $LIB library.")
+ unless $LIB->can('_dfac');
- $x->{value} = $CALC->_dfac($x->{value});
+ $x->{value} = $LIB->_dfac($x->{value});
$x->round(@r);
}
@@ -2740,8 +2790,8 @@ sub bfib {
# compute Fibonacci number(s)
my ($class, $x, @r) = objectify(1, @_);
- Carp::croak("bfib() requires a newer version of the $CALC library.")
- unless $CALC->can('_fib');
+ croak("bfib() requires a newer version of the $LIB library.")
+ unless $LIB->can('_fib');
return $x if $x->modify('bfib');
@@ -2749,12 +2799,12 @@ sub bfib {
if (wantarray) {
return () if $x -> is_nan();
- Carp::croak("bfib() can't return an infinitely long list of numbers")
+ croak("bfib() can't return an infinitely long list of numbers")
if $x -> is_inf();
# Use the backend library to compute the first $x Fibonacci numbers.
- my @values = $CALC->_fib($x->{value});
+ my @values = $LIB->_fib($x->{value});
# Make objects out of them. The last element in the array is the
# invocand.
@@ -2787,7 +2837,7 @@ sub bfib {
return $x->bnan() if $x -> is_nan() || $x -> is_inf('-');
$x->{sign} = $x -> is_neg() && $x -> is_even() ? '-' : '+';
- $x->{value} = $CALC->_fib($x->{value});
+ $x->{value} = $LIB->_fib($x->{value});
return $x->round(@r);
}
}
@@ -2796,8 +2846,8 @@ sub blucas {
# compute Lucas number(s)
my ($class, $x, @r) = objectify(1, @_);
- Carp::croak("blucas() requires a newer version of the $CALC library.")
- unless $CALC->can('_lucas');
+ croak("blucas() requires a newer version of the $LIB library.")
+ unless $LIB->can('_lucas');
return $x if $x->modify('blucas');
@@ -2805,12 +2855,12 @@ sub blucas {
if (wantarray) {
return () if $x -> is_nan();
- Carp::croak("blucas() can't return an infinitely long list of numbers")
+ croak("blucas() can't return an infinitely long list of numbers")
if $x -> is_inf();
# Use the backend library to compute the first $x Lucas numbers.
- my @values = $CALC->_lucas($x->{value});
+ my @values = $LIB->_lucas($x->{value});
# Make objects out of them. The last element in the array is the
# invocand.
@@ -2843,7 +2893,7 @@ sub blucas {
return $x->bnan() if $x -> is_nan() || $x -> is_inf('-');
$x->{sign} = $x -> is_neg() && $x -> is_even() ? '-' : '+';
- $x->{value} = $CALC->_lucas($x->{value});
+ $x->{value} = $LIB->_lucas($x->{value});
return $x->round(@r);
}
}
@@ -2868,7 +2918,7 @@ sub blsft {
$b = 2 if !defined $b;
return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-';
- $x -> {value} = $CALC -> _lsft($x -> {value}, $y -> {value}, $b);
+ $x -> {value} = $LIB -> _lsft($x -> {value}, $y -> {value}, $b);
$x -> round(@r);
}
@@ -2926,7 +2976,7 @@ sub brsft {
$x -> bdec(); # n == 2, but $y == 1: this fixes it
}
- $x -> {value} = $CALC -> _rsft($x -> {value}, $y -> {value}, $b);
+ $x -> {value} = $LIB -> _rsft($x -> {value}, $y -> {value}, $b);
$x -> round(@r);
}
@@ -2951,21 +3001,13 @@ sub band {
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- my $sx = $x->{sign} eq '+' ? 1 : -1;
- my $sy = $y->{sign} eq '+' ? 1 : -1;
-
- if ($sx == 1 && $sy == 1) {
- $x->{value} = $CALC->_and($x->{value}, $y->{value});
- return $x->round(@r);
- }
-
- if ($CAN{signed_and}) {
- $x->{value} = $CALC->_signed_and($x->{value}, $y->{value}, $sx, $sy);
- return $x->round(@r);
+ if ($x->{sign} eq '+' && $y->{sign} eq '+') {
+ $x->{value} = $LIB->_and($x->{value}, $y->{value});
+ } else {
+ ($x->{value}, $x->{sign}) = $LIB->_sand($x->{value}, $x->{sign},
+ $y->{value}, $y->{sign});
}
-
- require $EMU_LIB;
- __emu_band($class, $x, $y, $sx, $sy, @r);
+ return $x->round(@r);
}
sub bior {
@@ -2980,29 +3022,18 @@ sub bior {
}
return $x if $x->modify('bior');
+
$r[3] = $y; # no push!
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- my $sx = $x->{sign} eq '+' ? 1 : -1;
- my $sy = $y->{sign} eq '+' ? 1 : -1;
-
- # the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior()
-
- # don't use lib for negative values
- if ($sx == 1 && $sy == 1) {
- $x->{value} = $CALC->_or($x->{value}, $y->{value});
- return $x->round(@r);
- }
-
- # if lib can do negative values, let it handle this
- if ($CAN{signed_or}) {
- $x->{value} = $CALC->_signed_or($x->{value}, $y->{value}, $sx, $sy);
- return $x->round(@r);
+ if ($x->{sign} eq '+' && $y->{sign} eq '+') {
+ $x->{value} = $LIB->_or($x->{value}, $y->{value});
+ } else {
+ ($x->{value}, $x->{sign}) = $LIB->_sor($x->{value}, $x->{sign},
+ $y->{value}, $y->{sign});
}
-
- require $EMU_LIB;
- __emu_bior($class, $x, $y, $sx, $sy, @r);
+ return $x->round(@r);
}
sub bxor {
@@ -3017,34 +3048,25 @@ sub bxor {
}
return $x if $x->modify('bxor');
+
$r[3] = $y; # no push!
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- my $sx = $x->{sign} eq '+' ? 1 : -1;
- my $sy = $y->{sign} eq '+' ? 1 : -1;
-
- # don't use lib for negative values
- if ($sx == 1 && $sy == 1) {
- $x->{value} = $CALC->_xor($x->{value}, $y->{value});
- return $x->round(@r);
- }
-
- # if lib can do negative values, let it handle this
- if ($CAN{signed_xor}) {
- $x->{value} = $CALC->_signed_xor($x->{value}, $y->{value}, $sx, $sy);
- return $x->round(@r);
+ if ($x->{sign} eq '+' && $y->{sign} eq '+') {
+ $x->{value} = $LIB->_xor($x->{value}, $y->{value});
+ } else {
+ ($x->{value}, $x->{sign}) = $LIB->_sxor($x->{value}, $x->{sign},
+ $y->{value}, $y->{sign});
}
-
- require $EMU_LIB;
- __emu_bxor($class, $x, $y, $sx, $sy, @r);
+ return $x->round(@r);
}
sub bnot {
# (num_str or BINT) return BINT
# represent ~x as twos-complement number
# we don't need $class, so undef instead of ref($_[0]) make it slightly faster
- my ($class, $x, $a, $p, $r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my ($class, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
return $x if $x->modify('bnot');
$x->binc()->bneg(); # binc already does round
@@ -3085,9 +3107,11 @@ sub round {
}
}
- # if still none defined, use globals (#2)
- $a = ${"$class\::accuracy"} unless defined $a;
- $p = ${"$class\::precision"} unless defined $p;
+ # if still none defined, use globals
+ unless (defined $a || defined $p) {
+ $a = ${"$class\::accuracy"};
+ $p = ${"$class\::precision"};
+ }
# A == 0 is useless, so undef it to signal no rounding
$a = undef if defined $a && $a == 0;
@@ -3100,7 +3124,7 @@ sub round {
$r = ${"$class\::round_mode"} unless defined $r;
if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) {
- Carp::croak("Unknown round mode '$r'");
+ croak("Unknown round mode '$r'");
}
# now round, by calling either bround or bfround:
@@ -3152,7 +3176,7 @@ sub bround {
# do not use digit(), it is very costly for binary => decimal
# getting the entire string is also costly, but we need to do it only once
- my $xs = $CALC->_str($x->{value});
+ my $xs = $LIB->_str($x->{value});
my $pl = -$pad-1;
# pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
@@ -3207,7 +3231,7 @@ sub bround {
$xs = '1'.$xs if $c == 0;
}
- $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed
+ $x->{value} = $LIB->_new($xs) if $put_back == 1; # put back, if needed
$x->{_a} = $scale if $scale >= 0;
if ($scale < 0) {
@@ -3285,8 +3309,8 @@ sub bgcd {
my $y = shift @args;
$y = $class->new($y) unless ref($y) && $y -> isa($class);
return $class->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
- $x->{value} = $CALC->_gcd($x->{value}, $y->{value});
- last if $CALC->_is_one($x->{value});
+ $x->{value} = $LIB->_gcd($x->{value}, $y->{value});
+ last if $LIB->_is_one($x->{value});
}
return $x -> babs();
@@ -3307,7 +3331,7 @@ sub blcm {
my $y = shift @args;
$y = $class -> new($y) unless ref($y) && $y -> isa($class);
return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y not integer
- $x -> {value} = $CALC->_lcm($x -> {value}, $y -> {value});
+ $x -> {value} = $LIB->_lcm($x -> {value}, $y -> {value});
}
return $x -> babs();
@@ -3329,13 +3353,13 @@ sub digit {
my ($class, $x, $n) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
$n = $n->numify() if ref($n);
- $CALC->_digit($x->{value}, $n || 0);
+ $LIB->_digit($x->{value}, $n || 0);
}
sub length {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
- my $e = $CALC->_len($x->{value});
+ my $e = $LIB->_len($x->{value});
wantarray ? ($e, 0) : $e;
}
@@ -3351,7 +3375,7 @@ sub exponent {
return $class->bzero() if $x->is_zero();
# 12300 => 2 trailing zeros => exponent is 2
- $class->new($CALC->_zeros($x->{value}));
+ $class->new($LIB->_zeros($x->{value}));
}
sub mantissa {
@@ -3367,7 +3391,7 @@ sub mantissa {
delete $m->{_a};
# that's a bit inefficient:
- my $zeros = $CALC->_zeros($m->{value});
+ my $zeros = $LIB->_zeros($m->{value});
$m->brsft($zeros, 10) if $zeros != 0;
$m;
}
@@ -3383,7 +3407,7 @@ sub sparts {
my $self = shift;
my $class = ref $self;
- Carp::croak("sparts() is an instance method, not a class method")
+ croak("sparts() is an instance method, not a class method")
unless $class;
# Not-a-number.
@@ -3407,7 +3431,7 @@ sub sparts {
# Finite number.
my $mant = $self -> copy();
- my $nzeros = $CALC -> _zeros($mant -> {value});
+ my $nzeros = $LIB -> _zeros($mant -> {value});
$mant -> brsft($nzeros, 10) if $nzeros != 0;
return $mant unless wantarray;
@@ -3420,7 +3444,7 @@ sub nparts {
my $self = shift;
my $class = ref $self;
- Carp::croak("nparts() is an instance method, not a class method")
+ croak("nparts() is an instance method, not a class method")
unless $class;
# Not-a-number.
@@ -3466,7 +3490,7 @@ sub eparts {
my $self = shift;
my $class = ref $self;
- Carp::croak("eparts() is an instance method, not a class method")
+ croak("eparts() is an instance method, not a class method")
unless $class;
# Not-a-number and Infinity.
@@ -3505,7 +3529,7 @@ sub dparts {
my $self = shift;
my $class = ref $self;
- Carp::croak("dparts() is an instance method, not a class method")
+ croak("dparts() is an instance method, not a class method")
unless $class;
my $int = $self -> copy();
@@ -3526,7 +3550,7 @@ sub bstr {
return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
return 'inf'; # +inf
}
- my $str = $CALC->_str($x->{value});
+ my $str = $LIB->_str($x->{value});
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -3541,7 +3565,7 @@ sub bsstr {
return 'inf'; # +inf
}
my ($m, $e) = $x -> parts();
- my $str = $CALC->_str($m->{value}) . 'e+' . $CALC->_str($e->{value});
+ my $str = $LIB->_str($m->{value}) . 'e+' . $LIB->_str($e->{value});
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -3564,15 +3588,15 @@ sub bnstr {
my $fracpos = $mant -> length() - 1;
if ($fracpos == 0) {
- my $str = $CALC->_str($mant->{value}) . "e+" . $CALC->_str($expo->{value});
+ my $str = $LIB->_str($mant->{value}) . "e+" . $LIB->_str($expo->{value});
return $x->{sign} eq '-' ? "-$str" : $str;
}
$expo += $fracpos;
- my $mantstr = $CALC->_str($mant -> {value});
+ my $mantstr = $LIB->_str($mant -> {value});
substr($mantstr, -$fracpos, 0) = '.';
- my $str = $mantstr . 'e+' . $CALC->_str($expo -> {value});
+ my $str = $mantstr . 'e+' . $LIB->_str($expo -> {value});
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -3591,7 +3615,7 @@ sub bestr {
my $sign = $mant -> sign();
$mant -> babs();
- my $mantstr = $CALC->_str($mant -> {value});
+ my $mantstr = $LIB->_str($mant -> {value});
my $mantlen = CORE::length($mantstr);
my $dotidx = 1;
@@ -3607,7 +3631,7 @@ sub bestr {
substr($mantstr, $dotidx, 0) = ".";
}
- my $str = $mantstr . 'e+' . $CALC->_str($expo -> {value});
+ my $str = $mantstr . 'e+' . $LIB->_str($expo -> {value});
return $sign eq "-" ? "-$str" : $str;
}
@@ -3621,7 +3645,7 @@ sub bdstr {
return 'inf'; # +inf
}
- my $str = $CALC->_str($x->{value});
+ my $str = $LIB->_str($x->{value});
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -3632,7 +3656,7 @@ sub to_hex {
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $hex = $CALC->_to_hex($x->{value});
+ my $hex = $LIB->_to_hex($x->{value});
return $x->{sign} eq '-' ? "-$hex" : $hex;
}
@@ -3643,7 +3667,7 @@ sub to_oct {
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $oct = $CALC->_to_oct($x->{value});
+ my $oct = $LIB->_to_oct($x->{value});
return $x->{sign} eq '-' ? "-$oct" : $oct;
}
@@ -3654,7 +3678,7 @@ sub to_bin {
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $bin = $CALC->_to_bin($x->{value});
+ my $bin = $LIB->_to_bin($x->{value});
return $x->{sign} eq '-' ? "-$bin" : $bin;
}
@@ -3663,13 +3687,43 @@ sub to_bytes {
my $x = shift;
$x = $class->new($x) if !ref($x);
- Carp::croak("to_bytes() requires a finite, non-negative integer")
+ croak("to_bytes() requires a finite, non-negative integer")
if $x -> is_neg() || ! $x -> is_int();
- Carp::croak("to_bytes() requires a newer version of the $CALC library.")
- unless $CALC->can('_to_bytes');
+ croak("to_bytes() requires a newer version of the $LIB library.")
+ unless $LIB->can('_to_bytes');
- return $CALC->_to_bytes($x->{value});
+ return $LIB->_to_bytes($x->{value});
+}
+
+sub to_base {
+ # return a base anything string
+ my $x = shift;
+ $x = $class->new($x) if !ref($x);
+
+ croak("the value to convert must be a finite, non-negative integer")
+ if $x -> is_neg() || !$x -> is_int();
+
+ my $base = shift;
+ $base = $class->new($base) unless ref($base);
+
+ croak("the base must be a finite integer >= 2")
+ if $base < 2 || ! $base -> is_int();
+
+ # If no collating sequence is given, pass some of the conversions to
+ # methods optimized for those cases.
+
+ if (! @_) {
+ return $x -> to_bin() if $base == 2;
+ return $x -> to_oct() if $base == 8;
+ return uc $x -> to_hex() if $base == 16;
+ return $x -> bstr() if $base == 10;
+ }
+
+ croak("to_base() requires a newer version of the $LIB library.")
+ unless $LIB->can('_to_base');
+
+ return $LIB->_to_base($x->{value}, $base -> {value}, @_ ? shift() : ());
}
sub as_hex {
@@ -3679,7 +3733,7 @@ sub as_hex {
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $hex = $CALC->_as_hex($x->{value});
+ my $hex = $LIB->_as_hex($x->{value});
return $x->{sign} eq '-' ? "-$hex" : $hex;
}
@@ -3690,7 +3744,7 @@ sub as_oct {
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $oct = $CALC->_as_oct($x->{value});
+ my $oct = $LIB->_as_oct($x->{value});
return $x->{sign} eq '-' ? "-$oct" : $oct;
}
@@ -3701,7 +3755,7 @@ sub as_bin {
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $bin = $CALC->_as_bin($x->{value});
+ my $bin = $LIB->_as_bin($x->{value});
return $x->{sign} eq '-' ? "-$bin" : $bin;
}
@@ -3728,7 +3782,7 @@ sub numify {
return $x -> is_negative() ? -$inf : $inf;
}
- my $num = 0 + $CALC->_num($x->{value});
+ my $num = 0 + $LIB->_num($x->{value});
return $x->{sign} eq '-' ? -$num : $num;
}
@@ -3763,7 +3817,7 @@ sub objectify {
# Check the context.
unless (wantarray) {
- Carp::croak("${class}::objectify() needs list context");
+ croak("${class}::objectify() needs list context");
}
# Get the number of arguments to objectify.
@@ -3880,7 +3934,6 @@ sub objectify {
sub import {
my $class = shift;
-
$IMPORT++; # remember we did import()
my @a;
my $l = scalar @_;
@@ -3897,7 +3950,7 @@ sub import {
$i++;
} elsif ($_[$i] =~ /^(lib|try|only)\z/) {
# this causes a different low lib to take care...
- $CALC = $_[$i+1] || '';
+ $LIB = $_[$i+1] || '';
# lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback)
$warn_or_die = 1 if $_[$i] eq 'lib';
$warn_or_die = 2 if $_[$i] eq 'only';
@@ -3908,20 +3961,18 @@ sub import {
}
# any non :constant stuff is handled by our parent, Exporter
if (@a > 0) {
- require Exporter;
-
$class->SUPER::import(@a); # need it for subclasses
$class->export_to_level(1, $class, @a); # need it for MBF
}
# try to load core math lib
- my @c = split /\s*,\s*/, $CALC;
+ my @c = split /\s*,\s*/, $LIB;
foreach (@c) {
$_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
}
push @c, \'Calc' # if all fail, try these
if $warn_or_die < 2; # but not for "only"
- $CALC = ''; # signal error
+ $LIB = ''; # signal error
foreach my $l (@c) {
# fallback libraries are "marked" as \'string', extract string if nec.
my $lib = $l;
@@ -3964,7 +4015,7 @@ sub import {
/) {
if (!$lib->can("_$method")) {
if (($WARN{$lib} || 0) < 2) {
- Carp::carp("$lib is missing method '_$method'");
+ carp("$lib is missing method '_$method'");
$WARN{$lib} = 1; # still warn about the lib
}
$ok++;
@@ -3973,43 +4024,35 @@ sub import {
}
}
if ($ok == 0) {
- $CALC = $lib;
+ $LIB = $lib;
if ($warn_or_die > 0 && ref($l)) {
my $msg = "Math::BigInt: couldn't load specified"
. " math lib(s), fallback to $lib";
- Carp::carp($msg) if $warn_or_die == 1;
- Carp::croak($msg) if $warn_or_die == 2;
+ carp($msg) if $warn_or_die == 1;
+ croak($msg) if $warn_or_die == 2;
}
last; # found a usable one, break
} else {
if (($WARN{$lib} || 0) < 2) {
my $ver = eval "\$$lib\::VERSION" || 'unknown';
- Carp::carp("Cannot load outdated $lib v$ver, please upgrade");
+ carp("Cannot load outdated $lib v$ver, please upgrade");
$WARN{$lib} = 2; # never warn again
}
}
}
}
- if ($CALC eq '') {
+ if ($LIB eq '') {
if ($warn_or_die == 2) {
- Carp::croak("Couldn't load specified math lib(s)" .
+ croak("Couldn't load specified math lib(s)" .
" and fallback disallowed");
} else {
- Carp::croak("Couldn't load any math lib(s), not even fallback to Calc.pm");
+ croak("Couldn't load any math lib(s), not even fallback to Calc.pm");
}
}
# notify callbacks
foreach my $class (keys %CALLBACKS) {
- &{$CALLBACKS{$class}}($CALC);
- }
-
- # Fill $CAN with the results of $CALC->can(...) for emulating lower math lib
- # functions
-
- %CAN = ();
- for my $method (qw/ signed_and signed_or signed_xor /) {
- $CAN{$method} = $CALC->can("_$method") ? 1 : 0;
+ &{$CALLBACKS{$class}}($LIB);
}
# import done
@@ -4019,7 +4062,7 @@ sub _register_callback {
my ($class, $callback) = @_;
if (ref($callback) ne 'CODE') {
- Carp::croak("$callback is not a coderef");
+ croak("$callback is not a coderef");
}
$CALLBACKS{$class} = $callback;
}
@@ -4171,7 +4214,7 @@ sub _trailing_zeros {
return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
- $CALC->_zeros($x->{value}); # must handle odd values, 0 etc
+ $LIB->_zeros($x->{value}); # must handle odd values, 0 etc
}
sub _scan_for_nonzero {
@@ -4243,7 +4286,7 @@ sub _find_round_parameters {
$r = ${"$class\::round_mode"} unless defined $r;
if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) {
- Carp::croak("Unknown round mode '$r'");
+ croak("Unknown round mode '$r'");
}
$a = int($a) if defined $a;
@@ -4306,19 +4349,20 @@ Math::BigInt - Arbitrary size integer/float math package
# Constructor methods (when the class methods below are used as instance
# methods, the value is assigned the invocand)
- $x = Math::BigInt->new($str); # defaults to 0
- $x = Math::BigInt->new('0x123'); # from hexadecimal
- $x = Math::BigInt->new('0b101'); # from binary
- $x = Math::BigInt->from_hex('cafe'); # from hexadecimal
- $x = Math::BigInt->from_oct('377'); # from octal
- $x = Math::BigInt->from_bin('1101'); # from binary
- $x = Math::BigInt->bzero(); # create a +0
- $x = Math::BigInt->bone(); # create a +1
- $x = Math::BigInt->bone('-'); # create a -1
- $x = Math::BigInt->binf(); # create a +inf
- $x = Math::BigInt->binf('-'); # create a -inf
- $x = Math::BigInt->bnan(); # create a Not-A-Number
- $x = Math::BigInt->bpi(); # returns pi
+ $x = Math::BigInt->new($str); # defaults to 0
+ $x = Math::BigInt->new('0x123'); # from hexadecimal
+ $x = Math::BigInt->new('0b101'); # from binary
+ $x = Math::BigInt->from_hex('cafe'); # from hexadecimal
+ $x = Math::BigInt->from_oct('377'); # from octal
+ $x = Math::BigInt->from_bin('1101'); # from binary
+ $x = Math::BigInt->from_base('why', 36); # from any base
+ $x = Math::BigInt->bzero(); # create a +0
+ $x = Math::BigInt->bone(); # create a +1
+ $x = Math::BigInt->bone('-'); # create a -1
+ $x = Math::BigInt->binf(); # create a +inf
+ $x = Math::BigInt->binf('-'); # create a -inf
+ $x = Math::BigInt->bnan(); # create a Not-A-Number
+ $x = Math::BigInt->bpi(); # returns pi
$y = $x->copy(); # make a copy (unlike $y = $x)
$y = $x->as_int(); # return as a Math::BigInt
@@ -4383,7 +4427,7 @@ Math::BigInt - Arbitrary size integer/float math package
$x->bcos(); # cosine
$x->batan(); # inverse tangent
$x->batan2($y); # two-argument inverse tangent
- $x->bsqrt(); # calculate square-root
+ $x->bsqrt(); # calculate square root
$x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root)
$x->bfac(); # factorial of $x (1*2*3*4*..$x)
@@ -4445,6 +4489,7 @@ Math::BigInt - Arbitrary size integer/float math package
$x->to_bin(); # as signed binary string
$x->to_oct(); # as signed octal string
$x->to_bytes(); # as byte string
+ $x->to_base($b); # as string in any base
$x->as_hex(); # as signed hexadecimal string with prefixed 0x
$x->as_bin(); # as signed binary string with prefixed 0b
@@ -4652,54 +4697,39 @@ This is used for instance by L<Math::BigInt::Constant>.
=item config()
- use Data::Dumper;
-
- print Dumper ( Math::BigInt->config() );
- print Math::BigInt->config()->{lib},"\n";
- print Math::BigInt->config('lib')},"\n";
+ Math::BigInt->config("trap_nan" => 1); # set
+ $accu = Math::BigInt->config("accuracy"); # get
-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.
+Set or get class variables. Read-only parameters are marked as RO. Read-write
+parameters are marked as RW. The following parameters are supported.
- key Description
- Example
+ Parameter RO/RW Description
+ Example
============================================================
- lib Name of the low-level math library
- Math::BigInt::Calc
- lib_version Version of low-level math library (see 'lib')
- 0.30
- class The class name of config() you just called
- Math::BigInt
- upgrade To which class math operations might be
- upgraded Math::BigFloat
- downgrade To which class math operations might be
- downgraded undef
- precision Global precision
- undef
- accuracy Global accuracy
- undef
- round_mode Global round mode
- even
- version version number of the class you used
- 1.61
- div_scale Fallback accuracy for div
- 40
- trap_nan If true, traps creation of NaN via croak()
- 1
- trap_inf If true, traps creation of +inf/-inf via croak()
- 1
-
-The following values can be set by passing C<config()> a reference to a hash:
-
- accuracy precision round_mode div_scale
- upgrade downgrade trap_inf trap_nan
-
-Example:
-
- $new_cfg = Math::BigInt->config(
- { trap_inf => 1, precision => 5 }
- );
+ lib RO Name of the math backend library
+ Math::BigInt::Calc
+ lib_version RO Version of the math backend library
+ 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 division etc.
+ 40
+ trap_nan RW Trap NaNs
+ undef
+ trap_inf RW Trap +inf/-inf
+ undef
=back
@@ -4767,6 +4797,49 @@ In some special cases, from_bytes() matches the conversion done by unpack():
$x = Math::BigInt->from_bytes($b); # = 3305723134637787565
$y = unpack "Q>", $b; # ditto, but scalar
+=item from_base()
+
+Given a string, a base, and an optional collation sequence, interpret the
+string as a number in the given base. The collation sequence describes the
+value of each character in the string.
+
+If a collation sequence is not given, a default collation sequence is used. If
+the base is less than or equal to 36, the collation sequence is the string
+consisting of the 36 characters "0" to "9" and "A" to "Z". In this case, the
+letter case in the input is ignored. If the base is greater than 36, and
+smaller than or equal to 62, the collation sequence is the string consisting of
+the 62 characters "0" to "9", "A" to "Z", and "a" to "z". A base larger than 62
+requires the collation sequence to be specified explicitly.
+
+These examples show standard binary, octal, and hexadecimal conversion. All
+cases return 250.
+
+ $x = Math::BigInt->from_base("11111010", 2);
+ $x = Math::BigInt->from_base("372", 8);
+ $x = Math::BigInt->from_base("fa", 16);
+
+When the base is less than or equal to 36, and no collation sequence is given,
+the letter case is ignored, so both of these also return 250:
+
+ $x = Math::BigInt->from_base("6Y", 16);
+ $x = Math::BigInt->from_base("6y", 16);
+
+When the base greater than 36, and no collation sequence is given, the default
+collation sequence contains both uppercase and lowercase letters, so
+the letter case in the input is not ignored:
+
+ $x = Math::BigInt->from_base("6S", 37); # $x is 250
+ $x = Math::BigInt->from_base("6s", 37); # $x is 276
+ $x = Math::BigInt->from_base("121", 3); # $x is 16
+ $x = Math::BigInt->from_base("XYZ", 36); # $x is 44027
+ $x = Math::BigInt->from_base("Why", 42); # $x is 58314
+
+The collation sequence can be any set of unique characters. These two cases
+are equivalent
+
+ $x = Math::BigInt->from_base("100", 2, "01"); # $x is 4
+ $x = Math::BigInt->from_base("|--", 2, "-|"); # $x is 4
+
=item bzero()
$x = Math::BigInt->bzero();
@@ -5196,13 +5269,28 @@ See also L</blog()>.
$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:
+function, which is
- ( n ) n!
- | - | = -------
+ ( n ) n!
+ | | = --------
( k ) k!(n-k)!
-This method was added in v1.84 of Math::BigInt (April 2007).
+when n and k are non-negative. This method implements the full Kronenburg
+extension (Kronenburg, M.J. "The Binomial Coefficient for Negative Arguments."
+18 May 2011. http://arxiv.org/abs/1105.3689/) illustrated by the following
+pseudo-code:
+
+ if n >= 0 and k >= 0:
+ return binomial(n, k)
+ if k >= 0:
+ return (-1)^k*binomial(-n+k-1, k)
+ if k <= n:
+ return (-1)^(n-k)*binomial(-k-1, n-k)
+ else
+ return 0
+
+The behaviour is identical to the behaviour of the Maple and Mathematica
+function for negative integers n, k.
=item bsin()
@@ -5255,7 +5343,7 @@ This method was added in v1.87 of Math::BigInt (June 2007).
=item bsqrt()
- $x->bsqrt(); # calculate square-root
+ $x->bsqrt(); # calculate square root
C<bsqrt()> returns the square root truncated to an integer.
@@ -5602,8 +5690,8 @@ corresponds to the output from C<sparts()>.
Returns a string representing the number using normalized notation, the most
common variant of scientific notation. For finite non-zero numbers, the
-absolute value of the significand is less than or equal to 1 and less than 10.
-The output corresponds to the output from C<nparts()>.
+absolute value of the significand is greater than or equal to 1 and less than
+10. The output corresponds to the output from C<nparts()>.
123 is returned as "1.23e+2"
1230 is returned as "1.23e+3"
@@ -5614,8 +5702,8 @@ The output corresponds to the output from C<nparts()>.
=item bestr()
Returns a string representing the number using engineering notation. For finite
-non-zero numbers, the absolute value of the significand is less than or equal
-to 1 and less than 1000, and the exponent is a multiple of 3. The output
+non-zero numbers, the absolute value of the significand is greater than or
+equal to 1 and less than 1000, and the exponent is a multiple of 3. The output
corresponds to the output from C<eparts()>.
123 is returned as "123e+0"
@@ -5639,19 +5727,19 @@ corresponds to the output from C<dparts()>.
$x->to_hex();
-Returns a hexadecimal string representation of the number.
+Returns a hexadecimal string representation of the number. See also from_hex().
=item to_bin()
$x->to_bin();
-Returns a binary string representation of the number.
+Returns a binary string representation of the number. See also from_bin().
=item to_oct()
$x->to_oct();
-Returns an octal string representation of the number.
+Returns an octal string representation of the number. See also from_oct().
=item to_bytes()
@@ -5659,7 +5747,27 @@ Returns an octal string representation of the number.
$s = $x->to_bytes(); # $s = "cafe"
Returns a byte string representation of the number using big endian byte
-order. The invocand must be a non-negative, finite integer.
+order. The invocand must be a non-negative, finite integer. See also from_bytes().
+
+=item to_base()
+
+ $x = Math::BigInt->new("250");
+ $x->to_base(2); # returns "11111010"
+ $x->to_base(8); # returns "372"
+ $x->to_base(16); # returns "fa"
+
+Returns a string representation of the number in the given base. If a collation
+sequence is given, the collation sequence determines which characters are used
+in the output.
+
+Here are some more examples
+
+ $x = Math::BigInt->new("16")->to_base(3); # returns "121"
+ $x = Math::BigInt->new("44027")->to_base(36); # returns "XYZ"
+ $x = Math::BigInt->new("58314")->to_base(42); # returns "Why"
+ $x = Math::BigInt->new("4")->to_base(2, "-|"); # returns "|--"
+
+See from_base() for information and examples.
=item as_hex()
@@ -5767,59 +5875,66 @@ dividing numbers.
When rounding a number, different 'styles' or 'kinds' of rounding are possible.
(Note that random rounding, as in Math::Round, is not implemented.)
+=head3 Directed rounding
+
+These round modes always round in the same direction.
+
=over
=item 'trunc'
-truncation invariably removes all digits following the rounding place,
-replacing them with zeros. Thus, 987.65 rounded to tens (P = 1) becomes 980,
-and rounded to the fourth sigdig becomes 987.6 (A = 4). 123.456 rounded to the
-second place after the decimal point (P = -2) becomes 123.46.
+Round towards zero. Remove all digits following the rounding place, i.e.,
+replace them with zeros. Thus, 987.65 rounded to tens (P=1) becomes 980, and
+rounded to the fourth significant digit becomes 987.6 (A=4). 123.456 rounded to
+the second place after the decimal point (P=-2) becomes 123.46. This
+corresponds to the IEEE 754 rounding mode 'roundTowardZero'.
+
+=back
-All other implemented styles of rounding attempt to round to the "nearest
-digit." If the digit D immediately to the right of the rounding place (skipping
-the decimal point) is greater than 5, the number is incremented at the rounding
-place (possibly causing a cascade of incrementation): e.g. when rounding to
-units, 0.9 rounds to 1, and -19.9 rounds to -20. If D < 5, the number is
-similarly truncated at the rounding place: e.g. when rounding to units, 0.4
-rounds to 0, and -19.4 rounds to -19.
+=head3 Rounding to nearest
-However the results of other styles of rounding differ if the digit immediately
-to the right of the rounding place (skipping the decimal point) is 5 and if
-there are no digits, or no digits other than 0, after that 5. In such cases:
+These rounding modes round to the nearest digit. They differ in how they
+determine which way to round in the ambiguous case when there is a tie.
+
+=over
=item 'even'
-rounds the digit at the rounding place to 0, 2, 4, 6, or 8 if it is not
-already. E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55
-becomes -0.6, but 0.4501 becomes 0.5.
+Round towards the nearest even digit, e.g., when rounding to nearest integer,
+-5.5 becomes -6, 4.5 becomes 4, but 4.501 becomes 5. This corresponds to the
+IEEE 754 rounding mode 'roundTiesToEven'.
=item 'odd'
-rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if it is not
-already. E.g., when rounding to the first sigdig, 0.45 becomes 0.5, -0.55
-becomes -0.5, but 0.5501 becomes 0.6.
+Round towards the nearest odd digit, e.g., when rounding to nearest integer,
+4.5 becomes 5, -5.5 becomes -5, but 5.501 becomes 6. This corresponds to the
+IEEE 754 rounding mode 'roundTiesToOdd'.
=item '+inf'
-round to plus infinity, i.e. always round up. E.g., when rounding to the first
-sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5, and 0.4501 also becomes 0.5.
+Round towards plus infinity, i.e., always round up. E.g., when rounding to the
+nearest integer, 4.5 becomes 5, -5.5 becomes -5, and 4.501 also becomes 5. This
+corresponds to the IEEE 754 rounding mode 'roundTiesToPositive'.
=item '-inf'
-round to minus infinity, i.e. always round down. E.g., when rounding to the
-first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5.
+Round towards minus infinity, i.e., always round down. E.g., when rounding to
+the nearest integer, 4.5 becomes 4, -5.5 becomes -6, but 4.501 becomes 5. This
+corresponds to the IEEE 754 rounding mode 'roundTiesToNegative'.
=item 'zero'
-round to zero, i.e. positive numbers down, negative ones up. E.g., when
-rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.5, but 0.4501
-becomes 0.5.
+Round towards zero, i.e., round positive numbers down and negative numbers up.
+E.g., when rounding to the nearest integer, 4.5 becomes 4, -5.5 becomes -5, but
+4.501 becomes 5. This corresponds to the IEEE 754 rounding mode
+'roundTiesToZero'.
=item 'common'
-round up if the digit immediately to the right of the rounding place is 5 or
-greater, otherwise round down. E.g., 0.15 becomes 0.2 and 0.149 becomes 0.1.
+Round away from zero, i.e., round to the number with the largest absolute
+value. E.g., when rounding to the nearest integer, -1.5 becomes -2, 1.5 becomes
+2 and 1.49 becomes 1. This corresponds to the IEEE 754 rounding mode
+'roundTiesToAway'.
=back
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm
index 571006963f..2bb06a0976 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm
@@ -4,10 +4,10 @@ use 5.006001;
use strict;
use warnings;
-use Carp;
+use Carp qw< carp croak >;
use Math::BigInt::Lib;
-our $VERSION = '1.999811';
+our $VERSION = '1.999816';
our @ISA = ('Math::BigInt::Lib');
@@ -104,8 +104,7 @@ sub _new {
my ($class, $str) = @_;
#unless ($str =~ /^([1-9]\d*|0)\z/) {
- # require Carp;
- # Carp::croak("Invalid input string '$str'");
+ # croak("Invalid input string '$str'");
#}
my $input_len = length($str) - 1;
@@ -264,8 +263,7 @@ sub _str {
my $idx = $#$ary; # index of last element
if ($idx < 0) { # should not happen
- require Carp;
- Carp::croak("$_[1] has no elements");
+ croak("$_[1] has no elements");
}
# Handle first one differently, since it should not have any leading zeros.
@@ -693,7 +691,7 @@ sub _div_use_mul {
my $y = $c->_copy($yorg); # always make copy to preserve
- my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, @d, $tmp, $q, $u2, $u1, $u0);
+ my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0);
$car = $bar = $prd = 0;
if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
@@ -858,7 +856,7 @@ sub _div_use_div_64 {
my $y = $c->_copy($yorg); # always make copy to preserve
- my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, @d, $tmp, $q, $u2, $u1, $u0);
+ my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0);
$car = $bar = $prd = 0;
if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
@@ -2045,7 +2043,6 @@ sub _root {
elsif ($acmp > 0) {
$upper = $y;
- my $zero = $c -> _zero();
while ($acmp > 0) {
if ($c -> _acmp($upper, $delta) <= 0) {
$lower = $c -> _zero();
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm
deleted file mode 100644
index 69c02caffe..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm
+++ /dev/null
@@ -1,394 +0,0 @@
-package Math::BigInt::CalcEmu;
-
-use 5.006001;
-use strict;
-use warnings;
-
-our $VERSION = '1.999811';
-
-package Math::BigInt;
-
-# See SYNOPSIS below.
-
-my $CALC_EMU;
-
-BEGIN
- {
- $CALC_EMU = Math::BigInt->config('lib');
- # register us with MBI to get notified of future lib changes
- Math::BigInt::_register_callback( __PACKAGE__, sub { $CALC_EMU = $_[0]; } );
- }
-
-sub __emu_band
- {
- my ($self,$x,$y,$sx,$sy,@r) = @_;
-
- return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
-
- my $sign = 0; # sign of result
- $sign = 1 if $sx == -1 && $sy == -1;
-
- my ($bx,$by);
-
- if ($sx == -1) # if x is negative
- {
- # two's complement: inc and flip all "bits" in $bx
- $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $bx =~ s/-?0x//;
- $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $bx = $x->as_hex(); # get binary representation
- $bx =~ s/-?0x//;
- $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- if ($sy == -1) # if y is negative
- {
- # two's complement: inc and flip all "bits" in $by
- $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $by =~ s/-?0x//;
- $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $by = $y->as_hex(); # get binary representation
- $by =~ s/-?0x//;
- $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- # now we have bit-strings from X and Y, reverse them for padding
- $bx = reverse $bx;
- $by = reverse $by;
-
- # padd the shorter string
- my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
- my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
- my $diff = CORE::length($bx) - CORE::length($by);
- if ($diff > 0)
- {
- # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
- $by .= $yy x $diff;
- }
- elsif ($diff < 0)
- {
- # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
- $bx .= $xx x abs($diff);
- }
-
- # and the strings together
- my $r = $bx & $by;
-
- # and reverse the result again
- $bx = reverse $r;
-
- # One of $x or $y was negative, so need to flip bits in the result.
- # In both cases (one or two of them negative, or both positive) we need
- # to get the characters back.
- if ($sign == 1)
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
- }
- else
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
- }
-
- # leading zeros will be stripped by _from_hex()
- $bx = '0x' . $bx;
- $x->{value} = $CALC_EMU->_from_hex( $bx );
-
- # calculate sign of result
- $x->{sign} = '+';
- $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
-
- $x->bdec() if $sign == 1;
-
- $x->round(@r);
- }
-
-sub __emu_bior
- {
- my ($self,$x,$y,$sx,$sy,@r) = @_;
-
- return $x->round(@r) if $y->is_zero();
-
- my $sign = 0; # sign of result
- $sign = 1 if ($sx == -1) || ($sy == -1);
-
- my ($bx,$by);
-
- if ($sx == -1) # if x is negative
- {
- # two's complement: inc and flip all "bits" in $bx
- $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $bx =~ s/-?0x//;
- $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $bx = $x->as_hex(); # get binary representation
- $bx =~ s/-?0x//;
- $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- if ($sy == -1) # if y is negative
- {
- # two's complement: inc and flip all "bits" in $by
- $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $by =~ s/-?0x//;
- $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $by = $y->as_hex(); # get binary representation
- $by =~ s/-?0x//;
- $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- # now we have bit-strings from X and Y, reverse them for padding
- $bx = reverse $bx;
- $by = reverse $by;
-
- # padd the shorter string
- my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
- my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
- my $diff = CORE::length($bx) - CORE::length($by);
- if ($diff > 0)
- {
- $by .= $yy x $diff;
- }
- elsif ($diff < 0)
- {
- $bx .= $xx x abs($diff);
- }
-
- # or the strings together
- my $r = $bx | $by;
-
- # and reverse the result again
- $bx = reverse $r;
-
- # one of $x or $y was negative, so need to flip bits in the result
- # in both cases (one or two of them negative, or both positive) we need
- # to get the characters back.
- if ($sign == 1)
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
- }
- else
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
- }
-
- # leading zeros will be stripped by _from_hex()
- $bx = '0x' . $bx;
- $x->{value} = $CALC_EMU->_from_hex( $bx );
-
- # calculate sign of result
- $x->{sign} = '+';
- $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
-
- # if one of X or Y was negative, we need to decrement result
- $x->bdec() if $sign == 1;
-
- $x->round(@r);
- }
-
-sub __emu_bxor
- {
- my ($self,$x,$y,$sx,$sy,@r) = @_;
-
- return $x->round(@r) if $y->is_zero();
-
- my $sign = 0; # sign of result
- $sign = 1 if $x->{sign} ne $y->{sign};
-
- my ($bx,$by);
-
- if ($sx == -1) # if x is negative
- {
- # two's complement: inc and flip all "bits" in $bx
- $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $bx =~ s/-?0x//;
- $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $bx = $x->as_hex(); # get binary representation
- $bx =~ s/-?0x//;
- $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- if ($sy == -1) # if y is negative
- {
- # two's complement: inc and flip all "bits" in $by
- $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc
- $by =~ s/-?0x//;
- $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- else
- {
- $by = $y->as_hex(); # get binary representation
- $by =~ s/-?0x//;
- $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
- }
- # now we have bit-strings from X and Y, reverse them for padding
- $bx = reverse $bx;
- $by = reverse $by;
-
- # padd the shorter string
- my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
- my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
- my $diff = CORE::length($bx) - CORE::length($by);
- if ($diff > 0)
- {
- $by .= $yy x $diff;
- }
- elsif ($diff < 0)
- {
- $bx .= $xx x abs($diff);
- }
-
- # xor the strings together
- my $r = $bx ^ $by;
-
- # and reverse the result again
- $bx = reverse $r;
-
- # one of $x or $y was negative, so need to flip bits in the result
- # in both cases (one or two of them negative, or both positive) we need
- # to get the characters back.
- if ($sign == 1)
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
- }
- else
- {
- $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
- }
-
- # leading zeros will be stripped by _from_hex()
- $bx = '0x' . $bx;
- $x->{value} = $CALC_EMU->_from_hex( $bx );
-
- # calculate sign of result
- $x->{sign} = '+';
- $x->{sign} = '-' if $sx != $sy && !$x->is_zero();
-
- $x->bdec() if $sign == 1;
-
- $x->round(@r);
- }
-
-##############################################################################
-##############################################################################
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
-
-=head1 SYNOPSIS
-
- use Math::BigInt::CalcEmu;
-
-=head1 DESCRIPTION
-
-Contains routines that emulate low-level math functions in BigInt, e.g.
-optional routines the low-level math package does not provide on its own.
-
-Will be loaded on demand and called automatically by BigInt.
-
-Stuff here is really low-priority to optimize, since it is far better to
-implement the operation in the low-level math library directly, possible even
-using a call to the native lib.
-
-=head1 METHODS
-
-=over
-
-=item __emu_bxor
-
-=item __emu_band
-
-=item __emu_bior
-
-=back
-
-=head1 BUGS
-
-Please report any bugs or feature requests to
-C<bug-math-bigint at rt.cpan.org>, or through the web interface at
-L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt>
-(requires login).
-We will be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command.
-
- perldoc Math::BigInt::CalcEmu
-
-You can also look for information at:
-
-=over 4
-
-=item * RT: CPAN's request tracker
-
-L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt>
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/Math-BigInt>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/dist/Math-BigInt>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/Math-BigInt/>
-
-=item * CPAN Testers Matrix
-
-L<http://matrix.cpantesters.org/?dist=Math-BigInt>
-
-=item * The Bignum mailing list
-
-=over 4
-
-=item * Post to mailing list
-
-C<bignum at lists.scsys.co.uk>
-
-=item * View mailing list
-
-L<http://lists.scsys.co.uk/pipermail/bignum/>
-
-=item * Subscribe/Unsubscribe
-
-L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum>
-
-=back
-
-=back
-
-=head1 LICENSE
-
-This program is free software; you may redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=head1 AUTHORS
-
-(c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by
-Tels from 2001-2003.
-
-=head1 SEE ALSO
-
-L<Math::BigInt>, L<Math::BigFloat>,
-L<Math::BigInt::GMP> and L<Math::BigInt::Pari>.
-
-=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm
index 8d0ba4097a..3e772e92a3 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm
@@ -8,7 +8,7 @@ use Math::BigInt::Calc 1.999801;
our @ISA = qw< Math::BigInt::Calc >;
-our $VERSION = '0.5006';
+our $VERSION = '0.5008';
##############################################################################
# global constants, flags and accessory
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
index 23a44aa955..883f31f4c9 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
@@ -4,7 +4,7 @@ use 5.006001;
use strict;
use warnings;
-our $VERSION = '1.999811';
+our $VERSION = '1.999816';
use Carp;
@@ -1076,6 +1076,261 @@ sub _or {
return $z;
}
+sub _sand {
+ my ($class, $x, $sx, $y, $sy) = @_;
+
+ return ($class -> _zero(), '+')
+ if $class -> _is_zero($x) || $class -> _is_zero($y);
+
+ my $sign = $sx eq '-' && $sy eq '-' ? '-' : '+';
+
+ my ($bx, $by);
+
+ if ($sx eq '-') { # if x is negative
+ # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
+ $bx = $class -> _copy($x);
+ $bx = $class -> _dec($bx);
+ $bx = $class -> _as_hex($bx);
+ $bx =~ s/^-?0x//;
+ $bx =~ tr<0123456789abcdef>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ } else { # if x is positive
+ $bx = $class -> _as_hex($x); # get binary representation
+ $bx =~ s/^-?0x//;
+ $bx =~ tr<fedcba9876543210>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ }
+
+ if ($sy eq '-') { # if y is negative
+ # two's complement: inc (dec unsigned value) and flip all "bits" in $by
+ $by = $class -> _copy($y);
+ $by = $class -> _dec($by);
+ $by = $class -> _as_hex($by);
+ $by =~ s/^-?0x//;
+ $by =~ tr<0123456789abcdef>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ } else {
+ $by = $class -> _as_hex($y); # get binary representation
+ $by =~ s/^-?0x//;
+ $by =~ tr<fedcba9876543210>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ }
+
+ # now we have bit-strings from X and Y, reverse them for padding
+ $bx = reverse $bx;
+ $by = reverse $by;
+
+ # padd the shorter string
+ my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
+ my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
+ my $diff = CORE::length($bx) - CORE::length($by);
+ if ($diff > 0) {
+ # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
+ $by .= $yy x $diff;
+ } elsif ($diff < 0) {
+ # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
+ $bx .= $xx x abs($diff);
+ }
+
+ # and the strings together
+ my $r = $bx & $by;
+
+ # and reverse the result again
+ $bx = reverse $r;
+
+ # One of $bx or $by was negative, so need to flip bits in the result. In both
+ # cases (one or two of them negative, or both positive) we need to get the
+ # characters back.
+ if ($sign eq '-') {
+ $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
+ <0123456789abcdef>;
+ } else {
+ $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
+ <fedcba9876543210>;
+ }
+
+ # leading zeros will be stripped by _from_hex()
+ $bx = '0x' . $bx;
+ $bx = $class -> _from_hex($bx);
+
+ $bx = $class -> _inc($bx) if $sign eq '-';
+
+ # avoid negative zero
+ $sign = '+' if $class -> _is_zero($bx);
+
+ return $bx, $sign;
+}
+
+sub _sxor {
+ my ($class, $x, $sx, $y, $sy) = @_;
+
+ return ($class -> _zero(), '+')
+ if $class -> _is_zero($x) && $class -> _is_zero($y);
+
+ my $sign = $sx ne $sy ? '-' : '+';
+
+ my ($bx, $by);
+
+ if ($sx eq '-') { # if x is negative
+ # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
+ $bx = $class -> _copy($x);
+ $bx = $class -> _dec($bx);
+ $bx = $class -> _as_hex($bx);
+ $bx =~ s/^-?0x//;
+ $bx =~ tr<0123456789abcdef>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ } else { # if x is positive
+ $bx = $class -> _as_hex($x); # get binary representation
+ $bx =~ s/^-?0x//;
+ $bx =~ tr<fedcba9876543210>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ }
+
+ if ($sy eq '-') { # if y is negative
+ # two's complement: inc (dec unsigned value) and flip all "bits" in $by
+ $by = $class -> _copy($y);
+ $by = $class -> _dec($by);
+ $by = $class -> _as_hex($by);
+ $by =~ s/^-?0x//;
+ $by =~ tr<0123456789abcdef>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ } else {
+ $by = $class -> _as_hex($y); # get binary representation
+ $by =~ s/^-?0x//;
+ $by =~ tr<fedcba9876543210>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ }
+
+ # now we have bit-strings from X and Y, reverse them for padding
+ $bx = reverse $bx;
+ $by = reverse $by;
+
+ # padd the shorter string
+ my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
+ my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
+ my $diff = CORE::length($bx) - CORE::length($by);
+ if ($diff > 0) {
+ # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
+ $by .= $yy x $diff;
+ } elsif ($diff < 0) {
+ # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
+ $bx .= $xx x abs($diff);
+ }
+
+ # xor the strings together
+ my $r = $bx ^ $by;
+
+ # and reverse the result again
+ $bx = reverse $r;
+
+ # One of $bx or $by was negative, so need to flip bits in the result. In both
+ # cases (one or two of them negative, or both positive) we need to get the
+ # characters back.
+ if ($sign eq '-') {
+ $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
+ <0123456789abcdef>;
+ } else {
+ $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
+ <fedcba9876543210>;
+ }
+
+ # leading zeros will be stripped by _from_hex()
+ $bx = '0x' . $bx;
+ $bx = $class -> _from_hex($bx);
+
+ $bx = $class -> _inc($bx) if $sign eq '-';
+
+ # avoid negative zero
+ $sign = '+' if $class -> _is_zero($bx);
+
+ return $bx, $sign;
+}
+
+sub _sor {
+ my ($class, $x, $sx, $y, $sy) = @_;
+
+ return ($class -> _zero(), '+')
+ if $class -> _is_zero($x) && $class -> _is_zero($y);
+
+ my $sign = $sx eq '-' || $sy eq '-' ? '-' : '+';
+
+ my ($bx, $by);
+
+ if ($sx eq '-') { # if x is negative
+ # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
+ $bx = $class -> _copy($x);
+ $bx = $class -> _dec($bx);
+ $bx = $class -> _as_hex($bx);
+ $bx =~ s/^-?0x//;
+ $bx =~ tr<0123456789abcdef>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ } else { # if x is positive
+ $bx = $class -> _as_hex($x); # get binary representation
+ $bx =~ s/^-?0x//;
+ $bx =~ tr<fedcba9876543210>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ }
+
+ if ($sy eq '-') { # if y is negative
+ # two's complement: inc (dec unsigned value) and flip all "bits" in $by
+ $by = $class -> _copy($y);
+ $by = $class -> _dec($by);
+ $by = $class -> _as_hex($by);
+ $by =~ s/^-?0x//;
+ $by =~ tr<0123456789abcdef>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ } else {
+ $by = $class -> _as_hex($y); # get binary representation
+ $by =~ s/^-?0x//;
+ $by =~ tr<fedcba9876543210>
+ <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
+ }
+
+ # now we have bit-strings from X and Y, reverse them for padding
+ $bx = reverse $bx;
+ $by = reverse $by;
+
+ # padd the shorter string
+ my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
+ my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
+ my $diff = CORE::length($bx) - CORE::length($by);
+ if ($diff > 0) {
+ # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
+ $by .= $yy x $diff;
+ } elsif ($diff < 0) {
+ # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
+ $bx .= $xx x abs($diff);
+ }
+
+ # or the strings together
+ my $r = $bx | $by;
+
+ # and reverse the result again
+ $bx = reverse $r;
+
+ # One of $bx or $by was negative, so need to flip bits in the result. In both
+ # cases (one or two of them negative, or both positive) we need to get the
+ # characters back.
+ if ($sign eq '-') {
+ $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
+ <0123456789abcdef>;
+ } else {
+ $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
+ <fedcba9876543210>;
+ }
+
+ # leading zeros will be stripped by _from_hex()
+ $bx = '0x' . $bx;
+ $bx = $class -> _from_hex($bx);
+
+ $bx = $class -> _inc($bx) if $sign eq '-';
+
+ # avoid negative zero
+ $sign = '+' if $class -> _is_zero($bx);
+
+ return $bx, $sign;
+}
+
sub _to_bin {
# convert the number to a string of binary digits without prefix
my ($class, $x) = @_;
@@ -1162,6 +1417,43 @@ sub _to_bytes {
*_as_bytes = \&_to_bytes;
+sub _to_base {
+ # convert the number to a string of digits in various bases
+ my $class = shift;
+ my $x = shift;
+ my $base = shift;
+ $base = $class -> _new($base) unless ref($base);
+
+ my $collseq;
+ if (@_) {
+ $collseq = shift();
+ } else {
+ if ($class -> _acmp($base, $class -> _new("62")) <= 0) {
+ $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+ . 'abcdefghijklmnopqrstuvwxyz';
+ } else {
+ croak "When base > 62, a collation sequence must be given";
+ }
+ }
+
+ my @collseq = split '', $collseq;
+ my %collseq = map { $_ => $collseq[$_] } 0 .. $#collseq;
+
+ my $str = '';
+ my $tmp = $class -> _copy($x);
+ my $rem;
+ until ($class -> _is_zero($tmp)) {
+ ($tmp, $rem) = $class -> _div($tmp, $base);
+ my $num = $class -> _num($rem);
+ croak "no character to represent '$num' in collation sequence",
+ " (collation sequence is too short)" if $num > $#collseq;
+ my $chr = $collseq[$num];
+ $str = $chr . $str;
+ }
+ return "0" unless length $str;
+ return $str;
+}
+
sub _from_hex {
# Convert a string of hexadecimal digits to a number.
@@ -1264,6 +1556,56 @@ sub _from_bytes {
return $x;
}
+sub _from_base {
+ # convert a string to a decimal number
+ my $class = shift;
+ my $str = shift;
+ my $base = shift;
+ $base = $class -> _new($base) unless ref($base);
+
+ my $n = length($str);
+ my $x = $class -> _zero();
+
+ my $collseq;
+ if (@_) {
+ $collseq = shift();
+ } else {
+ if ($class -> _acmp($base, $class -> _new("36")) <= 0) {
+ $str = uc $str;
+ $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+ } elsif ($class -> _acmp($base, $class -> _new("62")) <= 0) {
+ $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
+ . 'abcdefghijklmnopqrstuvwxyz';
+ } else {
+ croak "When base > 62, a collation sequence must be given";
+ }
+ $collseq = substr $collseq, 0, $class -> _num($base);
+ }
+
+ # Create a mapping from each character in the collation sequence to the
+ # corresponding integer. Check for duplicates in the collation sequence.
+
+ my @collseq = split '', $collseq;
+ my %collseq;
+ for my $num (0 .. $#collseq) {
+ my $chr = $collseq[$num];
+ die "duplicate character '$chr' in collation sequence"
+ if exists $collseq{$chr};
+ $collseq{$chr} = $num;
+ }
+
+ for (my $i = 0 ; $i < $n ; ++$i) {
+ my $chr = substr($str, $i, 1);
+ die "input character '$chr' does not exist in collation sequence"
+ unless exists $collseq{$chr};
+ $x = $class -> _mul($x, $base);
+ my $num = $class -> _new($collseq{$chr});
+ $x = $class -> _add($x, $num);
+ }
+
+ return $x;
+}
+
##############################################################################
# special modulus functions
@@ -1637,6 +1979,37 @@ Returns an object given a byte string representing the number. The byte string
is in big endian byte order, so the two-byte input string "\x01\x00" should
give an output value representing the number 256.
+=item CLASS-E<gt>_from_base(STR, BASE, COLLSEQ)
+
+Returns an object given a string STR, a base BASE, and a collation sequence
+COLLSEQ. Each character in STR represents a numerical value identical to the
+character's position in COLLSEQ. All characters in STR must be present in
+COLLSEQ.
+
+If BASE is less than or equal to 62, and a collation sequence is not specified,
+a default collation sequence consisting of the 62 characters 0..9, A..Z, and
+a..z is used. If the default collation sequence is used, and the BASE is less
+than or equal to 36, the letter case in STR is ignored.
+
+For instance, with base 3 and collation sequence "-/|", the character "-"
+represents 0, "/" represents 1, and "|" represents 2. So if STR is "/|-", the
+output is 1 * 3**2 + 2 * 3**1 + 0 * 3**0 = 15.
+
+The following examples show standard binary, octal, decimal, and hexadecimal
+conversion. All examples return 250.
+
+ $x = $class -> _from_base("11111010", 2)
+ $x = $class -> _from_base("372", 8)
+ $x = $class -> _from_base("250", 10)
+ $x = $class -> _from_base("FA", 16)
+
+Some more examples, all returning 250:
+
+ $x = $class -> _from_base("100021", 3, "012")
+ $x = $class -> _from_base("3322", 4, "0123")
+ $x = $class -> _from_base("2000", 5, "01234")
+ $x = $class -> _from_base("caaa", 5, "abcde")
+
=back
=head3 Mathematical functions
@@ -1775,11 +2148,23 @@ Returns bitwise and.
=item CLASS-E<gt>_or(OBJ1, OBJ2)
-Return bitwise or.
+Returns bitwise or.
=item CLASS-E<gt>_xor(OBJ1, OBJ2)
-Return bitwise exclusive or.
+Returns bitwise exclusive or.
+
+=item CLASS-E<gt>_sand(OBJ1, OBJ2, SIGN1, SIGN2)
+
+Returns bitwise signed and.
+
+=item CLASS-E<gt>_sor(OBJ1, OBJ2, SIGN1, SIGN2)
+
+Returns bitwise signed or.
+
+=item CLASS-E<gt>_sxor(OBJ1, OBJ2, SIGN1, SIGN2)
+
+Returns bitwise signed exclusive or.
=back
@@ -1845,6 +2230,19 @@ Returns a byte string representation of OBJ. The byte string is in big endian
byte order, so if OBJ represents the number 256, the output should be the
two-byte string "\x01\x00".
+=item CLASS-E<gt>_to_base(OBJ, BASE, COLLSEQ)
+
+Returns a string representation of OBJ in base BASE with collation sequence
+COLLSEQ.
+
+ $val = $class -> _new("210");
+ $str = $class -> _to_base($val, 10, "xyz") # $str is "zyx"
+
+ $val = $class -> _new("32");
+ $str = $class -> _to_base($val, 2, "-|") # $str is "|-----"
+
+See _from_base() for more information.
+
=item CLASS-E<gt>_as_bin(OBJ)
Like C<_to_bin()> but with a '0b' prefix.
@@ -1951,30 +2349,6 @@ Perl scalar.
=back
-=head2 API optional methods
-
-The following methods are optional, and can be defined if the underlying lib
-has a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence
-slow) fallback routines to emulate these:
-
-=head3 Signed bitwise operators.
-
-=over 4
-
-=item CLASS-E<gt>_signed_or(OBJ1, OBJ2, SIGN1, SIGN2)
-
-Return the signed bitwise or.
-
-=item CLASS-E<gt>_signed_and(OBJ1, OBJ2, SIGN1, SIGN2)
-
-Return the signed bitwise and.
-
-=item CLASS-E<gt>_signed_xor(OBJ1, OBJ2, SIGN1, SIGN2)
-
-Return the signed bitwise exclusive or.
-
-=back
-
=head1 WRAP YOUR OWN
If you want to port your own favourite C library for big numbers to the
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Trace.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Trace.pm
index 5f83c79210..5517bedad9 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Trace.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Trace.pm
@@ -13,7 +13,7 @@ our ($accuracy, $precision, $round_mode, $div_scale);
our @ISA = qw(Exporter Math::BigInt);
-our $VERSION = '0.49';
+our $VERSION = '0.51';
use overload; # inherit overload from Math::BigInt
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat.pm
index 520b443b01..e3d172836c 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat.pm
@@ -16,11 +16,11 @@ use 5.006;
use strict;
use warnings;
-use Carp ();
+use Carp qw< carp croak >;
use Math::BigFloat 1.999718;
-our $VERSION = '0.2613';
+our $VERSION = '0.2614';
our @ISA = qw(Math::BigFloat);
@@ -42,7 +42,6 @@ use overload
'/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0])
: $_[0] -> copy() -> bdiv($_[1]); },
-
'%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0])
: $_[0] -> copy() -> bmod($_[1]); },
@@ -69,7 +68,6 @@ use overload
'**=' => sub { $_[0]->bpow($_[1]); },
-
'<<=' => sub { $_[0]->blsft($_[1]); },
'>>=' => sub { $_[0]->brsft($_[1]); },
@@ -207,7 +205,7 @@ BEGIN {
# only one library loaded)
*_e_add = \&Math::BigFloat::_e_add;
*_e_sub = \&Math::BigFloat::_e_sub;
- *as_int = \&as_number;
+ *as_number = \&as_int;
*is_pos = \&is_positive;
*is_neg = \&is_negative;
}
@@ -226,8 +224,7 @@ $downgrade = undef;
$_trap_nan = 0; # are NaNs ok? set w/ config()
$_trap_inf = 0; # are infs ok? set w/ config()
-# the package we are using for our private parts, defaults to:
-# Math::BigInt->config()->{lib}
+# the math backend library
my $LIB = 'Math::BigInt::Calc';
@@ -249,17 +246,17 @@ sub new {
# Check the way we are called.
if ($protoref) {
- Carp::croak("new() is a class method, not an instance method");
+ croak("new() is a class method, not an instance method");
}
if (@_ < 1) {
- #Carp::carp("Using new() with no argument is deprecated;",
+ #carp("Using new() with no argument is deprecated;",
# " use bzero() or new(0) instead");
return $class -> bzero();
}
if (@_ > 2) {
- Carp::carp("Superfluous arguments to new() ignored.");
+ carp("Superfluous arguments to new() ignored.");
}
# Get numerator and denominator. If any of the arguments is undefined,
@@ -270,7 +267,7 @@ sub new {
if (@_ == 1 && !defined $n ||
@_ == 2 && (!defined $n || !defined $d))
{
- #Carp::carp("Use of uninitialized value in new()");
+ #carp("Use of uninitialized value in new()");
return $class -> bzero();
}
@@ -553,7 +550,7 @@ sub bnan {
$self = bless {}, $class unless $selfref;
if ($_trap_nan) {
- Carp::croak ("Tried to set a variable to NaN in $class->bnan()");
+ croak ("Tried to set a variable to NaN in $class->bnan()");
}
$self -> {sign} = $nan;
@@ -577,7 +574,7 @@ sub binf {
$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()");
+ croak ("Tried to set a variable to +-inf in $class->binf()");
}
$self -> {sign} = $sign;
@@ -685,10 +682,10 @@ sub bnorm {
# Both parts must be objects of whatever we are using today.
if (my $c = $LIB->_check($x->{_n})) {
- Carp::croak("n did not pass the self-check ($c) in bnorm()");
+ croak("n did not pass the self-check ($c) in bnorm()");
}
if (my $c = $LIB->_check($x->{_d})) {
- Carp::croak("d did not pass the self-check ($c) in bnorm()");
+ croak("d did not pass the self-check ($c) in bnorm()");
}
# no normalize for NaN, inf etc.
@@ -742,7 +739,7 @@ sub _bnan {
# partial object (happens under trap_nan), so fix it beforehand
$self->{_d} = $LIB->_zero() unless defined $self->{_d};
$self->{_n} = $LIB->_zero() unless defined $self->{_n};
- Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
+ croak ("Tried to set $self to NaN in $class\::_bnan()");
}
$self->{_n} = $LIB->_zero();
$self->{_d} = $LIB->_zero();
@@ -758,7 +755,7 @@ sub _binf {
# partial object (happens under trap_nan), so fix it beforehand
$self->{_d} = $LIB->_zero() unless defined $self->{_d};
$self->{_n} = $LIB->_zero() unless defined $self->{_n};
- Carp::croak ("Tried to set $self to inf in $class\::_binf()");
+ croak ("Tried to set $self to inf in $class\::_binf()");
}
$self->{_n} = $LIB->_zero();
$self->{_d} = $LIB->_zero();
@@ -1137,9 +1134,11 @@ 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 && $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d}));
+ croak "too many arguments for is_one()" if @_ > 2;
+ my $sign = $_[1] || '';
+ $sign = '+' if $sign ne '-';
+ return 1 if ($x->{sign} eq $sign &&
+ $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d}));
0;
}
@@ -1280,69 +1279,62 @@ sub bpow {
($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();
+ # $x and/or $y is a NaN
+ return $x->bnan() if $x->is_nan() || $y->is_nan();
- if ($x->{sign} eq '-' && $LIB->_is_one($x->{_n}) && $LIB->_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;
+ # $x and/or $y is a +/-Inf
+ if ($x->is_inf("-")) {
+ return $x->bzero() if $y->is_negative();
+ return $x->bnan() if $y->is_zero();
+ return $x if $y->is_odd();
+ return $x->bneg();
+ } elsif ($x->is_inf("+")) {
+ return $x->bzero() if $y->is_negative();
+ return $x->bnan() if $y->is_zero();
+ return $x;
+ } elsif ($y->is_inf("-")) {
+ return $x->bnan() if $x -> is_one("-");
+ return $x->binf("+") if $x > -1 && $x < 1;
+ return $x->bone() if $x -> is_one("+");
+ return $x->bzero();
+ } elsif ($y->is_inf("+")) {
+ return $x->bnan() if $x -> is_one("-");
+ return $x->bzero() if $x > -1 && $x < 1;
+ return $x->bone() if $x -> is_one("+");
+ return $x->binf("+");
+ }
+
+ if ($x->is_zero()) {
+ return $x->binf() if $y->is_negative();
+ return $x->bone("+") if $y->is_zero();
+ return $x;
+ } elsif ($x->is_one()) {
+ return $x->round(@r) if $y->is_odd(); # x is -1, y is odd => -1
+ return $x->babs()->round(@r); # x is -1, y is even => 1
+ } elsif ($y->is_zero()) {
+ return $x->bone(@r); # x^0 and x != 0 => 1
+ } elsif ($y->is_one()) {
+ return $x->round(@r); # x^1 => x
}
- # 1 ** -y => 1 / (1 ** |y|)
- # so do test for negative $y after above's clause
- return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
-
- # shortcut if y == 1/N (is then sqrt() respective broot())
- if ($LIB->_is_one($y->{_n})) {
- return $x->bsqrt(@r) if $LIB->_is_two($y->{_d}); # 1/2 => sqrt
- return $x->broot($LIB->_str($y->{_d}), @r); # 1/N => root(N)
- }
+ # we don't support complex numbers, so return NaN
+ return $x->bnan() if $x->is_negative() && !$y->is_int();
- # shortcut y/1 (and/or x/1)
- if ($LIB->_is_one($y->{_d})) {
- # shortcut for x/1 and y/1
- if ($LIB->_is_one($x->{_d})) {
- $x->{_n} = $LIB->_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 '-' && $LIB->_is_even($y->{_n});
- }
- return $x->round(@r);
- }
+ # (a/b)^-(c/d) = (b/a)^(c/d)
+ ($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}) if $y->is_negative();
- # x/z ** y/1
- $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y
+ unless ($LIB->_is_one($y->{_n})) {
+ $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n});
$x->{_d} = $LIB->_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; + ** + => +
-
$x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_even($y->{_n});
- return $x->round(@r);
}
- # print STDERR "# $x $y\n";
-
- # otherwise:
-
- # n/d n ______________
- # a/b = -\/ (a/b) ** d
-
- # (a/b) ** n == (a ** n) / (b ** n)
- $LIB->_pow($x->{_n}, $y->{_n});
- $LIB->_pow($x->{_d}, $y->{_n});
+ unless ($LIB->_is_one($y->{_d})) {
+ return $x->bsqrt(@r) if $LIB->_is_two($y->{_d}); # 1/2 => sqrt
+ return $x->broot($LIB->_str($y->{_d}), @r); # 1/N => root(N)
+ }
- return $x->broot($LIB->_str($y->{_d}), @r); # n/d => root(n)
+ return $x->round(@r);
}
sub blog {
@@ -1616,16 +1608,38 @@ sub bsqrt {
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;
+ my $n = $x -> {_n};
+ my $d = $x -> {_d};
+
+ # Look for an exact solution. For the numerator and the denominator, take
+ # the square root and square it and see if we got the original value. If we
+ # did, for both the numerator and the denominator, we have an exact
+ # solution.
+
+ {
+ my $nsqrt = $LIB -> _sqrt($LIB -> _copy($n));
+ my $n2 = $LIB -> _mul($LIB -> _copy($nsqrt), $nsqrt);
+ if ($LIB -> _acmp($n, $n2) == 0) {
+ my $dsqrt = $LIB -> _sqrt($LIB -> _copy($d));
+ my $d2 = $LIB -> _mul($LIB -> _copy($dsqrt), $dsqrt);
+ if ($LIB -> _acmp($d, $d2) == 0) {
+ $x -> {_n} = $nsqrt;
+ $x -> {_d} = $dsqrt;
+ return $x->round(@r);
+ }
+ }
+ }
+
+ local $Math::BigFloat::upgrade = undef;
local $Math::BigFloat::downgrade = undef;
local $Math::BigFloat::precision = undef;
- local $Math::BigFloat::accuracy = undef;
- local $Math::BigInt::upgrade = undef;
- local $Math::BigInt::precision = undef;
- local $Math::BigInt::accuracy = undef;
+ local $Math::BigFloat::accuracy = undef;
+ local $Math::BigInt::upgrade = undef;
+ local $Math::BigInt::precision = undef;
+ local $Math::BigInt::accuracy = undef;
- my $xn = Math::BigFloat -> new($LIB -> _str($x->{_n}));
- my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
+ my $xn = Math::BigFloat -> new($LIB -> _str($n));
+ my $xd = Math::BigFloat -> new($LIB -> _str($d));
my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> bsqrt() -> bsstr());
@@ -1671,8 +1685,8 @@ sub band {
my $xref = ref($x);
my $class = $xref || $x;
- Carp::croak 'band() is an instance method, not a class method' unless $xref;
- Carp::croak 'Not enough arguments for band()' if @_ < 1;
+ croak 'band() is an instance method, not a class method' unless $xref;
+ croak 'Not enough arguments for band()' if @_ < 1;
my $y = shift;
$y = $class -> new($y) unless ref($y);
@@ -1695,8 +1709,8 @@ sub bior {
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;
+ croak 'bior() is an instance method, not a class method' unless $xref;
+ croak 'Not enough arguments for bior()' if @_ < 1;
my $y = shift;
$y = $class -> new($y) unless ref($y);
@@ -1719,8 +1733,8 @@ sub bxor {
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;
+ croak 'bxor() is an instance method, not a class method' unless $xref;
+ croak 'Not enough arguments for bxor()' if @_ < 1;
my $y = shift;
$y = $class -> new($y) unless ref($y);
@@ -1743,7 +1757,7 @@ sub bnot {
my $xref = ref($x);
my $class = $xref || $x;
- Carp::croak 'bnot() is an instance method, not a class method' unless $xref;
+ croak 'bnot() is an instance method, not a class method' unless $xref;
my @r = @_;
@@ -1852,8 +1866,8 @@ sub beq {
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;
+ croak 'beq() is an instance method, not a class method' unless $selfref;
+ croak 'Wrong number of arguments for beq()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && ! $cmp;
@@ -1864,8 +1878,8 @@ sub bne {
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;
+ croak 'bne() is an instance method, not a class method' unless $selfref;
+ croak 'Wrong number of arguments for bne()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && ! $cmp ? '' : 1;
@@ -1876,8 +1890,8 @@ sub blt {
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;
+ croak 'blt() is an instance method, not a class method' unless $selfref;
+ croak 'Wrong number of arguments for blt()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp < 0;
@@ -1888,8 +1902,8 @@ sub ble {
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;
+ croak 'ble() is an instance method, not a class method' unless $selfref;
+ croak 'Wrong number of arguments for ble()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp <= 0;
@@ -1900,8 +1914,8 @@ sub bgt {
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;
+ croak 'bgt() is an instance method, not a class method' unless $selfref;
+ croak 'Wrong number of arguments for bgt()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp > 0;
@@ -1912,9 +1926,9 @@ sub bge {
my $selfref = ref $self;
my $class = $selfref || $self;
- Carp::croak 'bge() is an instance method, not a class method'
+ croak 'bge() is an instance method, not a class method'
unless $selfref;
- Carp::croak 'Wrong number of arguments for bge()' unless @_ == 1;
+ croak 'Wrong number of arguments for bge()' unless @_ == 1;
my $cmp = $self -> bcmp(shift);
return defined($cmp) && $cmp >= 0;
@@ -1941,7 +1955,7 @@ sub numify {
return $x->{sign} eq '-' ? 0 - $abs : 0 + $abs;
}
-sub as_number {
+sub as_int {
my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
# NaN, inf etc
@@ -2076,13 +2090,13 @@ sub import {
# LIB already loaded, so feed it our lib arguments
Math::BigInt->import(@import);
- $LIB = Math::BigFloat->config()->{lib};
+ $LIB = Math::BigFloat->config("lib");
# register us with LIB to get notified of future lib changes
Math::BigInt::_register_callback($class, sub { $LIB = $_[0]; });
- # any non :constant stuff is handled by our parent, Exporter (loaded
- # by Math::BigFloat, even if @_ is empty, to give it a chance
+ # any non :constant stuff is handled by Exporter (loaded by parent class)
+ # even if @_ is empty, to give it a chance
$class->SUPER::import(@a); # for subclasses
$class->export_to_level(1, $class, @a); # need this, too
}
@@ -2193,7 +2207,7 @@ BigInts.
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()/as_number()"> or L</as_float()> instead.
+use L</as_int()> or L</as_float()> instead.
This routine is automatically used whenever a scalar is required:
@@ -2201,7 +2215,9 @@ This routine is automatically used whenever a scalar is required:
@array = (0, 1, 2, 3);
$y = $array[$x]; # set $y to 3
-=item as_int()/as_number()
+=item as_int()
+
+=item as_number()
$x = Math::BigRat->new('13/7');
print $x->as_int(), "\n"; # '1'
@@ -2642,21 +2658,19 @@ This method was added in v0.20 of Math::BigRat (May 2007).
=item config()
- use Data::Dumper;
-
- print Dumper ( Math::BigRat->config() );
- print Math::BigRat->config()->{lib}, "\n";
+ Math::BigRat->config("trap_nan" => 1); # set
+ $accu = Math::BigRat->config("accuracy"); # get
-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.
+Set or get configuration parameter values. Read-only parameters are marked as
+RO. Read-write parameters are marked as RW. The following parameters are
+supported.
- key RO/RW Description
+ Parameter RO/RW Description
Example
============================================================
- lib RO Name of the Math library
+ lib RO Name of the math backend library
Math::BigInt::Calc
- lib_version RO Version of 'lib'
+ lib_version RO Version of the math backend library
0.30
class RO The class of config you just called
Math::BigRat
@@ -2672,17 +2686,13 @@ appropriate information.
undef
round_mode RW Global round mode
even
- div_scale RW Fallback accuracy for div
+ div_scale RW Fallback accuracy for div, sqrt etc.
40
- trap_nan RW Trap creation of NaN (undef = no)
+ trap_nan RW Trap NaNs
undef
- trap_inf RW Trap creation of +inf/-inf (undef = no)
+ trap_inf RW Trap +inf/-inf
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.
-
=back
=head1 BUGS