summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Math/BigInt.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Math/BigInt.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Math/BigInt.pm1123
1 files changed, 619 insertions, 504 deletions
diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt.pm b/Master/tlpkg/tlperl/lib/Math/BigInt.pm
index 9fd9bd02ba3..a443cd4a5d4 100644
--- a/Master/tlpkg/tlperl/lib/Math/BigInt.pm
+++ b/Master/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