summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Math
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Math')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm3873
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm60
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm4335
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm1056
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm148
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm236
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Trace.pm60
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat.pm902
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat/Trace.pm76
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/Complex.pm4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/Trig.pm94
11 files changed, 6997 insertions, 3847 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm
index f1d7a1a0a0..66300a4928 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm
@@ -16,10 +16,12 @@ use 5.006001;
use strict;
use warnings;
-use Carp qw< carp croak >;
-use Math::BigInt ();
+use Carp qw< carp croak >;
+use Scalar::Util qw< blessed >;
+use Math::BigInt qw< >;
-our $VERSION = '1.999818';
+our $VERSION = '1.999837';
+$VERSION =~ tr/_//d;
require Exporter;
our @ISA = qw/Math::BigInt/;
@@ -58,21 +60,21 @@ use overload
# overload key: assign
- '+=' => sub { $_[0]->badd($_[1]); },
+ '+=' => sub { $_[0] -> badd($_[1]); },
- '-=' => sub { $_[0]->bsub($_[1]); },
+ '-=' => sub { $_[0] -> bsub($_[1]); },
- '*=' => sub { $_[0]->bmul($_[1]); },
+ '*=' => sub { $_[0] -> bmul($_[1]); },
- '/=' => sub { scalar $_[0]->bdiv($_[1]); },
+ '/=' => sub { scalar $_[0] -> bdiv($_[1]); },
- '%=' => sub { $_[0]->bmod($_[1]); },
+ '%=' => sub { $_[0] -> bmod($_[1]); },
- '**=' => sub { $_[0]->bpow($_[1]); },
+ '**=' => sub { $_[0] -> bpow($_[1]); },
- '<<=' => sub { $_[0]->blsft($_[1]); },
+ '<<=' => sub { $_[0] -> blsft($_[1]); },
- '>>=' => sub { $_[0]->brsft($_[1]); },
+ '>>=' => sub { $_[0] -> brsft($_[1]); },
# 'x=' => sub { },
@@ -194,7 +196,7 @@ use overload
'0+' => sub { $_[0] -> numify(); },
- '=' => sub { $_[0]->copy(); },
+ '=' => sub { $_[0] -> copy(); },
;
@@ -259,8 +261,7 @@ BEGIN {
$rnd_mode = 'even';
tie $rnd_mode, 'Math::BigFloat';
- # we need both of them in this package:
- *as_int = \&as_number;
+ *as_number = \&as_int;
}
sub DESTROY {
@@ -270,7 +271,6 @@ sub DESTROY {
sub AUTOLOAD {
# make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx()
my $name = $AUTOLOAD;
-
$name =~ s/(.*):://; # split package
my $c = $1 || __PACKAGE__;
no strict 'refs';
@@ -284,7 +284,8 @@ sub AUTOLOAD {
# delayed load of Carp and avoid recursion
croak("Can't call $c\-\>$name, not a valid method");
}
- # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
+ # try one level up, but subst. bxxx() for fxxx() since MBI only got
+ # bxxx()
$name =~ s/^f/b/;
return &{"Math::BigInt"."::$name"}(@_);
}
@@ -351,7 +352,8 @@ sub config {
###############################################################################
sub new {
- # Create a new Math::BigFloat object from a string or another bigfloat object.
+ # Create a new Math::BigFloat object from a string or another bigfloat
+ # object.
# _e: exponent
# _m: mantissa
# sign => ("+", "-", "+inf", "-inf", or "NaN")
@@ -360,193 +362,212 @@ sub new {
my $selfref = ref $self;
my $class = $selfref || $self;
- my ($wanted, @r) = @_;
+ # Make "require" work.
- # avoid numify-calls by not using || on $wanted!
+ $class -> import() if $IMPORT == 0;
- unless (defined $wanted) {
- #carp("Use of uninitialized value in new");
- return $self->bzero(@r);
- }
+ # Although this use has been discouraged for more than 10 years, people
+ # apparently still use it, so we still support it.
- # Using $wanted->isa("Math::BigFloat") here causes a 'Deep recursion on
- # subroutine "Math::BigFloat::as_number"' in some tests. Fixme!
+ return $class -> bzero() unless @_;
- if (UNIVERSAL::isa($wanted, 'Math::BigFloat')) {
- my $copy = $wanted -> copy();
- if ($selfref) { # if new() called as instance method
- %$self = %$copy;
- } else { # if new() called as class method
- $self = $copy;
- }
- return $copy;
+ my ($wanted, @r) = @_;
+
+ if (!defined($wanted)) {
+ #if (warnings::enabled("uninitialized")) {
+ # warnings::warn("uninitialized",
+ # "Use of uninitialized value in new()");
+ #}
+ return $class -> bzero(@r);
}
- $class->import() if $IMPORT == 0; # make require work
+ if (!ref($wanted) && $wanted eq "") {
+ #if (warnings::enabled("numeric")) {
+ # warnings::warn("numeric",
+ # q|Argument "" isn't numeric in new()|);
+ #}
+ #return $class -> bzero(@r);
+ return $class -> bnan(@r);
+ }
- # If called as a class method, initialize a new object.
+ # Initialize a new object.
$self = bless {}, $class unless $selfref;
- # 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} = $LIB->_zero();
- $self->{_es} = '+';
- $self->{sign} = $wanted->sign();
- return $self->bnorm();
+ # Math::BigFloat or subclass
+
+ if (defined(blessed($wanted)) && $wanted -> isa($class)) {
+
+ # Don't copy the accuracy and precision, because a new object should get
+ # them from the global configuration.
+
+ $self -> {sign} = $wanted -> {sign};
+ $self -> {_m} = $LIB -> _copy($wanted -> {_m});
+ $self -> {_es} = $wanted -> {_es};
+ $self -> {_e} = $LIB -> _copy($wanted -> {_e});
+ $self = $self->round(@r)
+ unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
+ return $self;
}
- # else: got a string or something masquerading as number (with overload)
+ # Shortcut for Math::BigInt and its subclasses. This should be improved.
+
+ if (defined(blessed($wanted))) {
+ if ($wanted -> isa('Math::BigInt')) {
+ $self->{sign} = $wanted -> {sign};
+ $self->{_m} = $LIB -> _copy($wanted -> {value});
+ $self->{_es} = '+';
+ $self->{_e} = $LIB -> _zero();
+ return $self -> bnorm();
+ }
+
+ if ($wanted -> can("as_number")) {
+ $self->{sign} = $wanted -> sign();
+ $self->{_m} = $wanted -> as_number() -> {value};
+ $self->{_es} = '+';
+ $self->{_e} = $LIB -> _zero();
+ return $self -> bnorm();
+ }
+ }
+
+ # Shortcut for simple forms like '123' that have no trailing zeros. Trailing
+ # zeros would require a non-zero exponent.
+
+ if ($wanted =~
+ / ^
+ \s* # optional leading whitespace
+ ( [+-]? ) # optional sign
+ 0* # optional leading zeros
+ ( [1-9] (?: [0-9]* [1-9] )? ) # significand
+ \s* # optional trailing whitespace
+ $
+ /x)
+ {
+ return $downgrade -> new($1 . $2) if defined $downgrade;
+ $self->{sign} = $1 || '+';
+ $self->{_m} = $LIB -> _new($2);
+ $self->{_es} = '+';
+ $self->{_e} = $LIB -> _zero();
+ $self = $self->round(@r)
+ unless @r >= 2 && !defined $r[0] && !defined $r[1];
+ return $self;
+ }
# Handle Infs.
- if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) {
- return $downgrade->new($wanted) if $downgrade;
+ if ($wanted =~ / ^
+ \s*
+ ( [+-]? )
+ inf (?: inity )?
+ \s*
+ \z
+ /ix)
+ {
my $sgn = $1 || '+';
- $self->{sign} = $sgn . 'inf'; # set a default sign for bstr()
- return $self->binf($sgn);
+ return $class -> binf($sgn, @r);
}
# Handle explicit NaNs (not the ones returned due to invalid input).
- if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) {
- return $downgrade->new($wanted) if $downgrade;
- $self = $class -> bnan();
- $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
- return $self;
+ if ($wanted =~ / ^
+ \s*
+ ( [+-]? )
+ nan
+ \s*
+ \z
+ /ix)
+ {
+ return $class -> bnan(@r);
}
- # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they
- # have a "0x" or "0X" prefix.
+ my @parts;
- if ($wanted =~ /^\s*[+-]?0[Xx]/) {
- $self = $class -> from_hex($wanted);
- $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
- return $self;
- }
+ if (
+ # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they
+ # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct().
+
+ $wanted =~ /^\s*[+-]?0?[Xx]/ and
+ @parts = $class -> _hex_str_to_flt_lib_parts($wanted)
+
+ or
- # Handle octal numbers. We auto-detect octal numbers if they have a "0"
- # prefix and a binary exponent.
+ # Handle octal numbers. We auto-detect octal numbers if they have a
+ # "0o", "0O", "o", "O" prefix, cf. CORE::oct().
- if ($wanted =~ /
- ^
- \s*
+ $wanted =~ /^\s*[+-]?0?[Oo]/ and
+ @parts = $class -> _oct_str_to_flt_lib_parts($wanted)
- # sign
- [+-]?
+ or
- # prefix
- 0
+ # Handle binary numbers. We auto-detect binary numbers if they have a
+ # "0b", "0B", "b", or "B" prefix, cf. CORE::oct().
- # significand using the octal digits 0..7
- [0-7]+ (?: _ [0-7]+ )*
- (?:
- \.
- (?: [0-7]+ (?: _ [0-7]+ )* )?
- )?
+ $wanted =~ /^\s*[+-]?0?[Bb]/ and
+ @parts = $class -> _bin_str_to_flt_lib_parts($wanted)
- # exponent (power of 2) using decimal digits
- [Pp]
- [+-]?
- \d+ (?: _ \d+ )*
+ or
- \s*
- $
- /x)
+ # At this point, what is left are decimal numbers that aren't handled
+ # above and octal floating point numbers that don't have any of the
+ # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number.
+
+ @parts = $class -> _dec_str_to_flt_lib_parts($wanted)
+ or
+
+ # See if it is an octal floating point number. The extra check is
+ # included because _oct_str_to_flt_lib_parts() accepts octal numbers
+ # that don't have a prefix (this is needed to make it work with, e.g.,
+ # from_oct() that don't require a prefix). However, Perl requires a
+ # prefix for octal floating point literals. For example, "1p+0" is not
+ # valid, but "01p+0" and "0__1p+0" are.
+
+ $wanted =~ /^\s*[+-]?0_*\d/ and
+ @parts = $class -> _oct_str_to_flt_lib_parts($wanted))
{
- $self = $class -> from_oct($wanted);
- $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
- return $self;
- }
+ ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
- # Handle binary numbers. We auto-detect binary numbers if they have a "0b"
- # or "0B" prefix.
+ $self = $self->round(@r)
+ unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
- if ($wanted =~ /^\s*[+-]?0[Bb]/) {
- $self = $class -> from_bin($wanted);
- $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
+ return $downgrade -> new($self -> bdstr(), @r)
+ if defined($downgrade) && $self -> is_int();
return $self;
}
- # Shortcut for simple forms like '12' that have no trailing zeros.
- if ($wanted =~ /^([+-]?)0*([1-9][0-9]*[1-9])$/) {
- $self->{_e} = $LIB -> _zero();
- $self->{_es} = '+';
- $self->{sign} = $1 || '+';
- $self->{_m} = $LIB -> _new($2);
- if (!$downgrade) {
- $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
- return $self;
- }
- }
+ # If we get here, the value is neither a valid decimal, binary, octal, or
+ # hexadecimal number. It is not an explicit Inf or a NaN either.
- my ($mis, $miv, $mfv, $es, $ev) = Math::BigInt::_split($wanted);
- if (!ref $mis) {
- if ($_trap_nan) {
- croak("$wanted is not a number initialized to $class");
- }
+ return $class -> bnan(@r);
+}
- return $downgrade->bnan() if $downgrade;
+sub from_dec {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- $self->{_e} = $LIB->_zero();
- $self->{_es} = '+';
- $self->{_m} = $LIB->_zero();
- $self->{sign} = $nan;
- } else {
- # make integer from mantissa by adjusting exp, then convert to int
- $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} = $LIB->_new($mantissa); # create mant.
-
- # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5
- if (CORE::length($$mfv) != 0) {
- my $len = $LIB->_new(CORE::length($$mfv));
- ($self->{_e}, $self->{_es}) =
- _e_sub($self->{_e}, $len, $self->{_es}, '+');
- }
- # we can only have trailing zeros on the mantissa if $$mfv eq ''
- else {
- # Use a regexp to count the trailing zeros in $$miv instead of
- # _zeros() because that is faster, especially when _m is not stored
- # in base 10.
- my $zeros = 0;
- $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/;
- if ($zeros != 0) {
- my $z = $LIB->_new($zeros);
- # turn '120e2' into '12e3'
- $self->{_m} = $LIB->_rsft($self->{_m}, $z, 10);
- ($self->{_e}, $self->{_es}) =
- _e_add($self->{_e}, $z, $self->{_es}, '+');
- }
- }
- $self->{sign} = $$mis;
+ # Don't modify constant (read-only) objects.
- # 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 $LIB->_is_zero().
- $self->{sign} = '+', $self->{_e} = $LIB->_zero()
- if $$miv eq '0' and $$mfv eq '';
+ return $self if $selfref && $self->modify('from_dec');
- if (!$downgrade) {
- $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
- return $self;
- }
- }
+ my $str = shift;
+ my @r = @_;
- # if downgrade, inf, NaN or integers go down
+ # If called as a class method, initialize a new object.
- if ($downgrade && $self->{_es} eq '+') {
- if ($LIB->_is_zero($self->{_e})) {
- return $downgrade->new($$mis . $LIB->_str($self->{_m}));
- }
- return $downgrade->new($self->bsstr());
+ $self = bless {}, $class unless $selfref;
+
+ if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) {
+ ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
+
+ $self = $self->round(@r)
+ unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
+
+ return $downgrade -> new($self -> bdstr(), @r)
+ if defined($downgrade) && $self -> is_int();
+ return $self;
}
- $self->bnorm();
- $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
- return $self;
+
+ return $self -> bnan(@r);
}
sub from_hex {
@@ -556,88 +577,27 @@ sub from_hex {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('from_hex');
+ return $self if $selfref && $self->modify('from_hex');
my $str = shift;
+ my @r = @_;
# If called as a class method, initialize a new object.
- $self = $class -> bzero() unless $selfref;
-
- if ($str =~ s/
- ^
- \s*
-
- # sign
- ( [+-]? )
-
- # optional "hex marker"
- (?: 0? x )?
-
- # significand using the hex digits 0..9 and a..f
- (
- [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )*
- (?:
- \.
- (?: [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* )?
- )?
- |
- \.
- [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )*
- )
-
- # exponent (power of 2) using decimal digits
- (?:
- [Pp]
- ( [+-]? )
- ( \d+ (?: _ \d+ )* )
- )?
-
- \s*
- $
- //x)
- {
- my $s_sign = $1 || '+';
- my $s_value = $2;
- my $e_sign = $3 || '+';
- my $e_value = $4 || '0';
- $s_value =~ tr/_//d;
- $e_value =~ tr/_//d;
-
- # The significand must be multiplied by 2 raised to this exponent.
-
- my $two_expon = $class -> new($e_value);
- $two_expon -> bneg() if $e_sign eq '-';
-
- # If there is a dot in the significand, remove it and adjust the
- # exponent according to the number of digits in the fraction part of
- # the significand. Since the digits in the significand are in base 16,
- # but the exponent is only in base 2, multiply the exponent adjustment
- # value by log(16) / log(2) = 4.
-
- my $idx = index($s_value, '.');
- if ($idx >= 0) {
- substr($s_value, $idx, 1) = '';
- $two_expon -= $class -> new(CORE::length($s_value))
- -> bsub($idx)
- -> bmul("4");
- }
+ $self = bless {}, $class unless $selfref;
- $self -> {sign} = $s_sign;
- $self -> {_m} = $LIB -> _from_hex('0x' . $s_value);
+ if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) {
+ ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
- if ($two_expon > 0) {
- my $factor = $class -> new("2") -> bpow($two_expon);
- $self -> bmul($factor);
- } elsif ($two_expon < 0) {
- my $factor = $class -> new("0.5") -> bpow(-$two_expon);
- $self -> bmul($factor);
- }
+ $self = $self->round(@r)
+ unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
+ return $downgrade -> new($self -> bdstr(), @r)
+ if defined($downgrade) && $self -> is_int();
return $self;
}
- return $self->bnan();
+ return $self -> bnan(@r);
}
sub from_oct {
@@ -647,85 +607,27 @@ sub from_oct {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('from_oct');
+ return $self if $selfref && $self->modify('from_oct');
my $str = shift;
+ my @r = @_;
# If called as a class method, initialize a new object.
- $self = $class -> bzero() unless $selfref;
-
- if ($str =~ s/
- ^
- \s*
-
- # sign
- ( [+-]? )
-
- # significand using the octal digits 0..7
- (
- [0-7]+ (?: _ [0-7]+ )*
- (?:
- \.
- (?: [0-7]+ (?: _ [0-7]+ )* )?
- )?
- |
- \.
- [0-7]+ (?: _ [0-7]+ )*
- )
-
- # exponent (power of 2) using decimal digits
- (?:
- [Pp]
- ( [+-]? )
- ( \d+ (?: _ \d+ )* )
- )?
-
- \s*
- $
- //x)
- {
- my $s_sign = $1 || '+';
- my $s_value = $2;
- my $e_sign = $3 || '+';
- my $e_value = $4 || '0';
- $s_value =~ tr/_//d;
- $e_value =~ tr/_//d;
-
- # The significand must be multiplied by 2 raised to this exponent.
-
- my $two_expon = $class -> new($e_value);
- $two_expon -> bneg() if $e_sign eq '-';
-
- # If there is a dot in the significand, remove it and adjust the
- # exponent according to the number of digits in the fraction part of
- # the significand. Since the digits in the significand are in base 8,
- # but the exponent is only in base 2, multiply the exponent adjustment
- # value by log(8) / log(2) = 3.
-
- my $idx = index($s_value, '.');
- if ($idx >= 0) {
- substr($s_value, $idx, 1) = '';
- $two_expon -= $class -> new(CORE::length($s_value))
- -> bsub($idx)
- -> bmul("3");
- }
+ $self = bless {}, $class unless $selfref;
- $self -> {sign} = $s_sign;
- $self -> {_m} = $LIB -> _from_oct($s_value);
+ if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) {
+ ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
- if ($two_expon > 0) {
- my $factor = $class -> new("2") -> bpow($two_expon);
- $self -> bmul($factor);
- } elsif ($two_expon < 0) {
- my $factor = $class -> new("0.5") -> bpow(-$two_expon);
- $self -> bmul($factor);
- }
+ $self = $self->round(@r)
+ unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
+ return $downgrade -> new($self -> bdstr(), @r)
+ if defined($downgrade) && $self -> is_int();
return $self;
}
- return $self->bnan();
+ return $self -> bnan(@r);
}
sub from_bin {
@@ -735,85 +637,27 @@ sub from_bin {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('from_bin');
+ return $self if $selfref && $self->modify('from_bin');
my $str = shift;
+ my @r = @_;
# If called as a class method, initialize a new object.
- $self = $class -> bzero() unless $selfref;
-
- if ($str =~ s/
- ^
- \s*
-
- # sign
- ( [+-]? )
-
- # optional "bin marker"
- (?: 0? b )?
-
- # significand using the binary digits 0 and 1
- (
- [01]+ (?: _ [01]+ )*
- (?:
- \.
- (?: [01]+ (?: _ [01]+ )* )?
- )?
- |
- \.
- [01]+ (?: _ [01]+ )*
- )
-
- # exponent (power of 2) using decimal digits
- (?:
- [Pp]
- ( [+-]? )
- ( \d+ (?: _ \d+ )* )
- )?
-
- \s*
- $
- //x)
- {
- my $s_sign = $1 || '+';
- my $s_value = $2;
- my $e_sign = $3 || '+';
- my $e_value = $4 || '0';
- $s_value =~ tr/_//d;
- $e_value =~ tr/_//d;
-
- # The significand must be multiplied by 2 raised to this exponent.
-
- my $two_expon = $class -> new($e_value);
- $two_expon -> bneg() if $e_sign eq '-';
-
- # If there is a dot in the significand, remove it and adjust the
- # exponent according to the number of digits in the fraction part of
- # the significand.
-
- my $idx = index($s_value, '.');
- if ($idx >= 0) {
- substr($s_value, $idx, 1) = '';
- $two_expon -= $class -> new(CORE::length($s_value))
- -> bsub($idx);
- }
+ $self = bless {}, $class unless $selfref;
- $self -> {sign} = $s_sign;
- $self -> {_m} = $LIB -> _from_bin('0b' . $s_value);
+ if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) {
+ ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
- if ($two_expon > 0) {
- my $factor = $class -> new("2") -> bpow($two_expon);
- $self -> bmul($factor);
- } elsif ($two_expon < 0) {
- my $factor = $class -> new("0.5") -> bpow(-$two_expon);
- $self -> bmul($factor);
- }
+ $self = $self->round(@r)
+ unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
+ return $downgrade -> new($self -> bdstr(), @r)
+ if defined($downgrade) && $self -> is_int();
return $self;
}
- return $self->bnan();
+ return $self -> bnan(@r);
}
sub from_ieee754 {
@@ -823,13 +667,14 @@ sub from_ieee754 {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('from_ieee754');
+ return $self if $selfref && $self->modify('from_ieee754');
my $in = shift; # input string (or raw bytes)
my $format = shift; # format ("binary32", "decimal64" etc.)
my $enc; # significand encoding (applies only to decimal)
my $k; # storage width in bits
my $b; # base
+ my @r = @_; # rounding parameters, if any
if ($format =~ /^binary(\d+)\z/) {
$k = $1;
@@ -890,7 +735,7 @@ sub from_ieee754 {
# The maximum exponent, minimum exponent, and exponent bias.
- my $emax = Math::BigInt -> new(2) -> bpow($w - 1) -> bdec();
+ my $emax = Math::BigFloat -> new(2) -> bpow($w - 1) -> bdec();
my $emin = 1 - $emax;
my $bias = $emax;
@@ -898,7 +743,7 @@ sub from_ieee754 {
unless (defined $in) {
carp("Input is undefined");
- return $self -> bzero();
+ return $self -> bzero(@r);
}
# Make sure input string is a string of zeros and ones.
@@ -927,7 +772,7 @@ sub from_ieee754 {
my $x;
- $expo -> bsub($bias); # subtract bias
+ $expo = $expo -> bsub($bias); # subtract bias
if ($expo < $emin) { # zero and subnormals
if ($mant == 0) { # zero
@@ -935,8 +780,8 @@ sub from_ieee754 {
} else { # subnormals
# compute (1/$b)**(N) rather than ($b)**(-N)
$x = $class -> new("0.5"); # 1/$b
- $x -> bpow($bias + $t - 1) -> bmul($mant);
- $x -> bneg() if $sign eq '-';
+ $x = $x -> bpow($bias + $t - 1) -> bmul($mant);
+ $x = $x -> bneg() if $sign eq '-';
}
}
@@ -944,7 +789,7 @@ sub from_ieee754 {
if ($mant == 0) { # inf
$x = $class -> binf($sign);
} else { # nan
- $x = $class -> bnan();
+ $x = $class -> bnan(@r);
}
}
@@ -953,12 +798,12 @@ sub from_ieee754 {
if ($expo < $t) {
# compute (1/$b)**(N) rather than ($b)**(-N)
$x = $class -> new("0.5"); # 1/$b
- $x -> bpow($t - $expo) -> bmul($mant);
+ $x = $x -> bpow($t - $expo) -> bmul($mant);
} else {
$x = $class -> new(2);
- $x -> bpow($expo - $t) -> bmul($mant);
+ $x = $x -> bpow($expo - $t) -> bmul($mant);
}
- $x -> bneg() if $sign eq '-';
+ $x = $x -> bneg() if $sign eq '-';
}
if ($selfref) {
@@ -969,7 +814,10 @@ sub from_ieee754 {
} else {
$self = $x;
}
- return $self;
+
+ return $downgrade -> new($self -> bdstr(), @r)
+ if defined($downgrade) && $self -> is_int();
+ return $self -> round(@r);
}
croak("The format '$format' is not yet supported.");
@@ -978,9 +826,12 @@ sub from_ieee754 {
sub bzero {
# create/assign '+0'
- if (@_ == 0) {
- #carp("Using bone() as a function is deprecated;",
- # " use bone() as a method instead");
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
unshift @_, __PACKAGE__;
}
@@ -989,7 +840,18 @@ sub bzero {
my $class = $selfref || $self;
$self->import() if $IMPORT == 0; # make require work
- return if $selfref && $self->modify('bzero');
+
+ # Don't modify constant (read-only) objects.
+
+ return $self if $selfref && $self->modify('bzero');
+
+ # Get the rounding parameters, if any.
+
+ my @r = @_;
+
+ return $downgrade -> bzero(@r) if defined $downgrade;
+
+ # If called as a class method, initialize a new object.
$self = bless {}, $class unless $selfref;
@@ -1002,11 +864,13 @@ sub bzero {
# parameters are given, and if called as a class method initialize the new
# instance with the class variables.
- if (@_) {
+ #return $self -> round(@r); # this should work, but doesnt; fixme!
+
+ if (@r) {
croak "can't specify both accuracy and precision"
- if @_ >= 2 && defined $_[0] && defined $_[1];
- $self->{_a} = $_[0];
- $self->{_p} = $_[1];
+ if @r >= 2 && defined($r[0]) && defined($r[1]);
+ $self->{_a} = $r[0];
+ $self->{_p} = $r[1];
} else {
unless($selfref) {
$self->{_a} = $class -> accuracy();
@@ -1020,9 +884,12 @@ sub bzero {
sub bone {
# Create or assign '+1' (or -1 if given sign '-').
- if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) {
- #carp("Using bone() as a function is deprecated;",
- # " use bone() as a method instead");
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
unshift @_, __PACKAGE__;
}
@@ -1031,10 +898,26 @@ sub bone {
my $class = $selfref || $self;
$self->import() if $IMPORT == 0; # make require work
- return if $selfref && $self->modify('bone');
- my $sign = shift;
- $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+";
+ # Don't modify constant (read-only) objects.
+
+ return $self if $selfref && $self->modify('bone');
+
+ return $downgrade -> bone(@_) if defined $downgrade;
+
+ # Get the sign.
+
+ my $sign = '+'; # default is to return +1
+ if (defined($_[0]) && $_[0] =~ /^\s*([+-])\s*$/) {
+ $sign = $1;
+ shift;
+ }
+
+ # Get the rounding parameters, if any.
+
+ my @r = @_;
+
+ # If called as a class method, initialize a new object.
$self = bless {}, $class unless $selfref;
@@ -1047,9 +930,11 @@ sub bone {
# parameters are given, and if called as a class method initialize the new
# instance with the class variables.
- if (@_) {
+ #return $self -> round(@r); # this should work, but doesnt; fixme!
+
+ if (@r) {
croak "can't specify both accuracy and precision"
- if @_ >= 2 && defined $_[0] && defined $_[1];
+ if @r >= 2 && defined($r[0]) && defined($r[1]);
$self->{_a} = $_[0];
$self->{_p} = $_[1];
} else {
@@ -1065,11 +950,12 @@ sub bone {
sub binf {
# create/assign a '+inf' or '-inf'
- if (@_ == 0 || (defined($_[0]) && !ref($_[0]) &&
- $_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/))
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
{
- #carp("Using binf() as a function is deprecated;",
- # " use binf() as a method instead");
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
unshift @_, __PACKAGE__;
}
@@ -1085,10 +971,26 @@ sub binf {
}
$self->import() if $IMPORT == 0; # make require work
- return if $selfref && $self->modify('binf');
- my $sign = shift;
- $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+";
+ # Don't modify constant (read-only) objects.
+
+ return $self if $selfref && $self->modify('binf');
+
+ return $downgrade -> binf(@_) if $downgrade;
+
+ # Get the sign.
+
+ my $sign = '+'; # default is to return positive infinity
+ if (defined($_[0]) && $_[0] =~ /^\s*([+-])(inf|$)/i) {
+ $sign = $1;
+ shift;
+ }
+
+ # Get the rounding parameters, if any.
+
+ my @r = @_;
+
+ # If called as a class method, initialize a new object.
$self = bless {}, $class unless $selfref;
@@ -1101,11 +1003,13 @@ sub binf {
# parameters are given, and if called as a class method initialize the new
# instance with the class variables.
- if (@_) {
+ #return $self -> round(@r); # this should work, but doesnt; fixme!
+
+ if (@r) {
croak "can't specify both accuracy and precision"
- if @_ >= 2 && defined $_[0] && defined $_[1];
- $self->{_a} = $_[0];
- $self->{_p} = $_[1];
+ if @r >= 2 && defined($r[0]) && defined($r[1]);
+ $self->{_a} = $r[0];
+ $self->{_p} = $r[1];
} else {
unless($selfref) {
$self->{_a} = $class -> accuracy();
@@ -1119,9 +1023,12 @@ sub binf {
sub bnan {
# create/assign a 'NaN'
- if (@_ == 0) {
- #carp("Using bnan() as a function is deprecated;",
- # " use bnan() as a method instead");
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
unshift @_, __PACKAGE__;
}
@@ -1137,7 +1044,18 @@ sub bnan {
}
$self->import() if $IMPORT == 0; # make require work
- return if $selfref && $self->modify('bnan');
+
+ # Don't modify constant (read-only) objects.
+
+ return $self if $selfref && $self->modify('bnan');
+
+ return $downgrade -> bnan(@_) if defined $downgrade;
+
+ # Get the rounding parameters, if any.
+
+ my @r = @_;
+
+ # If called as a class method, initialize a new object.
$self = bless {}, $class unless $selfref;
@@ -1150,11 +1068,13 @@ sub bnan {
# parameters are given, and if called as a class method initialize the new
# instance with the class variables.
- if (@_) {
+ #return $self -> round(@r); # this should work, but doesnt; fixme!
+
+ if (@r) {
croak "can't specify both accuracy and precision"
- if @_ >= 2 && defined $_[0] && defined $_[1];
- $self->{_a} = $_[0];
- $self->{_p} = $_[1];
+ if @r >= 2 && defined($r[0]) && defined($r[1]);
+ $self->{_a} = $r[0];
+ $self->{_p} = $r[1];
} else {
unless($selfref) {
$self->{_a} = $class -> accuracy();
@@ -1167,6 +1087,15 @@ sub bnan {
sub bpi {
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
+ unshift @_, __PACKAGE__;
+ }
+
# Called as Argument list
# --------- -------------
# Math::BigFloat->bpi() ("Math::BigFloat")
@@ -1188,35 +1117,12 @@ sub bpi {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
+ my @r = @_; # rounding paramters
- my @r; # rounding paramters
-
- # If bpi() is called as a function ...
- #
- # This cludge is necessary because we still support bpi() as a function. If
- # bpi() is called with either no argument or one argument, and that one
- # argument is either undefined or a scalar that looks like a number, then
- # we assume bpi() is called as a function.
-
- if (@_ == 0 &&
- (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/i)
- ||
- !defined($self))
- {
- $r[0] = $self;
- $class = __PACKAGE__;
- $self = $class -> bzero(@r); # initialize
- }
-
- # ... or if bpi() is called as a method ...
-
- else {
- @r = @_;
- if ($selfref) { # bpi() called as instance method
- return $self if $self -> modify('bpi');
- } else { # bpi() called as class method
- $self = $class -> bzero(@r); # initialize
- }
+ if ($selfref) { # bpi() called as an instance method
+ return $self if $self -> modify('bpi');
+ } else { # bpi() called as a class method
+ $self = bless {}, $class; # initialize new instance
}
($self, @r) = $self -> _find_round_parameters(@r);
@@ -1291,13 +1197,19 @@ EOF
if ($last_digit lt '9') {
substr($digits, -1, 1) = ++$last_digit;
} else {
- $digits =~ s/([0-8])(9+)$/ ($1 + 1) . ("0" x CORE::length($2)) /e;
+ $digits =~ s{([0-8])(9+)$}
+ { ($1 + 1) . ("0" x CORE::length($2)) }e;
}
}
- # Append the exponent and convert to an object.
+ # Convert to an object.
- $pi = Math::BigFloat -> new($digits . 'e-' . ($n - 1));
+ $pi = bless {
+ sign => '+',
+ _m => $LIB -> _new($digits),
+ _es => '-',
+ _e => $LIB -> _new($n - 1),
+ }, $class;
} else {
@@ -1308,20 +1220,21 @@ EOF
$n += 8;
$HALF = $class -> new($HALF) unless ref($HALF);
- my ($an, $bn, $tn, $pn) = ($class -> bone, $HALF -> copy() -> bsqrt($n),
- $HALF -> copy() -> bmul($HALF), $class -> bone);
+ my ($an, $bn, $tn, $pn)
+ = ($class -> bone, $HALF -> copy() -> bsqrt($n),
+ $HALF -> copy() -> bmul($HALF), $class -> bone);
while ($pn < $n) {
my $prev_an = $an -> copy();
- $an -> badd($bn) -> bmul($HALF, $n);
- $bn -> bmul($prev_an) -> bsqrt($n);
- $prev_an -> bsub($an);
- $tn -> bsub($pn * $prev_an * $prev_an);
- $pn -> badd($pn);
+ $an = $an -> badd($bn) -> bmul($HALF, $n);
+ $bn = $bn -> bmul($prev_an) -> bsqrt($n);
+ $prev_an = $prev_an -> bsub($an);
+ $tn = $tn -> bsub($pn * $prev_an * $prev_an);
+ $pn = $pn -> badd($pn);
}
- $an -> badd($bn);
- $an -> bmul($an, $n) -> bdiv(4 * $tn, $n);
+ $an = $an -> badd($bn);
+ $an = $an -> bmul($an, $n) -> bdiv(4 * $tn, $n);
- $an -> round(@r);
+ $an = $an -> round(@r);
$pi = $an;
}
@@ -1335,54 +1248,95 @@ EOF
$self -> {$key} = $pi -> {$key};
}
+ return $downgrade -> new($self -> bdstr(), @r)
+ if defined($downgrade) && $self->is_int();
return $self;
}
sub copy {
- my $self = shift;
- my $selfref = ref $self;
- my $class = $selfref || $self;
-
- # If called as a class method, the object to copy is the next argument.
+ my ($x, $class);
+ if (ref($_[0])) { # $y = $x -> copy()
+ $x = shift;
+ $class = ref($x);
+ } else { # $y = Math::BigInt -> copy($y)
+ $class = shift;
+ $x = shift;
+ }
- $self = shift() unless $selfref;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @_;
my $copy = bless {}, $class;
- $copy->{sign} = $self->{sign};
- $copy->{_es} = $self->{_es};
- $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};
+ $copy->{sign} = $x->{sign};
+ $copy->{_es} = $x->{_es};
+ $copy->{_m} = $LIB->_copy($x->{_m});
+ $copy->{_e} = $LIB->_copy($x->{_e});
+ $copy->{_a} = $x->{_a} if exists $x->{_a};
+ $copy->{_p} = $x->{_p} if exists $x->{_p};
return $copy;
}
-sub as_number {
+sub as_int {
# return copy as a bigint representation of this Math::BigFloat number
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- return $x if $x->modify('as_number');
+ return $x -> copy() if $x -> isa("Math::BigInt");
- if (!$x->isa('Math::BigFloat')) {
- # if the object can as_number(), use it
- return $x->as_number() if $x->can('as_number');
- # otherwise, get us a float and then a number
- $x = $x->can('as_float') ? $x->as_float() : $class->new(0+"$x");
- }
+ # disable upgrading and downgrading
- return Math::BigInt->binf($x->sign()) if $x->is_inf();
- return Math::BigInt->bnan() if $x->is_nan();
+ require Math::BigInt;
+ my $upg = Math::BigInt -> upgrade();
+ my $dng = Math::BigInt -> downgrade();
+ Math::BigInt -> upgrade(undef);
+ Math::BigInt -> downgrade(undef);
- my $z = $LIB->_copy($x->{_m});
- if ($x->{_es} eq '-') { # < 0
- $z = $LIB->_rsft($z, $x->{_e}, 10);
- } elsif (! $LIB->_is_zero($x->{_e})) { # > 0
- $z = $LIB->_lsft($z, $x->{_e}, 10);
+ my $y;
+ if ($x -> is_inf()) {
+ $y = Math::BigInt -> binf($x->sign());
+ } elsif ($x -> is_nan()) {
+ $y = Math::BigInt -> bnan();
+ } else {
+ $y = $LIB->_copy($x->{_m});
+ if ($x->{_es} eq '-') { # < 0
+ $y = $LIB->_rsft($y, $x->{_e}, 10);
+ } elsif (! $LIB->_is_zero($x->{_e})) { # > 0
+ $y = $LIB->_lsft($y, $x->{_e}, 10);
+ }
+ $y = Math::BigInt->new($x->{sign} . $LIB->_str($y));
}
- $z = Math::BigInt->new($x->{sign} . $LIB->_str($z));
- $z;
+
+ # reset upgrading and downgrading
+
+ Math::BigInt -> upgrade($upg);
+ Math::BigInt -> downgrade($dng);
+
+ return $y;
+}
+
+sub as_float {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ return $x -> copy() if $x -> isa("Math::BigFloat");
+
+ # disable upgrading and downgrading
+
+ require Math::BigFloat;
+ my $upg = Math::BigFloat -> upgrade();
+ my $dng = Math::BigFloat -> downgrade();
+ Math::BigFloat -> upgrade(undef);
+ Math::BigFloat -> downgrade(undef);
+
+ my $y = Math::BigFloat -> new($x);
+
+ # reset upgrading and downgrading
+
+ Math::BigFloat -> upgrade($upg);
+ Math::BigFloat -> downgrade($dng);
+
+ return $y;
}
###############################################################################
@@ -1391,14 +1345,14 @@ sub as_number {
sub is_zero {
# return true if arg (BFLOAT or num_str) is zero
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
($x->{sign} eq '+' && $LIB->_is_zero($x->{_m})) ? 1 : 0;
}
sub is_one {
# return true if arg (BFLOAT or num_str) is +1 or -1 if signis given
- my ($class, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my (undef, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
$sign = '+' if !defined $sign || $sign ne '-';
@@ -1409,7 +1363,7 @@ sub is_one {
sub is_odd {
# return true if arg (BFLOAT or num_str) is odd or false if even
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
(($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
($LIB->_is_zero($x->{_e})) &&
@@ -1418,7 +1372,7 @@ sub is_odd {
sub is_even {
# return true if arg (BINT or num_str) is even or false if odd
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
(($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
($x->{_es} eq '+') && # 123.45 isn't
@@ -1427,7 +1381,7 @@ sub is_even {
sub is_int {
# return true if arg (BFLOAT or num_str) is an integer
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
(($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
($x->{_es} eq '+')) ? 1 : 0; # 1e-1 => no integer
@@ -1441,19 +1395,15 @@ sub bcmp {
# Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
# set up parameters
- my ($class, $x, $y) = (ref($_[0]), @_);
-
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
- return $upgrade->bcmp($x, $y) if defined $upgrade &&
- ((!$x->isa($class)) || (!$y->isa($class)));
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
# Handle all 'nan' cases.
- return undef if ($x->{sign} eq $nan) || ($y->{sign} eq $nan);
+ return if ($x->{sign} eq $nan) || ($y->{sign} eq $nan);
# Handle all '+inf' and '-inf' cases.
@@ -1488,8 +1438,9 @@ sub bcmp {
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.
+ # 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.
if ($mxl == $myl) {
@@ -1527,8 +1478,8 @@ sub bcmp {
if ($x->{_es} eq '+') {
- # If the exponent of x is >= 0 and the exponent of y is >= 0, there is no
- # need to do anything special.
+ # If the exponent of x is >= 0 and the exponent of y is >= 0, there is
+ # no need to do anything special.
if ($y->{_es} eq '+') {
$ex = $LIB->_copy($x->{_e});
@@ -1577,8 +1528,8 @@ sub bcmp {
return $cmp if $cmp;
# Compare the mantissas, but first normalize them by padding the shorter
- # mantissa with zeros (shift left) until it has the same length as the longer
- # mantissa.
+ # mantissa with zeros (shift left) until it has the same length as the
+ # longer mantissa.
my $mx = $x->{_m};
my $my = $y->{_m};
@@ -1600,20 +1551,17 @@ sub bacmp {
# Returns one of undef, <0, =0, >0. (suitable for sort)
# set up parameters
- my ($class, $x, $y) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
- return $upgrade->bacmp($x, $y) if defined $upgrade &&
- ((!$x->isa($class)) || (!$y->isa($class)));
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
# handle +-inf and NaN's
if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
- return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- return 0 if ($x->is_inf() && $y->is_inf());
- return 1 if ($x->is_inf() && !$y->is_inf());
+ return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ return 0 if ($x->is_inf() && $y->is_inf());
+ return 1 if ($x->is_inf() && !$y->is_inf());
return -1;
}
@@ -1658,20 +1606,35 @@ sub bacmp {
sub bneg {
# (BINT or num_str) return BINT
# negate number or make a negated number from string
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
return $x if $x->modify('bneg');
- # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
- $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_m}));
- $x;
+ return $x -> bnan(@r) if $x -> is_nan();
+
+ # For +0 do not negate (to have always normalized +0).
+ $x->{sign} =~ tr/+-/-+/
+ unless $x->{sign} eq '+' && $LIB->_is_zero($x->{_m});
+
+ return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade)
+ && ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
+ return $x -> round(@r);
}
sub bnorm {
+ # bnorm() can't support rounding, because bround() and bfround() call
+ # bnorm(), which would recurse indefinitely.
+
# adjust m and e so that m is smallest possible
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
- return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # inf, nan etc
+ if ($x->{sign} !~ /^[+-]$/) {
+ return $downgrade -> new($x) if defined $downgrade;
+ return $x;
+ }
my $zeros = $LIB->_zeros($x->{_m}); # correct for trailing zeros
if ($zeros != 0) {
@@ -1690,12 +1653,17 @@ sub bnorm {
}
} 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} = $LIB->_one()
- if $LIB->_is_zero($x->{_m});
+ # zeros). So, for something like 0Ey, set y to 0, and -0 => +0
+ if ($LIB->_is_zero($x->{_m})) {
+ $x->{sign} = '+';
+ $x->{_es} = '+';
+ $x->{_e} = $LIB->_zero();
+ }
}
- $x;
+ return $downgrade -> new($x)
+ if defined($downgrade) && $x->is_int();
+ return $x;
}
sub binc {
@@ -1704,19 +1672,28 @@ sub binc {
return $x if $x->modify('binc');
+ # Inf and NaN
+
+ return $x -> bnan(@r) if $x -> is_nan();
+ return $x -> binf($x->{sign}, @r) if $x -> is_inf();
+
+ # Non-integer
+
if ($x->{_es} eq '-') {
- return $x->badd($class->bone(), @r); # digits after dot
+ return $x->badd($class->bone(), @r);
}
- 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
+ # If the exponent is non-zero, convert the internal representation, so that,
+ # e.g., 12e+3 becomes 12000e+0 and we can easily increment the mantissa.
+
+ if (!$LIB->_is_zero($x->{_e})) {
$x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100
- $x->{_e} = $LIB->_zero(); # normalize
+ $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} = $LIB->_inc($x->{_m});
@@ -1726,8 +1703,10 @@ sub binc {
$x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0
return $x->bnorm()->bround(@r);
}
- # inf, nan handling etc
- $x->badd($class->bone(), @r); # badd() does round
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x -> is_int();
+ return $x;
}
sub bdec {
@@ -1736,143 +1715,167 @@ sub bdec {
return $x if $x->modify('bdec');
+ # Inf and NaN
+
+ return $x -> bnan(@r) if $x -> is_nan();
+ return $x -> binf($x->{sign}, @r) if $x -> is_inf();
+
+ # Non-integer
+
if ($x->{_es} eq '-') {
- return $x->badd($class->bone('-'), @r); # digits after dot
+ return $x->badd($class->bone('-'), @r);
}
+ # If the exponent is non-zero, convert the internal representation, so that,
+ # e.g., 12e+3 becomes 12000e+0 and we can easily increment the mantissa.
+
if (!$LIB->_is_zero($x->{_e})) {
$x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100
- $x->{_e} = $LIB->_zero(); # normalize
+ $x->{_e} = $LIB->_zero(); # normalize
$x->{_es} = '+';
}
+
# now $x->{_e} == 0
my $zero = $x->is_zero();
- # <= 0
- if (($x->{sign} eq '-') || $zero) {
+ if (($x->{sign} eq '-') || $zero) { # x <= 0
$x->{_m} = $LIB->_inc($x->{_m});
$x->{sign} = '-' if $zero; # 0 => 1 => -1
$x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0
return $x->bnorm()->round(@r);
}
- # > 0
- elsif ($x->{sign} eq '+') {
+ elsif ($x->{sign} eq '+') { # x > 0
$x->{_m} = $LIB->_dec($x->{_m});
return $x->bnorm()->round(@r);
}
- # inf, nan handling etc
- $x->badd($class->bone('-'), @r); # does round
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x -> is_int();
+ return $x -> round(@r);
}
sub badd {
- # add second arg (BFLOAT or string) to first (BFLOAT) (modifies first)
- # return result as BFLOAT
-
# set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x->modify('badd');
# inf and NaN handling
- if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
- # NaN first
- return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- # inf handling
- if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) {
- # +inf++inf or -inf+-inf => same, rest is NaN
- return $x if $x->{sign} eq $y->{sign};
- return $x->bnan();
+ if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
+
+ # $x is NaN and/or $y is NaN
+ if ($x->{sign} eq $nan || $y->{sign} eq $nan) {
+ $x = $x->bnan();
}
- # +-inf + something => +inf; something +-inf => +-inf
- $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
- return $x;
+
+ # $x is Inf and $y is Inf
+ elsif ($x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/) {
+ # +Inf + +Inf or -Inf + -Inf => same, rest is NaN
+ $x = $x->bnan() if $x->{sign} ne $y->{sign};
+ }
+
+ # +-inf + something => +-inf; something +-inf => +-inf
+ elsif ($y->{sign} =~ /^[+-]inf$/) {
+ $x->{sign} = $y->{sign};
+ }
+
+ return $downgrade -> new($x -> bdstr(), @r) if defined $downgrade;
+ return $x -> round(@r);
}
- return $upgrade->badd($x, $y, @r) if defined $upgrade &&
- ((!$x->isa($class)) || (!$y->isa($class)));
+ return $upgrade->badd($x, $y, @r) if defined $upgrade;
$r[3] = $y; # no push!
- # speed: no add for 0+y or x+0
- return $x->bround(@r) if $y->is_zero(); # x+0
- if ($x->is_zero()) # 0+y
- {
+ # for speed: no add for $x + 0
+ if ($y->is_zero()) {
+ $x = $x->round(@r);
+ }
+
+ # for speed: no add for 0 + $y
+ elsif ($x->is_zero()) {
# make copy, clobbering up x (modify in place!)
$x->{_e} = $LIB->_copy($y->{_e});
$x->{_es} = $y->{_es};
$x->{_m} = $LIB->_copy($y->{_m});
$x->{sign} = $y->{sign} || $nan;
- return $x->round(@r);
+ $x = $x->round(@r);
}
- # take lower of the two e's and adapt m1 to it to match m2
- my $e = $y->{_e};
- $e = $LIB->_zero() if !defined $e; # if no BFLOAT?
- $e = $LIB->_copy($e); # make copy (didn't do it yet)
+ # both $x and $y are non-zero
+ else {
- my $es;
+ # take lower of the two e's and adapt m1 to it to match m2
+ my $e = $y->{_e};
+ $e = $LIB->_zero() if !defined $e; # if no BFLOAT?
+ $e = $LIB->_copy($e); # make copy (didn't do it yet)
- ($e, $es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es});
+ my $es;
- my $add = $LIB->_copy($y->{_m});
+ ($e, $es) = $LIB -> _ssub($e, $y->{_es} || '+', $x->{_e}, $x->{_es});
- if ($es eq '-') # < 0
- {
- $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
- ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
- } elsif (!$LIB->_is_zero($e)) # > 0
- {
- $add = $LIB->_lsft($add, $e, 10);
- }
- # else: both e are the same, so just leave them
+ my $add = $LIB->_copy($y->{_m});
- if ($x->{sign} eq $y->{sign}) {
- # add
- $x->{_m} = $LIB->_add($x->{_m}, $add);
- } else {
- ($x->{_m}, $x->{sign}) =
- _e_add($x->{_m}, $add, $x->{sign}, $y->{sign});
+ if ($es eq '-') { # < 0
+ $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
+ ($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es);
+ } elsif (!$LIB->_is_zero($e)) { # > 0
+ $add = $LIB->_lsft($add, $e, 10);
+ }
+
+ # else: both e are the same, so just leave them
+
+ if ($x->{sign} eq $y->{sign}) {
+ $x->{_m} = $LIB->_add($x->{_m}, $add);
+ } else {
+ ($x->{_m}, $x->{sign}) =
+ $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $y->{sign});
+ }
+
+ # delete trailing zeros, then round
+ $x = $x->bnorm()->round(@r);
}
- # delete trailing zeros, then round
- $x->bnorm()->round(@r);
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x -> is_int();
+ return $x; # rounding already done above
}
sub bsub {
- # (BINT or num_str, BINT or num_str) return BINT
- # subtract second arg from first, modify first
-
# set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
-
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x -> modify('bsub');
- return $upgrade -> new($x) -> bsub($upgrade -> new($y), @r)
- if defined $upgrade && (!$x -> isa($class) || !$y -> isa($class));
-
- return $x -> round(@r) if $y -> is_zero();
+ if ($y -> is_zero()) {
+ $x = $x -> round(@r);
+ } else {
- # To correctly handle the lone special case $x -> bsub($x), we note the
- # sign of $x, then flip the sign from $y, and if the sign of $x did change,
- # too, then we caught the special case:
+ # To correctly handle the special case $x -> bsub($x), we note the sign
+ # of $x, then flip the sign of $y, and if the sign of $x changed too,
+ # then we know that $x and $y are the same object.
- my $xsign = $x -> {sign};
- $y -> {sign} =~ tr/+-/-+/; # does nothing for NaN
- if ($xsign ne $x -> {sign}) {
- # special case of $x -> bsub($x) results in 0
- return $x -> bzero(@r) if $xsign =~ /^[+-]$/;
- return $x -> bnan(); # NaN, -inf, +inf
+ my $xsign = $x -> {sign};
+ $y -> {sign} =~ tr/+-/-+/; # does nothing for NaN
+ if ($xsign ne $x -> {sign}) {
+ # special case of $x -> bsub($x) results in 0
+ if ($xsign =~ /^[+-]$/) {
+ $x = $x -> bzero(@r);
+ } else {
+ $x = $x -> bnan(); # NaN, -inf, +inf
+ }
+ return $downgrade -> new($x -> bdstr(), @r) if defined $downgrade;
+ return $x -> round(@r);
+ }
+ $x = $x -> badd($y, @r); # badd does not leave internal zeros
+ $y -> {sign} =~ tr/+-/-+/; # reset $y (does nothing for NaN)
}
- $x -> badd($y, @r); # badd does not leave internal zeros
- $y -> {sign} =~ tr/+-/-+/; # refix $y (does nothing for NaN)
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
$x; # already rounded by badd() or no rounding
}
@@ -1880,70 +1883,73 @@ sub bmul {
# multiply two numbers
# set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x->modify('bmul');
- return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ return $x->bnan(@r) if ($x->{sign} eq $nan) || ($y->{sign} eq $nan);
# inf handling
if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) {
- return $x->bnan() if $x->is_zero() || $y->is_zero();
+ return $x->bnan(@r) if $x->is_zero() || $y->is_zero();
# result will always be +-inf:
# +inf * +/+inf => +inf, -inf * -/-inf => +inf
# +inf * -/-inf => -inf, -inf * +/+inf => -inf
- return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
- return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
- return $x->binf('-');
+ return $x->binf(@r) if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf(@r) if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf('-', @r);
}
- return $upgrade->bmul($x, $y, @r) if defined $upgrade &&
- ((!$x->isa($class)) || (!$y->isa($class)));
+ return $upgrade->bmul($x, $y, @r) if defined $upgrade;
# aEb * cEd = (a*c)E(b+d)
$x->{_m} = $LIB->_mul($x->{_m}, $y->{_m});
- ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
+ ($x->{_e}, $x->{_es})
+ = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es});
$r[3] = $y; # no push!
# adjust sign:
$x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
- $x->bnorm->round(@r);
+ $x = $x->bnorm->round(@r);
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
}
sub bmuladd {
# multiply two numbers and add the third to the result
# set up parameters
- my ($class, $x, $y, $z, @r) = objectify(3, @_);
+ my ($class, $x, $y, $z, @r)
+ = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
+ ? (ref($_[0]), @_)
+ : objectify(3, @_);
return $x if $x->modify('bmuladd');
- return $x->bnan() if (($x->{sign} eq $nan) ||
- ($y->{sign} eq $nan) ||
- ($z->{sign} eq $nan));
+ return $x->bnan(@r) if (($x->{sign} eq $nan) ||
+ ($y->{sign} eq $nan) ||
+ ($z->{sign} eq $nan));
# inf handling
if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) {
- return $x->bnan() if $x->is_zero() || $y->is_zero();
+ return $x->bnan(@r) if $x->is_zero() || $y->is_zero();
# result will always be +-inf:
# +inf * +/+inf => +inf, -inf * -/-inf => +inf
# +inf * -/-inf => -inf, -inf * +/+inf => -inf
- return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
- return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
- return $x->binf('-');
+ return $x->binf(@r) if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf(@r) if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf('-', @r);
}
- return $upgrade->bmul($x, $y, @r) if defined $upgrade &&
- ((!$x->isa($class)) || (!$y->isa($class)));
-
# aEb * cEd = (a*c)E(b+d)
$x->{_m} = $LIB->_mul($x->{_m}, $y->{_m});
- ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
+ ($x->{_e}, $x->{_es})
+ = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es});
$r[3] = $y; # no push!
@@ -1951,7 +1957,11 @@ sub bmuladd {
$x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
# z=inf handling (z=NaN handled above)
- $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/;
+ if ($z->{sign} =~ /^[+-]inf$/) {
+ $x->{sign} = $z->{sign};
+ return $downgrade -> new($x -> bdstr(), @r) if defined $downgrade;
+ return $x -> round(@r);
+ }
# take lower of the two e's and adapt m1 to it to match m2
my $e = $z->{_e};
@@ -1960,14 +1970,14 @@ sub bmuladd {
my $es;
- ($e, $es) = _e_sub($e, $x->{_e}, $z->{_es} || '+', $x->{_es});
+ ($e, $es) = $LIB -> _ssub($e, $z->{_es} || '+', $x->{_e}, $x->{_es});
my $add = $LIB->_copy($z->{_m});
if ($es eq '-') # < 0
{
$x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
- ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
+ ($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es);
} elsif (!$LIB->_is_zero($e)) # > 0
{
$add = $LIB->_lsft($add, $e, 10);
@@ -1979,11 +1989,15 @@ sub bmuladd {
$x->{_m} = $LIB->_add($x->{_m}, $add);
} else {
($x->{_m}, $x->{sign}) =
- _e_add($x->{_m}, $add, $x->{sign}, $z->{sign});
+ $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $z->{sign});
}
# delete trailing zeros, then round
- $x->bnorm()->round(@r);
+ $x = $x->bnorm()->round(@r);
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
}
sub bdiv {
@@ -1991,10 +2005,10 @@ sub bdiv {
# (BFLOAT, BFLOAT) (quo, rem) or BFLOAT (only quo)
# set up parameters
- my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_);
+ my ($class, $x, $y, @r) = (ref($_[0]), @_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, $a, $p, $r) = objectify(2, @_);
+ ($class, $x, $y, @r) = objectify(2, @_);
}
return $x if $x->modify('bdiv');
@@ -2005,7 +2019,8 @@ sub bdiv {
# Math::BigInt -> bdiv().
if ($x -> is_nan() || $y -> is_nan()) {
- return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan();
+ return $wantarray ? ($x -> bnan(@r), $class -> bnan(@r))
+ : $x -> bnan(@r);
}
# Divide by zero and modulo zero. This is handled the same way as in
@@ -2015,12 +2030,14 @@ sub bdiv {
if ($y -> is_zero()) {
my ($quo, $rem);
if ($wantarray) {
- $rem = $x -> copy();
+ $rem = $x -> copy() -> round(@r);
+ $rem = $downgrade -> new($rem, @r)
+ if defined($downgrade) && $rem -> is_int();
}
if ($x -> is_zero()) {
- $quo = $x -> bnan();
+ $quo = $x -> bnan(@r);
} else {
- $quo = $x -> binf($x -> {sign});
+ $quo = $x -> binf($x -> {sign}, @r);
}
return $wantarray ? ($quo, $rem) : $quo;
}
@@ -2031,12 +2048,12 @@ sub bdiv {
if ($x -> is_inf()) {
my ($quo, $rem);
- $rem = $class -> bnan() if $wantarray;
+ $rem = $class -> bnan(@r) if $wantarray;
if ($y -> is_inf()) {
- $quo = $x -> bnan();
+ $quo = $x -> bnan(@r);
} else {
my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
- $quo = $x -> binf($sign);
+ $quo = $x -> binf($sign, @r);
}
return $wantarray ? ($quo, $rem) : $quo;
}
@@ -2051,19 +2068,21 @@ sub bdiv {
my ($quo, $rem);
if ($wantarray) {
if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
- $rem = $x -> copy();
- $quo = $x -> bzero();
+ $rem = $x -> copy() -> round(@r);
+ $rem = $downgrade -> new($rem, @r)
+ if defined($downgrade) && $rem -> is_int();
+ $quo = $x -> bzero(@r);
} else {
- $rem = $class -> binf($y -> {sign});
- $quo = $x -> bone('-');
+ $rem = $class -> binf($y -> {sign}, @r);
+ $quo = $x -> bone('-', @r);
}
return ($quo, $rem);
} else {
if ($y -> is_inf()) {
if ($x -> is_nan() || $x -> is_inf()) {
- return $x -> bnan();
+ return $x -> bnan(@r);
} else {
- return $x -> bzero();
+ return $x -> bzero(@r);
}
}
}
@@ -2073,24 +2092,37 @@ sub bdiv {
# the denominator (divisor) is non-zero.
# x == 0?
- return wantarray ? ($x, $class->bzero()) : $x if $x->is_zero();
+ if ($x->is_zero()) {
+ my ($quo, $rem);
+ $quo = $x->round(@r);
+ $quo = $downgrade -> new($quo, @r)
+ if defined($downgrade) && $quo -> is_int();
+ if ($wantarray) {
+ $rem = $class -> bzero(@r);
+ return $quo, $rem;
+ }
+ return $quo;
+ }
+
+ # Division might return a value that we can not represent exactly, so
+ # upgrade, if upgrading is enabled.
- # upgrade ?
- return $upgrade->bdiv($upgrade->new($x), $y, $a, $p, $r) if defined $upgrade;
+ return $upgrade -> bdiv($x, $y, @r)
+ if defined($upgrade) && !wantarray && !$LIB -> _is_one($y -> {_m});
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
my (@params, $scale);
- ($x, @params) = $x->_find_round_parameters($a, $p, $r, $y);
+ ($x, @params) = $x->_find_round_parameters($r[0], $r[1], $r[2], $y);
- return $x if $x->is_nan(); # error in _find_round_parameters?
+ return $x -> round(@r) if $x->is_nan(); # error in _find_round_parameters?
# no rounding at all, so must use fallback
if (scalar @params == 0) {
# simulate old behaviour
$params[0] = $class->div_scale(); # and round to it as accuracy
$scale = $params[0]+4; # at least four more for proper round
- $params[2] = $r; # round mode by caller or undef
+ $params[2] = $r[2]; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
} else {
# the 4 below is empirical, and there might be cases where it is not
@@ -2103,7 +2135,8 @@ sub bdiv {
$y = $class->new($y) unless $y->isa('Math::BigFloat');
- my $lx = $LIB -> _len($x->{_m}); my $ly = $LIB -> _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;
@@ -2119,13 +2152,14 @@ sub bdiv {
if ($xsign ne $x->{sign}) {
# special case of $x /= $x results in 1
- $x->bone(); # "fixes" also sign of $y, since $x is $y
+ $x = $x->bone(); # "fixes" also sign of $y, since $x is $y
} else {
# correct $y's sign again
$y->{sign} =~ tr/+-/-+/;
# continue with normal div code:
- # make copy of $x in case of list context for later remainder calculation
+ # make copy of $x in case of list context for later remainder
+ # calculation
if (wantarray && $y_not_one) {
$rem = $x->copy();
}
@@ -2134,7 +2168,8 @@ sub bdiv {
# check for / +-1 (+/- 1E0)
if ($y_not_one) {
- # promote BigInts and it's subclasses (except when already a Math::BigFloat)
+ # promote Math::BigInt and its subclasses (except when already a
+ # Math::BigFloat)
$y = $class->new($y) unless $y->isa('Math::BigFloat');
# calculate the result to $scale digits and then round it
@@ -2143,70 +2178,77 @@ sub bdiv {
$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});
+ ($x->{_e}, $x->{_es})
+ = $LIB -> _ssub($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es});
# correct for 10**scale
- ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $LIB->_new($scale), $x->{_es}, '+');
- $x->bnorm(); # remove trailing 0's
+ ($x->{_e}, $x->{_es})
+ = $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($scale), '+');
+ $x = $x->bnorm(); # remove trailing 0's
}
} # end else $x != $y
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
delete $x->{_a}; # clear before round
- $x->bround($params[0], $params[2]); # then round accordingly
+ $x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
delete $x->{_p}; # clear before round
- $x->bfround($params[1], $params[2]); # then round accordingly
+ $x = $x->bfround($params[1], $params[2]); # then round accordingly
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $x->{_a}; delete $x->{_p};
+ delete $x->{_a};
+ delete $x->{_p};
}
if (wantarray) {
if ($y_not_one) {
- $x -> bfloor();
- $rem->bmod($y, @params); # copy already done
+ $x = $x -> bfloor();
+ $rem = $rem->bmod($y, @params); # copy already done
}
if ($fallback) {
# clear a/p after round, since user did not request it
- delete $rem->{_a}; delete $rem->{_p};
+ delete $rem->{_a};
+ delete $rem->{_p};
}
+ $x = $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x -> is_int();
+ $rem = $downgrade -> new($rem -> bdstr(), @r)
+ if defined($downgrade) && $rem -> is_int();
return ($x, $rem);
}
- $x;
+
+ $x = $downgrade -> new($x, @r)
+ if defined($downgrade) && $x -> is_int();
+ $x; # rounding already done above
}
sub bmod {
# (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return remainder
# set up parameters
- my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, $a, $p, $r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x->modify('bmod');
# At least one argument is NaN. This is handled the same way as in
# Math::BigInt -> bmod().
- if ($x -> is_nan() || $y -> is_nan()) {
- return $x -> bnan();
- }
+ return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
# Modulo zero. This is handled the same way as in Math::BigInt -> bmod().
if ($y -> is_zero()) {
- return $x;
+ return $x -> round(@r);
}
# Numerator (dividend) is +/-inf. This is handled the same way as in
# Math::BigInt -> bmod().
if ($x -> is_inf()) {
- return $x -> bnan();
+ return $x -> bnan(@r);
}
# Denominator (divisor) is +/-inf. This is handled the same way as in
@@ -2214,20 +2256,20 @@ sub bmod {
if ($y -> is_inf()) {
if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
- return $x;
+ return $x -> round(@r);
} else {
- return $x -> binf($y -> sign());
+ return $x -> binf($y -> sign(), @r);
}
}
- return $x->bzero() if $x->is_zero()
+ return $x->bzero(@r) if $x->is_zero()
|| ($x->is_int() &&
# check that $y == +1 or $y == -1:
($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
- return $x -> bzero($a, $p);
+ return $x -> bzero(@r);
}
# only $y of the operands negative?
@@ -2235,7 +2277,7 @@ sub bmod {
$x->{sign} = $y->{sign}; # calc sign first
if ($cmp < 0 && $neg == 0) { # $x < $y => result $x
- return $x -> round($a, $p, $r);
+ return $x -> round(@r);
}
my $ym = $LIB->_copy($y->{_m});
@@ -2250,7 +2292,8 @@ sub bmod {
{
# 123 % 2.5 => 1230 % 25 => 5 => 0.5
$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
+ # 123 => 1230, $y->{_m} is already 25
+ $x->{_m} = $LIB->_lsft($x->{_m}, $y->{_e}, 10);
}
# $ym is now mantissa of $y based on exponent 0
@@ -2276,48 +2319,60 @@ sub bmod {
$x->{_m} = $LIB->_mod($x->{_m}, $ym);
$x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0
- $x->bnorm();
+ $x = $x->bnorm();
- if ($neg != 0 && ! $x -> is_zero()) # one of them negative => correct in place
- {
+ # if one of them negative => correct in place
+ if ($neg != 0 && ! $x -> is_zero()) {
my $r = $y - $x;
$x->{_m} = $r->{_m};
$x->{_e} = $r->{_e};
$x->{_es} = $r->{_es};
$x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0
- $x->bnorm();
+ $x = $x->bnorm();
}
- $x->round($a, $p, $r, $y); # round and return
+ $x = $x->round($r[0], $r[1], $r[2], $y);
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
}
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) = objectify(3, @_);
+ my ($class, $num, $exp, $mod, @r)
+ = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
+ ? (ref($_[0]), @_)
+ : objectify(3, @_);
return $num if $num->modify('bmodpow');
+ return $num -> bnan(@r)
+ if $mod->is_nan() || $exp->is_nan() || $mod->is_nan();
+
# check modulus for valid values
- return $num->bnan() if ($mod->{sign} ne '+' # NaN, -, -inf, +inf
- || $mod->is_zero());
+ return $num->bnan(@r) if $mod->{sign} ne '+' || $mod->is_zero();
# check exponent for valid values
if ($exp->{sign} =~ /\w/) {
# i.e., if it's NaN, +inf, or -inf...
- return $num->bnan();
+ return $num->bnan(@r);
}
- $num->bmodinv ($mod) if ($exp->{sign} eq '-');
+ $num = $num->bmodinv($mod, @r) if $exp->{sign} eq '-';
# check num for valid values (also NaN if there was no inverse but $exp < 0)
- return $num->bnan() if $num->{sign} !~ /^[+-]$/;
+ return $num->bnan(@r) if $num->{sign} !~ /^[+-]$/;
# $mod is positive, sign on $exp is ignored, result also positive
# XXX TODO: speed it up when all three numbers are integers
- $num->bpow($exp)->bmod($mod);
+ $num = $num->bpow($exp)->bmod($mod);
+
+ return $downgrade -> new($num -> bdstr(), @r) if defined($downgrade)
+ && ($num->is_int() || $num->is_inf() || $num->is_nan());
+ return $num -> round(@r);
}
sub bpow {
@@ -2332,71 +2387,84 @@ sub bpow {
($class, $x, $y, $a, $p, $r) = objectify(2, @_);
}
- return $x if $x->modify('bpow');
+ return $x if $x -> modify('bpow');
# $x and/or $y is a NaN
- return $x->bnan() if $x->is_nan() || $y->is_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();
+ 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 -> bone() if $y -> is_zero();
+ return $x -> binf() if $y -> is_negative();
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();
- return $x->bone() if $y_is_zero;
- return $x if $x->is_one() || $y->is_one();
+ # We don't support complex numbers, so upgrade or return NaN.
- my $x_is_zero = $x->is_zero();
- 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 -> is_negative() && !$y -> is_int()) {
+ return $upgrade -> bpow($x, $y, $a, $p, $r) if defined $upgrade;
+ return $x -> bnan();
+ }
- if ($x->is_one("-")) {
- # if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1
- return $LIB->_is_odd($y1) ? $x : $x->babs(1);
+ if ($x -> is_one("+") || $y -> is_one()) {
+ return $x;
}
- if ($x_is_zero) {
- return $x if $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0)
- # 0 ** -y => 1 / (0 ** y) => 1 / 0! (1 / 0 => +inf)
- return $x->binf();
+
+ if ($x -> is_one("-")) {
+ return $x if $y -> is_odd();
+ return $x -> bneg();
}
+ return $x -> _pow($y, $a, $p, $r) if !$y -> is_int();
+
+ my $y1 = $y -> as_int()->{value}; # make MBI part
+
my $new_sign = '+';
- $new_sign = $LIB->_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} = $LIB->_pow($x->{_m}, $y1);
- $x->{_e} = $LIB->_mul ($x->{_e}, $y1);
+ $x->{_m} = $LIB -> _pow($x->{_m}, $y1);
+ $x->{_e} = $LIB -> _mul($x->{_e}, $y1);
$x->{sign} = $new_sign;
- $x->bnorm();
+ $x = $x -> bnorm();
+
+ # x ** (-y) = 1 / (x ** y)
+
if ($y->{sign} eq '-') {
# modify $x in place!
- my $z = $x->copy(); $x->bone();
- return scalar $x->bdiv($z, $a, $p, $r); # round in one go (might ignore y's A!)
+ my $z = $x -> copy();
+ $x = $x -> bone();
+ # round in one go (might ignore y's A!)
+ return scalar $x -> bdiv($z, $a, $p, $r);
}
- $x->round($a, $p, $r, $y);
+
+ $x = $x -> round($a, $p, $r, $y);
+
+ return $downgrade -> new($x)
+ if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
}
sub blog {
@@ -2404,29 +2472,32 @@ sub blog {
# value is used as the base, otherwise the base is assumed to be Euler's
# constant.
- my ($class, $x, $base, $a, $p, $r);
+ my ($class, $x, $base, @r);
- # Don't objectify the base, since an undefined base, as in $x->blog() or
- # $x->blog(undef) signals that the base is Euler's number.
+ # Only objectify the base if it is defined, since an undefined base, as in
+ # $x->blog() or $x->blog(undef) signals that the base is Euler's number.
if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
# E.g., Math::BigFloat->blog(256, 2)
- ($class, $x, $base, $a, $p, $r) =
+ ($class, $x, $base, @r) =
defined $_[2] ? objectify(2, @_) : objectify(1, @_);
} else {
# E.g., Math::BigFloat::blog(256, 2) or $x->blog(2)
- ($class, $x, $base, $a, $p, $r) =
+ ($class, $x, $base, @r) =
defined $_[1] ? objectify(2, @_) : objectify(1, @_);
}
return $x if $x->modify('blog');
- return $x -> bnan() if $x -> is_nan();
+ return $x -> bnan(@r) if $x -> is_nan();
+
+ return $upgrade -> blog($x, $base, @r)
+ if defined($upgrade) && $x -> is_neg();
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
my ($scale, @params);
- ($x, @params) = $x->_find_round_parameters($a, $p, $r);
+ ($x, @params) = $x->_find_round_parameters(@r);
# no rounding at all, so must use fallback
if (scalar @params == 0) {
@@ -2434,7 +2505,7 @@ sub blog {
$params[0] = $class->div_scale(); # and round to it as accuracy
$params[1] = undef; # P = undef
$scale = $params[0]+4; # at least four more for proper round
- $params[2] = $r; # round mode by caller or undef
+ $params[2] = $r[2]; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
} else {
# the 4 below is empirical, and there might be cases where it is not
@@ -2444,28 +2515,29 @@ sub blog {
my $done = 0;
if (defined $base) {
- $base = $class -> new($base) unless ref $base;
+ $base = $class -> new($base)
+ unless defined(blessed($base)) && $base -> isa($class);
if ($base -> is_nan() || $base -> is_one()) {
- $x -> bnan();
+ $x = $x -> bnan();
$done = 1;
} elsif ($base -> is_inf() || $base -> is_zero()) {
if ($x -> is_inf() || $x -> is_zero()) {
- $x -> bnan();
+ $x = $x -> bnan();
} else {
- $x -> bzero(@params);
+ $x = $x -> bzero(@params);
}
$done = 1;
} elsif ($base -> is_negative()) { # -inf < base < 0
if ($x -> is_one()) { # x = 1
- $x -> bzero(@params);
+ $x = $x -> bzero(@params);
} elsif ($x == $base) {
- $x -> bone('+', @params); # x = base
+ $x = $x -> bone('+', @params); # x = base
} else {
- $x -> bnan(); # otherwise
+ $x = $x -> bnan(); # otherwise
}
$done = 1;
} elsif ($x == $base) {
- $x -> bone('+', @params); # 0 < base && 0 < x < inf
+ $x = $x -> bone('+', @params); # 0 < base && 0 < x < inf
$done = 1;
}
}
@@ -2475,17 +2547,17 @@ sub blog {
unless ($done) {
if ($x -> is_inf()) { # x = +/-inf
my $sign = defined $base && $base < 1 ? '-' : '+';
- $x -> binf($sign);
+ $x = $x -> binf($sign);
$done = 1;
} elsif ($x -> is_neg()) { # -inf < x < 0
- $x -> bnan();
+ $x = $x -> bnan();
$done = 1;
} elsif ($x -> is_one()) { # x = 1
- $x -> bzero(@params);
+ $x = $x -> bzero(@params);
$done = 1;
} elsif ($x -> is_zero()) { # x = 0
my $sign = defined $base && $base < 1 ? '+' : '-';
- $x -> binf($sign);
+ $x = $x -> binf($sign);
$done = 1;
}
}
@@ -2496,69 +2568,61 @@ sub blog {
delete $x->{_a};
delete $x->{_p};
}
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x->is_int();
return $x;
}
# when user set globals, they would interfere with our calculation, so
# disable them and later re-enable them
no strict 'refs';
- my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
- my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
+ my $abr = "$class\::accuracy";
+ my $ab = $$abr;
+ $$abr = undef;
+ my $pbr = "$class\::precision";
+ my $pb = $$pbr;
+ $$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
- delete $x->{_a}; delete $x->{_p};
- # need to disable $upgrade in BigInt, to avoid deep recursion
- local $Math::BigInt::upgrade = undef;
- local $Math::BigFloat::downgrade = undef;
-
- # upgrade $x if $x is not a Math::BigFloat (handle BigInt input)
- # XXX TODO: rebless!
- if (!$x->isa('Math::BigFloat')) {
- $x = Math::BigFloat->new($x);
- $class = ref($x);
- }
+ delete $x->{_a};
+ delete $x->{_p};
$done = 0;
- # If the base is defined and an integer, try to calculate integer result
- # 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 $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};
+ # If both the invocand and the base are integers, try to calculate integer
+ # result 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 $x_lib = $LIB -> _new($x -> bdstr());
+ my $b_lib = $LIB -> _new($base -> bdstr());
+ ($x_lib, my $exact) = $LIB -> _log_int($x_lib, $b_lib);
+ if ($exact) {
+ $x->{_m} = $x_lib;
+ $x->{_e} = $LIB -> _zero();
+ $x = $x -> bnorm();
$done = 1;
}
}
- if ($done == 0) {
+ unless ($done) {
+
# First calculate the log to base e (using reduction by 10 and possibly
- # also by 2):
- $x->_log_10($scale);
+ # also by 2), and if a different base was requested, convert the result.
- # and if a different base was requested, convert it
+ $x = $x->_log_10($scale);
if (defined $base) {
- $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);
+ $x = $x->bdiv($base_log_e, $scale);
}
}
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
- $x->bround($params[0], $params[2]); # then round accordingly
+ $x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
- $x->bfround($params[1], $params[2]); # then round accordingly
+ $x = $x->bfround($params[1], $params[2]); # then round accordingly
}
if ($fallback) {
# clear a/p after round, since user did not request it
@@ -2569,25 +2633,28 @@ sub blog {
$$abr = $ab;
$$pbr = $pb;
- $x;
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x->is_int();
+ return $x;
}
sub bexp {
# Calculate e ** X (Euler's number to the power of X)
- my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bexp');
- return $x->binf() if $x->{sign} eq '+inf';
- return $x->bzero() if $x->{sign} eq '-inf';
+ return $x->bnan(@r) if $x -> is_nan();
+ return $x->binf(@r) if $x->{sign} eq '+inf';
+ return $x->bzero(@r) if $x->{sign} eq '-inf';
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
my ($scale, @params);
- ($x, @params) = $x->_find_round_parameters($a, $p, $r);
+ ($x, @params) = $x->_find_round_parameters(@r);
- # also takes care of the "error in _find_round_parameters?" case
- return $x if $x->{sign} eq 'NaN';
+ # error in _find_round_parameters?
+ return $x->bnan(@r) if $x->{sign} eq 'NaN';
# no rounding at all, so must use fallback
if (scalar @params == 0) {
@@ -2595,7 +2662,7 @@ sub bexp {
$params[0] = $class->div_scale(); # and round to it as accuracy
$params[1] = undef; # P = undef
$scale = $params[0]+4; # at least four more for proper round
- $params[2] = $r; # round mode by caller or undef
+ $params[2] = $r[2]; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
} else {
# the 4 below is empirical, and there might be cases where it's not
@@ -2613,13 +2680,21 @@ sub bexp {
# when user set globals, they would interfere with our calculation, so
# disable them and later re-enable them
no strict 'refs';
- my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
- my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
+ my $abr = "$class\::accuracy";
+ my $ab = $$abr;
+ $$abr = undef;
+ my $pbr = "$class\::precision";
+ my $pb = $$pbr;
+ $$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
delete $x->{_a};
delete $x->{_p};
- # need to disable $upgrade in BigInt, to avoid deep recursion
+
+ # Disabling upgrading and downgrading is no longer necessary to avoid an
+ # infinite recursion, but it avoids unnecessary upgrading and downgrading in
+ # the intermediate computations.
+
local $Math::BigInt::upgrade = undef;
local $Math::BigFloat::downgrade = undef;
@@ -2682,13 +2757,15 @@ sub bexp {
} 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:
+ # After some terms we end up with this, so we use it as a starting
+ # point:
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
+ # Compute how many steps we need to take to get $A and $B sufficiently
+ # big
my $steps = _len_to_steps($scale - 4);
# print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
while ($step++ <= $steps) {
@@ -2698,7 +2775,9 @@ sub bexp {
# increment f
$F = $LIB->_inc($F);
}
- # compute $B as factorial of $steps (this is faster than doing it manually)
+
+ # Compute $B as factorial of $steps (this is faster than doing it
+ # manually)
my $B = $LIB->_fac($LIB->_new($steps));
# print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n";
@@ -2713,7 +2792,8 @@ sub bexp {
$x->{_e} = $LIB->_new($scale);
}
- # $x contains now an estimate of e, with some surplus digits, so we can round
+ # $x contains now an estimate of e, with some surplus digits, so we can
+ # round
if (!$x_org->is_one()) {
# Reduce size of fractional part, followup with integer power of two.
my $lshift = 0;
@@ -2722,10 +2802,11 @@ sub bexp {
}
# Raise $x to the wanted power and round it.
if ($lshift == 0) {
- $x->bpow($x_org, @params);
+ $x = $x->bpow($x_org, @params);
} else {
my($mul, $rescale) = (1 << $lshift, $scale+1+$lshift);
- $x->bpow(scalar $x_org->bdiv($mul, $rescale), $rescale)->bpow($mul, @params);
+ $x = $x -> bpow(scalar $x_org->bdiv($mul, $rescale), $rescale)
+ -> bpow($mul, @params);
}
} else {
# else just round the already computed result
@@ -2733,9 +2814,9 @@ sub bexp {
delete $x->{_p};
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
- $x->bround($params[0], $params[2]); # then round accordingly
+ $x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
- $x->bfround($params[1], $params[2]); # then round accordingly
+ $x = $x->bfround($params[1], $params[2]); # then round accordingly
}
}
if ($fallback) {
@@ -2747,18 +2828,19 @@ sub bexp {
$$abr = $ab;
$$pbr = $pb;
- $x; # return modified $x
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x -> is_int();
+ $x;
}
sub bnok {
# Calculate n over k (binomial coefficient or "choose" function) as integer.
# set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return $x if $x->modify('bnok');
@@ -2768,7 +2850,10 @@ sub bnok {
my $xint = Math::BigInt -> new($x -> bsstr());
my $yint = Math::BigInt -> new($y -> bsstr());
- $xint -> bnok($yint);
+ $xint = $xint -> bnok($yint);
+
+ return $xint if defined $downgrade;
+
my $xflt = Math::BigFloat -> new($xint);
$x->{_m} = $xflt->{_m};
@@ -2787,15 +2872,18 @@ sub bsin {
# sin = x - --- + --- - --- + --- ...
# 3! 5! 7! 9!
+ return $x if $x->modify('bsin');
+
+ return $x -> bzero(@r) if $x->is_zero();
+ return $x -> bnan(@r) if $x->is_nan() || $x->is_inf();
+
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
my ($scale, @params);
($x, @params) = $x->_find_round_parameters(@r);
- # constant object or error in _find_round_parameters?
- return $x if $x->modify('bsin') || $x->is_nan();
-
- return $x->bzero(@r) if $x->is_zero();
+ # error in _find_round_parameters?
+ return $x->bnan(@r) if $x->is_nan();
# no rounding at all, so must use fallback
if (scalar @params == 0) {
@@ -2814,26 +2902,35 @@ sub bsin {
# when user set globals, they would interfere with our calculation, so
# disable them and later re-enable them
no strict 'refs';
- my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
- my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
+ my $abr = "$class\::accuracy";
+ my $ab = $$abr;
+ $$abr = undef;
+ my $pbr = "$class\::precision";
+ my $pb = $$pbr;
+ $$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
delete $x->{_a};
delete $x->{_p};
- # need to disable $upgrade in BigInt, to avoid deep recursion
+
+ # Disabling upgrading and downgrading is no longer necessary to avoid an
+ # infinite recursion, but it avoids unnecessary upgrading and downgrading in
+ # the intermediate computations.
+
local $Math::BigInt::upgrade = undef;
+ local $Math::BigFloat::downgrade = undef;
my $over = $x * $x; # X ^ 2
my $x2 = $over->copy(); # X ^ 2; difference between terms
- $over->bmul($x); # X ^ 3 as starting value
+ $over = $over->bmul($x); # X ^ 3 as starting value
my $sign = 1; # start with -=
- my $below = $class->new(6); my $factorial = $class->new(4);
+ my $below = $class->new(6);
+ my $factorial = $class->new(4);
delete $x->{_a};
delete $x->{_p};
my $limit = $class->new("1E-". ($scale-1));
- #my $steps = 0;
- while (3 < 5) {
+ while (1) {
# 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
# anymore, so we stop:
@@ -2841,22 +2938,24 @@ sub bsin {
last if $next->bacmp($limit) <= 0;
if ($sign == 0) {
- $x->badd($next);
+ $x = $x->badd($next);
} else {
- $x->bsub($next);
+ $x = $x->bsub($next);
}
$sign = 1-$sign; # alternate
# calculate things for the next term
- $over->bmul($x2); # $x*$x
- $below->bmul($factorial); $factorial->binc(); # n*(n+1)
- $below->bmul($factorial); $factorial->binc(); # n*(n+1)
+ $over = $over->bmul($x2); # $x*$x
+ $below = $below->bmul($factorial); # n*(n+1)
+ $factorial = $factorial->binc();
+ $below = $below -> bmul($factorial); # n*(n+1)
+ $factorial = $factorial->binc();
}
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
- $x->bround($params[0], $params[2]); # then round accordingly
+ $x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
- $x->bfround($params[1], $params[2]); # then round accordingly
+ $x = $x->bfround($params[1], $params[2]); # then round accordingly
}
if ($fallback) {
# clear a/p after round, since user did not request it
@@ -2866,6 +2965,9 @@ sub bsin {
# restore globals
$$abr = $ab;
$$pbr = $pb;
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x -> is_int();
$x;
}
@@ -2884,7 +2986,7 @@ sub bcos {
# constant object or error in _find_round_parameters?
return $x if $x->modify('bcos') || $x->is_nan();
-
+ return $x->bnan() if $x->is_inf();
return $x->bone(@r) if $x->is_zero();
# no rounding at all, so must use fallback
@@ -2904,20 +3006,23 @@ sub bcos {
# when user set globals, they would interfere with our calculation, so
# disable them and later re-enable them
no strict 'refs';
- my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
- my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
+ my $abr = "$class\::accuracy";
+ my $ab = $$abr;
+ $$abr = undef;
+ my $pbr = "$class\::precision";
+ my $pb = $$pbr;
+ $$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
- delete $x->{_a}; delete $x->{_p};
- # need to disable $upgrade in BigInt, to avoid deep recursion
- local $Math::BigInt::upgrade = undef;
+ delete $x->{_a};
+ delete $x->{_p};
my $over = $x * $x; # X ^ 2
my $x2 = $over->copy(); # X ^ 2; difference between terms
my $sign = 1; # start with -=
my $below = $class->new(2);
my $factorial = $class->new(3);
- $x->bone();
+ $x = $x->bone();
delete $x->{_a};
delete $x->{_p};
@@ -2931,22 +3036,24 @@ sub bcos {
last if $next->bacmp($limit) <= 0;
if ($sign == 0) {
- $x->badd($next);
+ $x = $x->badd($next);
} else {
- $x->bsub($next);
+ $x = $x->bsub($next);
}
$sign = 1-$sign; # alternate
# calculate things for the next term
- $over->bmul($x2); # $x*$x
- $below->bmul($factorial); $factorial->binc(); # n*(n+1)
- $below->bmul($factorial); $factorial->binc(); # n*(n+1)
+ $over = $over->bmul($x2); # $x*$x
+ $below = $below->bmul($factorial); # n*(n+1)
+ $factorial = $factorial -> binc();
+ $below = $below->bmul($factorial); # n*(n+1)
+ $factorial = $factorial -> binc();
}
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
- $x->bround($params[0], $params[2]); # then round accordingly
+ $x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
- $x->bfround($params[1], $params[2]); # then round accordingly
+ $x = $x->bfround($params[1], $params[2]); # then round accordingly
}
if ($fallback) {
# clear a/p after round, since user did not request it
@@ -2956,48 +3063,50 @@ sub bcos {
# restore globals
$$abr = $ab;
$$pbr = $pb;
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x -> is_int();
$x;
}
sub batan {
# Calculate a arcus tangens of x.
-
- my $self = shift;
- my $selfref = ref $self;
- my $class = $selfref || $self;
-
- my (@r) = @_;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
# taylor: x^3 x^5 x^7 x^9
# atan = x - --- + --- - --- + --- ...
# 3 5 7 9
+ return $x if $x->modify('batan');
+
+ return $x -> bnan(@r) if $x->is_nan();
+
# We need to limit the accuracy to protect against overflow.
my $fallback = 0;
my ($scale, @params);
- ($self, @params) = $self->_find_round_parameters(@r);
+ ($x, @params) = $x->_find_round_parameters(@r);
- # Constant object or error in _find_round_parameters?
+ # Error in _find_round_parameters?
- return $self if $self->modify('batan') || $self->is_nan();
+ return $x -> bnan(@r) if $x->is_nan();
- if ($self->{sign} =~ /^[+-]inf\z/) {
+ if ($x->{sign} =~ /^[+-]inf\z/) {
# +inf result is PI/2
# -inf result is -PI/2
# calculate PI/2
my $pi = $class->bpi(@r);
- # modify $self in place
- $self->{_m} = $pi->{_m};
- $self->{_e} = $pi->{_e};
- $self->{_es} = $pi->{_es};
+ # modify $x in place
+ $x->{_m} = $pi->{_m};
+ $x->{_e} = $pi->{_e};
+ $x->{_es} = $pi->{_es};
# -y => -PI/2, +y => PI/2
- $self->{sign} = substr($self->{sign}, 0, 1); # "+inf" => "+"
- $self -> {_m} = $LIB->_div($self->{_m}, $LIB->_new(2));
- return $self;
+ $x->{sign} = substr($x->{sign}, 0, 1); # "+inf" => "+"
+ $x -> {_m} = $LIB->_div($x->{_m}, $LIB->_new(2));
+ return $x;
}
- return $self->bzero(@r) if $self->is_zero();
+ return $x->bzero(@r) if $x->is_zero();
# no rounding at all, so must use fallback
if (scalar @params == 0) {
@@ -3015,57 +3124,67 @@ sub batan {
# 1 or -1 => PI/4
# inlined is_one() && is_one('-')
- if ($LIB->_is_one($self->{_m}) && $LIB->_is_zero($self->{_e})) {
+ if ($LIB->_is_one($x->{_m}) && $LIB->_is_zero($x->{_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} = $LIB->_div($self->{_m}, $LIB->_new(4));
- return $self;
+ # modify $x in place
+ $x->{_m} = $pi->{_m};
+ $x->{_e} = $pi->{_e};
+ $x->{_es} = $pi->{_es};
+ # leave the sign of $x alone (+1 => +PI/4, -1 => -PI/4)
+ $x->{_m} = $LIB->_div($x->{_m}, $LIB->_new(4));
+ return $x;
}
# This series is only valid if -1 < x < 1, so for other x we need to
# calculate PI/2 - atan(1/x):
my $pi = undef;
- if ($self->bacmp($self->copy()->bone) >= 0) {
+ if ($x->bacmp($x->copy()->bone) >= 0) {
# calculate PI/2
$pi = $class->bpi($scale - 3);
$pi->{_m} = $LIB->_div($pi->{_m}, $LIB->_new(2));
- # calculate 1/$self:
- my $self_copy = $self->copy();
- # modify $self in place
- $self->bone();
- $self->bdiv($self_copy, $scale);
+ # calculate 1/$x:
+ my $x_copy = $x->copy();
+ # modify $x in place
+ $x = $x->bone();
+ $x = $x->bdiv($x_copy, $scale);
}
my $fmul = 1;
foreach (0 .. int($scale / 20)) {
$fmul *= 2;
- $self->bdiv($self->copy()->bmul($self)->binc->bsqrt($scale + 4)->binc, $scale + 4);
+ $x = $x->bdiv($x->copy()->bmul($x)->binc()->bsqrt($scale + 4)->binc(),
+ $scale + 4);
}
# When user set globals, they would interfere with our calculation, so
# disable them and later re-enable them.
no strict 'refs';
- my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
- my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
- # We also need to disable any set A or P on $self (_find_round_parameters
+ my $abr = "$class\::accuracy";
+ my $ab = $$abr;
+ $$abr = undef;
+ my $pbr = "$class\::precision";
+ my $pb = $$pbr;
+ $$pbr = undef;
+ # We also need to disable any set A or P on $x (_find_round_parameters
# took them already into account), since these would interfere, too
- delete $self->{_a};
- delete $self->{_p};
- # Need to disable $upgrade in BigInt, to avoid deep recursion.
+ delete $x->{_a};
+ delete $x->{_p};
+
+ # Disabling upgrading and downgrading is no longer necessary to avoid an
+ # infinite recursion, but it avoids unnecessary upgrading and downgrading in
+ # the intermediate computations.
+
local $Math::BigInt::upgrade = undef;
+ local $Math::BigFloat::downgrade = undef;
- my $over = $self * $self; # X ^ 2
- my $self2 = $over->copy(); # X ^ 2; difference between terms
- $over->bmul($self); # X ^ 3 as starting value
+ my $over = $x * $x; # X ^ 2
+ my $x2 = $over->copy(); # X ^ 2; difference between terms
+ $over = $over->bmul($x); # X ^ 3 as starting value
my $sign = 1; # start with -=
my $below = $class->new(3);
my $two = $class->new(2);
- delete $self->{_a};
- delete $self->{_p};
+ delete $x->{_a};
+ delete $x->{_p};
my $limit = $class->new("1E-". ($scale-1));
#my $steps = 0;
@@ -3077,55 +3196,55 @@ sub batan {
last if $next->bacmp($limit) <= 0;
if ($sign == 0) {
- $self->badd($next);
+ $x = $x->badd($next);
} else {
- $self->bsub($next);
+ $x = $x->bsub($next);
}
$sign = 1-$sign; # alternatex
# calculate things for the next term
- $over->bmul($self2); # $self*$self
- $below->badd($two); # n += 2
+ $over = $over->bmul($x2); # $x*$x
+ $below = $below->badd($two); # n += 2
}
- $self->bmul($fmul);
+ $x = $x->bmul($fmul);
if (defined $pi) {
- my $self_copy = $self->copy();
- # modify $self in place
- $self->{_m} = $pi->{_m};
- $self->{_e} = $pi->{_e};
- $self->{_es} = $pi->{_es};
- # PI/2 - $self
- $self->bsub($self_copy);
+ my $x_copy = $x->copy();
+ # modify $x in place
+ $x->{_m} = $pi->{_m};
+ $x->{_e} = $pi->{_e};
+ $x->{_es} = $pi->{_es};
+ # PI/2 - $x
+ $x = $x->bsub($x_copy);
}
# Shortcut to not run through _find_round_parameters again.
if (defined $params[0]) {
- $self->bround($params[0], $params[2]); # then round accordingly
+ $x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
- $self->bfround($params[1], $params[2]); # then round accordingly
+ $x = $x->bfround($params[1], $params[2]); # then round accordingly
}
if ($fallback) {
# Clear a/p after round, since user did not request it.
- delete $self->{_a};
- delete $self->{_p};
+ delete $x->{_a};
+ delete $x->{_p};
}
# restore globals
$$abr = $ab;
$$pbr = $pb;
- $self;
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && ($x -> is_int() || $x -> is_inf());
+ $x;
}
sub batan2 {
# $y -> batan2($x) returns the arcus tangens of $y / $x.
# Set up parameters.
- my ($class, $y, $x, @r) = (ref($_[0]), @_);
-
- # Objectify is costly, so avoid it if we can.
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $y, $x, @r) = objectify(2, @_);
- }
+ my ($class, $y, $x, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
# Quick exit if $y is read-only.
return $y if $y -> modify('batan2');
@@ -3155,52 +3274,52 @@ sub batan2 {
$scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
}
- if ($x -> is_inf("+")) { # x = inf
- if ($y -> is_inf("+")) { # y = inf
- $y -> bpi($scale) -> bmul("0.25"); # pi/4
- } elsif ($y -> is_inf("-")) { # y = -inf
- $y -> bpi($scale) -> bmul("-0.25"); # -pi/4
- } else { # -inf < y < inf
- return $y -> bzero(@r); # 0
+ if ($x -> is_inf("+")) { # x = inf
+ if ($y -> is_inf("+")) { # y = inf
+ $y = $y -> bpi($scale) -> bmul("0.25"); # pi/4
+ } elsif ($y -> is_inf("-")) { # y = -inf
+ $y = $y -> bpi($scale) -> bmul("-0.25"); # -pi/4
+ } else { # -inf < y < inf
+ return $y -> bzero(@r); # 0
}
- } elsif ($x -> is_inf("-")) { # x = -inf
- if ($y -> is_inf("+")) { # y = inf
- $y -> bpi($scale) -> bmul("0.75"); # 3/4 pi
- } elsif ($y -> is_inf("-")) { # y = -inf
- $y -> bpi($scale) -> bmul("-0.75"); # -3/4 pi
- } elsif ($y >= 0) { # y >= 0
- $y -> bpi($scale); # pi
- } else { # y < 0
- $y -> bpi($scale) -> bneg(); # -pi
+ } elsif ($x -> is_inf("-")) { # x = -inf
+ if ($y -> is_inf("+")) { # y = inf
+ $y = $y -> bpi($scale) -> bmul("0.75"); # 3/4 pi
+ } elsif ($y -> is_inf("-")) { # y = -inf
+ $y = $y -> bpi($scale) -> bmul("-0.75"); # -3/4 pi
+ } elsif ($y >= 0) { # y >= 0
+ $y = $y -> bpi($scale); # pi
+ } else { # y < 0
+ $y = $y -> bpi($scale) -> bneg(); # -pi
}
- } elsif ($x > 0) { # 0 < x < inf
- if ($y -> is_inf("+")) { # y = inf
- $y -> bpi($scale) -> bmul("0.5"); # pi/2
- } elsif ($y -> is_inf("-")) { # y = -inf
- $y -> bpi($scale) -> bmul("-0.5"); # -pi/2
- } else { # -inf < y < inf
- $y -> bdiv($x, $scale) -> batan($scale); # atan(y/x)
+ } elsif ($x > 0) { # 0 < x < inf
+ if ($y -> is_inf("+")) { # y = inf
+ $y = $y -> bpi($scale) -> bmul("0.5"); # pi/2
+ } elsif ($y -> is_inf("-")) { # y = -inf
+ $y = $y -> bpi($scale) -> bmul("-0.5"); # -pi/2
+ } else { # -inf < y < inf
+ $y = $y -> bdiv($x, $scale) -> batan($scale); # atan(y/x)
}
- } elsif ($x < 0) { # -inf < x < 0
+ } elsif ($x < 0) { # -inf < x < 0
my $pi = $class -> bpi($scale);
- if ($y >= 0) { # y >= 0
- $y -> bdiv($x, $scale) -> batan() # atan(y/x) + pi
+ if ($y >= 0) { # y >= 0
+ $y = $y -> bdiv($x, $scale) -> batan() # atan(y/x) + pi
-> badd($pi);
- } else { # y < 0
- $y -> bdiv($x, $scale) -> batan() # atan(y/x) - pi
+ } else { # y < 0
+ $y = $y -> bdiv($x, $scale) -> batan() # atan(y/x) - pi
-> bsub($pi);
}
- } else { # x = 0
- if ($y > 0) { # y > 0
- $y -> bpi($scale) -> bmul("0.5"); # pi/2
- } elsif ($y < 0) { # y < 0
- $y -> bpi($scale) -> bmul("-0.5"); # -pi/2
- } else { # y = 0
- return $y -> bzero(@r); # 0
+ } else { # x = 0
+ if ($y > 0) { # y > 0
+ $y = $y -> bpi($scale) -> bmul("0.5"); # pi/2
+ } elsif ($y < 0) { # y < 0
+ $y = $y -> bpi($scale) -> bmul("-0.5"); # -pi/2
+ } else { # y = 0
+ return $y -> bzero(@r); # 0
}
}
- $y -> round(@r);
+ $y = $y -> round(@r);
if ($fallback) {
delete $y->{_a};
@@ -3209,31 +3328,40 @@ sub batan2 {
return $y;
}
-##############################################################################
sub bsqrt {
# calculate square root
- my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bsqrt');
- return $x->bnan() if $x->{sign} !~ /^\+/; # NaN, -inf or < 0
- return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
- return $x->round($a, $p, $r) if $x->is_zero() || $x->is_one();
+ # Handle trivial cases.
+
+ return $x -> bnan(@r) if $x->is_nan();
+ return $x -> binf("+", @r) if $x->{sign} eq '+inf';
+ return $x -> round(@r) if $x->is_zero() || $x->is_one();
+
+ # We don't support complex numbers.
+
+ if ($x -> is_neg()) {
+ return $upgrade -> bsqrt($x, @r) if defined($upgrade);
+ return $x -> bnan(@r);
+ }
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
my (@params, $scale);
- ($x, @params) = $x->_find_round_parameters($a, $p, $r);
+ ($x, @params) = $x->_find_round_parameters(@r);
- return $x if $x->is_nan(); # error in _find_round_parameters?
+ # error in _find_round_parameters?
+ return $x -> bnan(@r) if $x->is_nan();
# no rounding at all, so must use fallback
if (scalar @params == 0) {
# simulate old behaviour
$params[0] = $class->div_scale(); # and round to it as accuracy
$scale = $params[0]+4; # at least four more for proper round
- $params[2] = $r; # round mode by caller or undef
+ $params[2] = $r[2]; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
} else {
# the 4 below is empirical, and there might be cases where it is not
@@ -3244,14 +3372,23 @@ sub bsqrt {
# when user set globals, they would interfere with our calculation, so
# disable them and later re-enable them
no strict 'refs';
- my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
- my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
+ my $abr = "$class\::accuracy";
+ my $ab = $$abr;
+ $$abr = undef;
+ my $pbr = "$class\::precision";
+ my $pb = $$pbr;
+ $$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
delete $x->{_a};
delete $x->{_p};
- # need to disable $upgrade in BigInt, to avoid deep recursion
- local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI
+
+ # Disabling upgrading and downgrading is no longer necessary to avoid an
+ # infinite recursion, but it avoids unnecessary upgrading and downgrading in
+ # the intermediate computations.
+
+ local $Math::BigInt::upgrade = undef;
+ local $Math::BigFloat::downgrade = undef;
my $i = $LIB->_copy($x->{_m});
$i = $LIB->_lsft($i, $x->{_e}, 10) unless $LIB->_is_zero($x->{_e});
@@ -3268,12 +3405,12 @@ sub bsqrt {
$x->{_m} = $gs->{value};
$x->{_e} = $LIB->_zero();
$x->{_es} = '+';
- $x->bnorm();
+ $x = $x->bnorm();
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
- $x->bround($params[0], $params[2]); # then round accordingly
+ $x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
- $x->bfround($params[1], $params[2]); # then round accordingly
+ $x = $x->bfround($params[1], $params[2]); # then round accordingly
}
if ($fallback) {
# clear a/p after round, since user did not request it
@@ -3286,9 +3423,10 @@ sub bsqrt {
return $x;
}
- # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy
- # of the result by multiplying the input by 100 and then divide the integer
- # result of sqrt(input) by 10. Rounding afterwards returns the real result.
+ # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the
+ # accuracy of the result by multiplying the input by 100 and then divide the
+ # integer 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 = $LIB->_copy($x->{_m});
@@ -3348,13 +3486,13 @@ sub bsqrt {
$x->{_es} = '+';
}
$x->{_m} = $y1;
- $x->bnorm();
+ $x = $x->bnorm();
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
- $x->bround($params[0], $params[2]); # then round accordingly
+ $x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
- $x->bfround($params[1], $params[2]); # then round accordingly
+ $x = $x->bfround($params[1], $params[2]); # then round accordingly
}
if ($fallback) {
# clear a/p after round, since user did not request it
@@ -3364,6 +3502,9 @@ sub bsqrt {
# restore globals
$$abr = $ab;
$$pbr = $pb;
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && ($x -> is_int() || $x -> is_inf());
$x;
}
@@ -3371,14 +3512,24 @@ sub broot {
# calculate $y'th root of $x
# set up parameters
- my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, $a, $p, $r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x->modify('broot');
+ # Handle trivial cases.
+
+ return $x -> bnan(@r) if $x->is_nan() || $y->is_nan();
+
+ if ($x -> is_neg()) {
+ # -27 ** (1/3) = -3
+ return $x -> broot($y -> copy() -> bneg(), @r) -> bneg()
+ if $x -> is_int() && $y -> is_int() && $y -> is_neg();
+ return $upgrade -> broot($x, $y, @r) if defined $upgrade;
+ return $x -> bnan(@r);
+ }
+
# NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
$y->{sign} !~ /^\+$/;
@@ -3388,7 +3539,7 @@ sub broot {
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
my (@params, $scale);
- ($x, @params) = $x->_find_round_parameters($a, $p, $r);
+ ($x, @params) = $x->_find_round_parameters(@r);
return $x if $x->is_nan(); # error in _find_round_parameters?
@@ -3397,7 +3548,7 @@ sub broot {
# simulate old behaviour
$params[0] = $class->div_scale(); # and round to it as accuracy
$scale = $params[0]+4; # at least four more for proper round
- $params[2] = $r; # round mode by caller or undef
+ $params[2] = $r[2]; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
} else {
# the 4 below is empirical, and there might be cases where it is not
@@ -3408,14 +3559,23 @@ sub broot {
# when user set globals, they would interfere with our calculation, so
# disable them and later re-enable them
no strict 'refs';
- my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
- my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
+ my $abr = "$class\::accuracy";
+ my $ab = $$abr;
+ $$abr = undef;
+ my $pbr = "$class\::precision";
+ my $pb = $$pbr;
+ $$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
delete $x->{_a};
delete $x->{_p};
- # need to disable $upgrade in BigInt, to avoid deep recursion
- local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI
+
+ # Disabling upgrading and downgrading is no longer necessary to avoid an
+ # infinite recursion, but it avoids unnecessary upgrading and downgrading in
+ # the intermediate computations.
+
+ local $Math::BigInt::upgrade = undef;
+ local $Math::BigFloat::downgrade = undef;
# remember sign and make $x positive, since -4 ** (1/2) => -2
my $sign = 0;
@@ -3424,14 +3584,15 @@ sub broot {
my $is_two = 0;
if ($y->isa('Math::BigFloat')) {
- $is_two = ($y->{sign} eq '+' && $LIB->_is_two($y->{_m}) && $LIB->_is_zero($y->{_e}));
+ $is_two = $y->{sign} eq '+' && $LIB->_is_two($y->{_m})
+ && $LIB->_is_zero($y->{_e});
} else {
- $is_two = ($y == 2);
+ $is_two = $y == 2;
}
# normal square root if $y == 2:
if ($is_two) {
- $x->bsqrt($scale+4);
+ $x = $x->bsqrt($scale+4);
} elsif ($y->is_one('-')) {
# $x ** -1 => 1/$x
my $u = $class->bone()->bdiv($x, $scale);
@@ -3449,30 +3610,31 @@ sub broot {
$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());
+ $int = $int->broot($y->as_number());
# if ($exact)
if ($int->copy()->bpow($y) == $x) {
# found result, return it
$x->{_m} = $int->{value};
$x->{_e} = $LIB->_zero();
$x->{_es} = '+';
- $x->bnorm();
+ $x = $x->bnorm();
$done = 1;
}
}
if ($done == 0) {
my $u = $class->bone()->bdiv($y, $scale+4);
- delete $u->{_a}; delete $u->{_p}; # otherwise it conflicts
- $x->bpow($u, $scale+4); # el cheapo
+ delete $u->{_a};
+ delete $u->{_p};
+ $x = $x->bpow($u, $scale+4); # el cheapo
}
}
- $x->bneg() if $sign == 1;
+ $x = $x->bneg() if $sign == 1;
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
- $x->bround($params[0], $params[2]); # then round accordingly
+ $x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
- $x->bfround($params[1], $params[2]); # then round accordingly
+ $x = $x->bfround($params[1], $params[2]); # then round accordingly
}
if ($fallback) {
# clear a/p after round, since user did not request it
@@ -3482,6 +3644,9 @@ sub broot {
# restore globals
$$abr = $ab;
$$pbr = $pb;
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && ($x -> is_int() || $x -> is_inf());
$x;
}
@@ -3490,16 +3655,19 @@ sub bfac {
# compute factorial number, modifies first argument
# set up parameters
- my ($class, $x, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- ($class, $x, @r) = objectify(1, @_) if !ref($x);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
# inf => inf
- return $x if $x->modify('bfac') || $x->{sign} eq '+inf';
+ return $x if $x->modify('bfac');
+
+ return $x -> bnan(@r) if $x->is_nan() || $x->is_inf("-");
+ return $x -> binf("+", @r) if $x->is_inf("+");
+ return $x -> bone(@r) if $x->is_zero() || $x->is_one();
- return $x->bnan()
- if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
- ($x->{_es} ne '+')); # digits after dot?
+ if ($x -> is_neg() || !$x -> is_int()) {
+ return $upgrade -> bfac($x, @r) if defined($upgrade);
+ return $x -> bnan(@r);
+ }
if (! $LIB->_is_zero($x->{_e})) {
$x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
@@ -3507,23 +3675,31 @@ sub bfac {
$x->{_es} = '+';
}
$x->{_m} = $LIB->_fac($x->{_m}); # calculate factorial
- $x->bnorm()->round(@r); # norm again and round result
+
+ $x = $x->bnorm()->round(@r); # norm again and round result
+
+ return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade)
+ && ($x -> is_int() || $x -> is_inf());
+ $x;
}
sub bdfac {
# compute double factorial
# set up parameters
- my ($class, $x, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- ($class, $x, @r) = objectify(1, @_) if !ref($x);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- # inf => inf
- return $x if $x->modify('bfac') || $x->{sign} eq '+inf';
+ return $x if $x->modify('bdfac');
+
+ return $x -> bnan(@r) if $x->is_nan() || $x->is_inf("-");
+ return $x -> binf("+", @r) if $x->is_inf("+");
+
+ if ($x <= -2 || !$x -> is_int()) {
+ return $upgrade -> bdfac($x, @r) if defined($upgrade);
+ return $x -> bnan(@r);
+ }
- return $x->bnan()
- if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
- ($x->{_es} ne '+')); # digits after dot?
+ return $x->bone() if $x <= 1;
croak("bdfac() requires a newer version of the $LIB library.")
unless $LIB->can('_dfac');
@@ -3534,59 +3710,137 @@ sub bdfac {
$x->{_es} = '+';
}
$x->{_m} = $LIB->_dfac($x->{_m}); # calculate factorial
- $x->bnorm()->round(@r); # norm again and round result
+
+ $x = $x->bnorm()->round(@r); # norm again and round result
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x -> is_int();
+ return $x;
}
-sub blsft {
- # shift left by $y (multiply by $b ** $y)
+sub btfac {
+ # compute triple factorial
# set up parameters
- my ($class, $x, $y, $b, $a, $p, $r) = (ref($_[0]), @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, $b, $a, $p, $r) = objectify(2, @_);
+ return $x if $x->modify('btfac');
+
+ return $x -> bnan(@r) if $x->is_nan() || $x->is_inf("-");
+ return $x -> binf("+", @r) if $x->is_inf("+");
+
+ if ($x <= -3 || !$x -> is_int()) {
+ return $upgrade -> btfac($x, @r) if defined($upgrade);
+ return $x -> bnan(@r);
+ }
+
+ my $k = $class -> new("3");
+ return $x->bnan(@r) if $x <= -$k;
+
+ my $one = $class -> bone();
+ return $x->bone(@r) if $x <= $one;
+
+ my $f = $x -> copy();
+ while ($f -> bsub($k) > $one) {
+ $x = $x -> bmul($f);
}
+ $x = $x->round(@r);
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x -> is_int();
+ return $x;
+}
+
+sub bmfac {
+ my ($class, $x, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
+
+ return $x if $x->modify('bmfac');
+
+ return $x -> bnan(@r) if $x->is_nan() || $x->is_inf("-") || !$k->is_pos();
+ return $x -> binf("+", @r) if $x->is_inf("+");
+
+ if ($x <= -$k || !$x -> is_int() ||
+ ($k -> is_finite() && !$k -> is_int()))
+ {
+ return $upgrade -> bmfac($x, $k, @r) if defined($upgrade);
+ return $x -> bnan(@r);
+ }
+
+ my $one = $class -> bone();
+ return $x->bone(@r) if $x <= $one;
+
+ my $f = $x -> copy();
+ while ($f -> bsub($k) > $one) {
+ $x = $x -> bmul($f);
+ }
+
+ $x = $x->round(@r);
+
+ return $downgrade -> new($x -> bdstr(), @r)
+ if defined($downgrade) && $x -> is_int();
+ return $x;
+}
+
+sub blsft {
+ # shift left by $y (multiply by $b ** $y)
+
+ # set up parameters
+ my ($class, $x, $y, $b, @r)
+ = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
+
return $x if $x -> modify('blsft');
- return $x if $x -> {sign} !~ /^[+-]$/; # nan, +inf, -inf
+
+ return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
$b = 2 if !defined $b;
$b = $class -> new($b) unless ref($b) && $b -> isa($class);
+ return $x -> bnan(@r) if $b -> is_nan();
- return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();
+ # There needs to be more checking for special cases here. Fixme!
# shift by a negative amount?
return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
- $x -> bmul($b -> bpow($y), $a, $p, $r, $y);
+ $x = $x -> bmul($b -> bpow($y), $r[0], $r[1], $r[2], $y);
+
+ return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade)
+ && ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
+ return $x;
}
sub brsft {
# shift right by $y (divide $b ** $y)
# set up parameters
- my ($class, $x, $y, $b, $a, $p, $r) = (ref($_[0]), @_);
-
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, $b, $a, $p, $r) = objectify(2, @_);
- }
+ my ($class, $x, $y, $b, @r)
+ = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x -> modify('brsft');
- return $x if $x -> {sign} !~ /^[+-]$/; # nan, +inf, -inf
+
+ return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
+
+ # There needs to be more checking for special cases here. Fixme!
$b = 2 if !defined $b;
$b = $class -> new($b) unless ref($b) && $b -> isa($class);
-
- return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();
+ return $x -> bnan(@r) if $b -> is_nan();
# shift by a negative amount?
return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
- # the following call to bdiv() will return either quotient (scalar context)
- # or quotient and remainder (list context).
- $x -> bdiv($b -> bpow($y), $a, $p, $r, $y);
+ # call bdiv()
+ $x = $x -> bdiv($b -> bpow($y), $r[0], $r[1], $r[2], $y);
+
+ return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade)
+ && ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
+ return $x;
}
###############################################################################
@@ -3594,24 +3848,20 @@ sub brsft {
###############################################################################
sub band {
- my $x = shift;
- my $xref = ref($x);
- my $class = $xref || $x;
-
- croak 'band() is an instance method, not a class method' unless $xref;
- croak 'Not enough arguments for band()' if @_ < 1;
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return if $x -> modify('band');
- my $y = shift;
- $y = $class -> new($y) unless ref($y);
-
- my @r = @_;
+ return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
- $xtmp -> band($y);
- $xtmp = $class -> new($xtmp); # back to Math::BigFloat
+ $xtmp = $xtmp -> band($y);
+
+ return $xtmp -> round(@r) if defined $downgrade;
+ $xtmp = $class -> new($xtmp); # back to Math::BigFloat
$x -> {sign} = $xtmp -> {sign};
$x -> {_m} = $xtmp -> {_m};
$x -> {_es} = $xtmp -> {_es};
@@ -3621,24 +3871,20 @@ sub band {
}
sub bior {
- my $x = shift;
- my $xref = ref($x);
- my $class = $xref || $x;
-
- croak 'bior() is an instance method, not a class method' unless $xref;
- croak 'Not enough arguments for bior()' if @_ < 1;
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return if $x -> modify('bior');
- my $y = shift;
- $y = $class -> new($y) unless ref($y);
-
- my @r = @_;
+ return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
- $xtmp -> bior($y);
- $xtmp = $class -> new($xtmp); # back to Math::BigFloat
+ $xtmp = $xtmp -> bior($y);
+
+ return $xtmp -> round(@r) if defined $downgrade;
+ $xtmp = $class -> new($xtmp); # back to Math::BigFloat
$x -> {sign} = $xtmp -> {sign};
$x -> {_m} = $xtmp -> {_m};
$x -> {_es} = $xtmp -> {_es};
@@ -3648,24 +3894,20 @@ sub bior {
}
sub bxor {
- my $x = shift;
- my $xref = ref($x);
- my $class = $xref || $x;
-
- croak 'bxor() is an instance method, not a class method' unless $xref;
- croak 'Not enough arguments for bxor()' if @_ < 1;
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return if $x -> modify('bxor');
- my $y = shift;
- $y = $class -> new($y) unless ref($y);
-
- my @r = @_;
+ return $x -> bnan(@r) if $x -> is_nan() || $y -> is_nan();
my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
- $xtmp -> bxor($y);
- $xtmp = $class -> new($xtmp); # back to Math::BigFloat
+ $xtmp = $xtmp -> bxor($y);
+ return $xtmp -> round(@r) if defined $downgrade;
+
+ $xtmp = $class -> new($xtmp); # back to Math::BigFloat
$x -> {sign} = $xtmp -> {sign};
$x -> {_m} = $xtmp -> {_m};
$x -> {_es} = $xtmp -> {_es};
@@ -3675,20 +3917,18 @@ sub bxor {
}
sub bnot {
- my $x = shift;
- my $xref = ref($x);
- my $class = $xref || $x;
-
- croak 'bnot() is an instance method, not a class method' unless $xref;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return if $x -> modify('bnot');
- my @r = @_;
+ return $x -> bnan(@r) if $x -> is_nan();
my $xtmp = Math::BigInt -> new($x -> bint()); # to Math::BigInt
- $xtmp -> bnot();
- $xtmp = $class -> new($xtmp); # back to Math::BigFloat
+ $xtmp = $xtmp -> bnot();
+ return $xtmp -> round(@r) if defined $downgrade;
+
+ $xtmp = $class -> new($xtmp); # back to Math::BigFloat
$x -> {sign} = $xtmp -> {sign};
$x -> {_m} = $xtmp -> {_m};
$x -> {_es} = $xtmp -> {_es};
@@ -3703,42 +3943,61 @@ sub bnot {
sub bround {
# accuracy: preserve $N digits, and overwrite the rest with 0's
- my $x = shift;
- my $class = ref($x) || $x;
- $x = $class->new(shift) if !ref($x);
- if (($_[0] || 0) < 0) {
+ my ($class, $x, @a) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ if (($a[0] || 0) < 0) {
croak('bround() needs positive accuracy');
}
- my ($scale, $mode) = $x->_scale_a(@_);
- return $x if !defined $scale || $x->modify('bround'); # no-op
+ return $x if $x->modify('bround');
+
+ my ($scale, $mode) = $x->_scale_a(@a);
+ if (!defined $scale) { # no-op
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
+ }
- # scale is now either $x->{_a}, $accuracy, or the user parameter
- # test whether $x already has lower accuracy, do nothing in this case
- # but do round if the accuracy is the same, since a math operation might
- # want to round a number with A=5 to 5 digits afterwards again
- return $x if defined $x->{_a} && $x->{_a} < $scale;
+ # Scale is now either $x->{_a}, $accuracy, or the input argument. Test
+ # whether $x already has lower accuracy, do nothing in this case but do
+ # round if the accuracy is the same, since a math operation might want to
+ # round a number with A=5 to 5 digits afterwards again
+
+ if (defined $x->{_a} && $x->{_a} < $scale) {
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
+ }
# scale < 0 makes no sense
# scale == 0 => keep all digits
# never round a +-inf, NaN
- return $x if ($scale <= 0) || $x->{sign} !~ /^[+-]$/;
+
+ if ($scale <= 0 || $x->{sign} !~ /^[+-]$/) {
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
+ }
# 1: never round a 0
# 2: if we should keep more digits than the mantissa has, do nothing
if ($x->is_zero() || $LIB->_len($x->{_m}) <= $scale) {
$x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale;
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
return $x;
}
# pass sign to bround for '+inf' and '-inf' rounding modes
my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
- $m->bround($scale, $mode); # round mantissa
- $x->{_m} = $m->{value}; # get our mantissa back
- $x->{_a} = $scale; # remember rounding
- delete $x->{_p}; # and clear P
+ $m = $m->bround($scale, $mode); # round mantissa
+ $x->{_m} = $m->{value}; # get our mantissa back
+ $x->{_a} = $scale; # remember rounding
+ delete $x->{_p}; # and clear P
+
+ # bnorm() downgrades if necessary, so no need to check whether to downgrade.
$x->bnorm(); # del trailing zeros gen. by bround()
}
@@ -3746,29 +4005,50 @@ sub bfround {
# precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
# $n == 0 means round to integer
# expects and returns normalized numbers!
- my $x = shift;
- my $class = ref($x) || $x;
- $x = $class->new(shift) if !ref($x);
- my ($scale, $mode) = $x->_scale_p(@_);
- return $x if !defined $scale || $x->modify('bfround'); # no-op
+ my ($class, $x, @p) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ return $x if $x->modify('bfround'); # no-op
+
+ my ($scale, $mode) = $x->_scale_p(@p);
+ if (!defined $scale) {
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
+ }
# never round a 0, +-inf, NaN
+
if ($x->is_zero()) {
$x->{_p} = $scale if !defined $x->{_p} || $x->{_p} < $scale; # -3 < -2
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
+ }
+
+ if ($x->{sign} !~ /^[+-]$/) {
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
return $x;
}
- return $x if $x->{sign} !~ /^[+-]$/;
# don't round if x already has lower precision
- return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p});
+ if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p}) {
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
+ }
$x->{_p} = $scale; # remember round in any case
delete $x->{_a}; # and clear A
if ($scale < 0) {
# round right from the '.'
- return $x if $x->{_es} eq '+'; # e >= 0 => nothing to round
+ if ($x->{_es} eq '+') { # e >= 0 => nothing to round
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
+ }
$scale = -$scale; # positive for simplicity
my $len = $LIB->_len($x->{_m}); # length of mantissa
@@ -3788,13 +4068,23 @@ sub bfround {
# 1.2345 12345e-4 5 0 4
# do not round after/right of the $dad
- return $x if $scale > $dad; # 0.123, scale >= 3 => exit
+
+ if ($scale > $dad) { # 0.123, scale >= 3 => exit
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
+ }
# round to zero if rounding inside the $zad, but not for last zero like:
- # 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
- return $x->bzero() if $scale < $zad;
- if ($scale == $zad) # for 0.006, scale -3 and trunc
- {
+ # 0.0065, scale -2, round last '0' with following '65' (scale == zad
+ # case)
+ if ($scale < $zad) {
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x->bzero();
+ }
+
+ if ($scale == $zad) { # for 0.006, scale -3 and trunc
$scale = -$len;
} else {
# adjust round-point to be inside mantissa
@@ -3817,12 +4107,17 @@ sub bfround {
# should be the same, so treat it as this
$scale = 1 if $scale == 0;
# shortcut if already integer
- return $x if $scale == 1 && $dbt <= $dbd;
+ if ($scale == 1 && $dbt <= $dbd) {
+ return $downgrade -> new($x) if defined($downgrade)
+ && ($x->is_int() || $x->is_inf() || $x->is_nan());
+ return $x;
+ }
# maximum digits before dot
++$dbd;
if ($scale > $dbd) {
# not enough digits before dot, so round to zero
+ return $downgrade -> new($x) if defined($downgrade);
return $x->bzero;
} elsif ($scale == $dbd) {
# maximum
@@ -3831,66 +4126,87 @@ sub bfround {
$scale = $dbd - $scale;
}
}
+
# pass sign to bround for rounding modes '+inf' and '-inf'
my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
- $m->bround($scale, $mode);
+ $m = $m->bround($scale, $mode);
$x->{_m} = $m->{value}; # get our mantissa back
+
+ # bnorm() downgrades if necessary, so no need to check whether to downgrade.
$x->bnorm();
}
sub bfloor {
# round towards minus infinity
- my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bfloor');
- return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
- # if $x has digits after dot
- if ($x->{_es} eq '-') {
- $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} = $LIB->_inc($x->{_m}) if $x->{sign} eq '-'; # increment if negative
+ return $x -> bnan(@r) if $x -> is_nan();
+
+ if ($x->{sign} =~ /^[+-]$/) {
+ # if $x has digits after dot, remove them
+ if ($x->{_es} eq '-') {
+ $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10);
+ $x->{_e} = $LIB->_zero();
+ $x->{_es} = '+';
+ # increment if negative
+ $x->{_m} = $LIB->_inc($x->{_m}) if $x->{sign} eq '-';
+ }
+ $x = $x->round(@r);
}
- $x->round($a, $p, $r);
+ return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade);
+ return $x;
}
sub bceil {
# round towards plus infinity
- my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bceil');
- return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
- # if $x has digits after dot
- if ($x->{_es} eq '-') {
- $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} = $LIB->_inc($x->{_m}); # increment if positive
- } else {
- $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # avoid -0
+ return $x -> bnan(@r) if $x -> is_nan();
+
+ # if $x has digits after dot, remove them
+ if ($x->{sign} =~ /^[+-]$/) {
+ if ($x->{_es} eq '-') {
+ $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10);
+ $x->{_e} = $LIB->_zero();
+ $x->{_es} = '+';
+ if ($x->{sign} eq '+') {
+ $x->{_m} = $LIB->_inc($x->{_m}); # increment if positive
+ } else {
+ $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # avoid -0
+ }
}
+ $x = $x->round(@r);
}
- $x->round($a, $p, $r);
+
+ return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade);
+ return $x;
}
sub bint {
# round towards zero
- my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bint');
- return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
- # if $x has digits after the decimal point
- if ($x->{_es} eq '-') {
- $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 $LIB->_is_zero($x->{_m}); # avoid -0
+ return $x -> bnan(@r) if $x -> is_nan();
+
+ if ($x->{sign} =~ /^[+-]$/) {
+ # if $x has digits after the decimal point
+ if ($x->{_es} eq '-') {
+ $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # remove frac part
+ $x->{_e} = $LIB->_zero(); # truncate/normalize
+ $x->{_es} = '+'; # abs e
+ $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # avoid -0
+ }
+ $x = $x->round(@r);
}
- $x->round($a, $p, $r);
+
+ return $downgrade -> new($x -> bdstr(), @r) if defined($downgrade);
+ return $x;
}
###############################################################################
@@ -3901,8 +4217,14 @@ sub bgcd {
# (BINT or num_str, BINT or num_str) return BINT
# does not modify arguments, but returns new object
- unshift @_, __PACKAGE__
- unless ref($_[0]) || $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i;
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
+ unshift @_, __PACKAGE__;
+ }
my ($class, @args) = objectify(0, @_);
@@ -3922,7 +4244,11 @@ sub bgcd {
last if $x -> is_one();
}
- return $x -> babs();
+ $x = $x -> babs();
+
+ return $downgrade -> new($x)
+ if defined $downgrade && $x->is_int();
+ return $x;
}
sub blcm {
@@ -3930,8 +4256,14 @@ sub blcm {
# does not modify arguments, but returns new object
# Least Common Multiple
- unshift @_, __PACKAGE__
- unless ref($_[0]) || $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i;
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
+ unshift @_, __PACKAGE__;
+ }
my ($class, @args) = objectify(0, @_);
@@ -3944,10 +4276,14 @@ sub blcm {
$y = $class -> new($y) unless ref($y) && $y -> isa($class);
return $x->bnan() unless $y -> is_int();
my $gcd = $x -> bgcd($y);
- $x -> bdiv($gcd) -> bmul($y);
+ $x = $x -> bdiv($gcd) -> bmul($y);
}
- return $x -> babs();
+ $x = $x -> babs();
+
+ return $downgrade -> new($x)
+ if defined $downgrade && $x->is_int();
+ return $x;
}
###############################################################################
@@ -3955,9 +4291,9 @@ sub blcm {
###############################################################################
sub length {
- my $x = shift;
- my $class = ref($x) || $x;
- $x = $class->new(shift) unless ref($x);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return 1 if $LIB->_is_zero($x->{_m});
@@ -3973,7 +4309,13 @@ sub length {
sub mantissa {
# return a copy of the mantissa
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ # The following line causes a lot of noise in the test suits for
+ # the Math-BigRat and bignum distributions. Fixme!
+ #carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ return $x -> bnan(@r) if $x -> is_nan();
if ($x->{sign} !~ /^[+-]$/) {
my $s = $x->{sign};
@@ -3981,14 +4323,19 @@ sub mantissa {
return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
}
my $m = Math::BigInt->new($LIB->_str($x->{_m}), undef, undef);
- $m->bneg() if $x->{sign} eq '-';
-
+ $m = $m->bneg() if $x->{sign} eq '-';
$m;
}
sub exponent {
# return a copy of the exponent
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ # The following line causes a lot of noise in the test suits for
+ # the Math-BigRat and bignum distributions. Fixme!
+ #carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ return $x -> bnan(@r) if $x -> is_nan();
if ($x->{sign} !~ /^[+-]$/) {
my $s = $x->{sign};
@@ -4000,32 +4347,37 @@ sub exponent {
sub parts {
# return a copy of both the exponent and the mantissa
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
if ($x->{sign} !~ /^[+-]$/) {
my $s = $x->{sign};
$s =~ s/^\+//;
my $se = $s;
$se =~ s/^-//;
- return ($class->new($s), $class->new($se)); # +inf => inf and -inf, +inf => inf
+ # +inf => inf and -inf, +inf => inf
+ return ($class->new($s), $class->new($se));
}
my $m = Math::BigInt->bzero();
$m->{value} = $LIB->_copy($x->{_m});
- $m->bneg() if $x->{sign} eq '-';
+ $m = $m->bneg() if $x->{sign} eq '-';
($m, Math::BigInt->new($x->{_es} . $LIB->_num($x->{_e})));
}
+# Parts used for scientific notation with significand/mantissa and exponent as
+# integers. E.g., "12345.6789" is returned as "123456789" (mantissa) and "-4"
+# (exponent).
+
sub sparts {
- my $self = shift;
- my $class = ref $self;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- croak("sparts() is an instance method, not a class method")
- unless $class;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
# Not-a-number.
- if ($self -> is_nan()) {
- my $mant = $self -> copy(); # mantissa
+ if ($x -> is_nan()) {
+ my $mant = $class -> bnan(); # mantissa
return $mant unless wantarray; # scalar context
my $expo = $class -> bnan(); # exponent
return ($mant, $expo); # list context
@@ -4033,8 +4385,8 @@ sub sparts {
# Infinity.
- if ($self -> is_inf()) {
- my $mant = $self -> copy(); # mantissa
+ if ($x -> is_inf()) {
+ my $mant = $class -> binf($x->{sign}); # mantissa
return $mant unless wantarray; # scalar context
my $expo = $class -> binf('+'); # exponent
return ($mant, $expo); # list context
@@ -4042,56 +4394,46 @@ sub sparts {
# Finite number.
- my $mant = $class -> bzero();
- $mant -> {sign} = $self -> {sign};
- $mant -> {_m} = $LIB->_copy($self -> {_m});
+ my $mant = $x -> copy();
+ $mant->{_es} = '+';
+ $mant->{_e} = $LIB->_zero();
+ $mant = $downgrade -> new($mant) if defined $downgrade;
return $mant unless wantarray;
- my $expo = $class -> bzero();
- $expo -> {sign} = $self -> {_es};
- $expo -> {_m} = $LIB->_copy($self -> {_e});
-
+ my $expo = bless { sign => $x -> {_es},
+ _m => $LIB->_copy($x -> {_e}),
+ _es => '+',
+ _e => $LIB->_zero(),
+ }, $class;
+ $expo = $downgrade -> new($expo) if defined $downgrade;
return ($mant, $expo);
}
-sub nparts {
- my $self = shift;
- my $class = ref $self;
+# Parts used for normalized notation with significand/mantissa as either 0 or a
+# number in the semi-open interval [1,10). E.g., "12345.6789" is returned as
+# "1.23456789" and "4".
- croak("nparts() is an instance method, not a class method")
- unless $class;
+sub nparts {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- # Not-a-number.
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- if ($self -> is_nan()) {
- my $mant = $self -> copy(); # mantissa
- return $mant unless wantarray; # scalar context
- my $expo = $class -> bnan(); # exponent
- return ($mant, $expo); # list context
- }
-
- # Infinity.
+ # Not-a-number and Infinity.
- if ($self -> is_inf()) {
- my $mant = $self -> copy(); # mantissa
- return $mant unless wantarray; # scalar context
- my $expo = $class -> binf('+'); # exponent
- return ($mant, $expo); # list context
- }
+ return $x -> sparts() if $x -> is_nan() || $x -> is_inf();
# Finite number.
- my ($mant, $expo) = $self -> sparts();
+ my ($mant, $expo) = $x -> sparts();
if ($mant -> bcmp(0)) {
my ($ndigtot, $ndigfrac) = $mant -> length();
my $expo10adj = $ndigtot - $ndigfrac - 1;
- if ($expo10adj != 0) {
- my $factor = "1e" . -$expo10adj;
- $mant -> bmul($factor);
+ if ($expo10adj > 0) { # if mantissa is not an integer
+ $mant = $mant -> brsft($expo10adj, 10);
return $mant unless wantarray;
- $expo -> badd($expo10adj);
+ $expo = $expo -> badd($expo10adj);
return ($mant, $expo);
}
}
@@ -4100,63 +4442,182 @@ sub nparts {
return ($mant, $expo);
}
+# Parts used for engineering notation with significand/mantissa as either 0 or a
+# number in the semi-open interval [1,1000) and the exponent is a multiple of 3.
+# E.g., "12345.6789" is returned as "12.3456789" and "3".
+
sub eparts {
- my $self = shift;
- my $class = ref $self;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- croak("eparts() is an instance method, not a class method")
- unless $class;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
# Not-a-number and Infinity.
- return $self -> sparts() if $self -> is_nan() || $self -> is_inf();
+ return $x -> sparts() if $x -> is_nan() || $x -> is_inf();
# Finite number.
- my ($mant, $expo) = $self -> nparts();
+ my ($mant, $expo) = $x -> nparts();
my $c = $expo -> copy() -> bmod(3);
- $mant -> blsft($c, 10);
+ $mant = $mant -> blsft($c, 10);
return $mant unless wantarray;
- $expo -> bsub($c);
+ $expo = $expo -> bsub($c);
return ($mant, $expo);
}
+# Parts used for decimal notation, e.g., "12345.6789" is returned as "12345"
+# (integer part) and "0.6789" (fraction part).
+
sub dparts {
- my $self = shift;
- my $class = ref $self;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- croak("dparts() is an instance method, not a class method")
- unless $class;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- # Not-a-number and Infinity.
+ # Not-a-number.
+
+ if ($x -> is_nan()) {
+ my $int = $class -> bnan();
+ return $int unless wantarray;
+ my $frc = $class -> bzero(); # or NaN?
+ return ($int, $frc);
+ }
+
+ # Infinity.
- if ($self -> is_nan() || $self -> is_inf()) {
- my $int = $self -> copy();
+ if ($x -> is_inf()) {
+ my $int = $class -> binf($x->{sign});
return $int unless wantarray;
my $frc = $class -> bzero();
return ($int, $frc);
}
- my $int = $self -> copy();
- my $frc = $class -> bzero();
+ # Finite number.
+
+ my $int = $x -> copy();
+ my $frc;
+
+ # If the input is an integer.
- # If the input has a fraction part.
+ if ($int->{_es} eq '+') {
+ $frc = $class -> bzero();
+ }
+
+ # If the input has a fraction part
- if ($int->{_es} eq '-') {
+ else {
$int->{_m} = $LIB -> _rsft($int->{_m}, $int->{_e}, 10);
$int->{_e} = $LIB -> _zero();
$int->{_es} = '+';
$int->{sign} = '+' if $LIB->_is_zero($int->{_m}); # avoid -0
-
return $int unless wantarray;
- $frc = $self -> copy() -> bsub($int);
+ $frc = $x -> copy() -> bsub($int);
return ($int, $frc);
}
+ $int = $downgrade -> new($int) if defined $downgrade;
return $int unless wantarray;
- return ($int, $frc);
+ return $int, $frc;
+}
+
+# Fractional parts with the numerator and denominator as integers. E.g.,
+# "123.4375" is returned as "1975" and "16".
+
+sub fparts {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # NaN => NaN/NaN
+
+ if ($x -> is_nan()) {
+ return $class -> bnan() unless wantarray;
+ return $class -> bnan(), $class -> bnan();
+ }
+
+ # ±Inf => ±Inf/1
+
+ if ($x -> is_inf()) {
+ my $numer = $class -> binf($x->{sign});
+ return $numer unless wantarray;
+ my $denom = $class -> bone();
+ return $numer, $denom;
+ }
+
+ # Finite number.
+
+ # If we get here, we know that the output is an integer.
+
+ $class = $downgrade if defined $downgrade;
+
+ my @flt_parts = ($x->{sign}, $x->{_m}, $x->{_es}, $x->{_e});
+ my @rat_parts = $class -> _flt_lib_parts_to_rat_lib_parts(@flt_parts);
+ my $num = $class -> new($LIB -> _str($rat_parts[1]));
+ my $den = $class -> new($LIB -> _str($rat_parts[2]));
+ $num = $num -> bneg() if $rat_parts[0] eq "-";
+ return $num unless wantarray;
+ return $num, $den;
+}
+
+# Given "123.4375", returns "1975", since "123.4375" is "1975/16".
+
+sub numerator {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ return $class -> bnan() if $x -> is_nan();
+ return $class -> binf($x -> sign()) if $x -> is_inf();
+ return $class -> bzero() if $x -> is_zero();
+
+ # If we get here, we know that the output is an integer.
+
+ $class = $downgrade if defined $downgrade;
+
+ if ($x -> {_es} eq '-') { # exponent < 0
+ my $numer_lib = $LIB -> _copy($x -> {_m});
+ my $denom_lib = $LIB -> _1ex($x -> {_e});
+ my $gcd_lib = $LIB -> _gcd($LIB -> _copy($numer_lib), $denom_lib);
+ $numer_lib = $LIB -> _div($numer_lib, $gcd_lib);
+ return $class -> new($x -> {sign} . $LIB -> _str($numer_lib));
+ }
+
+ elsif (! $LIB -> _is_zero($x -> {_e})) { # exponent > 0
+ my $numer_lib = $LIB -> _copy($x -> {_m});
+ $numer_lib = $LIB -> _lsft($numer_lib, $x -> {_e}, 10);
+ return $class -> new($x -> {sign} . $LIB -> _str($numer_lib));
+ }
+
+ else { # exponent = 0
+ return $class -> new($x -> {sign} . $LIB -> _str($x -> {_m}));
+ }
+}
+
+# Given "123.4375", returns "16", since "123.4375" is "1975/16".
+
+sub denominator {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ return $class -> bnan() if $x -> is_nan();
+
+ # If we get here, we know that the output is an integer.
+
+ $class = $downgrade if defined $downgrade;
+
+ if ($x -> {_es} eq '-') { # exponent < 0
+ my $numer_lib = $LIB -> _copy($x -> {_m});
+ my $denom_lib = $LIB -> _1ex($x -> {_e});
+ my $gcd_lib = $LIB -> _gcd($LIB -> _copy($numer_lib), $denom_lib);
+ $denom_lib = $LIB -> _div($denom_lib, $gcd_lib);
+ return $class -> new($LIB -> _str($denom_lib));
+ }
+
+ else { # exponent >= 0
+ return $class -> bone();
+ }
}
###############################################################################
@@ -4167,13 +4628,19 @@ sub bstr {
# (ref to BFLOAT or num_str) return num_str
# Convert number from internal format to (non-scientific) string format.
# internal format is always normalized (no leading zeros, "-0" => "+0")
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- if ($x->{sign} !~ /^[+-]$/) {
- return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
- return 'inf'; # +inf
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
+ # Finite number
+
my $es = '0';
my $len = 1;
my $cad = 0;
@@ -4221,91 +4688,243 @@ sub bstr {
$es;
}
-# Decimal notation, e.g., "12345.6789".
+# Decimal notation, e.g., "12345.6789" (no exponent).
sub bdstr {
- my $x = shift;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
if ($x->{sign} ne '+' && $x->{sign} ne '-') {
- return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
- return 'inf'; # +inf
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
+ # Upgrade?
+
+ return $upgrade -> bdstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
my $mant = $LIB->_str($x->{_m});
- my $expo = $x -> exponent();
+ my $esgn = $x->{_es};
+ my $eabs = $LIB -> _num($x->{_e});
+
+ my $uintmax = ~0;
my $str = $mant;
- if ($expo >= 0) {
- $str .= "0" x $expo;
+ if ($esgn eq '+') {
+
+ croak("The absolute value of the exponent is too large")
+ if $eabs > $uintmax;
+
+ $str .= "0" x $eabs;
+
} else {
- my $mantlen = CORE::length($mant);
- my $c = $mantlen + $expo;
+ my $mlen = CORE::length($mant);
+ my $c = $mlen - $eabs;
+
+ my $intmax = ($uintmax - 1) / 2;
+ croak("The absolute value of the exponent is too large")
+ if (1 - $c) > $intmax;
+
$str = "0" x (1 - $c) . $str if $c <= 0;
- substr($str, $expo, 0) = '.';
+ substr($str, -$eabs, 0) = '.';
}
- return $x->{sign} eq '-' ? "-$str" : $str;
+ return $x->{sign} eq '-' ? '-' . $str : $str;
}
-# Scientific notation with significand/mantissa as an integer, e.g., "12345.6789"
-# is written as "123456789e-4".
+# Scientific notation with significand/mantissa and exponent as integers, e.g.,
+# "12345.6789" is written as "123456789e-4".
sub bsstr {
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
if ($x->{sign} ne '+' && $x->{sign} ne '-') {
- return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
- return 'inf'; # +inf
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
- my $str = $LIB->_str($x->{_m}) . 'e' . $x->{_es}. $LIB->_str($x->{_e});
- return $x->{sign} eq '-' ? "-$str" : $str;
+ # Upgrade?
+
+ return $upgrade -> bsstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
+ ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{_m})
+ . 'e' . $x->{_es} . $LIB->_str($x->{_e});
}
# Normalized notation, e.g., "12345.6789" is written as "1.23456789e+4".
sub bnstr {
- my $x = shift;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
if ($x->{sign} ne '+' && $x->{sign} ne '-') {
- return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
- return 'inf'; # +inf
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
- my ($mant, $expo) = $x -> nparts();
+ # Upgrade?
+
+ return $upgrade -> bnstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
- my $esgn = $expo < 0 ? '-' : '+';
- my $eabs = $expo -> babs() -> bfround(0) -> bstr();
- #$eabs = '0' . $eabs if length($eabs) < 2;
+ my $str = $x->{sign} eq '-' ? '-' : '';
- return $mant . 'e' . $esgn . $eabs;
+ # Get the mantissa and the length of the mantissa.
+
+ my $mant = $LIB->_str($x->{_m});
+ my $mantlen = CORE::length($mant);
+
+ if ($mantlen == 1) {
+
+ # Not decimal point when the mantissa has length one, i.e., return the
+ # number 2 as the string "2", not "2.".
+
+ $str .= $mant . 'e' . $x->{_es} . $LIB->_str($x->{_e});
+
+ } else {
+
+ # Compute new exponent where the original exponent is adjusted by the
+ # length of the mantissa minus one (because the decimal point is after
+ # one digit).
+
+ my ($eabs, $esgn) = $LIB -> _sadd($LIB -> _copy($x->{_e}), $x->{_es},
+ $LIB -> _new($mantlen - 1), "+");
+ substr $mant, 1, 0, ".";
+ $str .= $mant . 'e' . $esgn . $LIB->_str($eabs);
+
+ }
+
+ return $str;
}
# Engineering notation, e.g., "12345.6789" is written as "12.3456789e+3".
sub bestr {
- my $x = shift;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
if ($x->{sign} ne '+' && $x->{sign} ne '-') {
- return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
- return 'inf'; # +inf
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
+
+ # Upgrade?
+
+ return $upgrade -> bestr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
+ my $str = $x->{sign} eq '-' ? '-' : '';
+
+ # Get the mantissa, the length of the mantissa, and adjust the exponent by
+ # the length of the mantissa minus 1 (because the dot is after one digit).
+
+ my $mant = $LIB->_str($x->{_m});
+ my $mantlen = CORE::length($mant);
+ my ($eabs, $esgn) = $LIB -> _sadd($LIB -> _copy($x->{_e}), $x->{_es},
+ $LIB -> _new($mantlen - 1), "+");
+
+ my $dotpos = 1;
+ my $mod = $LIB -> _mod($LIB -> _copy($eabs), $LIB -> _new("3"));
+ unless ($LIB -> _is_zero($mod)) {
+ if ($esgn eq '+') {
+ $eabs = $LIB -> _sub($eabs, $mod);
+ $dotpos += $LIB -> _num($mod);
+ } else {
+ my $delta = $LIB -> _sub($LIB -> _new("3"), $mod);
+ $eabs = $LIB -> _add($eabs, $delta);
+ $dotpos += $LIB -> _num($delta);
+ }
}
- my ($mant, $expo) = $x -> eparts();
+ if ($dotpos < $mantlen) {
+ substr $mant, $dotpos, 0, ".";
+ } elsif ($dotpos > $mantlen) {
+ $mant .= "0" x ($dotpos - $mantlen);
+ }
- my $esgn = $expo < 0 ? '-' : '+';
- my $eabs = $expo -> babs() -> bfround(0) -> bstr();
- #$eabs = '0' . $eabs if length($eabs) < 2;
+ $str .= $mant . 'e' . $esgn . $LIB->_str($eabs);
- return $mant . 'e' . $esgn . $eabs;
+ return $str;
+}
+
+# Fractional notation, e.g., "123.4375" is written as "1975/16".
+
+sub bfstr {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
+
+ # Upgrade?
+
+ return $upgrade -> bfstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
+ my $str = $x->{sign} eq '-' ? '-' : '';
+
+ if ($x->{_es} eq '+') {
+ $str .= $LIB -> _str($x->{_m}) . ("0" x $LIB -> _num($x->{_e}));
+ } else {
+ my @flt_parts = ($x->{sign}, $x->{_m}, $x->{_es}, $x->{_e});
+ my @rat_parts = $class -> _flt_lib_parts_to_rat_lib_parts(@flt_parts);
+ $str = $LIB -> _str($rat_parts[1]) . "/" . $LIB -> _str($rat_parts[2]);
+ $str = "-" . $str if $rat_parts[0] eq "-";
+ }
+
+ return $str;
}
sub to_hex {
# return number as hexadecimal string (only for integers defined)
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
+
+ # Upgrade?
+
+ return $upgrade -> to_hex($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
return '0' if $x->is_zero();
return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex?
@@ -4320,10 +4939,24 @@ sub to_hex {
sub to_oct {
# return number as octal digit string (only for integers defined)
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
+
+ # Upgrade?
+
+ return $upgrade -> to_hex($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
return '0' if $x->is_zero();
return $nan if $x->{_es} ne '+'; # how to do 1e-1 in octal?
@@ -4338,10 +4971,24 @@ sub to_oct {
sub to_bin {
# return number as binary digit string (only for integers defined)
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
+
+ # Upgrade?
+
+ return $upgrade -> to_hex($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
return '0' if $x->is_zero();
return $nan if $x->{_es} ne '+'; # how to do 1e-1 in binary?
@@ -4355,9 +5002,9 @@ sub to_bin {
}
sub to_ieee754 {
- my $x = shift;
- my $format = shift;
- my $class = ref $x;
+ my ($class, $x, $format, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
my $enc; # significand encoding (applies only to decimal)
my $k; # storage width in bits
@@ -4494,41 +5141,85 @@ sub to_ieee754 {
$expo = $class -> new($expo_est);
if ($expo_est > 0) {
- $mant -> bmul($binv -> copy() -> bpow($expo));
+ $mant = $mant -> bmul($binv -> copy() -> bpow($expo));
} elsif ($expo_est < 0) {
my $expo_abs = $expo -> copy() -> bneg();
- $mant -> bmul($b -> copy() -> bpow($expo_abs));
+ $mant = $mant -> bmul($b -> copy() -> bpow($expo_abs));
}
- # Final adjustment.
+ # Final adjustment of the estimate above.
while ($mant >= $b && $expo <= $emax) {
- $mant -> bmul($binv);
- $expo -> binc();
+ $mant = $mant -> bmul($binv);
+ $expo = $expo -> binc();
}
while ($mant < $one && $expo >= $emin) {
- $mant -> bmul($b);
- $expo -> bdec();
+ $mant = $mant -> bmul($b);
+ $expo = $expo -> bdec();
}
- # Encode as infinity, normal number or subnormal number?
+ # This is when the magnitude is larger than what can be represented
+ # in this format. Encode as infinity.
- if ($expo > $emax) { # overflow => infinity
- $expo = $emax -> copy() -> binc();
+ if ($expo > $emax) {
$mant = $class -> bzero();
- } elsif ($expo < $emin) { # subnormal number
- my $const = $class -> new(2) -> bpow($t - 1);
- $mant -> bmul($const);
- $mant -> bfround(0);
- } else { # normal number
- $mant -> bdec(); # remove implicit leading bit
- my $const = $class -> new(2) -> bpow($t);
- $mant -> bmul($const) -> bfround(0);
+ $expo = $emax -> copy() -> binc();
+ }
+
+ # This is when the magnitude is so small that the number is encoded
+ # as a subnormal number.
+ #
+ # If the magnitude is smaller than that of the smallest subnormal
+ # number, and rounded downwards, it is encoded as zero. This works
+ # transparently and does not need to be treated as a special case.
+ #
+ # If the number is between the largest subnormal number and the
+ # smallest normal number, and the value is rounded upwards, the
+ # value must be encoded as a normal number. This must be treated as
+ # a special case.
+
+ elsif ($expo < $emin) {
+
+ # Scale up the mantissa (significand), and round to integer.
+
+ my $const = $class -> new($b) -> bpow($t - 1);
+ $mant = $mant -> bmul($const);
+ $mant = $mant -> bfround(0);
+
+ # If the mantissa overflowed, encode as the smallest normal
+ # number.
+
+ if ($mant == $const -> bmul($b)) {
+ $mant = $mant -> bzero();
+ $expo = $expo -> binc();
+ }
+ }
+
+ # This is when the magnitude is within the range of what can be
+ # encoded as a normal number.
+
+ else {
+
+ # Remove implicit leading bit, scale up the mantissa
+ # (significand) to an integer, and round.
+
+ $mant = $mant -> bdec();
+ my $const = $class -> new($b) -> bpow($t);
+ $mant = $mant -> bmul($const) -> bfround(0);
+
+ # If the mantissa overflowed, encode as the next larger value.
+ # This works correctly also when the next larger value is
+ # infinity.
+
+ if ($mant == $const) {
+ $mant = $mant -> bzero();
+ $expo = $expo -> binc();
+ }
}
}
- $expo -> badd($bias); # add bias
+ $expo = $expo -> badd($bias); # add bias
my $signbit = "$sign";
@@ -4548,7 +5239,9 @@ sub to_ieee754 {
sub as_hex {
# return number as hexadecimal string (only for integers defined)
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
return '0x0' if $x->is_zero();
@@ -4566,7 +5259,9 @@ sub as_hex {
sub as_oct {
# return number as octal digit string (only for integers defined)
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
return '00' if $x->is_zero();
@@ -4584,7 +5279,9 @@ sub as_oct {
sub as_bin {
# return number as binary digit string (only for integers defined)
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
return '0b0' if $x->is_zero();
@@ -4601,21 +5298,25 @@ sub as_bin {
sub numify {
# Make a Perl scalar number from a Math::BigFloat object.
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+
+ my (undef, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
if ($x -> is_nan()) {
require Math::Complex;
- my $inf = Math::Complex::Inf();
+ my $inf = $Math::Complex::Inf;
return $inf - $inf;
}
if ($x -> is_inf()) {
require Math::Complex;
- my $inf = Math::Complex::Inf();
+ my $inf = $Math::Complex::Inf;
return $x -> is_negative() ? -$inf : $inf;
}
# Create a string and let Perl's atoi()/atof() handle the rest.
+
return 0 + $x -> bnstr();
}
@@ -4625,65 +5326,97 @@ sub numify {
sub import {
my $class = shift;
- my $l = scalar @_;
- my $lib = '';
- my @a;
- my $lib_kind = 'try';
- $IMPORT=1;
- for (my $i = 0; $i < $l ; $i++) {
- if ($_[$i] eq ':constant') {
- # This causes overlord er load to step in. 'binary' and 'integer'
- # are handled by BigInt.
- overload::constant float => sub { $class->new(shift); };
- } elsif ($_[$i] eq 'upgrade') {
- # this causes upgrading
- $upgrade = $_[$i+1]; # or undef to disable
- $i++;
- } elsif ($_[$i] eq 'downgrade') {
- # this causes downgrading
- $downgrade = $_[$i+1]; # or undef to disable
- $i++;
- } elsif ($_[$i] =~ /^(lib|try|only)\z/) {
- # alternative library
- $lib = $_[$i+1] || ''; # default Calc
- $lib_kind = $1; # lib, try or only
- $i++;
- } elsif ($_[$i] eq 'with') {
+ $IMPORT++; # remember we did import()
+
+ my @import = ('objectify');
+ my @a; # unrecognized arguments
+
+ while (@_) {
+ my $param = shift;
+
+ # Enable overloading of constants.
+
+ if ($param eq ':constant') {
+ overload::constant
+
+ integer => sub {
+ $class -> new(shift);
+ },
+
+ float => sub {
+ $class -> new(shift);
+ },
+
+ binary => sub {
+ # E.g., a literal 0377 shall result in an object whose value
+ # is decimal 255, but new("0377") returns decimal 377.
+ return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
+ $class -> new(shift);
+ };
+ next;
+ }
+
+ # Upgrading.
+
+ if ($param eq 'upgrade') {
+ $class -> upgrade(shift);
+ next;
+ }
+
+ # Downgrading.
+
+ if ($param eq 'downgrade') {
+ $class -> downgrade(shift);
+ next;
+ }
+
+ # Accuracy.
+
+ if ($param eq 'accuracy') {
+ $class -> accuracy(shift);
+ next;
+ }
+
+ # Precision.
+
+ if ($param eq 'precision') {
+ $class -> precision(shift);
+ next;
+ }
+
+ # Rounding mode.
+
+ if ($param eq 'round_mode') {
+ $class -> round_mode(shift);
+ next;
+ }
+
+ # Backend library.
+
+ if ($param =~ /^(lib|try|only)\z/) {
+ push @import, $param;
+ push @import, shift() if @_;
+ next;
+ }
+
+ if ($param eq 'with') {
# alternative class for our private parts()
# XXX: no longer supported
- # $LIB = $_[$i+1] || 'Math::BigInt';
- $i++;
- } else {
- push @a, $_[$i];
+ # $LIB = shift() || 'Calc';
+ # carp "'with' is no longer supported, use 'lib', 'try', or 'only'";
+ shift;
+ next;
}
- }
-
- $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) && ($LIB eq 'Math::BigInt::Calc')) {
- # $LIB already loaded
- Math::BigInt->import($lib_kind, "$lib, $mbilib", 'objectify');
- } else {
- # $LIB not loaded, or with ne "Math::BigInt::Calc"
- $lib .= ",$mbilib" if defined $mbilib;
- $lib =~ s/^,//; # don't leave empty
- # replacement library can handle lib statement, but also could ignore it
+ # Unrecognized parameter.
- # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
- # used in the same script, or eval inside import(). So we require MBI:
- require Math::BigInt;
- Math::BigInt->import($lib_kind => $lib, 'objectify');
+ push @a, $param;
}
- if ($@) {
- croak("Couldn't load $lib: $! $@");
- }
- # find out which one was actually loaded
- $LIB = Math::BigInt->config('lib');
- # register us with MBI to get notified of future lib changes
- Math::BigInt::_register_callback($class, sub { $LIB = $_[0]; });
+ Math::BigInt -> import(@import);
+
+ # find out which one was actually loaded
+ $LIB = Math::BigInt -> config('lib');
$class->export_to_level(1, $class, @a); # export wanted functions
}
@@ -4701,17 +5434,20 @@ sub _len_to_steps {
my $l = 40;
my $r = $d;
- # Otherwise this does not work under -Mbignum and we do not yet have "no bignum;" :(
+ # Otherwise this does not work under -Mbignum and we do not yet have "no
+ # bignum;" :(
$l = $l->numify if ref($l);
$r = $r->numify if ref($r);
$lg2 = $lg2->numify if ref($lg2);
$lg10 = $lg10->numify if ref($lg10);
- # binary search for the right value (could this be written as the reverse of lg(n!)?)
+ # binary search for the right value (could this be written as the reverse of
+ # lg(n!)?)
while ($r - $l > 1) {
my $n = int(($r - $l) / 2) + $l;
- my $ramanujan =
- int(($n * log($n) - $n + log($n * (1 + 4*$n*(1+2*$n))) / 6 + $lg2) / $lg10);
+ my $ramanujan
+ = int(($n * log($n) - $n + log($n * (1 + 4*$n*(1+2*$n))) / 6 + $lg2)
+ / $lg10);
$ramanujan > $d ? $r = $n : $l = $n;
}
$l;
@@ -4745,15 +5481,19 @@ sub _log {
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
- $x->bdiv($v, $scale); # first term: u/v
+ $v = $x->copy();
+ $v = $v -> binc(); # v = x+1
+ $x = $x->bdec();
+ $u = $x->copy(); # u = x-1; x = x-1
+ $x = $x->bdiv($v, $scale); # first term: u/v
$below = $v->copy();
$over = $u->copy();
- $u *= $u; $v *= $v; # u^2, v^2
- $below->bmul($v); # u^3, v^3
- $over->bmul($u);
- $factor = $class->new(3); $f = $class->new(2);
+ $u = $u -> bmul($u); # u^2
+ $v = $v -> bmul($v); # v^2
+ $below = $below->bmul($v); # u^3, v^3
+ $over = $over->bmul($u);
+ $factor = $class->new(3);
+ $f = $class->new(2);
$limit = $class->new("1E-". ($scale-1));
@@ -4769,27 +5509,24 @@ sub _log {
# round $over and $below first, we save a lot of time for the division
# (not with log(1.2345), but try log (123**123) to see what I mean. This
# can introduce a rounding error if the division result would be f.i.
- # 0.1234500000001 and we round it to 5 digits it would become 0.12346, but
- # if we truncated $over and $below we might get 0.12345. Does this matter
- # for the end result? So we give $over and $below 4 more digits to be
- # on the safe side (unscientific error handling as usual... :+D
+ # 0.1234500000001 and we round it to 5 digits it would become 0.12346,
+ # but if we truncated $over and $below we might get 0.12345. Does this
+ # matter for the end result? So we give $over and $below 4 more digits
+ # to be on the safe side (unscientific error handling as usual... :+D
$next = $over->copy()->bround($scale+4)
->bdiv($below->copy()->bmul($factor)->bround($scale+4),
$scale);
- ## old version:
- ## $next = $over->copy()->bdiv($below->copy()->bmul($factor), $scale);
-
last if $next->bacmp($limit) <= 0;
delete $next->{_a};
delete $next->{_p};
- $x->badd($next);
+ $x = $x->badd($next);
# calculate things for the next term
$over *= $u;
$below *= $v;
- $factor->badd($f);
+ $factor = $factor->badd($f);
}
$x->bmul($f); # $x *= 2
}
@@ -4808,9 +5545,9 @@ sub _log_10 {
# long, we make it faster by about a factor of 100 by dividing $x by 10.
# The same observation is valid for numbers smaller than 0.1, e.g. computing
- # log(1) is fastest, and the further away we get from 1, the longer it takes.
- # So we also 'break' this down by multiplying $x with 10 and subtract the
- # log(10) afterwards to get the correct result.
+ # log(1) is fastest, and the further away we get from 1, the longer it
+ # takes. So we also 'break' this down by multiplying $x with 10 and subtract
+ # the log(10) afterwards to get the correct result.
# 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:
@@ -4841,8 +5578,8 @@ sub _log_10 {
$dbd = 0; # disable shortcut
# we can use the cached value in these cases
if ($scale <= $LOG_10_A) {
- $x->bzero();
- $x->badd($LOG_10); # modify $x in place
+ $x = $x->bzero();
+ $x = $x->badd($LOG_10); # modify $x in place
$calc = 0; # no need to calc, but round
}
# if we can't use the shortcut, we continue normally
@@ -4854,8 +5591,8 @@ sub _log_10 {
$dbd = 0; # disable shortcut
# we can use the cached value in these cases
if ($scale <= $LOG_2_A) {
- $x->bzero();
- $x->badd($LOG_2); # modify $x in place
+ $x = $x->bzero();
+ $x = $x->badd($LOG_2); # modify $x in place
$calc = 0; # no need to calc, but round
}
# if we can't use the shortcut, we continue normally
@@ -4871,8 +5608,8 @@ sub _log_10 {
$dbd = 0; # disable shortcut
# we can use the cached value in these cases
if ($scale <= $LOG_10_A) {
- $x->bzero();
- $x->bsub($LOG_10);
+ $x = $x->bzero();
+ $x = $x->bsub($LOG_10);
$calc = 0; # no need to calc, but round
}
}
@@ -4893,8 +5630,8 @@ sub _log_10 {
$LOG_10 = $class->new($LOG_10, undef, undef) unless ref $LOG_10;
#print "x = $x, dbd = $dbd, calc = $calc\n";
- # got more than one digit before the dot, or more than one zero after the
- # dot, so do:
+ # got more than one digit before the dot, or more than one zero after
+ # the dot, so do:
# log(123) == log(1.23) + log(10) * 2
# log(0.0123) == log(1.23) - log(10) * 2
@@ -4903,7 +5640,12 @@ sub _log_10 {
$l_10 = $LOG_10->copy(); # copy for mul
} else {
# else: slower, compute and cache result
- # also disable downgrade for this code path
+
+ # Disabling upgrading and downgrading is no longer necessary to
+ # avoid an infinite recursion, but it avoids unnecessary upgrading
+ # and downgrading in the intermediate computations.
+
+ local $Math::BigInt::upgrade = undef;
local $Math::BigFloat::downgrade = undef;
# shorten the time to calculate log(10) based on the following:
@@ -4918,7 +5660,7 @@ sub _log_10 {
} else {
# else: slower, compute and cache result
$l_2 = $two->copy();
- $l_2->_log($scale); # scale+4, actually
+ $l_2 = $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;
@@ -4926,26 +5668,25 @@ sub _log_10 {
# now calculate log(1.25):
$l_10 = $class->new('1.25');
- $l_10->_log($scale); # scale+4, actually
+ $l_10 = $l_10->_log($scale); # scale+4, actually
# log(1.25) + log(2) + log(2) + log(2):
- $l_10->badd($l_2);
- $l_10->badd($l_2);
- $l_10->badd($l_2);
+ $l_10 = $l_10->badd($l_2);
+ $l_10 = $l_10->badd($l_2);
+ $l_10 = $l_10->badd($l_2);
$LOG_10 = $l_10->copy(); # cache the result for later
# the copy() is for mul below
$LOG_10_A = $scale;
}
$dbd-- if ($dbd > 1); # 20 => dbd=2, so make it dbd=1
- $l_10->bmul($class->new($dbd)); # log(10) * (digits_before_dot-1)
+ $l_10 = $l_10->bmul($class->new($dbd)); # log(10) * (digits_before_dot-1)
my $dbd_sign = '+';
if ($dbd < 0) {
$dbd = -$dbd;
$dbd_sign = '-';
}
($x->{_e}, $x->{_es}) =
- _e_sub($x->{_e}, $LIB->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23
-
+ $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($dbd), $dbd_sign);
}
# Now: 0.1 <= $x < 10 (and possible correction in l_10)
@@ -4958,13 +5699,13 @@ sub _log_10 {
my $twos = 0; # default: none (0 times)
while ($x->bacmp($HALF) <= 0) { # X <= 0.5
$twos--;
- $x->bmul($two);
+ $x = $x->bmul($two);
}
while ($x->bacmp($two) >= 0) { # X >= 2
$twos++;
- $x->bdiv($two, $scale+4); # keep all digits
+ $x = $x->bdiv($two, $scale+4); # keep all digits
}
- $x->bround($scale+4);
+ $x = $x->bround($scale+4);
# $twos > 0 => did mul 2, < 0 => did div 2 (but we never did both)
# So calculate correction factor based on ln(2):
if ($twos != 0) {
@@ -4974,69 +5715,33 @@ sub _log_10 {
$l_2 = $LOG_2->copy(); # copy() for the mul below
} else {
# else: slower, compute and cache result
- # also disable downgrade for this code path
+
+ # Disabling upgrading and downgrading is no longer necessary to
+ # avoid an infinite recursion, but it avoids unnecessary upgrading
+ # and downgrading in the intermediate computations.
+
+ local $Math::BigInt::upgrade = undef;
local $Math::BigFloat::downgrade = undef;
+
$l_2 = $two->copy();
- $l_2->_log($scale); # scale+4, actually
+ $l_2 = $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;
}
- $l_2->bmul($twos); # * -2 => subtract, * 2 => add
+ $l_2 = $l_2->bmul($twos); # * -2 => subtract, * 2 => add
} else {
undef $l_2;
}
- $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)
+ $x = $x->_log($scale); # need to do the "normal" way
+ $x = $x->badd($l_10) if defined $l_10; # correct it by ln(10)
+ $x = $x->badd($l_2) if defined $l_2; # and maybe by ln(2)
# all done, $x contains now the result
$x;
}
-sub _e_add {
- # Internal helper sub to take two positive integers and their signs and
- # 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 = $LIB->_add($x, $y); # +a + +b or -a + -b
- } else {
- my $a = $LIB->_acmp($x, $y);
- if ($a == 0) {
- # This does NOT modify $x in-place. TODO: Fix this?
- $x = $LIB->_zero(); # result is 0
- $xs = '+';
- return ($x, $xs);
- }
- if ($a > 0) {
- $x = $LIB->_sub($x, $y); # abs sub
- } else { # a < 0
- $x = $LIB->_sub ($y, $x, 1); # abs sub
- $xs = $ys;
- }
- }
-
- $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 ($LIB, $LIB, ('+'|'-'), ('+'|'-')),
- # output ($LIB, ('+'|'-'))
- my ($x, $y, $xs, $ys) = @_;
-
- # flip sign
- $ys = $ys eq '+' ? '-' : '+'; # swap sign of second operand ...
- _e_add($x, $y, $xs, $ys); # ... and let _e_add() do the job
-}
-
sub _pow {
# Calculate a power where $y is a non-integer, like 2 ** 0.3
my ($x, $y, @r) = @_;
@@ -5079,23 +5784,32 @@ sub _pow {
# when user set globals, they would interfere with our calculation, so
# disable them and later re-enable them
no strict 'refs';
- my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
- my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
+ my $abr = "$class\::accuracy";
+ my $ab = $$abr;
+ $$abr = undef;
+ my $pbr = "$class\::precision";
+ my $pb = $$pbr;
+ $$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
delete $x->{_a};
delete $x->{_p};
- # need to disable $upgrade in BigInt, to avoid deep recursion
+
+ # Disabling upgrading and downgrading is no longer necessary to avoid an
+ # infinite recursion, but it avoids unnecessary upgrading and downgrading in
+ # the intermediate computations.
+
local $Math::BigInt::upgrade = undef;
+ local $Math::BigFloat::downgrade = undef;
my ($limit, $v, $u, $below, $factor, $next, $over);
$u = $x->copy()->blog(undef, $scale)->bmul($y);
my $do_invert = ($u->{sign} eq '-');
- $u->bneg() if $do_invert;
+ $u = $u->bneg() if $do_invert;
$v = $class->bone(); # 1
$factor = $class->new(2); # 2
- $x->bone(); # first term: 1
+ $x = $x->bone(); # first term: 1
$below = $v->copy();
$over = $u->copy();
@@ -5107,25 +5821,25 @@ sub _pow {
# anymore, so we stop:
$next = $over->copy()->bdiv($below, $scale);
last if $next->bacmp($limit) <= 0;
- $x->badd($next);
+ $x = $x->badd($next);
# calculate things for the next term
$over *= $u;
$below *= $factor;
- $factor->binc();
+ $factor = $factor->binc();
last if $x->{sign} !~ /^[-+]$/;
}
if ($do_invert) {
my $x_copy = $x->copy();
- $x->bone->bdiv($x_copy, $scale);
+ $x = $x->bone->bdiv($x_copy, $scale);
}
# shortcut to not run through _find_round_parameters again
if (defined $params[0]) {
- $x->bround($params[0], $params[2]); # then round accordingly
+ $x = $x->bround($params[0], $params[2]); # then round accordingly
} else {
- $x->bfround($params[1], $params[2]); # then round accordingly
+ $x = $x->bfround($params[1], $params[2]); # then round accordingly
}
if ($fallback) {
# clear a/p after round, since user did not request it
@@ -5138,6 +5852,19 @@ sub _pow {
$x;
}
+# These functions are only provided for backwards compabibility so that old
+# version of Math::BigRat etc. don't complain about missing them.
+
+sub _e_add {
+ my ($x, $y, $xs, $ys) = @_;
+ return $LIB -> _sadd($x, $xs, $y, $ys);
+}
+
+sub _e_sub {
+ my ($x, $y, $xs, $ys) = @_;
+ return $LIB -> _ssub($x, $xs, $y, $ys);
+}
+
1;
__END__
@@ -5146,7 +5873,7 @@ __END__
=head1 NAME
-Math::BigFloat - Arbitrary size floating point math package
+Math::BigFloat - arbitrary size floating point math package
=head1 SYNOPSIS
@@ -5169,10 +5896,13 @@ Math::BigFloat - Arbitrary size floating point math package
$x = Math::BigFloat->new($str); # defaults to 0
$x = Math::BigFloat->new('0x123'); # from hexadecimal
+ $x = Math::BigFloat->new('0o377'); # from octal
$x = Math::BigFloat->new('0b101'); # from binary
$x = Math::BigFloat->from_hex('0xc.afep+3'); # from hex
$x = Math::BigFloat->from_hex('cafe'); # ditto
$x = Math::BigFloat->from_oct('1.3267p-4'); # from octal
+ $x = Math::BigFloat->from_oct('01.3267p-4'); # ditto
+ $x = Math::BigFloat->from_oct('0o1.3267p-4'); # ditto
$x = Math::BigFloat->from_oct('0377'); # ditto
$x = Math::BigFloat->from_bin('0b1.1001p-4'); # from binary
$x = Math::BigFloat->from_bin('0101'); # ditto
@@ -5187,6 +5917,8 @@ Math::BigFloat - Arbitrary size floating point math package
$y = $x->copy(); # make a copy (unlike $y = $x)
$y = $x->as_int(); # return as BigInt
+ $y = $x->as_float(); # return as a Math::BigFloat
+ $y = $x->as_rat(); # return as a Math::BigRat
# Boolean methods (these don't modify the invocand)
@@ -5297,6 +6029,9 @@ Math::BigFloat - Arbitrary size floating point math package
$x->nparts(); # mantissa and exponent (normalised)
$x->eparts(); # mantissa and exponent (engineering notation)
$x->dparts(); # integer and fraction part
+ $x->fparts(); # numerator and denominator
+ $x->numerator(); # numerator
+ $x->denominator(); # denominator
# Conversion methods (do not modify the invocand)
@@ -5305,6 +6040,8 @@ Math::BigFloat - Arbitrary size floating point math package
$x->bnstr(); # string in normalized notation
$x->bestr(); # string in engineering notation
$x->bdstr(); # string in decimal notation
+ $x->bfstr(); # string in fractional notation
+
$x->as_hex(); # as signed hexadecimal string with prefixed 0x
$x->as_bin(); # as signed binary string with prefixed 0b
$x->as_oct(); # as signed octal string with prefixed 0
@@ -5330,7 +6067,8 @@ exactly what you expect.
=head2 Input
Input values to these routines may be any scalar number or string that looks
-like a number and represents a floating point number.
+like a number. Anything that is accepted by Perl as a literal numeric constant
+should be accepted by this module.
=over
@@ -5340,48 +6078,77 @@ Leading and trailing whitespace is ignored.
=item *
-Leading and trailing zeros are ignored.
+Leading zeros are ignored, except for floating point numbers with a binary
+exponent, in which case the number is interpreted as an octal floating point
+number. For example, "01.4p+0" gives 1.5, "00.4p+0" gives 0.5, but "0.4p+0"
+gives a NaN. And while "0377" gives 255, "0377p0" gives 255.
=item *
-If the string has a "0x" prefix, it is interpreted as a hexadecimal number.
+If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal
+number.
=item *
-If the string has a "0b" prefix, it is interpreted as a binary number.
+If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A
+floating point literal with a "0" prefix is also interpreted as an octal number.
=item *
-For hexadecimal and binary numbers, the exponent must be separated from the
-significand (mantissa) by the letter "p" or "P", not "e" or "E" as with decimal
-numbers.
+If the string has a "0b" or "0B" prefix, it is interpreted as a binary number.
=item *
-One underline is allowed between any two digits, including hexadecimal and
-binary digits.
+Underline characters are allowed in the same way as they are allowed in literal
+numerical constants.
=item *
If the string can not be interpreted, NaN is returned.
-=back
+=item *
+
+For hexadecimal, octal, and binary floating point numbers, the exponent must be
+separated from the significand (mantissa) by the letter "p" or "P", not "e" or
+"E" as with decimal numbers.
-Octal numbers are typically prefixed by "0", but since leading zeros are
-stripped, these methods can not automatically recognize octal numbers, so use
-the constructor from_oct() to interpret octal strings.
+=back
Some examples of valid string input
Input string Resulting value
+
123 123
1.23e2 123
12300e-2 123
- 0xcafe 51966
- 0b1101 13
+
67_538_754 67538754
-4_5_6.7_8_9e+0_1_0 -4567890000000
+
+ 0x13a 314
+ 0x13ap0 314
+ 0x1.3ap+8 314
+ 0x0.00013ap+24 314
+ 0x13a000p-12 314
+
+ 0o472 314
+ 0o1.164p+8 314
+ 0o0.0001164p+20 314
+ 0o1164000p-10 314
+
+ 0472 472 Note!
+ 01.164p+8 314
+ 00.0001164p+20 314
+ 01164000p-10 314
+
+ 0b100111010 314
+ 0b1.0011101p+8 314
+ 0b0.00010011101p+12 314
+ 0b100111010000p-3 314
+
0x1.921fb5p+1 3.14159262180328369140625e+0
+ 0o1.2677025p1 2.71828174591064453125
+ 01.2677025p1 2.71828174591064453125
0b1.1001p-4 9.765625e-2
=head2 Output
@@ -5680,10 +6447,11 @@ supplied to the operation after the I<scale>:
Math::BigFloat->round_mode('zero');
$y = $x->copy()->bdiv(3,6); # will also give 0.666667
-Note that C<< Math::BigFloat->accuracy() >> and C<< Math::BigFloat->precision() >>
-set the global variables, and thus B<any> newly created number will be subject
-to the global rounding B<immediately>. This means that in the examples above, the
-C<3> as argument to C<bdiv()> will also get an accuracy of B<5>.
+Note that C<< Math::BigFloat->accuracy() >> and
+C<< Math::BigFloat->precision() >> set the global variables, and thus B<any>
+newly created number will be subject to the global rounding B<immediately>. This
+means that in the examples above, the C<3> as argument to C<bdiv()> will also
+get an accuracy of B<5>.
It is less confusing to either calculate the result fully, and afterwards
round it explicitly, or use the additional parameters to the math
@@ -5752,76 +6520,103 @@ C<as_number()>:
$x = Math::BigFloat->new(2.5);
$y = $x->as_number('odd'); # $y = 3
-=head1 Autocreating constants
+=head1 NUMERIC LITERALS
-After C<use Math::BigFloat ':constant'> all the floating point constants
-in the given scope are converted to C<Math::BigFloat>. This conversion
-happens at compile time.
+After C<use Math::BigFloat ':constant'> all numeric literals in the given scope
+are converted to C<Math::BigFloat> objects. This conversion happens at compile
+time.
-In particular
+For example,
- perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"'
+ perl -MMath::BigFloat=:constant -le 'print 2e-150'
-prints the value of C<2E-100>. Note that without conversion of
-constants the expression 2E-100 will be calculated as normal floating point
-number.
+prints the exact value of C<2e-150>. Note that without conversion of constants
+the expression C<2e-150> is calculated using Perl scalars, which leads to an
+inaccuracte result.
-Please note that ':constant' does not affect integer constants, nor binary
-nor hexadecimal constants. Use L<bignum> or L<Math::BigInt> to get this to
-work.
+Note that strings are not affected, so that
-=head2 Math library
+ use Math::BigFloat qw/:constant/;
-Math with the numbers is done (by default) by a module called
-Math::BigInt::Calc. This is equivalent to saying:
+ $y = "1234567890123456789012345678901234567890"
+ + "123456789123456789";
- use Math::BigFloat lib => 'Calc';
+does not give you what you expect. You need an explicit Math::BigFloat->new()
+around at least one of the operands. You should also quote large constants to
+prevent loss of precision:
-You can change this by using:
+ use Math::BigFloat;
- use Math::BigFloat lib => 'GMP';
+ $x = Math::BigFloat->new("1234567889123456789123456789123456789");
-B<Note>: General purpose packages should not be explicit about the library
-to use; let the script author decide which is best.
+Without the quotes Perl converts the large number to a floating point constant
+at compile time, and then converts the result to a Math::BigFloat object at
+runtime, which results in an inaccurate result.
-Note: The keyword 'lib' will warn when the requested library could not be
-loaded. To suppress the warning use 'try' instead:
+=head2 Hexadecimal, octal, and binary floating point literals
- use Math::BigFloat try => 'GMP';
+Perl (and this module) accepts hexadecimal, octal, and binary floating point
+literals, but use them with care with Perl versions before v5.32.0, because some
+versions of Perl silently give the wrong result. Below are some examples of
+different ways to write the number decimal 314.
-If your script works with huge numbers and Calc is too slow for them,
-you can also for the loading of one of these libraries and if none
-of them can be used, the code will die:
+Hexadecimal floating point literals:
- use Math::BigFloat only => 'GMP,Pari';
+ 0x1.3ap+8 0X1.3AP+8
+ 0x1.3ap8 0X1.3AP8
+ 0x13a0p-4 0X13A0P-4
-The following would first try to find Math::BigInt::Foo, then
-Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
+Octal floating point literals (with "0" prefix):
- use Math::BigFloat lib => 'Foo,Math::BigInt::Bar';
+ 01.164p+8 01.164P+8
+ 01.164p8 01.164P8
+ 011640p-4 011640P-4
-See the respective low-level library documentation for further details.
+Octal floating point literals (with "0o" prefix) (requires v5.34.0):
-Please note that Math::BigFloat does B<not> use the denoted library itself,
-but it merely passes the lib argument to Math::BigInt. So, instead of the need
-to do:
+ 0o1.164p+8 0O1.164P+8
+ 0o1.164p8 0O1.164P8
+ 0o11640p-4 0O11640P-4
- use Math::BigInt lib => 'GMP';
- use Math::BigFloat;
+Binary floating point literals:
+
+ 0b1.0011101p+8 0B1.0011101P+8
+ 0b1.0011101p8 0B1.0011101P8
+ 0b10011101000p-2 0B10011101000P-2
-you can roll it all into one line:
+=head2 Math library
- use Math::BigFloat lib => 'GMP';
+Math with the numbers is done (by default) by a module called
+Math::BigInt::Calc. This is equivalent to saying:
-It is also possible to just require Math::BigFloat:
+ use Math::BigFloat lib => "Calc";
- require Math::BigFloat;
+You can change this by using:
+
+ use Math::BigFloat lib => "GMP";
+
+B<Note>: General purpose packages should not be explicit about the library to
+use; let the script author decide which is best.
+
+Note: The keyword 'lib' will warn when the requested library could not be
+loaded. To suppress the warning use 'try' instead:
+
+ use Math::BigFloat try => "GMP";
-This will load the necessary things (like BigInt) when they are needed, and
-automatically.
+If your script works with huge numbers and Calc is too slow for them, you can
+also for the loading of one of these libraries and if none of them can be used,
+the code will die:
-See L<Math::BigInt> for more details than you ever wanted to know about using
-a different low-level library.
+ use Math::BigFloat only => "GMP,Pari";
+
+The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar,
+and when this also fails, revert to Math::BigInt::Calc:
+
+ use Math::BigFloat lib => "Foo,Math::BigInt::Bar";
+
+See the respective low-level library documentation for further details.
+
+See L<Math::BigInt> for more details about using a different low-level library.
=head2 Using Math::BigInt::Lite
@@ -5835,7 +6630,8 @@ math library for directly storing the number parts.
=head1 EXPORTS
-C<Math::BigFloat> exports nothing by default, but can export the C<bpi()> method:
+C<Math::BigFloat> exports nothing by default, but can export the C<bpi()>
+method:
use Math::BigFloat qw/bpi/;
@@ -5910,7 +6706,8 @@ a certain number of digits:
print "$z\n";
print $z->precision(),"\n"; # 4
-Replacing L</precision()> with L</accuracy()> is probably not what you want, either:
+Replacing L</precision()> with L</accuracy()> is probably not what you want,
+either:
use Math::BigFloat;
@@ -5944,8 +6741,7 @@ influence any further operation.
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).
+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.
@@ -5959,17 +6755,13 @@ 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
+=item * GitHub
-L<http://annocpan.org/dist/Math-BigInt>
+L<https://github.com/pjacklam/p5-Math-BigInt>
-=item * CPAN Ratings
+=item * RT: CPAN's request tracker
-L<https://cpanratings.perl.org/dist/Math-BigInt>
+L<https://rt.cpan.org/Dist/Display.html?Name=Math-BigInt>
=item * MetaCPAN
@@ -5979,6 +6771,10 @@ L<https://metacpan.org/release/Math-BigInt>
L<http://matrix.cpantesters.org/?dist=Math-BigInt>
+=item * CPAN Ratings
+
+L<https://cpanratings.perl.org/dist/Math-BigInt>
+
=item * The Bignum mailing list
=over 4
@@ -6006,11 +6802,10 @@ the same terms as Perl itself.
=head1 SEE ALSO
-L<Math::BigFloat> and L<Math::BigInt> as well as the backends
+L<Math::BigInt> and L<Math::BigInt> as well as the backends
L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>.
-The pragmas L<bignum>, L<bigint> and L<bigrat> also might be of interest
-because they solve the autoupgrading/downgrading issue, at least partly.
+The pragmas L<bignum>, L<bigint> and L<bigrat>.
=head1 AUTHORS
@@ -6030,7 +6825,7 @@ Florian Ragwitz E<lt>flora@cpan.orgE<gt>, 2010.
=item *
-Peter John Acklam E<lt>pjacklam@online.noE<gt>, 2011-.
+Peter John Acklam E<lt>pjacklam@gmail.comE<gt>, 2011-.
=back
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 2fc069370a..14baa9f292 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm
@@ -1,58 +1,76 @@
-#!perl
+# -*- mode: perl; -*-
package Math::BigFloat::Trace;
-require 5.010;
use strict;
use warnings;
use Exporter;
use Math::BigFloat;
-our ($accuracy, $precision, $round_mode, $div_scale);
-
our @ISA = qw(Exporter Math::BigFloat);
-our $VERSION = '0.51';
+our $VERSION = '0.66';
use overload; # inherit overload from Math::BigFloat
# Globals
-$accuracy = $precision = undef;
-$round_mode = 'even';
-$div_scale = 40;
+our $accuracy = undef;
+our $precision = undef;
+our $round_mode = 'even';
+our $div_scale = 40;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $value = shift;
+
my $a = $accuracy;
$a = $_[0] if defined $_[0];
+
my $p = $precision;
$p = $_[1] if defined $_[1];
- my $self = Math::BigFloat->new($value, $a, $p, $round_mode);
- # remember, downgrading may return a BigInt, so don't meddle with class
- # bless $self, $class;
+ my $self = $class -> SUPER::new($value, $a, $p, $round_mode);
+
+ printf "Math::BigFloat new '%s' => '%s' (%s)\n",
+ $value, $self, ref($self);
- print "MBF new '$value' => '$self' (", ref($self), ")";
return $self;
}
sub import {
- print "MBF import ", join(' ', @_);
- my $self = shift;
+ my $class = shift;
+
+ printf "%s -> import(%s)\n", $class, join(", ", @_);
+
+ # we catch the constants, the rest goes to parent
+
+ my $constant = grep { $_ eq ':constant' } @_;
+ my @a = grep { $_ ne ':constant' } @_;
+
+ if ($constant) {
+ overload::constant
+
+ integer => sub {
+ $class -> new(shift);
+ },
+
+ float => sub {
+ $class -> new(shift);
+ },
- # we catch the constants, the rest goes go BigFloat
- my @a = ();
- foreach (@_) {
- push @a, $_ if $_ ne ':constant';
+ binary => sub {
+ # E.g., a literal 0377 shall result in an object whose value
+ # is decimal 255, but new("0377") returns decimal 377.
+ return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
+ $class -> new(shift);
+ };
}
- overload::constant float => sub { $self->new(shift); };
- Math::BigFloat->import(@a); # need it for subclasses
-# $self->export_to_level(1,$self,@_); # need this ?
+ $class -> SUPER::import(@a); # need it for subclasses
+ #$self -> export_to_level(1, $class, @_); # need this ?
}
1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm
index 185f802835..65e14467bb 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm
@@ -20,9 +20,11 @@ use 5.006001;
use strict;
use warnings;
-use Carp qw< carp croak >;
+use Carp qw< carp croak >;
+use Scalar::Util qw< blessed refaddr >;
-our $VERSION = '1.999818';
+our $VERSION = '1.999837';
+$VERSION =~ tr/_//d;
require Exporter;
our @ISA = qw(Exporter);
@@ -45,44 +47,43 @@ use overload
'+' => sub { $_[0] -> copy() -> badd($_[1]); },
- '-' => sub { my $c = $_[0] -> copy;
+ '-' => sub { my $c = $_[0] -> copy();
$_[2] ? $c -> bneg() -> badd($_[1])
: $c -> bsub($_[1]); },
'*' => sub { $_[0] -> copy() -> bmul($_[1]); },
'/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0])
- : $_[0] -> copy -> bdiv($_[1]); },
+ : $_[0] -> copy() -> bdiv($_[1]); },
'%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0])
- : $_[0] -> copy -> bmod($_[1]); },
-
+ : $_[0] -> copy() -> bmod($_[1]); },
'**' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0])
- : $_[0] -> copy -> bpow($_[1]); },
+ : $_[0] -> copy() -> bpow($_[1]); },
'<<' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0])
- : $_[0] -> copy -> blsft($_[1]); },
+ : $_[0] -> copy() -> blsft($_[1]); },
'>>' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0])
- : $_[0] -> copy -> brsft($_[1]); },
+ : $_[0] -> copy() -> brsft($_[1]); },
# overload key: assign
- '+=' => sub { $_[0]->badd($_[1]); },
+ '+=' => sub { $_[0] -> badd($_[1]); },
- '-=' => sub { $_[0]->bsub($_[1]); },
+ '-=' => sub { $_[0] -> bsub($_[1]); },
- '*=' => sub { $_[0]->bmul($_[1]); },
+ '*=' => sub { $_[0] -> bmul($_[1]); },
- '/=' => sub { scalar $_[0]->bdiv($_[1]); },
+ '/=' => sub { scalar $_[0] -> bdiv($_[1]); },
- '%=' => sub { $_[0]->bmod($_[1]); },
+ '%=' => sub { $_[0] -> bmod($_[1]); },
- '**=' => sub { $_[0]->bpow($_[1]); },
+ '**=' => sub { $_[0] -> bpow($_[1]); },
- '<<=' => sub { $_[0]->blsft($_[1]); },
+ '<<=' => sub { $_[0] -> blsft($_[1]); },
- '>>=' => sub { $_[0]->brsft($_[1]); },
+ '>>=' => sub { $_[0] -> brsft($_[1]); },
# 'x=' => sub { },
@@ -116,13 +117,13 @@ use overload
# overload key: str_comparison
-# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0])
+# 'lt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0])
# : $_[0] -> bstrlt($_[1]); },
#
# 'le' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0])
# : $_[0] -> bstrle($_[1]); },
#
-# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0])
+# 'gt' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0])
# : $_[0] -> bstrgt($_[1]); },
#
# 'ge' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0])
@@ -135,17 +136,17 @@ use overload
# overload key: binary
'&' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0])
- : $_[0] -> copy -> band($_[1]); },
+ : $_[0] -> copy() -> band($_[1]); },
'&=' => sub { $_[0] -> band($_[1]); },
'|' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0])
- : $_[0] -> copy -> bior($_[1]); },
+ : $_[0] -> copy() -> bior($_[1]); },
'|=' => sub { $_[0] -> bior($_[1]); },
'^' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0])
- : $_[0] -> copy -> bxor($_[1]); },
+ : $_[0] -> copy() -> bxor($_[1]); },
'^=' => sub { $_[0] -> bxor($_[1]); },
@@ -182,9 +183,9 @@ use overload
'atan2' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0])
: $_[0] -> copy() -> batan2($_[1]); },
- 'cos' => sub { $_[0] -> copy -> bcos(); },
+ 'cos' => sub { $_[0] -> copy() -> bcos(); },
- 'sin' => sub { $_[0] -> copy -> bsin(); },
+ 'sin' => sub { $_[0] -> copy() -> bsin(); },
'exp' => sub { $_[0] -> copy() -> bexp($_[1]); },
@@ -204,7 +205,7 @@ use overload
'0+' => sub { $_[0] -> numify(); },
- '=' => sub { $_[0]->copy(); },
+ '=' => sub { $_[0] -> copy(); },
;
@@ -214,7 +215,8 @@ use overload
# These vars are public, but their direct usage is not recommended, use the
# accessor methods instead
-our $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
+# $round_mode is 'even', 'odd', '+inf', '-inf', 'zero', 'trunc', or 'common'.
+our $round_mode = 'even';
our $accuracy = undef;
our $precision = undef;
our $div_scale = 40;
@@ -228,11 +230,14 @@ our $_trap_inf = 0; # are infs ok? set w/ config()
my $nan = 'NaN'; # constants for easier life
-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 %CALLBACKS; # callbacks to notify on lib loads
+# Module to do the low level math.
+
+my $DEFAULT_LIB = 'Math::BigInt::Calc';
+my $LIB;
+
+# Has import() been called yet? Needed to make "require" work.
+
+my $IMPORT = 0;
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
@@ -257,9 +262,9 @@ BEGIN {
tie $rnd_mode, 'Math::BigInt';
# set up some handy alias names
- *as_int = \&as_number;
*is_pos = \&is_positive;
*is_neg = \&is_negative;
+ *as_number = \&as_int;
}
###############################################################################
@@ -267,18 +272,24 @@ BEGIN {
###############################################################################
sub round_mode {
- no strict 'refs';
- # make Class->round_mode() work
my $self = shift;
my $class = ref($self) || $self || __PACKAGE__;
- if (defined $_[0]) {
+
+ if (@_) { # setter
my $m = shift;
- if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/) {
- croak("Unknown round mode '$m'");
- }
- return ${"${class}::round_mode"} = $m;
+ croak("The value for 'round_mode' must be defined")
+ unless defined $m;
+ croak("Unknown round mode '$m'")
+ unless $m =~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/;
+ no strict 'refs';
+ ${"${class}::round_mode"} = $m;
+ }
+
+ else { # getter
+ no strict 'refs';
+ my $m = ${"${class}::round_mode"};
+ defined($m) ? $m : $round_mode;
}
- ${"${class}::round_mode"};
}
sub upgrade {
@@ -286,6 +297,7 @@ sub upgrade {
# make Class->upgrade() work
my $self = shift;
my $class = ref($self) || $self || __PACKAGE__;
+
# need to set new value?
if (@_ > 0) {
return ${"${class}::upgrade"} = $_[0];
@@ -306,17 +318,23 @@ sub downgrade {
}
sub div_scale {
- no strict 'refs';
- # make Class->div_scale() work
my $self = shift;
my $class = ref($self) || $self || __PACKAGE__;
- if (defined $_[0]) {
- if ($_[0] < 0) {
- croak('div_scale must be greater than zero');
- }
- ${"${class}::div_scale"} = $_[0];
+
+ if (@_) { # setter
+ my $ds = shift;
+ croak("The value for 'div_scale' must be defined") unless defined $ds;
+ croak("The value for 'div_scale' must be positive") unless $ds > 0;
+ $ds = $ds -> numify() if defined(blessed($ds));
+ no strict 'refs';
+ ${"${class}::div_scale"} = $ds;
+ }
+
+ else { # getter
+ no strict 'refs';
+ my $ds = ${"${class}::div_scale"};
+ defined($ds) ? $ds : $div_scale;
}
- ${"${class}::div_scale"};
}
sub accuracy {
@@ -344,11 +362,11 @@ sub accuracy {
if (ref($x)) {
# Set instance variable.
- $x->bround($a) if $a; # not for undef, 0
+ $x = $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
+ $a = ${"${class}::accuracy"} unless defined $a;
} else {
# Set class variable.
${"${class}::accuracy"} = $a; # set global A
@@ -359,7 +377,7 @@ sub accuracy {
}
# Return instance variable.
- return $x->{_a} if ref($x) && (defined $x->{_a} || defined $x->{_p});
+ return $x->{_a} if ref($x) && (defined($x->{_a}) || defined($x->{_p}));
# Return class variable.
return ${"${class}::accuracy"};
@@ -386,11 +404,11 @@ sub precision {
if (ref($x)) {
# Set instance variable.
- $x->bfround($p) if $p; # not for undef, 0
+ $x = $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
+ $p = ${"${class}::precision"} unless defined $p;
} else {
# Set class variable.
${"${class}::precision"} = $p; # set global P
@@ -401,7 +419,7 @@ sub precision {
}
# Return instance variable.
- return $x->{_p} if ref($x) && (defined $x->{_a} || defined $x->{_p});
+ return $x->{_p} if ref($x) && (defined($x->{_a}) || defined($x->{_p}));
# Return class variable.
return ${"${class}::precision"};
@@ -530,183 +548,195 @@ sub new {
my $selfref = ref $self;
my $class = $selfref || $self;
- # The POD says:
- #
- # "Currently, Math::BigInt->new() defaults to 0, while Math::BigInt->new('')
- # results in 'NaN'. This might change in the future, so use always the
- # following explicit forms to get a zero or NaN:
- # $zero = Math::BigInt->bzero();
- # $nan = Math::BigInt->bnan();
- #
- # But although this use has been discouraged for more than 10 years, people
- # apparently still use it, so we still support it.
+ # Make "require" work.
- return $self->bzero() unless @_;
+ $class -> import() if $IMPORT == 0;
- my ($wanted, $a, $p, $r) = @_;
+ # Calling new() with no input arguments has been discouraged for more than
+ # 10 years, but people apparently still use it, so we still support it.
- # 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.
+ return $class -> bzero() unless @_;
- $self = $selfref ? $self -> copy()
- : bless {}, $class;
+ my ($wanted, @r) = @_;
- unless (defined $wanted) {
- #carp("Use of uninitialized value in new()");
- return $self->bzero($a, $p, $r);
+ if (!defined($wanted)) {
+ #carp("Use of uninitialized value in new()")
+ # if warnings::enabled("uninitialized");
+ return $class -> bzero(@r);
}
- if (ref($wanted) && $wanted->isa($class)) { # MBI or subclass
- # Using "$copy = $wanted -> copy()" here fails some tests. Fixme!
- my $copy = $class -> copy($wanted);
- if ($selfref) {
- %$self = %$copy;
- } else {
- $self = $copy;
- }
- return $self;
+ if (!ref($wanted) && $wanted eq "") {
+ #carp(q|Argument "" isn't numeric in new()|)
+ # if warnings::enabled("numeric");
+ #return $class -> bzero(@r);
+ return $class -> bnan(@r);
}
- $class->import() if $IMPORT == 0; # make require work
+ # Initialize a new object.
+
+ $self = bless {}, $class;
+
+ # Math::BigInt or subclass
+
+ if (defined(blessed($wanted)) && $wanted -> isa($class)) {
+
+ # Don't copy the accuracy and precision, because a new object should get
+ # them from the global configuration.
+
+ $self -> {sign} = $wanted -> {sign};
+ $self -> {value} = $LIB -> _copy($wanted -> {value});
+ $self = $self->round(@r)
+ unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
+ return $self;
+ }
# Shortcut for non-zero scalar integers with no non-zero exponent.
- if (!ref($wanted) &&
- $wanted =~ / ^
- ([+-]?) # optional sign
- ([1-9][0-9]*) # non-zero significand
- (\.0*)? # ... with optional zero fraction
- ([Ee][+-]?0+)? # optional zero exponent
- \z
- /x)
+ if ($wanted =~
+ / ^
+ ( [+-]? ) # optional sign
+ ( [1-9] [0-9]* ) # non-zero significand
+ ( \.0* )? # ... with optional zero fraction
+ ( [Ee] [+-]? 0+ )? # optional zero exponent
+ \z
+ /x)
{
my $sgn = $1;
my $abs = $2;
$self->{sign} = $sgn || '+';
$self->{value} = $LIB->_new($abs);
-
- no strict 'refs';
- if (defined($a) || defined($p)
- || defined(${"${class}::precision"})
- || defined(${"${class}::accuracy"}))
- {
- $self->round($a, $p, $r)
- unless @_ >= 3 && !defined $a && !defined $p;
- }
-
+ $self = $self->round(@r);
return $self;
}
# Handle Infs.
- if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) {
+ if ($wanted =~ / ^
+ \s*
+ ( [+-]? )
+ inf (?: inity )?
+ \s*
+ \z
+ /ix)
+ {
my $sgn = $1 || '+';
- $self->{sign} = $sgn . 'inf'; # set a default sign for bstr()
- return $class->binf($sgn);
+ return $class -> binf($sgn, @r);
}
# Handle explicit NaNs (not the ones returned due to invalid input).
- if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) {
- $self = $class -> bnan();
- $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p;
- return $self;
+ if ($wanted =~ / ^
+ \s*
+ ( [+-]? )
+ nan
+ \s*
+ \z
+ /ix)
+ {
+ return $class -> bnan(@r);
}
- # Handle hexadecimal numbers.
+ my @parts;
- if ($wanted =~ /^\s*[+-]?0[Xx]/) {
- $self = $class -> from_hex($wanted);
- $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p;
- return $self;
- }
+ if (
+ # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they
+ # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct().
- # Handle binary numbers.
+ $wanted =~ /^\s*[+-]?0?[Xx]/ and
+ @parts = $class -> _hex_str_to_flt_lib_parts($wanted)
- if ($wanted =~ /^\s*[+-]?0[Bb]/) {
- $self = $class -> from_bin($wanted);
- $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p;
- return $self;
- }
+ or
- # Split string into mantissa, exponent, integer, fraction, value, and sign.
- my ($mis, $miv, $mfv, $es, $ev) = _split($wanted);
- if (!ref $mis) {
- if ($_trap_nan) {
- croak("$wanted is not a number in $class");
- }
- $self->{value} = $LIB->_zero();
- $self->{sign} = $nan;
- return $self;
- }
+ # Handle octal numbers. We auto-detect octal numbers if they have a
+ # "0o", "0O", "o", "O" prefix, cf. CORE::oct().
- if (!ref $miv) {
- # _from_hex or _from_bin
- $self->{value} = $mis->{value};
- $self->{sign} = $mis->{sign};
- return $self; # throw away $mis
- }
+ $wanted =~ /^\s*[+-]?0?[Oo]/ and
+ @parts = $class -> _oct_str_to_flt_lib_parts($wanted)
- # Make integer from mantissa by adjusting exponent, then convert to a
- # Math::BigInt.
- $self->{sign} = $$mis; # store sign
- $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) {
- croak("$wanted not an integer in $class");
- }
- #print "NOI 1\n";
- return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
- $self->{sign} = $nan;
- } else { # diff >= 0
- # adjust fraction and add it to value
- #print "diff > 0 $$miv\n";
- $$miv = $$miv . ($$mfv . '0' x $diff);
+ or
+
+ # Handle binary numbers. We auto-detect binary numbers if they have a
+ # "0b", "0B", "b", or "B" prefix, cf. CORE::oct().
+
+ $wanted =~ /^\s*[+-]?0?[Bb]/ and
+ @parts = $class -> _bin_str_to_flt_lib_parts($wanted)
+
+ or
+
+ # At this point, what is left are decimal numbers that aren't handled
+ # above and octal floating point numbers that don't have any of the
+ # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number.
+
+ @parts = $class -> _dec_str_to_flt_lib_parts($wanted)
+ or
+
+ # See if it is an octal floating point number. The extra check is
+ # included because _oct_str_to_flt_lib_parts() accepts octal numbers
+ # that don't have a prefix (this is needed to make it work with, e.g.,
+ # from_oct() that don't require a prefix). However, Perl requires a
+ # prefix for octal floating point literals. For example, "1p+0" is not
+ # valid, but "01p+0" and "0__1p+0" are.
+
+ $wanted =~ /^\s*[+-]?0_*\d/ and
+ @parts = $class -> _oct_str_to_flt_lib_parts($wanted))
+ {
+ # The value is an integer iff the exponent is non-negative.
+
+ if ($parts[2] eq '+') {
+ $self -> {sign} = $parts[0];
+ $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10);
+ $self = $self->round(@r)
+ unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
+ return $self;
}
+
+ # The value is not an integer, so upgrade if upgrading is enabled.
+
+ return $upgrade -> new($wanted, @r) if defined $upgrade;
}
- else {
- if ($$mfv ne '') { # e <= 0
- # fraction and negative/zero E => NOI
- if ($_trap_nan) {
- croak("$wanted not an integer in $class");
- }
- #print "NOI 2 \$\$mfv '$$mfv'\n";
- return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
- $self->{sign} = $nan;
- } elsif ($e < 0) {
- # xE-y, and empty mfv
- # Split the mantissa at the decimal point. E.g., if
- # $$miv = 12345 and $e = -2, then $frac = 45 and $$miv = 123.
-
- my $frac = substr($$miv, $e); # $frac is fraction part
- substr($$miv, $e) = ""; # $$miv is now integer part
-
- if ($frac =~ /[^0]/) {
- if ($_trap_nan) {
- croak("$wanted not an integer in $class");
- }
- #print "NOI 3\n";
- return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
- $self->{sign} = $nan;
- }
+ # If we get here, the value is neither a valid decimal, binary, octal, or
+ # hexadecimal number. It is not explicit an Inf or a NaN either.
+
+ return $class -> bnan(@r);
+}
+
+# Create a Math::BigInt from a decimal string. This is an equivalent to
+# from_hex(), from_oct(), and from_bin(). It is like new() except that it does
+# not accept anything but a string representing a finite decimal number.
+
+sub from_dec {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
+
+ # Don't modify constant (read-only) objects.
+
+ return $self if $selfref && $self->modify('from_dec');
+
+ my $str = shift;
+ my @r = @_;
+
+ # If called as a class method, initialize a new object.
+
+ $self = $class -> bzero(@r) unless $selfref;
+
+ if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) {
+
+ # The value is an integer iff the exponent is non-negative.
+
+ if ($parts[2] eq '+') {
+ $self -> {sign} = $parts[0];
+ $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10);
+ return $self -> round(@r);
}
- }
- unless ($self->{sign} eq $nan) {
- $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
- $self->{value} = $LIB->_new($$miv) if $self->{sign} =~ /^[+-]$/;
- }
+ # The value is not an integer, so upgrade if upgrading is enabled.
- # If any of the globals are set, use them to round, and store them inside
- # $self. Do not round for new($x, undef, undef) since that is used by MBF
- # to signal no rounding.
+ return $upgrade -> new($str, @r) if defined $upgrade;
+ }
- $self->round($a, $p, $r) unless @_ >= 3 && !defined $a && !defined $p;
- $self;
+ return $self -> bnan(@r);
}
# Create a Math::BigInt from a hexadecimal string.
@@ -718,51 +748,31 @@ sub from_hex {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('from_hex');
+ return $self if $selfref && $self->modify('from_hex');
my $str = shift;
+ my @r = @_;
# If called as a class method, initialize a new object.
- $self = $class -> bzero() unless $selfref;
+ $self = $class -> bzero(@r) unless $selfref;
- if ($str =~ s/
- ^
- \s*
- ( [+-]? )
- (0?x)?
- (
- [0-9a-fA-F]*
- ( _ [0-9a-fA-F]+ )*
- )
- \s*
- $
- //x)
- {
- # Get a "clean" version of the string, i.e., non-emtpy and with no
- # underscores or invalid characters.
-
- my $sign = $1;
- my $chrs = $3;
- $chrs =~ tr/_//d;
- $chrs = '0' unless CORE::length $chrs;
+ if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) {
- # The library method requires a prefix.
+ # The value is an integer iff the exponent is non-negative.
- $self->{value} = $LIB->_from_hex('0x' . $chrs);
-
- # Place the sign.
+ if ($parts[2] eq '+') {
+ $self -> {sign} = $parts[0];
+ $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10);
+ return $self -> round(@r);
+ }
- $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value})
- ? '-' : '+';
+ # The value is not an integer, so upgrade if upgrading is enabled.
- return $self;
+ return $upgrade -> new($str, @r) if defined $upgrade;
}
- # CORE::hex() parses as much as it can, and ignores any trailing garbage.
- # For backwards compatibility, we return NaN.
-
- return $self->bnan();
+ return $self -> bnan(@r);
}
# Create a Math::BigInt from an octal string.
@@ -774,50 +784,31 @@ sub from_oct {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('from_oct');
+ return $self if $selfref && $self->modify('from_oct');
my $str = shift;
+ my @r = @_;
# If called as a class method, initialize a new object.
- $self = $class -> bzero() unless $selfref;
-
- if ($str =~ s/
- ^
- \s*
- ( [+-]? )
- (
- [0-7]*
- ( _ [0-7]+ )*
- )
- \s*
- $
- //x)
- {
- # Get a "clean" version of the string, i.e., non-emtpy and with no
- # underscores or invalid characters.
-
- my $sign = $1;
- my $chrs = $2;
- $chrs =~ tr/_//d;
- $chrs = '0' unless CORE::length $chrs;
+ $self = $class -> bzero(@r) unless $selfref;
- # The library method requires a prefix.
+ if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) {
- $self->{value} = $LIB->_from_oct('0' . $chrs);
+ # The value is an integer iff the exponent is non-negative.
- # Place the sign.
+ if ($parts[2] eq '+') {
+ $self -> {sign} = $parts[0];
+ $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10);
+ return $self -> round(@r);
+ }
- $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value})
- ? '-' : '+';
+ # The value is not an integer, so upgrade if upgrading is enabled.
- return $self;
+ return $upgrade -> new($str, @r) if defined $upgrade;
}
- # CORE::oct() parses as much as it can, and ignores any trailing garbage.
- # For backwards compatibility, we return NaN.
-
- return $self->bnan();
+ return $self -> bnan(@r);
}
# Create a Math::BigInt from a binary string.
@@ -829,52 +820,31 @@ sub from_bin {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('from_bin');
+ return $self if $selfref && $self->modify('from_bin');
my $str = shift;
+ my @r = @_;
# If called as a class method, initialize a new object.
- $self = $class -> bzero() unless $selfref;
-
- if ($str =~ s/
- ^
- \s*
- ( [+-]? )
- (0?b)?
- (
- [01]*
- ( _ [01]+ )*
- )
- \s*
- $
- //x)
- {
- # Get a "clean" version of the string, i.e., non-emtpy and with no
- # underscores or invalid characters.
-
- my $sign = $1;
- my $chrs = $3;
- $chrs =~ tr/_//d;
- $chrs = '0' unless CORE::length $chrs;
+ $self = $class -> bzero(@r) unless $selfref;
- # The library method requires a prefix.
+ if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) {
- $self->{value} = $LIB->_from_bin('0b' . $chrs);
+ # The value is an integer iff the exponent is non-negative.
- # Place the sign.
+ if ($parts[2] eq '+') {
+ $self -> {sign} = $parts[0];
+ $self -> {value} = $LIB -> _lsft($parts[1], $parts[3], 10);
+ return $self -> round(@r);
+ }
- $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value})
- ? '-' : '+';
+ # The value is not an integer, so upgrade if upgrading is enabled.
- return $self;
+ return $upgrade -> new($str, @r) if defined $upgrade;
}
- # For consistency with from_hex() and from_oct(), we return NaN when the
- # input is invalid.
-
- return $self->bnan();
-
+ return $self -> bnan(@r);
}
# Create a Math::BigInt from a byte string.
@@ -886,19 +856,20 @@ sub from_bytes {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('from_bytes');
+ return $self if $selfref && $self->modify('from_bytes');
croak("from_bytes() requires a newer version of the $LIB library.")
unless $LIB->can('_from_bytes');
my $str = shift;
+ my @r = @_;
# If called as a class method, initialize a new object.
- $self = $class -> bzero() unless $selfref;
+ $self = $class -> bzero(@r) unless $selfref;
$self -> {sign} = '+';
$self -> {value} = $LIB -> _from_bytes($str);
- return $self;
+ return $self -> round(@r);
}
sub from_base {
@@ -908,11 +879,10 @@ sub from_base {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('from_base');
+ return $self if $selfref && $self->modify('from_base');
- my $str = shift;
+ my ($str, $base, $cs, @r) = @_; # $cs is the collation sequence
- my $base = shift;
$base = $class->new($base) unless ref($base);
croak("the base must be a finite integer >= 2")
@@ -925,14 +895,15 @@ sub from_base {
# 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;
+ unless (defined $cs) {
+ return $self -> from_bin($str, @r) if $base == 2;
+ return $self -> from_oct($str, @r) if $base == 8;
+ return $self -> from_hex($str, @r) if $base == 16;
if ($base == 10) {
- my $tmp = $class -> new($str);
+ my $tmp = $class -> from_dec($str, @r);
$self -> {value} = $tmp -> {value};
$self -> {sign} = '+';
+ return $self -> bround(@r);
}
}
@@ -941,16 +912,61 @@ sub from_base {
$self -> {sign} = '+';
$self -> {value}
- = $LIB->_from_base($str, $base -> {value}, @_ ? shift() : ());
- return $self
+ = $LIB->_from_base($str, $base -> {value}, defined($cs) ? $cs : ());
+ return $self -> bround(@r);
+}
+
+sub from_base_num {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
+
+ # Don't modify constant (read-only) objects.
+
+ return $self if $selfref && $self->modify('from_base_num');
+
+ # Make sure we have an array of non-negative, finite, numerical objects.
+
+ my $nums = shift;
+ $nums = [ @$nums ]; # create new reference
+
+ for my $i (0 .. $#$nums) {
+ # Make sure we have an object.
+ $nums -> [$i] = $class -> new($nums -> [$i])
+ unless ref($nums -> [$i]) && $nums -> [$i] -> isa($class);
+ # Make sure we have a finite, non-negative integer.
+ croak "the elements must be finite non-negative integers"
+ if $nums -> [$i] -> is_neg() || ! $nums -> [$i] -> is_int();
+ }
+
+ my $base = shift;
+ $base = $class -> new($base) unless ref($base) && $base -> isa($class);
+
+ my @r = @_;
+
+ # If called as a class method, initialize a new object.
+
+ $self = $class -> bzero(@r) unless $selfref;
+
+ croak("from_base_num() requires a newer version of the $LIB library.")
+ unless $LIB->can('_from_base_num');
+
+ $self -> {sign} = '+';
+ $self -> {value} = $LIB -> _from_base_num([ map { $_ -> {value} } @$nums ],
+ $base -> {value});
+
+ return $self -> round(@r);
}
sub bzero {
# create/assign '+0'
- if (@_ == 0) {
- #carp("Using bzero() as a function is deprecated;",
- # " use bzero() as a method instead");
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
unshift @_, __PACKAGE__;
}
@@ -962,7 +978,13 @@ sub bzero {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('bzero');
+ return $self if $selfref && $self->modify('bzero');
+
+ # Get the rounding parameters, if any.
+
+ my @r = @_;
+
+ # If called as a class method, initialize a new object.
$self = bless {}, $class unless $selfref;
@@ -970,19 +992,17 @@ sub bzero {
$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
+ # parameters are given, and if called as a class method, initialize the new
# instance with the class variables.
- if (@_) {
+ if (@r) {
croak "can't specify both accuracy and precision"
- if @_ >= 2 && defined $_[0] && defined $_[1];
+ if @r >= 2 && defined($r[0]) && defined($r[1]);
$self->{_a} = $_[0];
$self->{_p} = $_[1];
- } else {
- unless($selfref) {
- $self->{_a} = $class -> accuracy();
- $self->{_p} = $class -> precision();
- }
+ } elsif (!$selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
}
return $self;
@@ -991,9 +1011,12 @@ sub bzero {
sub bone {
# Create or assign '+1' (or -1 if given sign '-').
- if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) {
- #carp("Using bone() as a function is deprecated;",
- # " use bone() as a method instead");
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
unshift @_, __PACKAGE__;
}
@@ -1005,33 +1028,38 @@ sub bone {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('bone');
+ return $self if $selfref && $self->modify('bone');
+
+ my ($sign, @r) = @_;
- my $sign = '+'; # default
- if (@_) {
- $sign = shift;
- $sign = $sign =~ /^\s*-/ ? "-" : "+";
+ # Get the sign.
+
+ if (defined($_[0]) && $_[0] =~ /^\s*([+-])\s*$/) {
+ $sign = $1;
+ shift;
+ } else {
+ $sign = '+';
}
+ # If called as a class method, initialize a new object.
+
$self = bless {}, $class unless $selfref;
$self->{sign} = $sign;
$self->{value} = $LIB->_one();
# 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
+ # parameters are given, and if called as a class method, initialize the new
# instance with the class variables.
- if (@_) {
+ if (@r) {
croak "can't specify both accuracy and precision"
- if @_ >= 2 && defined $_[0] && defined $_[1];
+ if @r >= 2 && defined($r[0]) && defined($r[1]);
$self->{_a} = $_[0];
$self->{_p} = $_[1];
- } else {
- unless($selfref) {
- $self->{_a} = $class -> accuracy();
- $self->{_p} = $class -> precision();
- }
+ } elsif (!$selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
}
return $self;
@@ -1040,11 +1068,12 @@ sub bone {
sub binf {
# create/assign a '+inf' or '-inf'
- if (@_ == 0 || (defined($_[0]) && !ref($_[0]) &&
- $_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/))
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
{
- #carp("Using binf() as a function is deprecated;",
- # " use binf() as a method instead");
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
unshift @_, __PACKAGE__;
}
@@ -1063,10 +1092,21 @@ sub binf {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('binf');
+ return $self if $selfref && $self->modify('binf');
- my $sign = shift;
- $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+";
+ # Get the sign.
+
+ my $sign = '+'; # default is to return positive infinity
+ if (defined($_[0]) && $_[0] =~ /^\s*([+-])(inf|$)/i) {
+ $sign = $1;
+ shift;
+ }
+
+ # Get the rounding parameters, if any.
+
+ my @r = @_;
+
+ # If called as a class method, initialize a new object.
$self = bless {}, $class unless $selfref;
@@ -1074,19 +1114,17 @@ sub binf {
$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
+ # parameters are given, and if called as a class method, initialize the new
# instance with the class variables.
- if (@_) {
+ if (@r) {
croak "can't specify both accuracy and precision"
- if @_ >= 2 && defined $_[0] && defined $_[1];
+ if @r >= 2 && defined($r[0]) && defined($r[1]);
$self->{_a} = $_[0];
$self->{_p} = $_[1];
- } else {
- unless($selfref) {
- $self->{_a} = $class -> accuracy();
- $self->{_p} = $class -> precision();
- }
+ } elsif (!$selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
}
return $self;
@@ -1095,9 +1133,12 @@ sub binf {
sub bnan {
# create/assign a 'NaN'
- if (@_ == 0) {
- #carp("Using bnan() as a function is deprecated;",
- # " use bnan() as a method instead");
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
unshift @_, __PACKAGE__;
}
@@ -1116,57 +1157,173 @@ sub bnan {
# Don't modify constant (read-only) objects.
- return if $selfref && $self->modify('bnan');
+ return $self if $selfref && $self->modify('bnan');
+
+ # Get the rounding parameters, if any.
+
+ my @r = @_;
$self = bless {}, $class unless $selfref;
$self -> {sign} = $nan;
$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 (@r) {
+ croak "can't specify both accuracy and precision"
+ if @r >= 2 && defined($r[0]) && defined($r[1]);
+ $self->{_a} = $_[0];
+ $self->{_p} = $_[1];
+ } elsif (!$selfref) {
+ $self->{_a} = $class -> accuracy();
+ $self->{_p} = $class -> precision();
+ }
+
return $self;
}
sub bpi {
- # Calculate PI to N digits. Unless upgrading is in effect, returns the
- # result truncated to an integer, that is, always returns '3'.
- my ($self, $n) = @_;
- if (@_ == 1) {
- # called like Math::BigInt::bpi(10);
- $n = $self;
- $self = __PACKAGE__;
- }
- $self = ref($self) if ref($self);
- return $upgrade->new($n) if defined $upgrade;
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
+ unshift @_, __PACKAGE__;
+ }
- # hard-wired to "3"
- $self->new(3);
-}
+ # Called as Argument list
+ # --------- -------------
+ # Math::BigFloat->bpi() ("Math::BigFloat")
+ # Math::BigFloat->bpi(10) ("Math::BigFloat", 10)
+ # $x->bpi() ($x)
+ # $x->bpi(10) ($x, 10)
+ # Math::BigFloat::bpi() ()
+ # Math::BigFloat::bpi(10) (10)
+ #
+ # In ambiguous cases, we favour the OO-style, so the following case
+ #
+ # $n = Math::BigFloat->new("10");
+ # $x = Math::BigFloat->bpi($n);
+ #
+ # which gives an argument list with the single element $n, is resolved as
+ #
+ # $n->bpi();
-sub copy {
my $self = shift;
my $selfref = ref $self;
my $class = $selfref || $self;
+ my @r = @_; # rounding paramters
+
+ if ($selfref) { # bpi() called as an instance method
+ return $self if $self -> modify('bpi');
+ } else { # bpi() called as a class method
+ $self = bless {}, $class; # initialize new instance
+ }
+
+ return $upgrade -> bpi(@r) if defined $upgrade;
+
+ # hard-wired to "3"
+ $self -> {sign} = '+';
+ $self -> {value} = $LIB -> _new("3");
+ $self = $self -> round(@r);
+ return $self;
+}
- # If called as a class method, the object to copy is the next argument.
+sub copy {
+ my ($x, $class);
+ if (ref($_[0])) { # $y = $x -> copy()
+ $x = shift;
+ $class = ref($x);
+ } else { # $y = Math::BigInt -> copy($y)
+ $class = shift;
+ $x = shift;
+ }
- $self = shift() unless $selfref;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @_;
my $copy = bless {}, $class;
- $copy->{sign} = $self->{sign};
- $copy->{value} = $LIB->_copy($self->{value});
- $copy->{_a} = $self->{_a} if exists $self->{_a};
- $copy->{_p} = $self->{_p} if exists $self->{_p};
+ $copy->{sign} = $x->{sign};
+ $copy->{value} = $LIB->_copy($x->{value});
+ $copy->{_a} = $x->{_a} if exists $x->{_a};
+ $copy->{_p} = $x->{_p} if exists $x->{_p};
return $copy;
}
-sub as_number {
- # An object might be asked to return itself as bigint on certain overloaded
- # operations. This does exactly this, so that sub classes can simple inherit
- # it or override with their own integer conversion routine.
- $_[0]->copy();
+sub as_int {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # If called as an instance method, and the instance class is something we
+ # upgrade to, $x might not be a Math::BigInt, so don't just call copy().
+
+ return $x -> copy() if $x -> isa("Math::BigInt");
+
+ # disable upgrading and downgrading
+
+ my $upg = Math::BigInt -> upgrade();
+ my $dng = Math::BigInt -> downgrade();
+ Math::BigInt -> upgrade(undef);
+ Math::BigInt -> downgrade(undef);
+
+ my $y = Math::BigInt -> new($x);
+
+ # reset upgrading and downgrading
+
+ Math::BigInt -> upgrade($upg);
+ Math::BigInt -> downgrade($dng);
+
+ return $y;
+}
+
+sub as_float {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # disable upgrading and downgrading
+
+ require Math::BigFloat;
+ my $upg = Math::BigFloat -> upgrade();
+ my $dng = Math::BigFloat -> downgrade();
+ Math::BigFloat -> upgrade(undef);
+ Math::BigFloat -> downgrade(undef);
+
+ my $y = Math::BigFloat -> new($x);
+
+ # reset upgrading and downgrading
+
+ Math::BigFloat -> upgrade($upg);
+ Math::BigFloat -> downgrade($dng);
+
+ return $y;
+}
+
+sub as_rat {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # disable upgrading and downgrading
+
+ require Math::BigRat;
+ my $upg = Math::BigRat -> upgrade();
+ my $dng = Math::BigRat -> downgrade();
+ Math::BigRat -> upgrade(undef);
+ Math::BigRat -> downgrade(undef);
+
+ my $y = Math::BigRat -> new($x);
+
+ # reset upgrading and downgrading
+
+ Math::BigRat -> upgrade($upg);
+ Math::BigRat -> downgrade($dng);
+
+ return $y;
}
###############################################################################
@@ -1175,7 +1332,7 @@ sub as_number {
sub is_zero {
# return true if arg (BINT or num_str) is zero (array '+', '0')
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
$LIB->_is_zero($x->{value});
@@ -1183,22 +1340,22 @@ sub is_zero {
sub is_one {
# return true if arg (BINT or num_str) is +1, or -1 if sign is given
- my ($class, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my (undef, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
- $sign = '+' if !defined $sign || $sign ne '-';
+ $sign = '+' if !defined($sign) || $sign ne '-';
return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
$LIB->_is_one($x->{value});
}
sub is_finite {
- my $x = shift;
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
return $x->{sign} eq '+' || $x->{sign} eq '-';
}
sub is_inf {
# return true if arg (BINT or num_str) is +-inf
- my ($class, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my (undef, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
if (defined $sign) {
$sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf
@@ -1210,14 +1367,14 @@ sub is_inf {
sub is_nan {
# return true if arg (BINT or num_str) is NaN
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
$x->{sign} eq $nan ? 1 : 0;
}
sub is_positive {
# return true when arg (BINT or num_str) is positive (> 0)
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
return 1 if $x->{sign} eq '+inf'; # +inf is positive
@@ -1227,14 +1384,14 @@ sub is_positive {
sub is_negative {
# return true when arg (BINT or num_str) is negative (< 0)
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
$x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not
}
sub is_non_negative {
# Return true if argument is non-negative (>= 0).
- my ($class, $x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
return 1 if $x->{sign} =~ /^\+/;
return 1 if $x -> is_zero();
@@ -1243,7 +1400,7 @@ sub is_non_negative {
sub is_non_positive {
# Return true if argument is non-positive (<= 0).
- my ($class, $x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
return 1 if $x->{sign} =~ /^\-/;
return 1 if $x -> is_zero();
@@ -1252,7 +1409,7 @@ sub is_non_positive {
sub is_odd {
# return true when arg (BINT or num_str) is odd, false for even
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
$LIB->_is_odd($x->{value});
@@ -1260,7 +1417,7 @@ sub is_odd {
sub is_even {
# return true when arg (BINT or num_str) is even, false for odd
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
$LIB->_is_even($x->{value});
@@ -1268,8 +1425,7 @@ sub is_even {
sub is_int {
# return true when arg (BINT or num_str) is an integer
- # always true for Math::BigInt, but different for Math::BigFloat objects
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my (undef, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
$x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
}
@@ -1283,22 +1439,25 @@ sub bcmp {
# (BINT or num_str, BINT or num_str) return cond_code
# set up parameters
- my ($class, $x, $y) = ref($_[0]) && ref($_[0]) eq ref($_[1])
- ? (ref($_[0]), @_)
- : objectify(2, @_);
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
- return $upgrade->bcmp($x, $y) if defined $upgrade &&
- ((!$x->isa($class)) || (!$y->isa($class)));
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ return $upgrade->bcmp($x, $y)
+ if defined($upgrade) && (!$x->isa($class) || !$y->isa($class));
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
# handle +-inf and NaN
- return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
+ return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
return +1 if $x->{sign} eq '+inf';
return -1 if $x->{sign} eq '-inf';
return -1 if $y->{sign} eq '+inf';
return +1;
}
+
# check sign for speed first
return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
@@ -1323,16 +1482,18 @@ sub bacmp {
# (BINT, BINT) return cond_code
# set up parameters
- my ($class, $x, $y) = ref($_[0]) && ref($_[0]) eq ref($_[1])
- ? (ref($_[0]), @_)
- : objectify(2, @_);
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- return $upgrade->bacmp($x, $y) if defined $upgrade &&
- ((!$x->isa($class)) || (!$y->isa($class)));
+ return $upgrade->bacmp($x, $y)
+ if defined($upgrade) && (!$x->isa($class) || !$y->isa($class));
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
# handle +-inf and NaN
- return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
return -1;
@@ -1341,69 +1502,68 @@ sub bacmp {
}
sub beq {
- my $self = shift;
- my $selfref = ref $self;
+ my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (undef, @_)
+ : objectify(2, @_);
- croak 'beq() is an instance method, not a class method' unless $selfref;
- croak 'Wrong number of arguments for beq()' unless @_ == 1;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- my $cmp = $self -> bcmp(shift);
- return defined($cmp) && ! $cmp;
+ my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary
+ return defined($cmp) && !$cmp;
}
sub bne {
- my $self = shift;
- my $selfref = ref $self;
+ my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (undef, @_)
+ : objectify(2, @_);
- croak 'bne() is an instance method, not a class method' unless $selfref;
- croak 'Wrong number of arguments for bne()' unless @_ == 1;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- my $cmp = $self -> bcmp(shift);
- return defined($cmp) && ! $cmp ? '' : 1;
+ my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary
+ return defined($cmp) && !$cmp ? '' : 1;
}
sub blt {
- my $self = shift;
- my $selfref = ref $self;
+ my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (undef, @_)
+ : objectify(2, @_);
- croak 'blt() is an instance method, not a class method' unless $selfref;
- croak 'Wrong number of arguments for blt()' unless @_ == 1;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- my $cmp = $self -> bcmp(shift);
+ my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary
return defined($cmp) && $cmp < 0;
}
sub ble {
- my $self = shift;
- my $selfref = ref $self;
+ my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (undef, @_)
+ : objectify(2, @_);
- croak 'ble() is an instance method, not a class method' unless $selfref;
- croak 'Wrong number of arguments for ble()' unless @_ == 1;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- my $cmp = $self -> bcmp(shift);
+ my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary
return defined($cmp) && $cmp <= 0;
}
sub bgt {
- my $self = shift;
- my $selfref = ref $self;
+ my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (undef, @_)
+ : objectify(2, @_);
- croak 'bgt() is an instance method, not a class method' unless $selfref;
- croak 'Wrong number of arguments for bgt()' unless @_ == 1;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- my $cmp = $self -> bcmp(shift);
+ my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary
return defined($cmp) && $cmp > 0;
}
sub bge {
- my $self = shift;
- my $selfref = ref $self;
+ my (undef, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (undef, @_)
+ : objectify(2, @_);
- croak 'bge() is an instance method, not a class method'
- unless $selfref;
- croak 'Wrong number of arguments for bge()' unless @_ == 1;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- my $cmp = $self -> bcmp(shift);
+ my $cmp = $x -> bcmp($y); # bcmp() upgrades if necessary
return defined($cmp) && $cmp >= 0;
}
@@ -1414,84 +1574,104 @@ sub bge {
sub bneg {
# (BINT or num_str) return BINT
# negate number or make a negated number from string
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bneg');
- # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
- $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{value}));
- $x;
+ return $upgrade -> bneg($x, @r) if defined($upgrade) && !$x->isa($class);
+
+ # Don't negate +0 so we always have the normalized form +0. Does nothing for
+ # 'NaN'.
+ $x->{sign} =~ tr/+-/-+/
+ unless $x->{sign} eq '+' && $LIB->_is_zero($x->{value});
+
+ $x -> round(@r);
}
sub babs {
# (BINT or num_str) return BINT
# make number absolute, or return absolute BINT from string
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('babs');
- # post-normalized abs for internal use (does nothing for NaN)
+
+ return $upgrade -> babs($x, @r) if defined($upgrade) && !$x->isa($class);
+
$x->{sign} =~ s/^-/+/;
- $x;
+
+ $x -> round(@r);
}
sub bsgn {
# Signum function.
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- my $self = shift;
+ return $x if $x->modify('bsgn');
+
+ return $upgrade -> bsgn($x, @r) if defined($upgrade) && !$x->isa($class);
- return $self if $self->modify('bsgn');
+ return $x -> bone("+", @r) if $x -> is_pos();
+ return $x -> bone("-", @r) if $x -> is_neg();
- return $self -> bone("+") if $self -> is_pos();
- return $self -> bone("-") if $self -> is_neg();
- return $self; # zero or NaN
+ $x -> round(@r);
}
sub bnorm {
# (numstr or BINT) return BINT
# Normalize number -- no-op here
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+
+ # This method is called from the rounding methods, so if this method
+ # supports rounding by calling the rounding methods, we get an infinite
+ # recursion.
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
$x;
}
sub binc {
# increment arg by one
- my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
return $x if $x->modify('binc');
+ return $x->round(@r) if $x -> is_inf() || $x -> is_nan();
+
+ return $upgrade -> binc($x, @r) if defined($upgrade) && !$x -> isa($class);
+
if ($x->{sign} eq '+') {
$x->{value} = $LIB->_inc($x->{value});
- return $x->round($a, $p, $r);
} elsif ($x->{sign} eq '-') {
$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
- $x->badd($class->bone(), $a, $p, $r); # badd does round
+
+ return $x->round(@r);
}
sub bdec {
# decrement arg by one
my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
return $x if $x->modify('bdec');
+ return $x->round(@r) if $x -> is_inf() || $x -> is_nan();
+
+ return $upgrade -> bdec($x, @r) if defined($upgrade) && !$x -> isa($class);;
+
if ($x->{sign} eq '-') {
- # x already < 0
$x->{value} = $LIB->_inc($x->{value});
- } else {
- return $x->badd($class->bone('-'), @r)
- unless $x->{sign} eq '+'; # inf or NaN
- # >= 0
- if ($LIB->_is_zero($x->{value})) {
- # == 0
+ } elsif ($x->{sign} eq '+') {
+ if ($LIB->_is_zero($x->{value})) { # +1 - 1 => +0
$x->{value} = $LIB->_one();
- $x->{sign} = '-'; # 0 => -1
+ $x->{sign} = '-';
} else {
- # > 0
$x->{value} = $LIB->_dec($x->{value});
}
}
- $x->round(@r);
+
+ return $x->round(@r);
}
#sub bstrcmp {
@@ -1589,51 +1769,37 @@ sub badd {
# return result as BINT
# set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x->modify('badd');
- return $upgrade->badd($upgrade->new($x), $upgrade->new($y), @r) if defined $upgrade &&
- ((!$x->isa($class)) || (!$y->isa($class)));
$r[3] = $y; # no push!
- # inf and NaN handling
+
+ return $upgrade->badd($x, $y, @r)
+ if defined($upgrade) && (!$x->isa($class) || !$y->isa($class));
+
+ # Inf and NaN handling
if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
# NaN first
- return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- # inf handling
+ return $x->bnan(@r) if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ # Inf handling
if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) {
- # +inf++inf or -inf+-inf => same, rest is NaN
- return $x if $x->{sign} eq $y->{sign};
- return $x->bnan();
+ # +Inf + +Inf or -Inf + -Inf => same, rest is NaN
+ return $x->round(@r) if $x->{sign} eq $y->{sign};
+ return $x->bnan(@r);
}
- # +-inf + something => +inf
- # something +-inf => +-inf
- $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
- return $x;
- }
-
- my ($sx, $sy) = ($x->{sign}, $y->{sign}); # get signs
-
- if ($sx eq $sy) {
- $x->{value} = $LIB->_add($x->{value}, $y->{value}); # same sign, abs add
- } else {
- my $a = $LIB->_acmp ($y->{value}, $x->{value}); # absolute compare
- if ($a > 0) {
- $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} = $LIB->_zero();
- $x->{sign} = '+';
- } else # a < 0
- {
- $x->{value} = $LIB->_sub($x->{value}, $y->{value}); # abs sub
+ # ±Inf + something => ±Inf
+ # something + ±Inf => ±Inf
+ if ($y->{sign} =~ /^[+-]inf$/) {
+ $x->{sign} = $y->{sign};
}
+ return $x -> round(@r);
}
+
+ ($x->{value}, $x->{sign})
+ = $LIB -> _sadd($x->{value}, $x->{sign}, $y->{value}, $y->{sign});
$x->round(@r);
}
@@ -1642,17 +1808,14 @@ sub bsub {
# subtract second arg from first, modify first
# set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
-
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x -> modify('bsub');
- return $upgrade -> new($x) -> bsub($upgrade -> new($y), @r)
- if defined $upgrade && (!$x -> isa($class) || !$y -> isa($class));
+ return $upgrade -> bsub($x, $y, @r)
+ if defined($upgrade) && (!$x->isa($class) || !$y->isa($class));
return $x -> round(@r) if $y -> is_zero();
@@ -1665,9 +1828,10 @@ sub bsub {
if ($xsign ne $x -> {sign}) {
# special case of $x -> bsub($x) results in 0
return $x -> bzero(@r) if $xsign =~ /^[+-]$/;
- return $x -> bnan(); # NaN, -inf, +inf
+ return $x -> bnan(@r); # NaN, -inf, +inf
}
- $x -> badd($y, @r); # badd does not leave internal zeros
+
+ $x = $x -> badd($y, @r); # badd() does not leave internal zeros
$y -> {sign} =~ tr/+-/-+/; # refix $y (does nothing for NaN)
$x; # already rounded by badd() or no rounding
}
@@ -1677,29 +1841,27 @@ sub bmul {
# (BINT or num_str, BINT or num_str) return BINT
# set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x->modify('bmul');
- return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ return $x->bnan(@r) if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
# inf handling
if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) {
- return $x->bnan() if $x->is_zero() || $y->is_zero();
+ return $x->bnan(@r) if $x->is_zero() || $y->is_zero();
# result will always be +-inf:
# +inf * +/+inf => +inf, -inf * -/-inf => +inf
# +inf * -/-inf => -inf, -inf * +/+inf => -inf
- return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
- return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
- return $x->binf('-');
+ return $x->binf(@r) if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf(@r) if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf('-', @r);
}
- return $upgrade->bmul($x, $upgrade->new($y), @r)
- if defined $upgrade && !$y->isa($class);
+ return $upgrade->bmul($x, $y, @r)
+ if defined($upgrade) && (!$x->isa($class) || !$y->isa($class));
$r[3] = $y; # no push here
@@ -1716,60 +1878,143 @@ sub bmuladd {
# (BINT or num_str, BINT or num_str, BINT or num_str) return BINT
# set up parameters
- my ($class, $x, $y, $z, @r) = objectify(3, @_);
+ my ($class, $x, $y, $z, @r)
+ = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
+ ? (ref($_[0]), @_)
+ : objectify(3, @_);
return $x if $x->modify('bmuladd');
- return $x->bnan() if (($x->{sign} eq $nan) ||
- ($y->{sign} eq $nan) ||
- ($z->{sign} eq $nan));
+ # x, y, and z are finite numbers
- # inf handling of x and y
- if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) {
- return $x->bnan() if $x->is_zero() || $y->is_zero();
- # result will always be +-inf:
- # +inf * +/+inf => +inf, -inf * -/-inf => +inf
- # +inf * -/-inf => -inf, -inf * +/+inf => -inf
- return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
- return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
- return $x->binf('-');
- }
- # inf handling x*y and z
- if (($z->{sign} =~ /^[+-]inf$/)) {
- # something +-inf => +-inf
- $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/;
+ if ($x->{sign} =~ /^[+-]$/ &&
+ $y->{sign} =~ /^[+-]$/ &&
+ $z->{sign} =~ /^[+-]$/)
+ {
+ return $upgrade->bmuladd($x, $y, $z, @r)
+ if defined($upgrade)
+ && (!$x->isa($class) || !$y->isa($class) || !$z->isa($class));
+
+ # TODO: what if $y and $z have A or P set?
+ $r[3] = $z; # no push here
+
+ my $zs = $z->{sign};
+ my $zv = $z->{value};
+ $zv = $LIB -> _copy($zv) if refaddr($x) eq refaddr($z);
+
+ $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
+ $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math
+ $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # no -0
+
+ ($x->{value}, $x->{sign})
+ = $LIB -> _sadd($x->{value}, $x->{sign}, $zv, $zs);
+ return $x->round(@r);
}
- return $upgrade->bmuladd($x, $upgrade->new($y), $upgrade->new($z), @r)
- if defined $upgrade && (!$y->isa($class) || !$z->isa($class) || !$x->isa($class));
+ # At least one of x, y, and z is a NaN
- # TODO: what if $y and $z have A or P set?
- $r[3] = $z; # no push here
+ return $x->bnan(@r) if (($x->{sign} eq $nan) ||
+ ($y->{sign} eq $nan) ||
+ ($z->{sign} eq $nan));
- $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
+ # At least one of x, y, and z is an Inf
- $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math
- $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # no -0
+ if ($x->{sign} eq "-inf") {
- my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs
+ if ($y -> is_neg()) { # x = -inf, y < 0
+ if ($z->{sign} eq "-inf") {
+ return $x->bnan(@r);
+ } else {
+ return $x->binf("+", @r);
+ }
+ } elsif ($y -> is_zero()) { # x = -inf, y = 0
+ return $x->bnan(@r);
+ } else { # x = -inf, y > 0
+ if ($z->{sign} eq "+inf") {
+ return $x->bnan(@r);
+ } else {
+ return $x->binf("-", @r);
+ }
+ }
- if ($sx eq $sz) {
- $x->{value} = $LIB->_add($x->{value}, $z->{value}); # same sign, abs add
- } else {
- my $a = $LIB->_acmp ($z->{value}, $x->{value}); # absolute compare
- if ($a > 0) {
- $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} = $LIB->_zero();
- $x->{sign} = '+';
- } else # a < 0
- {
- $x->{value} = $LIB->_sub($x->{value}, $z->{value}); # abs sub
+ } elsif ($x->{sign} eq "+inf") {
+
+ if ($y -> is_neg()) { # x = +inf, y < 0
+ if ($z->{sign} eq "+inf") {
+ return $x->bnan(@r);
+ } else {
+ return $x->binf("-", @r);
+ }
+ } elsif ($y -> is_zero()) { # x = +inf, y = 0
+ return $x->bnan(@r);
+ } else { # x = +inf, y > 0
+ if ($z->{sign} eq "-inf") {
+ return $x->bnan(@r);
+ } else {
+ return $x->binf("+", @r);
+ }
+ }
+
+ } elsif ($x -> is_neg()) {
+
+ if ($y->{sign} eq "-inf") { # -inf < x < 0, y = -inf
+ if ($z->{sign} eq "-inf") {
+ return $x->bnan(@r);
+ } else {
+ return $x->binf("+", @r);
+ }
+ } elsif ($y->{sign} eq "+inf") { # -inf < x < 0, y = +inf
+ if ($z->{sign} eq "+inf") {
+ return $x->bnan(@r);
+ } else {
+ return $x->binf("-", @r);
+ }
+ } else { # -inf < x < 0, -inf < y < +inf
+ if ($z->{sign} eq "-inf") {
+ return $x->binf("-", @r);
+ } elsif ($z->{sign} eq "+inf") {
+ return $x->binf("+", @r);
+ }
+ }
+
+ } elsif ($x -> is_zero()) {
+
+ if ($y->{sign} eq "-inf") { # x = 0, y = -inf
+ return $x->bnan(@r);
+ } elsif ($y->{sign} eq "+inf") { # x = 0, y = +inf
+ return $x->bnan(@r);
+ } else { # x = 0, -inf < y < +inf
+ if ($z->{sign} eq "-inf") {
+ return $x->binf("-", @r);
+ } elsif ($z->{sign} eq "+inf") {
+ return $x->binf("+", @r);
+ }
+ }
+
+ } elsif ($x -> is_pos()) {
+
+ if ($y->{sign} eq "-inf") { # 0 < x < +inf, y = -inf
+ if ($z->{sign} eq "+inf") {
+ return $x->bnan(@r);
+ } else {
+ return $x->binf("-", @r);
+ }
+ } elsif ($y->{sign} eq "+inf") { # 0 < x < +inf, y = +inf
+ if ($z->{sign} eq "-inf") {
+ return $x->bnan(@r);
+ } else {
+ return $x->binf("+", @r);
+ }
+ } else { # 0 < x < +inf, -inf < y < +inf
+ if ($z->{sign} eq "-inf") {
+ return $x->binf("-", @r);
+ } elsif ($z->{sign} eq "+inf") {
+ return $x->binf("+", @r);
+ }
}
}
- $x->round(@r);
+
+ die;
}
sub bdiv {
@@ -1778,12 +2023,9 @@ sub bdiv {
# sign as the divisor.
# Set up parameters.
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
-
- # objectify() is costly, so avoid it if we can.
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x -> modify('bdiv');
@@ -1793,7 +2035,8 @@ sub bdiv {
# modulo/remainder.
if ($x -> is_nan() || $y -> is_nan()) {
- return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan();
+ return $wantarray ? ($x -> bnan(@r), $class -> bnan(@r))
+ : $x -> bnan(@r);
}
# Divide by zero and modulo zero.
@@ -1816,12 +2059,12 @@ sub bdiv {
if ($y -> is_zero()) {
my $rem;
if ($wantarray) {
- $rem = $x -> copy();
+ $rem = $x -> copy() -> round(@r);
}
if ($x -> is_zero()) {
- $x -> bnan();
+ $x = $x -> bnan(@r);
} else {
- $x -> binf($x -> {sign});
+ $x = $x -> binf($x -> {sign}, @r);
}
return $wantarray ? ($x, $rem) : $x;
}
@@ -1842,12 +2085,12 @@ sub bdiv {
if ($x -> is_inf()) {
my $rem;
- $rem = $class -> bnan() if $wantarray;
+ $rem = $class -> bnan(@r) if $wantarray;
if ($y -> is_inf()) {
- $x -> bnan();
+ $x = $x -> bnan(@r);
} else {
my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
- $x -> binf($sign);
+ $x = $x -> binf($sign, @r);
}
return $wantarray ? ($x, $rem) : $x;
}
@@ -1868,11 +2111,11 @@ sub bdiv {
if ($y -> is_inf()) {
my $rem;
if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
- $rem = $x -> copy() if $wantarray;
- $x -> bzero();
+ $rem = $x -> copy() -> round(@r) if $wantarray;
+ $x = $x -> bzero(@r);
} else {
- $rem = $class -> binf($y -> {sign}) if $wantarray;
- $x -> bone('-');
+ $rem = $class -> binf($y -> {sign}, @r) if $wantarray;
+ $x = $x -> bone('-', @r);
}
return $wantarray ? ($x, $rem) : $x;
}
@@ -1880,8 +2123,10 @@ sub bdiv {
# At this point, both the numerator and denominator are finite numbers, and
# the denominator (divisor) is non-zero.
- return $upgrade -> bdiv($upgrade -> new($x), $upgrade -> new($y), @r)
- if defined $upgrade;
+ # Division might return a non-integer result, so upgrade unconditionally, if
+ # upgrading is enabled.
+
+ return $upgrade -> bdiv($x, $y, @r) if defined $upgrade;
$r[3] = $y; # no push!
@@ -1900,7 +2145,7 @@ sub bdiv {
$y -> {sign} = $ysign; # Re-insert the original sign.
if ($same) {
- $x -> bone();
+ $x = $x -> bone();
} else {
($x -> {value}, $rem -> {value}) =
$LIB -> _div($x -> {value}, $y -> {value});
@@ -1916,16 +2161,16 @@ sub bdiv {
$x -> {sign} = '+';
} else {
if ($xsign eq '+') {
- $x -> badd(1);
+ $x = $x -> badd(1);
} else {
- $x -> bsub(1);
+ $x = $x -> bsub(1);
}
$x -> {sign} = '-';
}
}
}
- $x -> round(@r);
+ $x = $x -> round(@r);
if ($wantarray) {
unless ($LIB -> _is_zero($rem -> {value})) {
@@ -1936,7 +2181,7 @@ sub bdiv {
}
$rem -> {_a} = $x -> {_a};
$rem -> {_p} = $x -> {_p};
- $rem -> round(@r);
+ $rem = $rem -> round(@r);
return ($x, $rem);
}
@@ -1951,12 +2196,9 @@ sub btdiv {
# and $q * $y + $r = $x.
# Set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
-
- # objectify is costly, so avoid it if we can.
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x -> modify('btdiv');
@@ -1966,7 +2208,8 @@ sub btdiv {
# modulo/remainder.
if ($x -> is_nan() || $y -> is_nan()) {
- return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan();
+ return $wantarray ? ($x -> bnan(@r), $class -> bnan(@r))
+ : $x -> bnan(@r);
}
# Divide by zero and modulo zero.
@@ -1989,12 +2232,12 @@ sub btdiv {
if ($y -> is_zero()) {
my $rem;
if ($wantarray) {
- $rem = $x -> copy();
+ $rem = $x -> copy(@r);
}
if ($x -> is_zero()) {
- $x -> bnan();
+ $x = $x -> bnan(@r);
} else {
- $x -> binf($x -> {sign});
+ $x = $x -> binf($x -> {sign}, @r);
}
return $wantarray ? ($x, $rem) : $x;
}
@@ -2015,12 +2258,12 @@ sub btdiv {
if ($x -> is_inf()) {
my $rem;
- $rem = $class -> bnan() if $wantarray;
+ $rem = $class -> bnan(@r) if $wantarray;
if ($y -> is_inf()) {
- $x -> bnan();
+ $x = $x -> bnan(@r);
} else {
my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
- $x -> binf($sign);
+ $x = $x -> binf($sign,@r );
}
return $wantarray ? ($x, $rem) : $x;
}
@@ -2040,13 +2283,15 @@ sub btdiv {
if ($y -> is_inf()) {
my $rem;
- $rem = $x -> copy() if $wantarray;
- $x -> bzero();
+ $rem = $x -> copy() -> round(@r) if $wantarray;
+ $x = $x -> bzero(@r);
return $wantarray ? ($x, $rem) : $x;
}
- return $upgrade -> btdiv($upgrade -> new($x), $upgrade -> new($y), @r)
- if defined $upgrade;
+ # Division might return a non-integer result, so upgrade unconditionally, if
+ # upgrading is enabled.
+
+ return $upgrade -> btdiv($x, $y, @r) if defined $upgrade;
$r[3] = $y; # no push!
@@ -2065,14 +2310,14 @@ sub btdiv {
$y -> {sign} = $ysign; # Re-insert the original sign.
if ($same) {
- $x -> bone();
+ $x = $x -> bone(@r);
} else {
($x -> {value}, $rem -> {value}) =
$LIB -> _div($x -> {value}, $y -> {value});
$x -> {sign} = $xsign eq $ysign ? '+' : '-';
$x -> {sign} = '+' if $LIB -> _is_zero($x -> {value});
- $x -> round(@r);
+ $x = $x -> round(@r);
}
if (wantarray) {
@@ -2080,7 +2325,7 @@ sub btdiv {
$rem -> {sign} = '+' if $LIB -> _is_zero($rem -> {value});
$rem -> {_a} = $x -> {_a};
$rem -> {_p} = $x -> {_p};
- $rem -> round(@r);
+ $rem = $rem -> round(@r);
return ($x, $rem);
}
@@ -2091,44 +2336,45 @@ sub bmod {
# This is the remainder after floored division.
# Set up parameters.
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
-
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x -> modify('bmod');
+
$r[3] = $y; # no push!
# At least one argument is NaN.
if ($x -> is_nan() || $y -> is_nan()) {
- return $x -> bnan();
+ return $x -> bnan(@r);
}
# Modulo zero. See documentation for bdiv().
if ($y -> is_zero()) {
- return $x;
+ return $x -> round(@r);
}
# Numerator (dividend) is +/-inf.
if ($x -> is_inf()) {
- return $x -> bnan();
+ return $x -> bnan(@r);
}
# Denominator (divisor) is +/-inf.
if ($y -> is_inf()) {
if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
- return $x;
+ return $x -> round(@r);
} else {
- return $x -> binf($y -> sign());
+ return $x -> binf($y -> sign(), @r);
}
}
+ return $upgrade -> bmod($x, $y, @r)
+ if defined($upgrade) && (!$x -> isa($class) || !$y -> isa($class));
+
# Calc new sign and in case $y == +/- 1, return $x.
$x -> {value} = $LIB -> _mod($x -> {value}, $y -> {value});
@@ -2147,41 +2393,38 @@ sub btmod {
# Remainder after truncated division.
# set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
-
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x -> modify('btmod');
# At least one argument is NaN.
if ($x -> is_nan() || $y -> is_nan()) {
- return $x -> bnan();
+ return $x -> bnan(@r);
}
# Modulo zero. See documentation for btdiv().
if ($y -> is_zero()) {
- return $x;
+ return $x -> round(@r);
}
# Numerator (dividend) is +/-inf.
if ($x -> is_inf()) {
- return $x -> bnan();
+ return $x -> bnan(@r);
}
# Denominator (divisor) is +/-inf.
if ($y -> is_inf()) {
- return $x;
+ return $x -> round(@r);
}
- return $upgrade -> btmod($upgrade -> new($x), $upgrade -> new($y), @r)
- if defined $upgrade;
+ return $upgrade -> btmod($x, $y, @r)
+ if defined($upgrade) && (!$x -> isa($class) || !$y -> isa($class));
$r[3] = $y; # no push!
@@ -2192,7 +2435,6 @@ sub btmod {
$x -> {sign} = $xsign;
$x -> {sign} = '+' if $LIB -> _is_zero($x -> {value});
$x -> round(@r);
- return $x;
}
sub bmodinv {
@@ -2208,28 +2450,29 @@ sub bmodinv {
# If no modular multiplicative inverse exists, NaN is returned.
# set up parameters
- my ($class, $x, $y, @r) = (undef, @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
return $x if $x->modify('bmodinv');
# Return NaN if one or both arguments is +inf, -inf, or nan.
- return $x->bnan() if ($y->{sign} !~ /^[+-]$/ ||
- $x->{sign} !~ /^[+-]$/);
+ return $x->bnan(@r) if ($y->{sign} !~ /^[+-]$/ ||
+ $x->{sign} !~ /^[+-]$/);
# Return NaN if $y is zero; 1 % 0 makes no sense.
- return $x->bnan() if $y->is_zero();
+ return $x->bnan(@r) if $y->is_zero();
# Return 0 in the trivial case. $x % 1 or $x % -1 is zero for all finite
# integers $x.
- return $x->bzero() if ($y->is_one() ||
- $y->is_one('-'));
+ return $x->bzero(@r) if ($y->is_one('+') ||
+ $y->is_one('-'));
+
+ return $upgrade -> bmodinv($x, $y, @r)
+ if defined($upgrade) && (!$x -> isa($class) || !$y -> isa($class));
# Return NaN if $x = 0, or $x modulo $y is zero. The only valid case when
# $x = 0 is when $y = 1 or $y = -1, but that was covered above.
@@ -2240,14 +2483,14 @@ sub bmodinv {
# $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.
- $x->bmod($y);
- return $x->bnan() if $x->is_zero();
+ $x = $x->bmod($y);
+ return $x->bnan(@r) if $x->is_zero();
# 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}) = $LIB->_modinv($x->{value}, $y->{value});
- return $x->bnan() if !defined $x->{value};
+ return $x->bnan(@r) if !defined($x->{value});
# Library inconsistency workaround: _modinv() in Math::BigInt::GMP versions
# <= 1.32 return undef rather than a "+" for the sign.
@@ -2266,20 +2509,23 @@ sub bmodinv {
# inverse modulo. The net effect is that we must swap the sign of the
# result if $y is negative.
- $x -> bneg() if $y->{sign} eq '-';
+ $x = $x -> bneg() if $y->{sign} eq '-';
# Compute $x modulo $y again after correcting the sign.
- $x -> bmod($y) if $x->{sign} ne $y->{sign};
+ $x = $x -> bmod($y) if $x->{sign} ne $y->{sign};
- return $x;
+ $x -> round(@r);
}
sub bmodpow {
- # Modular exponentiation. Raises 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, @_);
+ # Modular exponentiation. Raises 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)
+ = ref($_[0]) && ref($_[0]) eq ref($_[1]) && ref($_[1]) eq ref($_[2])
+ ? (ref($_[0]), @_)
+ : objectify(3, @_);
return $num if $num->modify('bmodpow');
@@ -2288,25 +2534,30 @@ sub bmodpow {
#
# b^(-e) (mod m) = d^e (mod m) where b*d = 1 (mod m)
- $num->bmodinv($mod) if ($exp->{sign} eq '-');
+ $num = $num -> bmodinv($mod) if ($exp->{sign} eq '-');
- # Check for valid input. All operands must be finite, and the modulus must be
- # non-zero.
+ # Check for valid input. All operands must be finite, and the modulus must
+ # be non-zero.
- return $num->bnan() if ($num->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf
- $exp->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf
- $mod->{sign} =~ /NaN|inf/); # NaN, -inf, +inf
+ return $num->bnan(@r) if ($num->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf
+ $exp->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf
+ $mod->{sign} =~ /NaN|inf/); # NaN, -inf, +inf
# Modulo zero. See documentation for Math::BigInt's bmod() method.
if ($mod -> is_zero()) {
if ($num -> is_zero()) {
- return $class -> bnan();
+ return $class -> bnan(@r);
} else {
- return $num -> copy();
+ return $num -> copy(@r);
}
}
+ return $upgrade -> bmodinv($num, $exp, $mod, @r)
+ if defined($upgrade) && (!$num -> isa($class) ||
+ !$exp -> isa($class) ||
+ !$mod -> ($class));
+
# Compute 'a (mod m)', ignoring the signs on 'a' and 'm'. If the resulting
# value is zero, the output is also zero, regardless of the signs on 'a' and
# 'm'.
@@ -2379,53 +2630,67 @@ sub bpow {
# modifies first argument
# set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
- return $x if $x->modify('bpow');
+ return $x if $x -> modify('bpow');
# $x and/or $y is a NaN
- return $x->bnan() if $x->is_nan() || $y->is_nan();
+ return $x -> bnan(@r) 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("+");
+ if ($x -> is_inf("-")) {
+ return $x -> bzero(@r) if $y -> is_negative();
+ return $x -> bnan(@r) if $y -> is_zero();
+ return $x -> round(@r) if $y -> is_odd();
+ return $x -> bneg(@r);
+ } elsif ($x -> is_inf("+")) {
+ return $x -> bzero(@r) if $y -> is_negative();
+ return $x -> bnan(@r) if $y -> is_zero();
+ return $x -> round(@r);
+ } elsif ($y -> is_inf("-")) {
+ return $x -> bnan(@r) if $x -> is_one("-");
+ return $x -> binf("+", @r) if $x -> is_zero();
+ return $x -> bone(@r) if $x -> is_one("+");
+ return $x -> bzero(@r);
+ } elsif ($y -> is_inf("+")) {
+ return $x -> bnan(@r) if $x -> is_one("-");
+ return $x -> bzero(@r) if $x -> is_zero();
+ return $x -> bone(@r) if $x -> is_one("+");
+ return $x -> binf("+", @r);
+ }
+
+ if ($x -> is_zero()) {
+ return $x -> bone(@r) if $y -> is_zero();
+ return $x -> binf(@r) if $y -> is_negative();
+ return $x -> round(@r);
}
- return $upgrade->bpow($upgrade->new($x), $y, @r)
- if defined $upgrade && (!$y->isa($class) || $y->{sign} eq '-');
+ if ($x -> is_one("+")) {
+ return $x -> round(@r);
+ }
- $r[3] = $y; # no push!
+ if ($x -> is_one("-")) {
+ return $x -> round(@r) if $y -> is_odd();
+ return $x -> bneg(@r);
+ }
- # 0 ** -y => ( 1 / (0 ** y)) => 1 / 0 => +inf
- return $x->binf() if $y->is_negative() && $x->is_zero();
+ return $upgrade -> bpow($x, $y, @r) if defined $upgrade;
- # 1 ** -y => 1 / (1 ** |y|)
- return $x->bzero() if $y->is_negative() && !$LIB->_is_one($x->{value});
+ # We don't support finite non-integers, so return zero. The reason for
+ # returning zero, not NaN, is that all output is in the open interval (0,1),
+ # and truncating that to integer gives zero.
- $x->{value} = $LIB->_pow($x->{value}, $y->{value});
- $x->{sign} = $x->is_negative() && $y->is_odd() ? '-' : '+';
- $x->round(@r);
+ if ($y->{sign} eq '-' || !$y -> isa($class)) {
+ return $x -> bzero(@r);
+ }
+
+ $r[3] = $y; # no push!
+
+ $x->{value} = $LIB -> _pow($x->{value}, $y->{value});
+ $x->{sign} = $x -> is_negative() && $y -> is_odd() ? '-' : '+';
+ $x -> round(@r);
}
sub blog {
@@ -2438,12 +2703,12 @@ sub blog {
# Don't objectify the base, since an undefined base, as in $x->blog() or
# $x->blog(undef) signals that the base is Euler's number.
- if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
+ if (!ref($_[0]) && $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i) {
# E.g., Math::BigInt->blog(256, 2)
($class, $x, $base, @r) =
defined $_[2] ? objectify(2, @_) : objectify(1, @_);
} else {
- # E.g., Math::BigInt::blog(256, 2) or $x->blog(2)
+ # E.g., $x->blog(2) or the deprecated Math::BigInt::blog(256, 2)
($class, $x, $base, @r) =
defined $_[1] ? objectify(2, @_) : objectify(1, @_);
}
@@ -2453,80 +2718,70 @@ sub blog {
# Handle all exception cases and all trivial cases. I have used Wolfram
# Alpha (http://www.wolframalpha.com) as the reference for these cases.
- return $x -> bnan() if $x -> is_nan();
+ return $x -> bnan(@r) if $x -> is_nan();
if (defined $base) {
$base = $class -> new($base) unless ref $base;
if ($base -> is_nan() || $base -> is_one()) {
- return $x -> bnan();
+ return $x -> bnan(@r);
} elsif ($base -> is_inf() || $base -> is_zero()) {
- return $x -> bnan() if $x -> is_inf() || $x -> is_zero();
- return $x -> bzero();
- } elsif ($base -> is_negative()) { # -inf < base < 0
- return $x -> bzero() if $x -> is_one(); # x = 1
- return $x -> bone() if $x == $base; # x = base
- return $x -> bnan(); # otherwise
+ return $x -> bnan(@r) if $x -> is_inf() || $x -> is_zero();
+ return $x -> bzero(@r);
+ } elsif ($base -> is_negative()) { # -inf < base < 0
+ return $x -> bzero(@r) if $x -> is_one(); # x = 1
+ return $x -> bone(@r) if $x == $base; # x = base
+ return $x -> bnan(@r); # otherwise
}
- return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf
+ return $x -> bone(@r) if $x == $base; # 0 < base && 0 < x < inf
}
# We now know that the base is either undefined or >= 2 and finite.
- return $x -> binf('+') if $x -> is_inf(); # x = +/-inf
- return $x -> bnan() if $x -> is_neg(); # -inf < x < 0
- return $x -> bzero() if $x -> is_one(); # x = 1
- return $x -> binf('-') if $x -> is_zero(); # x = 0
+ return $x -> binf('+', @r) if $x -> is_inf(); # x = +/-inf
+ return $x -> bnan(@r) if $x -> is_neg(); # -inf < x < 0
+ return $x -> bzero(@r) if $x -> is_one(); # x = 1
+ return $x -> binf('-', @r) if $x -> is_zero(); # x = 0
# At this point we are done handling all exception cases and trivial cases.
- return $upgrade -> blog($upgrade -> new($x), $base, @r) if defined $upgrade;
+ return $upgrade -> blog($x, $base, @r) if defined $upgrade;
# fix for bug #24969:
# the default base is e (Euler's number) which is not an integer
if (!defined $base) {
require Math::BigFloat;
- my $u = Math::BigFloat->blog(Math::BigFloat->new($x))->as_int();
+ my $u = Math::BigFloat->blog($x)->as_int();
# modify $x in place
$x->{value} = $u->{value};
$x->{sign} = $u->{sign};
- return $x;
+ return $x -> round(@r);
}
my ($rc) = $LIB->_log_int($x->{value}, $base->{value});
- return $x->bnan() unless defined $rc; # not possible to take log?
+ return $x->bnan(@r) unless defined $rc; # not possible to take log?
$x->{value} = $rc;
- $x->round(@r);
+ $x = $x -> round(@r);
}
sub bexp {
# Calculate e ** $x (Euler's number to the power of X), truncated to
# an integer value.
my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
return $x if $x->modify('bexp');
# inf, -inf, NaN, <0 => NaN
- return $x->bnan() if $x->{sign} eq 'NaN';
- return $x->bone() if $x->is_zero();
- return $x if $x->{sign} eq '+inf';
- return $x->bzero() if $x->{sign} eq '-inf';
+ return $x -> bnan(@r) if $x->{sign} eq 'NaN';
+ return $x -> bone(@r) if $x->is_zero();
+ return $x -> round(@r) if $x->{sign} eq '+inf';
+ return $x -> bzero(@r) if $x->{sign} eq '-inf';
- my $u;
- {
- # run through Math::BigFloat unless told otherwise
- require Math::BigFloat unless defined $upgrade;
- local $upgrade = 'Math::BigFloat' unless defined $upgrade;
- # calculate result, truncate it to integer
- $u = $upgrade->bexp($upgrade->new($x), @r);
- }
+ return $upgrade -> bexp($x, @r) if defined $upgrade;
- if (defined $upgrade) {
- $x = $u;
- } else {
- $u = $u->as_int();
- # modify $x in place
- $x->{value} = $u->{value};
- $x->round(@r);
- }
+ require Math::BigFloat;
+ my $tmp = Math::BigFloat -> bexp($x, @r) -> as_int();
+ $x->{value} = $tmp->{value};
+ return $x -> round(@r);
}
sub bnok {
@@ -2534,49 +2789,51 @@ sub bnok {
# integer.
# Set up parameters.
- my ($self, $n, $k, @r) = (ref($_[0]), @_);
+ my ($class, $n, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_)
+ : objectify(2, @_);
- # Objectify is costly, so avoid it.
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($self, $n, $k, @r) = objectify(2, @_);
- }
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return $n if $n->modify('bnok');
# All cases where at least one argument is NaN.
- return $n->bnan() if $n->{sign} eq 'NaN' || $k->{sign} eq 'NaN';
+ return $n->bnan(@r) if $n->{sign} eq 'NaN' || $k->{sign} eq 'NaN';
# All cases where at least one argument is +/-inf.
if ($n -> is_inf()) {
if ($k -> is_inf()) { # bnok(+/-inf,+/-inf)
- return $n -> bnan();
+ return $n -> bnan(@r);
} elsif ($k -> is_neg()) { # bnok(+/-inf,k), k < 0
- return $n -> bzero();
+ return $n -> bzero(@r);
} elsif ($k -> is_zero()) { # bnok(+/-inf,k), k = 0
- return $n -> bone();
+ return $n -> bone(@r);
} else {
- if ($n -> is_inf("+")) { # bnok(+inf,k), 0 < k < +inf
+ if ($n -> is_inf("+", @r)) { # bnok(+inf,k), 0 < k < +inf
return $n -> binf("+");
} else { # bnok(-inf,k), k > 0
my $sign = $k -> is_even() ? "+" : "-";
- return $n -> binf($sign);
+ return $n -> binf($sign, @r);
}
}
}
elsif ($k -> is_inf()) { # bnok(n,+/-inf), -inf <= n <= inf
- return $n -> bnan();
+ return $n -> bnan(@r);
}
# At this point, both n and k are real numbers.
+ return $upgrade -> bnok($n, $k, @r)
+ if defined($upgrade) && (!$n -> isa($class) || !$k -> isa($class));
+
my $sign = 1;
if ($n >= 0) {
if ($k < 0 || $k > $n) {
- return $n -> bzero();
+ return $n -> bzero(@r);
}
} else {
@@ -2585,7 +2842,7 @@ sub bnok {
# n < 0 and k >= 0: bnok(n,k) = (-1)^k * bnok(-n+k-1,k)
$sign = (-1) ** $k;
- $n -> bneg() -> badd($k) -> bdec();
+ $n = $n -> bneg() -> badd($k) -> bdec();
} elsif ($k <= $n) {
@@ -2593,22 +2850,22 @@ sub bnok {
$sign = (-1) ** ($n - $k);
my $x0 = $n -> copy();
- $n -> bone() -> badd($k) -> bneg();
+ $n = $n -> bone() -> badd($k) -> bneg();
$k = $k -> copy();
- $k -> bneg() -> badd($x0);
+ $k = $k -> bneg() -> badd($x0);
} else {
# n < 0 and n < k < 0:
- return $n -> bzero();
+ return $n -> bzero(@r);
}
}
$n->{value} = $LIB->_nok($n->{value}, $k->{value});
- $n -> bneg() if $sign == -1;
+ $n = $n -> bneg() if $sign == -1;
- $n->round(@r);
+ $n -> round(@r);
}
sub buparrow {
@@ -2721,9 +2978,9 @@ sub ackermann {
} elsif ($m == $three) {
$n = $class -> bone() -> blsft($n + $three) -> bsub($three);
} elsif ($m == $two) {
- $n -> bmul($two) -> badd($three);
+ $n = $n -> bmul($two) -> badd($three);
} elsif ($m >= 0) {
- $n -> badd($m) -> binc();
+ $n = $n -> badd($m) -> binc();
} else {
die "negative m!";
}
@@ -2732,109 +2989,102 @@ sub ackermann {
}
sub bsin {
- # Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the
+ # Calculate sin(x) to N digits. Unless upgrading is in effect, returns the
# result truncated to an integer.
- my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bsin');
- return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x->bnan(@r) if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x->bzero(@r) if $x->is_zero();
- return $upgrade->new($x)->bsin(@r) if defined $upgrade;
+ return $upgrade -> bsin($x, @r) if defined $upgrade;
require Math::BigFloat;
# calculate the result and truncate it to integer
my $t = Math::BigFloat->new($x)->bsin(@r)->as_int();
- $x->bone() if $t->is_one();
- $x->bzero() if $t->is_zero();
+ $x = $x->bone(@r) if $t->is_one();
+ $x = $x->bzero(@r) if $t->is_zero();
$x->round(@r);
}
sub bcos {
- # Calculate cosinus(x) to N digits. Unless upgrading is in effect, returns the
+ # Calculate cos(x) to N digits. Unless upgrading is in effect, returns the
# result truncated to an integer.
- my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bcos');
- return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x->bnan(@r) if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x->bone(@r) if $x->is_zero();
- return $upgrade->new($x)->bcos(@r) if defined $upgrade;
+ return $upgrade -> bcos($x, @r) if defined $upgrade;
require Math::BigFloat;
- # calculate the result and truncate it to integer
- my $t = Math::BigFloat->new($x)->bcos(@r)->as_int();
-
- $x->bone() if $t->is_one();
- $x->bzero() if $t->is_zero();
- $x->round(@r);
+ my $tmp = Math::BigFloat -> bcos($x, @r) -> as_int();
+ $x->{value} = $tmp->{value};
+ return $x -> round(@r);
}
sub batan {
- # Calculate arcus tangens of x to N digits. Unless upgrading is in effect, returns the
- # result truncated to an integer.
- my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ # Calculate arctan(x) to N digits. Unless upgrading is in effect, returns
+ # the result truncated to an integer.
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('batan');
- return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x -> bnan(@r) if $x -> is_nan();
+ return $x -> bzero(@r) if $x -> is_zero();
- return $upgrade->new($x)->batan(@r) if defined $upgrade;
+ return $upgrade -> batan($x, @r) if defined $upgrade;
- # calculate the result and truncate it to integer
- my $tmp = Math::BigFloat->new($x)->batan(@r);
+ return $x -> bone("+", @r) if $x -> bgt("1");
+ return $x -> bone("-", @r) if $x -> blt("-1");
- $x->{value} = $LIB->_new($tmp->as_int()->bstr());
- $x->round(@r);
+ $x -> bzero(@r);
}
sub batan2 {
# calculate arcus tangens of ($y/$x)
- # set up parameters
- my ($class, $y, $x, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $y, $x, @r) = objectify(2, @_);
- }
+ my ($class, $y, $x, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_) : objectify(2, @_);
return $y if $y->modify('batan2');
return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan);
+ return $upgrade->batan2($y, $x, @r) if defined $upgrade;
+
# Y X
# != 0 -inf result is +- pi
if ($x->is_inf() || $y->is_inf()) {
- # upgrade to Math::BigFloat etc.
- return $upgrade->new($y)->batan2($upgrade->new($x), @r) if defined $upgrade;
if ($y->is_inf()) {
if ($x->{sign} eq '-inf') {
# calculate 3 pi/4 => 2.3.. => 2
- $y->bone(substr($y->{sign}, 0, 1));
- $y->bmul($class->new(2));
+ $y = $y->bone(substr($y->{sign}, 0, 1));
+ $y = $y->bmul($class->new(2));
} elsif ($x->{sign} eq '+inf') {
# calculate pi/4 => 0.7 => 0
- $y->bzero();
+ $y = $y->bzero();
} else {
# calculate pi/2 => 1.5 => 1
- $y->bone(substr($y->{sign}, 0, 1));
+ $y = $y->bone(substr($y->{sign}, 0, 1));
}
} else {
if ($x->{sign} eq '+inf') {
# calculate pi/4 => 0.7 => 0
- $y->bzero();
+ $y = $y->bzero();
} else {
# PI => 3.1415.. => 3
- $y->bone(substr($y->{sign}, 0, 1));
- $y->bmul($class->new(3));
+ $y = $y->bone(substr($y->{sign}, 0, 1));
+ $y = $y->bmul($class->new(3));
}
}
return $y;
}
- return $upgrade->new($y)->batan2($upgrade->new($x), @r) if defined $upgrade;
-
require Math::BigFloat;
my $r = Math::BigFloat->new($y)
->batan2(Math::BigFloat->new($x), @r)
@@ -2843,17 +3093,17 @@ sub batan2 {
$x->{value} = $r->{value};
$x->{sign} = $r->{sign};
- $x;
+ $x->round(@r);
}
sub bsqrt {
# calculate square root of $x
- my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bsqrt');
- return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN
- return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf
+ return $x->bnan(@r) if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN
+ return $x->round(@r) if $x->{sign} eq '+inf'; # sqrt(+inf) == inf
return $upgrade->bsqrt($x, @r) if defined $upgrade;
@@ -2865,25 +3115,22 @@ sub broot {
# calculate $y'th root of $x
# set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
- $y = $class->new(2) unless defined $y;
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_) : objectify(2, @_);
- # objectify is costly, so avoid it
- if ((!ref($x)) || (ref($x) ne ref($y))) {
- ($class, $x, $y, @r) = objectify(2, $class || $class, @_);
- }
+ $y = $class->new(2) unless defined $y;
return $x if $x->modify('broot');
# NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
- return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
- $y->{sign} !~ /^\+$/;
+ return $x->bnan(@r) if $x->{sign} !~ /^\+/ || $y->is_zero() ||
+ $y->{sign} !~ /^\+$/;
return $x->round(@r)
if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
- return $upgrade->new($x)->broot($upgrade->new($y), @r) if defined $upgrade;
+ return $upgrade->broot($x, $y, @r) if defined $upgrade;
$x->{value} = $LIB->_root($x->{value}, $y->{value});
$x->round(@r);
@@ -2892,10 +3139,14 @@ sub broot {
sub bfac {
# (BINT or num_str, BINT or num_str) return BINT
# compute factorial number from $x, modify $x in place
- my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf
- return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
+
+ return $x->bnan(@r) if $x->{sign} ne '+'; # NaN, <0 => NaN
+
+ return $upgrade -> bfac($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
$x->{value} = $LIB->_fac($x->{value});
$x->round(@r);
@@ -2903,10 +3154,15 @@ sub bfac {
sub bdfac {
# compute double factorial, modify $x in place
- my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bdfac') || $x->{sign} eq '+inf'; # inf => inf
- return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
+
+ return $x->bnan(@r) if $x->is_nan() || $x <= -2;
+ return $x->bone(@r) if $x <= 1;
+
+ return $upgrade -> bdfac($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
croak("bdfac() requires a newer version of the $LIB library.")
unless $LIB->can('_dfac');
@@ -2915,21 +3171,69 @@ sub bdfac {
$x->round(@r);
}
+sub btfac {
+ # compute triple factorial, modify $x in place
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ return $x if $x->modify('btfac') || $x->{sign} eq '+inf'; # inf => inf
+
+ return $x->bnan(@r) if $x->is_nan();
+
+ return $upgrade -> btfac($x, @r) if defined($upgrade) && !$x -> isa($class);
+
+ my $k = $class -> new("3");
+ return $x->bnan(@r) if $x <= -$k;
+
+ my $one = $class -> bone();
+ return $x->bone(@r) if $x <= $one;
+
+ my $f = $x -> copy();
+ while ($f -> bsub($k) > $one) {
+ $x = $x -> bmul($f);
+ }
+ $x->round(@r);
+}
+
+sub bmfac {
+ # compute multi-factorial
+
+ my ($class, $x, $k, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_) : objectify(2, @_);
+
+ return $x if $x->modify('bmfac') || $x->{sign} eq '+inf';
+ return $x->bnan(@r) if $x->is_nan() || $k->is_nan() || $k < 1 || $x <= -$k;
+
+ return $upgrade -> bmfac($x, $k, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ my $one = $class -> bone();
+ return $x->bone(@r) if $x <= $one;
+
+ my $f = $x -> copy();
+ while ($f -> bsub($k) > $one) {
+ $x = $x -> bmul($f);
+ }
+ $x->round(@r);
+}
+
sub bfib {
# compute Fibonacci number(s)
- my ($class, $x, @r) = objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
croak("bfib() requires a newer version of the $LIB library.")
unless $LIB->can('_fib');
return $x if $x->modify('bfib');
+ return $upgrade -> bfib($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
# List context.
if (wantarray) {
- return () if $x -> is_nan();
+ return () if $x -> is_nan();
croak("bfib() can't return an infinitely long list of numbers")
- if $x -> is_inf();
+ if $x -> is_inf();
# Use the backend library to compute the first $x Fibonacci numbers.
@@ -2939,7 +3243,7 @@ sub bfib {
# invocand.
for (my $i = 0 ; $i < $#values ; ++ $i) {
- my $fib = $class -> bzero();
+ my $fib = $class -> bzero();
$fib -> {value} = $values[$i];
$values[$i] = $fib;
}
@@ -2973,13 +3277,16 @@ sub bfib {
sub blucas {
# compute Lucas number(s)
- my ($class, $x, @r) = objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
croak("blucas() requires a newer version of the $LIB library.")
unless $LIB->can('_lucas');
return $x if $x->modify('blucas');
+ return $upgrade -> blucas($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
# List context.
if (wantarray) {
@@ -3050,8 +3357,19 @@ sub blsft {
return $x -> bnan() if ($x -> {sign} !~ /^[+-]$/ ||
$y -> {sign} !~ /^[+-]$/);
return $x -> round(@r) if $y -> is_zero();
+ return $x -> bzero(@r) if $x -> is_zero(); # 0 => 0
+
+ $b = 2 if !defined $b;
+ return $x -> bnan(@r) if $b <= 0 || $y -> {sign} eq '-';
+ $b = $class -> new($b) unless defined(blessed($b));
- $b = defined($b) ? $b -> numify() : 2;
+ #return $upgrade -> blsft($x, $y, $b, @r)
+ # if defined($upgrade) && (!$x -> isa($class) ||
+ # !$y -> isa($class) ||
+ # !$b -> isa($class));
+
+ # shift by a negative amount?
+ #return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;
# While some of the libraries support an arbitrarily large base, not all of
# them do, so rather than returning an incorrect result in those cases,
@@ -3060,6 +3378,8 @@ sub blsft {
my $uintmax = ~0;
croak("Base is too large.") if $b > $uintmax;
+ $b = $b -> numify();
+
return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-';
$x -> {value} = $LIB -> _lsft($x -> {value}, $y -> {value}, $b);
@@ -3070,21 +3390,48 @@ sub brsft {
# (BINT or num_str, BINT or num_str) return BINT
# compute x >> y, base n, y >= 0
- # set up parameters
my ($class, $x, $y, $b, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, $b, @r) = objectify(2, @_);
+ # Objectify the base only when it is defined, since an undefined base, as
+ # in $x->blsft(3) or $x->blog(3, undef) means use the default base 2.
+
+ if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
+ # E.g., Math::BigInt->blog(256, 5, 2)
+ ($class, $x, $y, $b, @r) =
+ defined $_[3] ? objectify(3, @_) : objectify(2, @_);
+ } else {
+ # E.g., Math::BigInt::blog(256, 5, 2) or $x->blog(5, 2)
+ ($class, $x, $y, $b, @r) =
+ defined $_[2] ? objectify(3, @_) : objectify(2, @_);
}
return $x if $x -> modify('brsft');
- return $x -> bnan() if ($x -> {sign} !~ /^[+-]$/ || $y -> {sign} !~ /^[+-]$/);
+ return $x -> bnan(@r) if $x -> {sign} !~ /^[+-]$/ ||
+ $y -> {sign} !~ /^[+-]$/;
return $x -> round(@r) if $y -> is_zero();
return $x -> bzero(@r) if $x -> is_zero(); # 0 => 0
$b = 2 if !defined $b;
- return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-';
+ return $x -> bnan(@r) if $b <= 0 || $y -> {sign} eq '-';
+ $b = $class -> new($b) unless defined(blessed($b));
+
+ # Shifting right by a positive amount might lead to a non-integer result, so
+ # include this case in the test.
+
+ return $upgrade -> brsft($x, $y, $b, @r)
+ if defined($upgrade) && (!$x -> isa($class) ||
+ !$y -> isa($class) ||
+ !$b -> isa($class) ||
+ $y -> is_pos());
+
+ # While some of the libraries support an arbitrarily large base, not all of
+ # them do, so rather than returning an incorrect result in those cases,
+ # disallow bases that don't work with all libraries.
+
+ my $uintmax = ~0;
+ croak("Base is too large.") if $b > $uintmax;
+
+ $b = $b -> numify();
# this only works for negative numbers when shifting in base 2
if (($x -> {sign} eq '-') && ($b == 2)) {
@@ -3095,7 +3442,7 @@ sub brsft {
# shift...
# if $y != 1, we must simulate it by doing:
# convert to bin, flip all bits, shift, and be done
- $x -> binc(); # -3 => -2
+ $x = $x -> binc(); # -3 => -2
my $bin = $x -> as_bin();
$bin =~ s/^-0b//; # strip '-0b' prefix
$bin =~ tr/10/01/; # flip bits
@@ -3111,13 +3458,13 @@ sub brsft {
$bin =~ tr/10/01/; # flip bits back
}
my $res = $class -> new('0b' . $bin); # add prefix and convert back
- $res -> binc(); # remember to increment
+ $res = $res -> binc(); # remember to increment
$x -> {value} = $res -> {value}; # take over value
return $x -> round(@r); # we are done now, magic, isn't?
}
# x < 0, n == 2, y == 1
- $x -> bdec(); # n == 2, but $y == 1: this fixes it
+ $x = $x -> bdec(); # n == 2, but $y == 1: this fixes it
}
$x -> {value} = $LIB -> _rsft($x -> {value}, $y -> {value}, $b);
@@ -3132,18 +3479,18 @@ sub band {
#(BINT or num_str, BINT or num_str) return BINT
# compute x & y
- # set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_) : objectify(2, @_);
return $x if $x->modify('band');
+ return $upgrade -> band($x, $y, @r)
+ if defined($upgrade) && (!$x -> isa($class) ||
+ !$y -> isa($class));
+
$r[3] = $y; # no push!
- return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
+ return $x->bnan(@r) if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/;
if ($x->{sign} eq '+' && $y->{sign} eq '+') {
$x->{value} = $LIB->_and($x->{value}, $y->{value});
@@ -3158,15 +3505,15 @@ sub bior {
#(BINT or num_str, BINT or num_str) return BINT
# compute x | y
- # set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_) : objectify(2, @_);
return $x if $x->modify('bior');
+ return $upgrade -> bior($x, $y, @r)
+ if defined($upgrade) && (!$x -> isa($class) ||
+ !$y -> isa($class));
+
$r[3] = $y; # no push!
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
@@ -3184,18 +3531,18 @@ sub bxor {
#(BINT or num_str, BINT or num_str) return BINT
# compute x ^ y
- # set up parameters
- my ($class, $x, $y, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
- }
+ my ($class, $x, $y, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_) : objectify(2, @_);
return $x if $x->modify('bxor');
+ return $upgrade -> bxor($x, $y, @r)
+ if defined($upgrade) && (!$x -> isa($class) ||
+ !$y -> isa($class));
+
$r[3] = $y; # no push!
- return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
+ return $x->bnan(@r) if $x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/;
if ($x->{sign} eq '+' && $y->{sign} eq '+') {
$x->{value} = $LIB->_xor($x->{value}, $y->{value});
@@ -3209,11 +3556,14 @@ sub bxor {
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) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
return $x if $x->modify('bnot');
- $x->binc()->bneg(); # binc already does round
+
+ return $upgrade -> bnot($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ $x -> binc() -> bneg(@r);
}
###############################################################################
@@ -3224,22 +3574,39 @@ sub round {
# Round $self according to given parameters, or given second argument's
# parameters or global defaults
- # for speed reasons, _find_round_parameters is embedded here:
+ my ($class, $self, @args) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ # $x->round(undef, undef) signals no rounding
+
+ if (@args >= 2 && @args <= 3 && !defined($args[0]) && !defined($args[1])) {
+ $self->{_a} = undef;
+ $self->{_p} = undef;
+ return $self;
+ }
+
+ my ($a, $p, $r) = splice @args, 0, 3;
- my ($self, $a, $p, $r, @args) = @_;
# $a accuracy, if given by caller
# $p precision, if given by caller
# $r round_mode, if given by caller
# @args all 'other' arguments (0 for unary, 1 for binary ops)
- my $class = ref($self); # find out class of argument(s)
- no strict 'refs';
+ if (defined $a) {
+ croak "accuracy must be a number, not '$a'"
+ unless $a =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
+ }
+
+ if (defined $p) {
+ croak "precision must be a number, not '$p'"
+ unless $p =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
+ }
# now pick $a or $p, but only if we have got "arguments"
if (!defined $a) {
foreach ($self, @args) {
# take the defined one, or if both defined, the one that is smaller
- $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
+ $a = $_->{_a}
+ if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
}
}
if (!defined $p) {
@@ -3247,10 +3614,13 @@ sub round {
foreach ($self, @args) {
# take the defined one, or if both defined, the one that is bigger
# -2 > -3, and 3 > 2
- $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
+ $p = $_->{_p}
+ if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
}
}
+ no strict 'refs';
+
# if still none defined, use globals
unless (defined $a || defined $p) {
$a = ${"$class\::accuracy"};
@@ -3273,9 +3643,11 @@ sub round {
# now round, by calling either bround or bfround:
if (defined $a) {
- $self->bround(int($a), $r) if !defined $self->{_a} || $self->{_a} >= $a;
+ $self = $self->bround(int($a), $r)
+ if !defined $self->{_a} || $self->{_a} >= $a;
} else { # both can't be undefined due to early out
- $self->bfround(int($p), $r) if !defined $self->{_p} || $self->{_p} <= $p;
+ $self = $self->bfround(int($p), $r)
+ if !defined $self->{_p} || $self->{_p} <= $p;
}
# bround() or bfround() already called bnorm() if nec.
@@ -3289,9 +3661,9 @@ sub bround {
# and overwrite the rest with 0's, return normalized number
# do not return $x->bnorm(), but $x
- my $x = shift;
- $x = __PACKAGE__->new($x) unless ref $x;
- my ($scale, $mode) = $x->_scale_a(@_);
+ my ($class, $x, @a) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ my ($scale, $mode) = $x->_scale_a(@a);
return $x if !defined $scale || $x->modify('bround'); # no-op
if ($x->is_zero() || $scale == 0) {
@@ -3303,8 +3675,8 @@ sub bround {
# we have fewer digits than we want to scale to
my $len = $x->length();
# convert $scale to a scalar in case it is an object (put's a limit on the
- # number length, but this would already limited by memory constraints), makes
- # it faster
+ # number length, but this would already limited by memory constraints),
+ # makes it faster
$scale = $scale->numify() if ref ($scale);
# scale < 0, but > -len (not >=!)
@@ -3352,9 +3724,10 @@ sub bround {
if (($pad > 0) && ($pad <= $len)) {
substr($xs, -$pad, $pad) = '0' x $pad; # replace with '00...'
+ $xs =~ s/^0+(\d)/$1/; # "00000" -> "0"
$put_back = 1; # need to put back
} elsif ($pad > $len) {
- $x->bzero(); # round to '0'
+ $x = $x->bzero(); # round to '0'
}
if ($round_up) { # what gave test above?
@@ -3373,7 +3746,6 @@ sub bround {
last if $c != 0; # no overflow => early out
}
$xs = '1'.$xs if $c == 0;
-
}
$x->{value} = $LIB->_new($xs) if $put_back == 1; # put back, if needed
@@ -3388,16 +3760,15 @@ sub bround {
sub bfround {
# precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
# $n == 0 || $n == 1 => round to integer
- my $x = shift;
- my $class = ref($x) || $x;
- $x = $class->new($x) unless ref $x;
- my ($scale, $mode) = $x->_scale_p(@_);
+ my ($class, $x, @p) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ my ($scale, $mode) = $x->_scale_p(@p);
return $x if !defined $scale || $x->modify('bfround'); # no-op
# no-op for Math::BigInt objects if $n <= 0
- $x->bround($x->length()-$scale, $mode) if $scale > 0;
+ $x = $x->bround($x->length()-$scale, $mode) if $scale > 0;
delete $x->{_a}; # delete to save memory
$x->{_p} = $scale; # store new _p
@@ -3414,21 +3785,30 @@ sub fround {
sub bfloor {
# round towards minus infinity; no-op since it's already integer
- my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ return $upgrade -> bfloor($x)
+ if defined($upgrade) && !$x -> isa($class);
$x->round(@r);
}
sub bceil {
# round towards plus infinity; no-op since it's already int
- my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ return $upgrade -> bceil($x)
+ if defined($upgrade) && !$x -> isa($class);
$x->round(@r);
}
sub bint {
# round towards zero; no-op since it's already integer
- my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ return $upgrade -> bint($x)
+ if defined($upgrade) && !$x -> isa($class);
$x->round(@r);
}
@@ -3442,8 +3822,30 @@ sub bgcd {
# does not modify arguments, but returns new object
# GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff)
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
+ unshift @_, __PACKAGE__;
+ }
+
my ($class, @args) = objectify(0, @_);
+ # Upgrade?
+
+ if (defined $upgrade) {
+ my $do_upgrade = 0;
+ for my $arg (@args) {
+ unless ($arg -> isa($class)) {
+ $do_upgrade = 1;
+ last;
+ }
+ }
+ return $upgrade -> bgcd(@args) if $do_upgrade;
+ }
+
my $x = shift @args;
$x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x);
@@ -3465,8 +3867,30 @@ sub blcm {
# does not modify arguments, but returns new object
# Least Common Multiple
+ # Class::method(...) -> Class->method(...)
+ unless (@_ && (defined(blessed($_[0])) && $_[0] -> isa(__PACKAGE__) ||
+ $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i))
+ {
+ #carp "Using ", (caller(0))[3], "() as a function is deprecated;",
+ # " use is as a method instead";
+ unshift @_, __PACKAGE__;
+ }
+
my ($class, @args) = objectify(0, @_);
+ # Upgrade?
+
+ if (defined $upgrade) {
+ my $do_upgrade = 0;
+ for my $arg (@args) {
+ unless ($arg -> isa($class)) {
+ $do_upgrade = 1;
+ last;
+ }
+ }
+ return $upgrade -> blcm(@args) if $do_upgrade;
+ }
+
my $x = shift @args;
$x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x);
return $class->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN?
@@ -3487,14 +3911,18 @@ sub blcm {
sub sign {
# return the sign of the number: +/-/-inf/+inf/NaN
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
$x->{sign};
}
sub digit {
# return the nth decimal digit, negative values count backward, 0 is right
- my ($class, $x, $n) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+ my (undef, $x, $n, @r) = ref($_[0]) ? (undef, @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
$n = $n->numify() if ref($n);
$LIB->_digit($x->{value}, $n || 0);
@@ -3502,7 +3930,9 @@ sub digit {
sub bdigitsum {
# like digitsum(), but assigns the result to the invocand
- my $x = shift;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return $x if $x -> is_nan();
return $x -> bnan() if $x -> is_inf();
@@ -3514,19 +3944,22 @@ sub bdigitsum {
sub digitsum {
# compute sum of decimal digits and return it
- my $x = shift;
- my $class = ref $x;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return $class -> bnan() if $x -> is_nan();
return $class -> bnan() if $x -> is_inf();
my $y = $class -> bzero();
$y -> {value} = $LIB -> _digitsum($x -> {value});
- return $y;
+ $y -> round(@r);
}
sub length {
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
my $e = $LIB->_len($x->{value});
wantarray ? ($e, 0) : $e;
@@ -3534,26 +3967,40 @@ sub length {
sub exponent {
# return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Upgrade?
+
+ return $upgrade -> exponent($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
if ($x->{sign} !~ /^[+-]$/) {
my $s = $x->{sign};
$s =~ s/^[+-]//; # NaN, -inf, +inf => NaN or inf
- return $class->new($s);
+ return $class->new($s, @r);
}
- return $class->bzero() if $x->is_zero();
+ return $class->bzero(@r) if $x->is_zero();
# 12300 => 2 trailing zeros => exponent is 2
- $class->new($LIB->_zeros($x->{value}));
+ $class->new($LIB->_zeros($x->{value}), @r);
}
sub mantissa {
# return the mantissa (compatible to Math::BigFloat, e.g. reduced)
- my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Upgrade?
+
+ return $upgrade -> mantissa($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
if ($x->{sign} !~ /^[+-]$/) {
# for NaN, +inf, -inf: keep the sign
- return $class->new($x->{sign});
+ return $class->new($x->{sign}, @r);
}
my $m = $x->copy();
delete $m->{_p};
@@ -3561,92 +4008,100 @@ sub mantissa {
# that's a bit inefficient:
my $zeros = $LIB->_zeros($m->{value});
- $m->brsft($zeros, 10) if $zeros != 0;
- $m;
+ $m = $m->brsft($zeros, 10) if $zeros != 0;
+ $m -> round(@r);
}
sub parts {
# return a copy of both the exponent and the mantissa
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Upgrade?
- ($x->mantissa(), $x->exponent());
+ return $upgrade -> parts($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ ($x->mantissa(@r), $x->exponent(@r));
}
+# Parts used for scientific notation with significand/mantissa and exponent as
+# integers. E.g., "12345.6789" is returned as "123456789" (mantissa) and "-4"
+# (exponent).
+
sub sparts {
- my $self = shift;
- my $class = ref $self;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- croak("sparts() is an instance method, not a class method")
- unless $class;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
# Not-a-number.
- if ($self -> is_nan()) {
- my $mant = $self -> copy(); # mantissa
+ if ($x -> is_nan()) {
+ my $mant = $class -> bnan(@r); # mantissa
return $mant unless wantarray; # scalar context
- my $expo = $class -> bnan(); # exponent
+ my $expo = $class -> bnan(@r); # exponent
return ($mant, $expo); # list context
}
# Infinity.
- if ($self -> is_inf()) {
- my $mant = $self -> copy(); # mantissa
- return $mant unless wantarray; # scalar context
- my $expo = $class -> binf('+'); # exponent
- return ($mant, $expo); # list context
+ if ($x -> is_inf()) {
+ my $mant = $class -> binf($x->{sign}, @r); # mantissa
+ return $mant unless wantarray; # scalar context
+ my $expo = $class -> binf('+', @r); # exponent
+ return ($mant, $expo); # list context
}
+ # Upgrade?
+
+ return $upgrade -> sparts($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
# Finite number.
- my $mant = $self -> copy();
+ my $mant = $x -> copy();
my $nzeros = $LIB -> _zeros($mant -> {value});
- $mant -> brsft($nzeros, 10) if $nzeros != 0;
+ $mant -> {value}
+ = $LIB -> _rsft($mant -> {value}, $LIB -> _new($nzeros), 10)
+ if $nzeros != 0;
return $mant unless wantarray;
- my $expo = $class -> new($nzeros);
+ my $expo = $class -> new($nzeros, @r);
return ($mant, $expo);
}
+# Parts used for normalized notation with significand/mantissa as either 0 or a
+# number in the semi-open interval [1,10). E.g., "12345.6789" is returned as
+# "1.23456789" and "4".
+
sub nparts {
- my $self = shift;
- my $class = ref $self;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- croak("nparts() is an instance method, not a class method")
- unless $class;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- # Not-a-number.
+ # Not-a-Number and Infinity.
- if ($self -> is_nan()) {
- my $mant = $self -> copy(); # mantissa
- return $mant unless wantarray; # scalar context
- my $expo = $class -> bnan(); # exponent
- return ($mant, $expo); # list context
- }
+ return $x -> sparts(@r) if $x -> is_nan() || $x -> is_inf();
- # Infinity.
+ # Upgrade?
- if ($self -> is_inf()) {
- my $mant = $self -> copy(); # mantissa
- return $mant unless wantarray; # scalar context
- my $expo = $class -> binf('+'); # exponent
- return ($mant, $expo); # list context
- }
+ return $upgrade -> nparts($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
# Finite number.
- my ($mant, $expo) = $self -> sparts();
-
+ my ($mant, $expo) = $x -> sparts(@r);
if ($mant -> bcmp(0)) {
my ($ndigtot, $ndigfrac) = $mant -> length();
my $expo10adj = $ndigtot - $ndigfrac - 1;
- if ($expo10adj != 0) {
- return $upgrade -> new($self) -> nparts() if $upgrade;
- $mant -> bnan();
+ if ($expo10adj > 0) { # if mantissa is not an integer
+ return $upgrade -> nparts($x, @r) if defined $upgrade;
+ $mant = $mant -> bnan(@r);
return $mant unless wantarray;
- $expo -> badd($expo10adj);
+ $expo = $expo -> badd($expo10adj, @r);
return ($mant, $expo);
}
}
@@ -3655,70 +4110,174 @@ sub nparts {
return ($mant, $expo);
}
+# Parts used for engineering notation with significand/mantissa as either 0 or a
+# number in the semi-open interval [1,1000) and the exponent is a multiple of 3.
+# E.g., "12345.6789" is returned as "12.3456789" and "3".
+
sub eparts {
- my $self = shift;
- my $class = ref $self;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- croak("eparts() is an instance method, not a class method")
- unless $class;
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
# Not-a-number and Infinity.
- return $self -> sparts() if $self -> is_nan() || $self -> is_inf();
+ return $x -> sparts(@r) if $x -> is_nan() || $x -> is_inf();
+
+ # Upgrade?
+
+ return $upgrade -> eparts($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
# Finite number.
- my ($mant, $expo) = $self -> sparts();
+ my ($mant, $expo) = $x -> sparts(@r);
if ($mant -> bcmp(0)) {
my $ndigmant = $mant -> length();
- $expo -> badd($ndigmant);
+ $expo = $expo -> badd($ndigmant, @r);
# $c is the number of digits that will be in the integer part of the
# final mantissa.
my $c = $expo -> copy() -> bdec() -> bmod(3) -> binc();
- $expo -> bsub($c);
+ $expo = $expo -> bsub($c);
if ($ndigmant > $c) {
- return $upgrade -> new($self) -> eparts() if $upgrade;
- $mant -> bnan();
+ return $upgrade -> eparts($x, @r) if defined $upgrade;
+ $mant = $mant -> bnan(@r);
return $mant unless wantarray;
return ($mant, $expo);
}
- $mant -> blsft($c - $ndigmant, 10);
+ $mant = $mant -> blsft($c - $ndigmant, 10, @r);
}
return $mant unless wantarray;
return ($mant, $expo);
}
+# Parts used for decimal notation, e.g., "12345.6789" is returned as "12345"
+# (integer part) and "0.6789" (fraction part).
+
sub dparts {
- my $self = shift;
- my $class = ref $self;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- croak("dparts() is an instance method, not a class method")
- unless $class;
+ # Not-a-number.
+
+ if ($x -> is_nan()) {
+ my $int = $class -> bnan(@r);
+ return $int unless wantarray;
+ my $frc = $class -> bzero(@r); # or NaN?
+ return ($int, $frc);
+ }
+
+ # Infinity.
+
+ if ($x -> is_inf()) {
+ my $int = $class -> binf($x->{sign}, @r);
+ return $int unless wantarray;
+ my $frc = $class -> bzero(@r);
+ return ($int, $frc);
+ }
+
+ # Upgrade?
- my $int = $self -> copy();
+ return $upgrade -> dparts($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number.
+
+ my $int = $x -> copy() -> round(@r);
return $int unless wantarray;
- my $frc = $class -> bzero();
+ my $frc = $class -> bzero(@r);
return ($int, $frc);
}
+# Fractional parts with the numerator and denominator as integers. E.g.,
+# "123.4375" is returned as "1975" and "16".
+
+sub fparts {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # NaN => NaN/NaN
+
+ if ($x -> is_nan()) {
+ return $class -> bnan(@r) unless wantarray;
+ return $class -> bnan(@r), $class -> bnan(@r);
+ }
+
+ # ±Inf => ±Inf/1
+
+ if ($x -> is_inf()) {
+ my $numer = $class -> binf($x->{sign}, @r);
+ return $numer unless wantarray;
+ my $denom = $class -> bone(@r);
+ return $numer, $denom;
+ }
+
+ # Upgrade?
+
+ return $upgrade -> fparts($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # N => N/1
+
+ my $numer = $x -> copy() -> round(@r);
+ return $numer unless wantarray;
+ my $denom = $class -> bone(@r);
+ return $numer, $denom;
+}
+
+sub numerator {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ return $upgrade -> numerator($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ return $x -> copy() -> round(@r);
+}
+
+sub denominator {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ return $upgrade -> denominator($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ return $x -> is_nan() ? $class -> bnan(@r) : $class -> bone(@r);
+}
+
###############################################################################
# String conversion methods
###############################################################################
sub bstr {
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
if ($x->{sign} ne '+' && $x->{sign} ne '-') {
return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
return 'inf'; # +inf
}
+
+ # Upgrade?
+
+ return $upgrade -> bstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
my $str = $LIB->_str($x->{value});
return $x->{sign} eq '-' ? "-$str" : $str;
}
@@ -3727,125 +4286,223 @@ sub bstr {
# written as "1.2345e+4".
sub bsstr {
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
if ($x->{sign} ne '+' && $x->{sign} ne '-') {
return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
return 'inf'; # +inf
}
- my ($m, $e) = $x -> parts();
- my $str = $LIB->_str($m->{value}) . 'e+' . $LIB->_str($e->{value});
- return $x->{sign} eq '-' ? "-$str" : $str;
+
+ # Upgrade?
+
+ return $upgrade -> bsstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
+ my $expo = $LIB -> _zeros($x->{value});
+ my $mant = $LIB -> _str($x->{value});
+ $mant = substr($mant, 0, -$expo) if $expo; # strip trailing zeros
+
+ ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo;
}
-# Normalized notation, e.g., "12345" is written as "12345e+0".
+# Normalized notation, e.g., "12345" is written as "1.2345e+4".
sub bnstr {
- my $x = shift;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
if ($x->{sign} ne '+' && $x->{sign} ne '-') {
return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
return 'inf'; # +inf
}
- return $x -> bstr() if $x -> is_nan() || $x -> is_inf();
+ # Upgrade?
- my ($mant, $expo) = $x -> parts();
+ return $upgrade -> bnstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
- # The "fraction posision" is the position (offset) for the decimal point
- # relative to the end of the digit string.
+ # Finite number
- my $fracpos = $mant -> length() - 1;
- if ($fracpos == 0) {
- my $str = $LIB->_str($mant->{value}) . "e+" . $LIB->_str($expo->{value});
- return $x->{sign} eq '-' ? "-$str" : $str;
- }
+ my $expo = $LIB -> _zeros($x->{value});
+ my $mant = $LIB -> _str($x->{value});
+ $mant = substr($mant, 0, -$expo) if $expo; # strip trailing zeros
- $expo += $fracpos;
- my $mantstr = $LIB->_str($mant -> {value});
- substr($mantstr, -$fracpos, 0) = '.';
+ my $mantlen = CORE::length($mant);
+ if ($mantlen > 1) {
+ $expo += $mantlen - 1; # adjust exponent
+ substr $mant, 1, 0, "."; # insert decimal point
+ }
- my $str = $mantstr . 'e+' . $LIB->_str($expo -> {value});
- return $x->{sign} eq '-' ? "-$str" : $str;
+ ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo;
}
# Engineering notation, e.g., "12345" is written as "12.345e+3".
sub bestr {
- my $x = shift;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
if ($x->{sign} ne '+' && $x->{sign} ne '-') {
return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
return 'inf'; # +inf
}
- my ($mant, $expo) = $x -> parts();
+ # Upgrade?
- my $sign = $mant -> sign();
- $mant -> babs();
+ return $upgrade -> bestr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
- my $mantstr = $LIB->_str($mant -> {value});
- my $mantlen = CORE::length($mantstr);
+ # Finite number
- my $dotidx = 1;
- $expo += $mantlen - 1;
+ my $expo = $LIB -> _zeros($x->{value}); # number of trailing zeros
+ my $mant = $LIB -> _str($x->{value}); # mantissa as a string
+ $mant = substr($mant, 0, -$expo) if $expo; # strip trailing zeros
+ my $mantlen = CORE::length($mant); # length of mantissa
+ $expo += $mantlen;
- my $c = $expo -> copy() -> bmod(3);
- $expo -= $c;
- $dotidx += $c;
+ my $dotpos = ($expo - 1) % 3 + 1; # offset of decimal point
+ $expo -= $dotpos;
- if ($mantlen < $dotidx) {
- $mantstr .= "0" x ($dotidx - $mantlen);
- } elsif ($mantlen > $dotidx) {
- substr($mantstr, $dotidx, 0) = ".";
+ if ($dotpos < $mantlen) {
+ substr $mant, $dotpos, 0, "."; # insert decimal point
+ } elsif ($dotpos > $mantlen) {
+ $mant .= "0" x ($dotpos - $mantlen); # append zeros
}
- my $str = $mantstr . 'e+' . $LIB->_str($expo -> {value});
- return $sign eq "-" ? "-$str" : $str;
+ ($x->{sign} eq '-' ? '-' : '') . $mant . 'e+' . $expo;
}
-# Decimal notation, e.g., "12345".
+# Decimal notation, e.g., "12345" (no exponent).
sub bdstr {
- my $x = shift;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
if ($x->{sign} ne '+' && $x->{sign} ne '-') {
- return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
- return 'inf'; # +inf
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
- my $str = $LIB->_str($x->{value});
- return $x->{sign} eq '-' ? "-$str" : $str;
+ # Upgrade?
+
+ return $upgrade -> bdstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
+ ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{value});
+}
+
+# Fraction notation, e.g., "123.4375" is written as "1975/16", but "123" is
+# written as "123", not "123/1".
+
+sub bfstr {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
+
+ # Upgrade?
+
+ return $upgrade -> bfstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
+ ($x->{sign} eq '-' ? '-' : '') . $LIB->_str($x->{value});
}
sub to_hex {
- # return as hex string, with prefixed 0x
- my $x = shift;
- $x = __PACKAGE__->new($x) if !ref($x);
+ # return as hex string with no prefix
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
+
+ # Upgrade?
+
+ return $upgrade -> to_hex($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
my $hex = $LIB->_to_hex($x->{value});
return $x->{sign} eq '-' ? "-$hex" : $hex;
}
sub to_oct {
- # return as octal string, with prefixed 0
- my $x = shift;
- $x = __PACKAGE__->new($x) if !ref($x);
+ # return as octal string with no prefix
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
+
+ # Upgrade?
+
+ return $upgrade -> to_oct($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
my $oct = $LIB->_to_oct($x->{value});
return $x->{sign} eq '-' ? "-$oct" : $oct;
}
sub to_bin {
- # return as binary string, with prefixed 0b
- my $x = shift;
- $x = __PACKAGE__->new($x) if !ref($x);
+ # return as binary string with no prefix
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
+
+ # Upgrade?
+
+ return $upgrade -> to_bin($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
my $bin = $LIB->_to_bin($x->{value});
return $x->{sign} eq '-' ? "-$bin" : $bin;
@@ -3853,12 +4510,17 @@ sub to_bin {
sub to_bytes {
# return a byte string
- my $x = shift;
- $x = __PACKAGE__->new($x) if !ref($x);
+
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
croak("to_bytes() requires a finite, non-negative integer")
if $x -> is_neg() || ! $x -> is_int();
+ return $upgrade -> to_bytes($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
croak("to_bytes() requires a newer version of the $LIB library.")
unless $LIB->can('_to_bytes');
@@ -3867,22 +4529,23 @@ sub to_bytes {
sub to_base {
# return a base anything string
- my $x = shift;
- $x = __PACKAGE__->new($x) if !ref($x);
+
+ # $cs is the collation sequence
+ my ($class, $x, $base, $cs, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_) : objectify(2, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
croak("the value to convert must be a finite, non-negative integer")
if $x -> is_neg() || !$x -> is_int();
- my $base = shift;
- $base = __PACKAGE__->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 (! @_) {
+ unless (defined $cs) {
return $x -> to_bin() if $base == 2;
return $x -> to_oct() if $base == 8;
return uc $x -> to_hex() if $base == 16;
@@ -3892,38 +4555,93 @@ sub to_base {
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() : ());
+ return $upgrade -> to_base($x, $base, $cs, @r)
+ if defined($upgrade) && (!$x -> isa($class) || !$base -> isa($class));
+
+ return $LIB->_to_base($x->{value}, $base -> {value},
+ defined($cs) ? $cs : ());
+}
+
+sub to_base_num {
+ # return a base anything array ref, e.g.,
+ # Math::BigInt -> new(255) -> to_base_num(10) returns [2, 5, 5];
+
+ # $cs is the collation sequence
+ my ($class, $x, $base, @r) = ref($_[0]) && ref($_[0]) eq ref($_[1])
+ ? (ref($_[0]), @_) : objectify(2, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ croak("the value to convert must be a finite non-negative integer")
+ if $x -> is_neg() || !$x -> is_int();
+
+ croak("the base must be a finite integer >= 2")
+ if $base < 2 || ! $base -> is_int();
+
+ croak("to_base() requires a newer version of the $LIB library.")
+ unless $LIB->can('_to_base');
+
+ return $upgrade -> to_base_num($x, $base, @r)
+ if defined($upgrade) && (!$x -> isa($class) || !$base -> isa($class));
+
+ # Get a reference to an array of library thingies, and replace each element
+ # with a Math::BigInt object using that thingy.
+
+ my $vals = $LIB -> _to_base_num($x->{value}, $base -> {value});
+
+ for my $i (0 .. $#$vals) {
+ my $x = $class -> bzero();
+ $x -> {value} = $vals -> [$i];
+ $vals -> [$i] = $x;
+ }
+
+ return $vals;
}
sub as_hex {
# return as hex string, with prefixed 0x
- my $x = shift;
- $x = __PACKAGE__->new($x) if !ref($x);
+
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return $upgrade -> as_hex($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
my $hex = $LIB->_as_hex($x->{value});
return $x->{sign} eq '-' ? "-$hex" : $hex;
}
sub as_oct {
# return as octal string, with prefixed 0
- my $x = shift;
- $x = __PACKAGE__->new($x) if !ref($x);
+
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return $upgrade -> as_oct($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
my $oct = $LIB->_as_oct($x->{value});
return $x->{sign} eq '-' ? "-$oct" : $oct;
}
sub as_bin {
# return as binary string, with prefixed 0b
- my $x = shift;
- $x = __PACKAGE__->new($x) if !ref($x);
+
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return $upgrade -> as_bin($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
my $bin = $LIB->_as_bin($x->{value});
return $x->{sign} eq '-' ? "-$bin" : $bin;
}
@@ -3936,21 +4654,25 @@ sub as_bin {
sub numify {
# Make a Perl scalar number from a Math::BigInt object.
- my $x = shift;
- $x = __PACKAGE__->new($x) unless ref $x;
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
if ($x -> is_nan()) {
require Math::Complex;
- my $inf = Math::Complex::Inf();
+ my $inf = $Math::Complex::Inf;
return $inf - $inf;
}
if ($x -> is_inf()) {
require Math::Complex;
- my $inf = Math::Complex::Inf();
+ my $inf = $Math::Complex::Inf;
return $x -> is_negative() ? -$inf : $inf;
}
+ return $upgrade -> numify($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
my $num = 0 + $LIB->_num($x->{value});
return $x->{sign} eq '-' ? -$num : $num;
}
@@ -4015,9 +4737,13 @@ sub objectify {
no strict 'refs';
- # What we upgrade to, if anything.
+ # What we upgrade to, if anything. Note that we need the whole upgrade
+ # chain, since there might be multiple levels of upgrading. E.g., class A
+ # upgrades to class B, which upgrades to class C. Delay getting the chain
+ # until we actually need it.
- my $up = ${"$a[0]::upgrade"};
+ my @upg = ();
+ my $have_upgrade_chain = 0;
# Disable downgrading, because Math::BigFloat -> foo('1.0', '2.0') needs
# floats.
@@ -4028,7 +4754,7 @@ sub objectify {
${"$a[0]::downgrade"} = undef;
}
- for my $i (1 .. $count) {
+ ARG: for my $i (1 .. $count) {
my $ref = ref $a[$i];
@@ -4043,10 +4769,23 @@ sub objectify {
next if $ref -> isa($a[0]);
- # Upgrading is OK, so skip further tests if the argument is upgraded.
+ # Upgrading is OK, so skip further tests if the argument is upgraded,
+ # but first get the whole upgrade chain if we haven't got it yet.
+
+ unless ($have_upgrade_chain) {
+ my $cls = $class;
+ my $upg = $cls -> upgrade();
+ while (defined $upg) {
+ last if $upg eq $cls;
+ push @upg, $upg;
+ $cls = $upg;
+ $upg = $cls -> upgrade();
+ }
+ $have_upgrade_chain = 1;
+ }
- if (defined $up && $ref -> isa($up)) {
- next;
+ for my $upg (@upg) {
+ next ARG if $ref -> isa($upg);
}
# See if we can call one of the as_xxx() methods. We don't know whether
@@ -4105,233 +4844,190 @@ sub import {
my $class = shift;
$IMPORT++; # remember we did import()
my @a; # unrecognized arguments
- my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die
- for (my $i = 0; $i <= $#_ ; $i++) {
- if ($_[$i] eq ':constant') {
- # this causes overlord er load to step in
+
+ while (@_) {
+ my $param = shift;
+
+ # Enable overloading of constants.
+
+ if ($param eq ':constant') {
overload::constant
- integer => sub { $class->new(shift) },
- binary => sub { $class->new(shift) };
- } elsif ($_[$i] eq 'upgrade') {
- # this causes upgrading
- $upgrade = $_[$i+1]; # or undef to disable
- $i++;
- } elsif ($_[$i] =~ /^(lib|try|only)\z/) {
- # this causes a different low lib to take care...
- $LIB = $_[$i+1] || '';
- # try => 0 (no warn)
- # lib => 1 (warn on fallback)
- # only => 2 (die on fallback)
- $warn_or_die = 1 if $_[$i] eq 'lib';
- $warn_or_die = 2 if $_[$i] eq 'only';
- $i++;
- } else {
- push @a, $_[$i];
+
+ integer => sub {
+ $class -> new(shift);
+ },
+
+ float => sub {
+ $class -> new(shift);
+ },
+
+ binary => sub {
+ # E.g., a literal 0377 shall result in an object whose value
+ # is decimal 255, but new("0377") returns decimal 377.
+ return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
+ $class -> new(shift);
+ };
+ next;
}
- }
- # any non :constant stuff is handled by our parent, Exporter
- if (@a > 0) {
- $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*/, $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"
- $LIB = ''; # signal error
- foreach my $l (@c) {
- # fallback libraries are "marked" as \'string', extract string if nec.
- my $lib = $l;
- $lib = $$l if ref($l);
-
- next unless defined($lib) && CORE::length($lib);
- $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
- $lib =~ s/\.pm$//;
- my @parts = split /::/, $lib; # Math::BigInt => Math BigInt
- $parts[-1] .= '.pm'; # BigInt => BigInt.pm
- require File::Spec;
- my $file = File::Spec->catfile(@parts);
- eval { require $file; };
- if ($@ eq '') {
- $lib->import();
- $LIB = $lib;
- if ($warn_or_die > 0 && ref($l)) {
- my $msg = "Math::BigInt: couldn't load specified"
- . " math lib(s), fallback to $lib";
- carp($msg) if $warn_or_die == 1;
- croak($msg) if $warn_or_die == 2;
- }
- last; # found a usable one, break
+
+ # Upgrading.
+
+ if ($param eq 'upgrade') {
+ $class -> upgrade(shift);
+ next;
}
- }
- if ($LIB eq '') {
- if ($warn_or_die == 2) {
- croak("Couldn't load specified math lib(s)" .
- " and fallback disallowed");
- } else {
- croak("Couldn't load any math lib(s), not even fallback to Calc.pm");
+
+ # Downgrading.
+
+ if ($param eq 'downgrade') {
+ $class -> downgrade(shift);
+ next;
}
- }
- # notify callbacks
- foreach my $class (keys %CALLBACKS) {
- &{$CALLBACKS{$class}}($LIB);
- }
+ # Accuracy.
- # import done
-}
+ if ($param eq 'accuracy') {
+ $class -> accuracy(shift);
+ next;
+ }
-sub _register_callback {
- my ($class, $callback) = @_;
+ # Precision.
- if (ref($callback) ne 'CODE') {
- croak("$callback is not a coderef");
- }
- $CALLBACKS{$class} = $callback;
-}
+ if ($param eq 'precision') {
+ $class -> precision(shift);
+ next;
+ }
-sub _split_dec_string {
- my $str = shift;
+ # Rounding mode.
- if ($str =~ s/
- ^
+ if ($param eq 'round_mode') {
+ $class -> round_mode(shift);
+ next;
+ }
- # leading whitespace
- ( \s* )
+ # Backend library.
- # optional sign
- ( [+-]? )
+ if ($param =~ /^(lib|try|only)\z/) {
+ # try => 0 (no warn if unavailable module)
+ # lib => 1 (warn on fallback)
+ # only => 2 (die on fallback)
- # significand
- (
- \d+ (?: _ \d+ )*
- (?:
- \.
- (?: \d+ (?: _ \d+ )* )?
- )?
- |
- \.
- \d+ (?: _ \d+ )*
- )
-
- # optional exponent
- (?:
- [Ee]
- ( [+-]? )
- ( \d+ (?: _ \d+ )* )
- )?
-
- # trailing stuff
- ( \D .*? )?
+ # Get the list of user-specified libraries.
- \z
- //x) {
- my $leading = $1;
- my $significand_sgn = $2 || '+';
- my $significand_abs = $3;
- my $exponent_sgn = $4 || '+';
- my $exponent_abs = $5 || '0';
- my $trailing = $6;
-
- # Remove underscores and leading zeros.
-
- $significand_abs =~ tr/_//d;
- $exponent_abs =~ tr/_//d;
-
- $significand_abs =~ s/^0+(.)/$1/;
- $exponent_abs =~ s/^0+(.)/$1/;
-
- # If the significand contains a dot, remove it and adjust the exponent
- # accordingly. E.g., "1234.56789e+3" -> "123456789e-2"
-
- my $idx = index $significand_abs, '.';
- if ($idx > -1) {
- $significand_abs =~ s/0+\z//;
- substr($significand_abs, $idx, 1) = '';
- my $exponent = $exponent_sgn . $exponent_abs;
- $exponent .= $idx - CORE::length($significand_abs);
- $exponent_abs = abs $exponent;
- $exponent_sgn = $exponent < 0 ? '-' : '+';
- }
+ croak "Library argument for import parameter '$param' is missing"
+ unless @_;
+ my $libs = shift;
+ croak "Library argument for import parameter '$param' is undefined"
+ unless defined($libs);
- return($leading,
- $significand_sgn, $significand_abs,
- $exponent_sgn, $exponent_abs,
- $trailing);
- }
+ # Check and clean up the list of user-specified libraries.
- return undef;
-}
+ my @libs;
+ for my $lib (split /,/, $libs) {
+ $lib =~ s/^\s+//;
+ $lib =~ s/\s+$//;
-sub _split {
- # input: num_str; output: undef for invalid or
- # (\$mantissa_sign, \$mantissa_value, \$mantissa_fraction,
- # \$exp_sign, \$exp_value)
- # Internal, take apart a string and return the pieces.
- # Strip leading/trailing whitespace, leading zeros, underscore and reject
- # invalid input.
- my $x = shift;
+ if ($lib =~ /[^a-zA-Z0-9_:]/) {
+ carp "Library name '$lib' contains invalid characters";
+ next;
+ }
+
+ if (! CORE::length $lib) {
+ carp "Library name is empty";
+ next;
+ }
- # strip white space at front, also extraneous leading zeros
- $x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
- $x =~ s/^\s+//; # but this will
- $x =~ s/\s+$//g; # strip white space at end
+ $lib = "Math::BigInt::$lib" if $lib !~ /^Math::BigInt::/i;
- # shortcut, if nothing to split, return early
- if ($x =~ /^[+-]?[0-9]+\z/) {
- $x =~ s/^([+-])0*([0-9])/$2/;
- my $sign = $1 || '+';
- return (\$sign, \$x, \'', \'', \0);
- }
+ # If a library has already been loaded, that is OK only if the
+ # requested library is identical to the loaded one.
- # invalid starting char?
- return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
+ if (defined($LIB)) {
+ if ($lib ne $LIB) {
+ #carp "Library '$LIB' has already been loaded, so",
+ # " ignoring requested library '$lib'";
+ }
+ next;
+ }
- return Math::BigInt->from_hex($x) if $x =~ /^[+-]?0x/; # hex string
- return Math::BigInt->from_bin($x) if $x =~ /^[+-]?0b/; # binary string
+ push @libs, $lib;
+ }
- # strip underscores between digits
- $x =~ s/([0-9])_([0-9])/$1$2/g;
- $x =~ s/([0-9])_([0-9])/$1$2/g; # do twice for 1_2_3
+ next if defined $LIB;
- # some possible inputs:
- # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
- # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2 # 0e999
+ croak "Library list contains no valid libraries" unless @libs;
- my ($m, $e, $last) = split /[Ee]/, $x;
- return if defined $last; # last defined => 1e2E3 or others
- $e = '0' if !defined $e || $e eq "";
+ # Try to load the specified libraries, if any.
- # sign, value for exponent, mantint, mantfrac
- my ($es, $ev, $mis, $miv, $mfv);
- # valid exponent?
- if ($e =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
- {
- $es = $1;
- $ev = $2;
- # valid mantissa?
- return if $m eq '.' || $m eq '';
- my ($mi, $mf, $lastf) = split /\./, $m;
- return if defined $lastf; # lastf defined => 1.2.3 or others
- $mi = '0' if !defined $mi;
- $mi .= '0' if $mi =~ /^[\-\+]?$/;
- $mf = '0' if !defined $mf || $mf eq '';
- if ($mi =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
- {
- $mis = $1 || '+';
- $miv = $2;
- return unless ($mf =~ /^([0-9]*?)0*$/); # strip trailing zeros
- $mfv = $1;
- # handle the 0e999 case here
- $ev = 0 if $miv eq '0' && $mfv eq '';
- return (\$mis, \$miv, \$mfv, \$es, \$ev);
+ for (my $i = 0 ; $i <= $#libs ; $i++) {
+ my $lib = $libs[$i];
+ eval "require $lib";
+ unless ($@) {
+ $LIB = $lib;
+ last;
+ }
+ }
+
+ next if defined $LIB;
+
+ # No library has been loaded, and none of the requested libraries
+ # could be loaded, and fallback and the user doesn't allow fallback.
+
+ if ($param eq 'only') {
+ croak "Couldn't load the specified math lib(s) ",
+ join(", ", map "'$_'", @libs),
+ ", and fallback to '$DEFAULT_LIB' is not allowed";
+ }
+
+ # No library has been loaded, and none of the requested libraries
+ # could be loaded, but the user accepts the use of a fallback
+ # library, so try to load it.
+
+ eval "require $DEFAULT_LIB";
+ if ($@) {
+ croak "Couldn't load the specified math lib(s) ",
+ join(", ", map "'$_'", @libs),
+ ", not even the fallback lib '$DEFAULT_LIB'";
+ }
+
+ # The fallback library was successfully loaded, but the user
+ # might want to know that we are using the fallback.
+
+ if ($param eq 'lib') {
+ carp "Couldn't load the specified math lib(s) ",
+ join(", ", map "'$_'", @libs),
+ ", so using fallback lib '$DEFAULT_LIB'";
+ }
+
+ next;
}
+
+ # Unrecognized parameter.
+
+ push @a, $param;
+ }
+
+ # Any non-':constant' stuff is handled by our parent, Exporter
+
+ if (@a) {
+ $class->SUPER::import(@a); # need it for subclasses
+ $class->export_to_level(1, $class, @a); # need it for Math::BigFloat
+ }
+
+ # We might not have loaded any backend library yet, either because the user
+ # didn't specify any, or because the specified libraries failed to load and
+ # the user allows the use of a fallback library.
+
+ unless (defined $LIB) {
+ eval "require $DEFAULT_LIB";
+ if ($@) {
+ croak "No lib specified, and couldn't load the default",
+ " lib '$DEFAULT_LIB'";
+ }
+ $LIB = $DEFAULT_LIB;
}
- return; # NaN, not a number
+
+ # import done
}
sub _trailing_zeros {
@@ -4386,7 +5082,8 @@ sub _find_round_parameters {
if (!defined $a) {
foreach ($self, @args) {
# take the defined one, or if both defined, the one that is smaller
- $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
+ $a = $_->{_a}
+ if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
}
}
if (!defined $p) {
@@ -4394,7 +5091,8 @@ sub _find_round_parameters {
foreach ($self, @args) {
# take the defined one, or if both defined, the one that is bigger
# -2 > -3, and 3 > 2
- $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
+ $p = $_->{_p}
+ if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
}
}
@@ -4422,6 +5120,699 @@ sub _find_round_parameters {
($self, $a, $p, $r);
}
+# Return true if the input is numeric and false if it is a string.
+
+sub _is_numeric {
+ shift; # class name
+ my $value = shift;
+ no warnings 'numeric';
+ # detect numbers
+ # string & "" -> ""
+ # number & "" -> 0 (with warning)
+ # nan and inf can detect as numbers, so check with * 0
+ return unless CORE::length((my $dummy = "") & $value);
+ return unless 0 + $value eq $value;
+ return 1 if $value * 0 == 0;
+ return -1; # Inf/NaN
+}
+
+# Trims the sign of the significand, the (absolute value of the) significand,
+# the sign of the exponent, and the (absolute value of the) exponent. The
+# returned values have no underscores ("_") or unnecessary leading or trailing
+# zeros.
+
+sub _trim_split_parts {
+ shift; # class name
+
+ my $sig_sgn = shift() || '+';
+ my $sig_str = shift() || '0';
+ my $exp_sgn = shift() || '+';
+ my $exp_str = shift() || '0';
+
+ $sig_str =~ tr/_//d; # "1.0_0_0" -> "1.000"
+ $sig_str =~ s/^0+//; # "01.000" -> "1.000"
+ $sig_str =~ s/\.0*$// # "1.000" -> "1"
+ || $sig_str =~ s/(\..*[^0])0+$/$1/; # "1.010" -> "1.01"
+ $sig_str = '0' unless CORE::length($sig_str);
+
+ return '+', '0', '+', '0' if $sig_str eq '0';
+
+ $exp_str =~ tr/_//d; # "01_234" -> "01234"
+ $exp_str =~ s/^0+//; # "01234" -> "1234"
+ $exp_str = '0' unless CORE::length($exp_str);
+ $exp_sgn = '+' if $exp_str eq '0'; # "+3e-0" -> "+3e+0"
+
+ return $sig_sgn, $sig_str, $exp_sgn, $exp_str;
+}
+
+# Takes any string representing a valid decimal number and splits it into four
+# strings: the sign of the significand, the absolute value of the significand,
+# the sign of the exponent, and the absolute value of the exponent. Both the
+# significand and the exponent are in base 10.
+#
+# Perl accepts literals like the following. The value is 100.1.
+#
+# 1__0__.__0__1__e+0__1__ (prints "Misplaced _ in number")
+# 1_0.0_1e+0_1
+#
+# Strings representing decimal numbers do not allow underscores, so only the
+# following is valid
+#
+# "10.01e+01"
+
+sub _dec_str_to_dec_str_parts {
+ my $class = shift;
+ my $str = shift;
+
+ if ($str =~ /
+ ^
+
+ # optional leading whitespace
+ \s*
+
+ # optional sign
+ ( [+-]? )
+
+ # significand
+ (
+ # integer part and optional fraction part ...
+ \d+ (?: _+ \d+ )* _*
+ (?:
+ \.
+ (?: _* \d+ (?: _+ \d+ )* _* )?
+ )?
+ |
+ # ... or mandatory fraction part
+ \.
+ \d+ (?: _+ \d+ )* _*
+ )
+
+ # optional exponent
+ (?:
+ [Ee]
+ ( [+-]? )
+ ( \d+ (?: _+ \d+ )* _* )
+ )?
+
+ # optional trailing whitespace
+ \s*
+
+ $
+ /x)
+ {
+ return $class -> _trim_split_parts($1, $2, $3, $4);
+ }
+
+ return;
+}
+
+# Takes any string representing a valid hexadecimal number and splits it into
+# four strings: the sign of the significand, the absolute value of the
+# significand, the sign of the exponent, and the absolute value of the exponent.
+# The significand is in base 16, and the exponent is in base 2.
+#
+# Perl accepts literals like the following. The "x" might be a capital "X". The
+# value is 32.0078125.
+#
+# 0x__1__0__.0__1__p+0__1__ (prints "Misplaced _ in number")
+# 0x1_0.0_1p+0_1
+#
+# The CORE::hex() function does not accept floating point accepts
+#
+# "0x_1_0"
+# "x_1_0"
+# "_1_0"
+
+sub _hex_str_to_hex_str_parts {
+ my $class = shift;
+ my $str = shift;
+
+ if ($str =~ /
+ ^
+
+ # optional leading whitespace
+ \s*
+
+ # optional sign
+ ( [+-]? )
+
+ # optional hex prefix
+ (?: 0? [Xx] _* )?
+
+ # significand using the hex digits 0..9 and a..f
+ (
+ # integer part and optional fraction part ...
+ [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _*
+ (?:
+ \.
+ (?: _* [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _* )?
+ )?
+ |
+ # ... or mandatory fraction part
+ \.
+ [0-9a-fA-F]+ (?: _+ [0-9a-fA-F]+ )* _*
+ )
+
+ # optional exponent (power of 2) using decimal digits
+ (?:
+ [Pp]
+ ( [+-]? )
+ ( \d+ (?: _+ \d+ )* _* )
+ )?
+
+ # optional trailing whitespace
+ \s*
+
+ $
+ /x)
+ {
+ return $class -> _trim_split_parts($1, $2, $3, $4);
+ }
+
+ return;
+}
+
+# Takes any string representing a valid octal number and splits it into four
+# strings: the sign of the significand, the absolute value of the significand,
+# the sign of the exponent, and the absolute value of the exponent. The
+# significand is in base 8, and the exponent is in base 2.
+
+sub _oct_str_to_oct_str_parts {
+ my $class = shift;
+ my $str = shift;
+
+ if ($str =~ /
+ ^
+
+ # optional leading whitespace
+ \s*
+
+ # optional sign
+ ( [+-]? )
+
+ # optional octal prefix
+ (?: 0? [Oo] _* )?
+
+ # significand using the octal digits 0..7
+ (
+ # integer part and optional fraction part ...
+ [0-7]+ (?: _+ [0-7]+ )* _*
+ (?:
+ \.
+ (?: _* [0-7]+ (?: _+ [0-7]+ )* _* )?
+ )?
+ |
+ # ... or mandatory fraction part
+ \.
+ [0-7]+ (?: _+ [0-7]+ )* _*
+ )
+
+ # optional exponent (power of 2) using decimal digits
+ (?:
+ [Pp]
+ ( [+-]? )
+ ( \d+ (?: _+ \d+ )* _* )
+ )?
+
+ # optional trailing whitespace
+ \s*
+
+ $
+ /x)
+ {
+ return $class -> _trim_split_parts($1, $2, $3, $4);
+ }
+
+ return;
+}
+
+# Takes any string representing a valid binary number and splits it into four
+# strings: the sign of the significand, the absolute value of the significand,
+# the sign of the exponent, and the absolute value of the exponent. The
+# significand is in base 2, and the exponent is in base 2.
+
+sub _bin_str_to_bin_str_parts {
+ my $class = shift;
+ my $str = shift;
+
+ if ($str =~ /
+ ^
+
+ # optional leading whitespace
+ \s*
+
+ # optional sign
+ ( [+-]? )
+
+ # optional binary prefix
+ (?: 0? [Bb] _* )?
+
+ # significand using the binary digits 0 and 1
+ (
+ # integer part and optional fraction part ...
+ [01]+ (?: _+ [01]+ )* _*
+ (?:
+ \.
+ (?: _* [01]+ (?: _+ [01]+ )* _* )?
+ )?
+ |
+ # ... or mandatory fraction part
+ \.
+ [01]+ (?: _+ [01]+ )* _*
+ )
+
+ # optional exponent (power of 2) using decimal digits
+ (?:
+ [Pp]
+ ( [+-]? )
+ ( \d+ (?: _+ \d+ )* _* )
+ )?
+
+ # optional trailing whitespace
+ \s*
+
+ $
+ /x)
+ {
+ return $class -> _trim_split_parts($1, $2, $3, $4);
+ }
+
+ return;
+}
+
+# Takes any string representing a valid decimal number and splits it into four
+# parts: the sign of the significand, the absolute value of the significand as a
+# libray thingy, the sign of the exponent, and the absolute value of the
+# exponent as a library thingy.
+
+sub _dec_str_parts_to_flt_lib_parts {
+ shift; # class name
+
+ my ($sig_sgn, $sig_str, $exp_sgn, $exp_str) = @_;
+
+ # Handle zero.
+
+ if ($sig_str eq '0') {
+ return '+', $LIB -> _zero(), '+', $LIB -> _zero();
+ }
+
+ # Absolute value of exponent as library "object".
+
+ my $exp_lib = $LIB -> _new($exp_str);
+
+ # If there is a dot in the significand, remove it so the significand
+ # becomes an integer and adjust the exponent accordingly. Also remove
+ # leading zeros which might now appear in the significand. E.g.,
+ #
+ # 12.345e-2 -> 12345e-5
+ # 12.345e+2 -> 12345e-1
+ # 0.0123e+5 -> 00123e+1 -> 123e+1
+
+ my $idx = index $sig_str, '.';
+ if ($idx >= 0) {
+ substr($sig_str, $idx, 1) = '';
+
+ # delta = length - index
+ my $delta = $LIB -> _new(CORE::length($sig_str));
+ $delta = $LIB -> _sub($delta, $LIB -> _new($idx));
+
+ # exponent - delta
+ ($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+');
+
+ $sig_str =~ s/^0+//;
+ }
+
+ # If there are trailing zeros in the significand, remove them and
+ # adjust the exponent. E.g.,
+ #
+ # 12340e-5 -> 1234e-4
+ # 12340e-1 -> 1234e0
+ # 12340e+3 -> 1234e4
+
+ if ($sig_str =~ s/(0+)\z//) {
+ my $len = CORE::length($1);
+ ($exp_lib, $exp_sgn) =
+ $LIB -> _sadd($exp_lib, $exp_sgn, $LIB -> _new($len), '+');
+ }
+
+ # At this point, the significand is empty or an integer with no trailing
+ # zeros. The exponent is in base 10.
+
+ unless (CORE::length $sig_str) {
+ return '+', $LIB -> _zero(), '+', $LIB -> _zero();
+ }
+
+ # Absolute value of significand as library "object".
+
+ my $sig_lib = $LIB -> _new($sig_str);
+
+ return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib;
+}
+
+# Takes any string representing a valid binary number and splits it into four
+# parts: the sign of the significand, the absolute value of the significand as a
+# libray thingy, the sign of the exponent, and the absolute value of the
+# exponent as a library thingy.
+
+sub _bin_str_parts_to_flt_lib_parts {
+ shift; # class name
+
+ my ($sig_sgn, $sig_str, $exp_sgn, $exp_str, $bpc) = @_;
+ my $bpc_lib = $LIB -> _new($bpc);
+
+ # Handle zero.
+
+ if ($sig_str eq '0') {
+ return '+', $LIB -> _zero(), '+', $LIB -> _zero();
+ }
+
+ # Absolute value of exponent as library "object".
+
+ my $exp_lib = $LIB -> _new($exp_str);
+
+ # If there is a dot in the significand, remove it so the significand
+ # becomes an integer and adjust the exponent accordingly. Also remove
+ # leading zeros which might now appear in the significand. E.g., with
+ # hexadecimal numbers
+ #
+ # 12.345p-2 -> 12345p-14
+ # 12.345p+2 -> 12345p-10
+ # 0.0123p+5 -> 00123p-11 -> 123p-11
+
+ my $idx = index $sig_str, '.';
+ if ($idx >= 0) {
+ substr($sig_str, $idx, 1) = '';
+
+ # delta = (length - index) * bpc
+ my $delta = $LIB -> _new(CORE::length($sig_str));
+ $delta = $LIB -> _sub($delta, $LIB -> _new($idx));
+ $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1;
+
+ # exponent - delta
+ ($exp_lib, $exp_sgn) = $LIB -> _ssub($exp_lib, $exp_sgn, $delta, '+');
+
+ $sig_str =~ s/^0+//;
+ }
+
+ # If there are trailing zeros in the significand, remove them and
+ # adjust the exponent accordingly. E.g., with hexadecimal numbers
+ #
+ # 12340p-5 -> 1234p-1
+ # 12340p-1 -> 1234p+3
+ # 12340p+3 -> 1234p+7
+
+ if ($sig_str =~ s/(0+)\z//) {
+
+ # delta = length * bpc
+ my $delta = $LIB -> _new(CORE::length($1));
+ $delta = $LIB -> _mul($delta, $bpc_lib) if $bpc != 1;
+
+ # exponent + delta
+ ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $delta, '+');
+ }
+
+ # At this point, the significand is empty or an integer with no leading
+ # or trailing zeros. The exponent is in base 2.
+
+ unless (CORE::length $sig_str) {
+ return '+', $LIB -> _zero(), '+', $LIB -> _zero();
+ }
+
+ # Absolute value of significand as library "object".
+
+ my $sig_lib = $bpc == 1 ? $LIB -> _from_bin('0b' . $sig_str)
+ : $bpc == 3 ? $LIB -> _from_oct('0' . $sig_str)
+ : $bpc == 4 ? $LIB -> _from_hex('0x' . $sig_str)
+ : die "internal error: invalid exponent multiplier";
+
+ # If the exponent (in base 2) is positive or zero ...
+
+ if ($exp_sgn eq '+') {
+
+ if (!$LIB -> _is_zero($exp_lib)) {
+
+ # Multiply significand by 2 raised to the exponent.
+
+ my $p = $LIB -> _pow($LIB -> _two(), $exp_lib);
+ $sig_lib = $LIB -> _mul($sig_lib, $p);
+ $exp_lib = $LIB -> _zero();
+ }
+ }
+
+ # ... else if the exponent is negative ...
+
+ else {
+
+ # Rather than dividing the significand by 2 raised to the absolute
+ # value of the exponent, multiply the significand by 5 raised to the
+ # absolute value of the exponent and let the exponent be in base 10:
+ #
+ # a * 2^(-b) = a * 5^b * 10^(-b) = c * 10^(-b), where c = a * 5^b
+
+ my $p = $LIB -> _pow($LIB -> _new("5"), $exp_lib);
+ $sig_lib = $LIB -> _mul($sig_lib, $p);
+ }
+
+ # Adjust for the case when the conversion to decimal introduced trailing
+ # zeros in the significand.
+
+ my $n = $LIB -> _zeros($sig_lib);
+ if ($n) {
+ $n = $LIB -> _new($n);
+ $sig_lib = $LIB -> _rsft($sig_lib, $n, 10);
+ ($exp_lib, $exp_sgn) = $LIB -> _sadd($exp_lib, $exp_sgn, $n, '+');
+ }
+
+ return $sig_sgn, $sig_lib, $exp_sgn, $exp_lib;
+}
+
+# Takes any string representing a valid hexadecimal number and splits it into
+# four parts: the sign of the significand, the absolute value of the significand
+# as a libray thingy, the sign of the exponent, and the absolute value of the
+# exponent as a library thingy.
+
+sub _hex_str_to_flt_lib_parts {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _hex_str_to_hex_str_parts($str)) {
+ return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 4); # 4 bits pr. chr
+ }
+ return;
+}
+
+# Takes any string representing a valid octal number and splits it into four
+# parts: the sign of the significand, the absolute value of the significand as a
+# libray thingy, the sign of the exponent, and the absolute value of the
+# exponent as a library thingy.
+
+sub _oct_str_to_flt_lib_parts {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _oct_str_to_oct_str_parts($str)) {
+ return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 3); # 3 bits pr. chr
+ }
+ return;
+}
+
+# Takes any string representing a valid binary number and splits it into four
+# parts: the sign of the significand, the absolute value of the significand as a
+# libray thingy, the sign of the exponent, and the absolute value of the
+# exponent as a library thingy.
+
+sub _bin_str_to_flt_lib_parts {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _bin_str_to_bin_str_parts($str)) {
+ return $class -> _bin_str_parts_to_flt_lib_parts(@parts, 1); # 1 bit pr. chr
+ }
+ return;
+}
+
+# Decimal string is split into the sign of the signficant, the absolute value of
+# the significand as library thingy, the sign of the exponent, and the absolute
+# value of the exponent as a a library thingy.
+
+sub _dec_str_to_flt_lib_parts {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _dec_str_to_dec_str_parts($str)) {
+ return $class -> _dec_str_parts_to_flt_lib_parts(@parts);
+ }
+ return;
+}
+
+# Hexdecimal string to a string using decimal floating point notation.
+
+sub hex_str_to_dec_flt_str {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _hex_str_to_flt_lib_parts($str)) {
+ return $class -> _flt_lib_parts_to_flt_str(@parts);
+ }
+ return;
+}
+
+# Octal string to a string using decimal floating point notation.
+
+sub oct_str_to_dec_flt_str {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) {
+ return $class -> _flt_lib_parts_to_flt_str(@parts);
+ }
+ return;
+}
+
+# Binary string to a string decimal floating point notation.
+
+sub bin_str_to_dec_flt_str {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) {
+ return $class -> _flt_lib_parts_to_flt_str(@parts);
+ }
+ return;
+}
+
+# Decimal string to a string using decimal floating point notation.
+
+sub dec_str_to_dec_flt_str {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) {
+ return $class -> _flt_lib_parts_to_flt_str(@parts);
+ }
+ return;
+}
+
+# Hexdecimal string to decimal notation (no exponent).
+
+sub hex_str_to_dec_str {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) {
+ return $class -> _flt_lib_parts_to_dec_str(@parts);
+ }
+ return;
+}
+
+# Octal string to decimal notation (no exponent).
+
+sub oct_str_to_dec_str {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _oct_str_to_flt_lib_parts($str)) {
+ return $class -> _flt_lib_parts_to_dec_str(@parts);
+ }
+ return;
+}
+
+# Binary string to decimal notation (no exponent).
+
+sub bin_str_to_dec_str {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _bin_str_to_flt_lib_parts($str)) {
+ return $class -> _flt_lib_parts_to_dec_str(@parts);
+ }
+ return;
+}
+
+# Decimal string to decimal notation (no exponent).
+
+sub dec_str_to_dec_str {
+ my $class = shift;
+ my $str = shift;
+ if (my @parts = $class -> _dec_str_to_flt_lib_parts($str)) {
+ return $class -> _flt_lib_parts_to_dec_str(@parts);
+ }
+ return;
+}
+
+sub _flt_lib_parts_to_flt_str {
+ my $class = shift;
+ my @parts = @_;
+ return $parts[0] . $LIB -> _str($parts[1])
+ . 'e' . $parts[2] . $LIB -> _str($parts[3]);
+}
+
+sub _flt_lib_parts_to_dec_str {
+ my $class = shift;
+ my @parts = @_;
+
+ # The number is an integer iff the exponent is non-negative.
+
+ if ($parts[2] eq '+') {
+ my $str = $parts[0]
+ . $LIB -> _str($LIB -> _lsft($parts[1], $parts[3], 10));
+ return $str;
+ }
+
+ # If it is not an integer, add a decimal point.
+
+ else {
+ my $mant = $LIB -> _str($parts[1]);
+ my $mant_len = CORE::length($mant);
+ my $expo = $LIB -> _num($parts[3]);
+ my $len_cmp = $mant_len <=> $expo;
+ if ($len_cmp <= 0) {
+ return $parts[0] . '0.' . '0' x ($expo - $mant_len) . $mant;
+ } else {
+ substr $mant, $mant_len - $expo, 0, '.';
+ return $parts[0] . $mant;
+ }
+ }
+}
+
+# Takes four arguments, the sign of the significand, the absolute value of the
+# significand as a libray thingy, the sign of the exponent, and the absolute
+# value of the exponent as a library thingy, and returns three parts: the sign
+# of the rational number, the absolute value of the numerator as a libray
+# thingy, and the absolute value of the denominator as a library thingy.
+#
+# For example, to convert data representing the value "+12e-2", then
+#
+# $sm = "+";
+# $m = $LIB -> _new("12");
+# $se = "-";
+# $e = $LIB -> _new("2");
+# ($sr, $n, $d) = $class -> _flt_lib_parts_to_rat_lib_parts($sm, $m, $se, $e);
+#
+# returns data representing the same value written as the fraction "+3/25"
+#
+# $sr = "+"
+# $n = $LIB -> _new("3");
+# $d = $LIB -> _new("12");
+
+sub _flt_lib_parts_to_rat_lib_parts {
+ my $self = shift;
+ my ($msgn, $mabs, $esgn, $eabs) = @_;
+
+ if ($esgn eq '-') { # "12e-2" -> "12/100" -> "3/25"
+ my $num_lib = $LIB -> _copy($mabs);
+ my $den_lib = $LIB -> _1ex($LIB -> _num($eabs));
+ my $gcd_lib = $LIB -> _gcd($LIB -> _copy($num_lib), $den_lib);
+ $num_lib = $LIB -> _div($LIB -> _copy($num_lib), $gcd_lib);
+ $den_lib = $LIB -> _div($den_lib, $gcd_lib);
+ return $msgn, $num_lib, $den_lib;
+ }
+
+ elsif (!$LIB -> _is_zero($eabs)) { # "12e+2" -> "1200" -> "1200/1"
+ return $msgn, $LIB -> _lsft($LIB -> _copy($mabs), $eabs, 10),
+ $LIB -> _one();
+ }
+
+ else { # "12e+0" -> "12" -> "12/1"
+ return $msgn, $mabs, $LIB -> _one();
+ }
+}
+
+# Add the function _register_callback() to Math::BigInt. It is provided for
+# backwards compabibility so that old version of Math::BigRat etc. don't
+# complain about missing it.
+
+sub _register_callback { }
+
###############################################################################
# this method returns 0 if the object can be modified, or 1 if not.
# We use a fast constant sub() here, to avoid costly calls. Subclasses
@@ -4437,7 +5828,7 @@ __END__
=head1 NAME
-Math::BigInt - Arbitrary size integer/float math package
+Math::BigInt - arbitrary size integer math package
=head1 SYNOPSIS
@@ -4448,19 +5839,15 @@ Math::BigInt - Arbitrary size integer/float math package
# pure Perl if the GMP library is not installed):
# (See also the L<MATH LIBRARY> section!)
- # warns if Math::BigInt::GMP cannot be found
+ # to warn if Math::BigInt::GMP cannot be found, use
use Math::BigInt lib => 'GMP';
- # to suppress the warning use this:
+ # to suppress the warning if Math::BigInt::GMP cannot be found, use
# use Math::BigInt try => 'GMP';
- # dies if GMP cannot be loaded:
+ # to die if Math::BigInt::GMP cannot be found, use
# use Math::BigInt only => 'GMP';
- my $str = '1234567890';
- my @values = (64, 74, 18);
- my $n = 1; my $sign = '-';
-
# Configuration methods (may be used as class methods and instance methods)
Math::BigInt->accuracy(); # get class accuracy
@@ -4483,6 +5870,7 @@ Math::BigInt - Arbitrary size integer/float math package
$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->from_base_num([1, 0], 2); # from any base
$x = Math::BigInt->bzero(); # create a +0
$x = Math::BigInt->bone(); # create a +1
$x = Math::BigInt->bone('-'); # create a -1
@@ -4491,8 +5879,10 @@ Math::BigInt - Arbitrary size integer/float math package
$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
+ $y = $x->copy(); # make a copy (unlike $y = $x)
+ $y = $x->as_int(); # return as a Math::BigInt
+ $y = $x->as_float(); # return as a Math::BigFloat
+ $y = $x->as_rat(); # return as a Math::BigRat
# Boolean methods (these don't modify the invocand)
@@ -4559,6 +5949,9 @@ Math::BigInt - Arbitrary size integer/float math package
$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)
+ $x->bdfac(); # double factorial of $x ($x*($x-2)*($x-4)*...)
+ $x->btfac(); # triple factorial of $x ($x*($x-3)*($x-6)*...)
+ $x->bmfac($k); # $k'th multi-factorial of $x ($x*($x-$k)*...)
$x->blsft($n); # left shift $n places in base 2
$x->blsft($n,$b); # left shift $n places in base $b
@@ -4605,6 +5998,9 @@ Math::BigInt - Arbitrary size integer/float math package
$x->nparts(); # mantissa and exponent (normalised)
$x->eparts(); # mantissa and exponent (engineering notation)
$x->dparts(); # integer and fraction part
+ $x->fparts(); # numerator and denominator
+ $x->numerator(); # numerator
+ $x->denominator(); # denominator
# Conversion methods (do not modify the invocand)
@@ -4612,13 +6008,14 @@ Math::BigInt - Arbitrary size integer/float math package
$x->bsstr(); # string in scientific notation with integers
$x->bnstr(); # string in normalized notation
$x->bestr(); # string in engineering notation
- $x->bdstr(); # string in decimal notation
+ $x->bfstr(); # string in fractional notation
$x->to_hex(); # as signed hexadecimal string
$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->to_base_num($b); # as array of integers in any base
$x->as_hex(); # as signed hexadecimal string with prefixed 0x
$x->as_bin(); # as signed binary string with prefixed 0b
@@ -4636,7 +6033,9 @@ also provided for Perl operators.
=head2 Input
Input values to these routines may be any scalar number or string that looks
-like a number and represents an integer.
+like a number and represents an integer. Anything that is accepted by Perl as a
+literal numeric constant should be accepted by this module, except that finite
+non-integers return NaN.
=over
@@ -4646,53 +6045,86 @@ Leading and trailing whitespace is ignored.
=item *
-Leading and trailing zeros are ignored.
+Leading zeros are ignored, except for floating point numbers with a binary
+exponent, in which case the number is interpreted as an octal floating point
+number. For example, "01.4p+0" gives 1.5, "00.4p+0" gives 0.5, but "0.4p+0"
+gives a NaN. And while "0377" gives 255, "0377p0" gives 255.
=item *
-If the string has a "0x" prefix, it is interpreted as a hexadecimal number.
+If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal
+number.
=item *
-If the string has a "0b" prefix, it is interpreted as a binary number.
+If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A
+floating point literal with a "0" prefix is also interpreted as an octal number.
=item *
-One underline is allowed between any two digits.
+If the string has a "0b" or "0B" prefix, it is interpreted as a binary number.
=item *
-If the string can not be interpreted, NaN is returned.
+Underline characters are allowed in the same way as they are allowed in literal
+numerical constants.
-=back
+=item *
-Octal numbers are typically prefixed by "0", but since leading zeros are
-stripped, these methods can not automatically recognize octal numbers, so use
-the constructor from_oct() to interpret octal strings.
+If the string can not be interpreted, or does not represent a finite integer,
+NaN is returned.
+
+=item *
+
+For hexadecimal, octal, and binary floating point numbers, the exponent must be
+separated from the significand (mantissa) by the letter "p" or "P", not "e" or
+"E" as with decimal numbers.
+
+=back
Some examples of valid string input
Input string Resulting value
+
123 123
1.23e2 123
12300e-2 123
- 0xcafe 51966
- 0b1101 13
+
67_538_754 67538754
-4_5_6.7_8_9e+0_1_0 -4567890000000
+ 0x13a 314
+ 0x13ap0 314
+ 0x1.3ap+8 314
+ 0x0.00013ap+24 314
+ 0x13a000p-12 314
+
+ 0o472 314
+ 0o1.164p+8 314
+ 0o0.0001164p+20 314
+ 0o1164000p-10 314
+
+ 0472 472 Note!
+ 01.164p+8 314
+ 00.0001164p+20 314
+ 01164000p-10 314
+
+ 0b100111010 314
+ 0b1.0011101p+8 314
+ 0b0.00010011101p+12 314
+ 0b100111010000p-3 314
+
Input given as scalar numbers might lose precision. Quote your input to ensure
that no digits are lost:
$x = Math::BigInt->new( 56789012345678901234 ); # bad
$x = Math::BigInt->new('56789012345678901234'); # good
-Currently, Math::BigInt->new() defaults to 0, while Math::BigInt->new('')
-results in 'NaN'. This might change in the future, so use always the following
-explicit forms to get a zero or NaN:
+Currently, C<Math::BigInt->new()> (no input argument) and
+C<Math::BigInt->new("")> return 0. This might change in the future, so always
+use the following explicit forms to get a zero:
$zero = Math::BigInt->bzero();
- $nan = Math::BigInt->bnan();
=head2 Output
@@ -4802,18 +6234,25 @@ Set/get the rounding mode.
Set/get the class for upgrading. When a computation might result in a
non-integer, the operands are upgraded to this class. This is used for instance
-by L<bignum>. The default is C<undef>, thus the following operation creates
-a Math::BigInt, not a Math::BigFloat:
+by L<bignum>. The default is C<undef>, i.e., no upgrading.
- my $i = Math::BigInt->new(123);
- my $f = Math::BigFloat->new('123.1');
+ # with no upgrading
+ $x = Math::BigInt->new(12);
+ $y = Math::BigInt->new(5);
+ print $x / $y, "\n"; # 2 as a Math::BigInt
- print $i + $f, "\n"; # prints 246
+ # with upgrading to Math::BigFloat
+ Math::BigInt -> upgrade("Math::BigFloat");
+ print $x / $y, "\n"; # 2.4 as a Math::BigFloat
+
+ # with upgrading to Math::BigRat (after loading Math::BigRat)
+ Math::BigInt -> upgrade("Math::BigRat");
+ print $x / $y, "\n"; # 12/5 as a Math::BigRat
=item downgrade()
-Set/get the class for downgrading. The default is C<undef>. Downgrading is not
-done by Math::BigInt.
+Set/get the class for downgrading. The default is C<undef>, i.e., no
+downgrading. Downgrading is not done by Math::BigInt.
=item modify()
@@ -4871,11 +6310,18 @@ parameters are marked as RW. The following parameters are supported.
$x = Math::BigInt->new($str,$A,$P,$R);
Creates a new Math::BigInt object from a scalar or another Math::BigInt object.
-The input is accepted as decimal, hexadecimal (with leading '0x') or binary
-(with leading '0b').
+The input is accepted as decimal, hexadecimal (with leading '0x'), octal (with
+leading ('0o') or binary (with leading '0b').
See L</Input> for more info on accepted input formats.
+=item from_dec()
+
+ $x = Math::BigInt->from_dec("314159"); # input is decimal
+
+Interpret input as a decimal. It is equivalent to new(), but does not accept
+anything but strings representing finite, decimal numbers.
+
=item from_hex()
$x = Math::BigInt->from_hex("0xcafe"); # input is hexadecimal
@@ -4969,6 +6415,16 @@ are equivalent
$x = Math::BigInt->from_base("100", 2, "01"); # $x is 4
$x = Math::BigInt->from_base("|--", 2, "-|"); # $x is 4
+=item from_base_num()
+
+Returns a new Math::BigInt object given an array of values and a base. This
+method is equivalent to C<from_base()>, but works on numbers in an array rather
+than characters in a string. Unlike C<from_base()>, all input values may be
+arbitrarily large.
+
+ $x = Math::BigInt->from_base_num([1, 1, 0, 1], 2) # $x is 13
+ $x = Math::BigInt->from_base_num([3, 125, 39], 128) # $x is 65191
+
=item bzero()
$x = Math::BigInt->bzero();
@@ -5055,6 +6511,14 @@ v1.22, while C<as_int()> was introduced in v1.68.
In Math::BigInt, C<as_int()> has the same effect as C<copy()>.
+=item as_float()
+
+Return the argument as a Math::BigFloat object.
+
+=item as_rat()
+
+Return the argument as a Math::BigRat object.
+
=back
=head2 Boolean methods
@@ -5539,19 +7003,35 @@ Calculates the N'th root of C<$x>.
=item bfac()
- $x->bfac(); # factorial of $x (1*2*3*4*..*$x)
+ $x->bfac(); # factorial of $x
-Returns the factorial of C<$x>, i.e., the product of all positive integers up
-to and including C<$x>.
+Returns the factorial of C<$x>, i.e., $x*($x-1)*($x-2)*...*2*1, the product of
+all positive integers up to and including C<$x>. C<$x> must be > -1. The
+factorial of N is commonly written as N!, or N!1, when using the multifactorial
+notation.
=item bdfac()
- $x->bdfac(); # double factorial of $x (1*2*3*4*..*$x)
+ $x->bdfac(); # double factorial of $x
+
+Returns the double factorial of C<$x>, i.e., $x*($x-2)*($x-4)*... C<$x> must be
+> -2. The double factorial of N is commonly written as N!!, or N!2, when using
+the multifactorial notation.
+
+=item btfac()
-Returns the double factorial of C<$x>. If C<$x> is an even integer, returns the
-product of all positive, even integers up to and including C<$x>, i.e.,
-2*4*6*...*$x. If C<$x> is an odd integer, returns the product of all positive,
-odd integers, i.e., 1*3*5*...*$x.
+ $x->btfac(); # triple factorial of $x
+
+Returns the triple factorial of C<$x>, i.e., $x*($x-3)*($x-6)*... C<$x> must be
+> -3. The triple factorial of N is commonly written as N!!!, or N!3, when using
+the multifactorial notation.
+
+=item bmfac()
+
+ $x->bmfac($k); # $k'th multifactorial of $x
+
+Returns the multi-factorial of C<$x>, i.e., $x*($x-$k)*($x-2*$k)*... C<$x> must
+be > -$k. The multi-factorial of N is commonly written as N!K.
=item bfib()
@@ -5847,6 +7327,24 @@ Returns the integer part and the fraction part. If the fraction part can not be
represented as an integer, upgrading is performed or NaN is returned. The
output of C<dparts()> corresponds to the output from C<bdstr()>.
+=item fparts()
+
+Returns the smallest possible numerator and denominator so that the numerator
+divided by the denominator gives back the original value. For finite numbers,
+both values are integers. Mnemonic: fraction.
+
+=item numerator()
+
+Together with L</denominator()>, returns the smallest integers so that the
+numerator divided by the denominator reproduces the original value. With
+Math::BigInt, numerator() simply returns a copy of the invocand.
+
+=item denominator()
+
+Together with L</numerator()>, returns the smallest integers so that the
+numerator divided by the denominator reproduces the original value. With
+Math::BigInt, denominator() always returns either a 1 or a NaN.
+
=back
=head2 String conversion methods
@@ -5908,6 +7406,17 @@ corresponds to the output from C<dparts()>.
12000 is returned as "12000"
10000 is returned as "10000"
+=item bfstr()
+
+Returns a string representing the number using fractional notation. The output
+corresponds to the output from C<fparts()>.
+
+ 12.345 is returned as "2469/200"
+ 123.45 is returned as "2469/20"
+ 1234.5 is returned as "2469/2"
+ 12345 is returned as "12345"
+ 123450 is returned as "123450"
+
=item to_hex()
$x->to_hex();
@@ -5931,8 +7440,8 @@ Returns an octal string representation of the number. See also from_oct().
$x = Math::BigInt->new("1667327589");
$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. See also from_bytes().
+Returns a byte string representation of the number using big endian byte order.
+The invocand must be a non-negative, finite integer. See also from_bytes().
=item to_base()
@@ -5954,6 +7463,19 @@ Here are some more examples
See from_base() for information and examples.
+=item to_base_num()
+
+Converts the given number to the given base. This method is equivalent to
+C<_to_base()>, but returns numbers in an array rather than characters in a
+string. In the output, the first element is the most significant. Unlike
+C<_to_base()>, all input values may be arbitrarily large.
+
+ $x = Math::BigInt->new(13);
+ $x->to_base_num(2); # returns [1, 1, 0, 1]
+
+ $x = Math::BigInt->new(65191);
+ $x->to_base_num(128); # returns [3, 125, 39]
+
=item as_hex()
$x->as_hex();
@@ -5991,6 +7513,94 @@ needed, for instance in array index operations.
=back
+=head2 Utility methods
+
+These utility methods are made public
+
+=over
+
+=item dec_str_to_dec_flt_str()
+
+Takes a string representing any valid number using decimal notation and converts
+it to a string representing the same number using decimal floating point
+notation. The output consists of five parts joined together: the sign of the
+significand, the absolute value of the significand as the smallest possible
+integer, the letter "e", the sign of the exponent, and the absolute value of the
+exponent. If the input is invalid, nothing is returned.
+
+ $str2 = $class -> dec_str_to_dec_flt_str($str1);
+
+Some examples
+
+ Input Output
+ 31400.00e-4 +314e-2
+ -0.00012300e8 -123e+2
+ 0 +0e+0
+
+=item hex_str_to_dec_flt_str()
+
+Takes a string representing any valid number using hexadecimal notation and
+converts it to a string representing the same number using decimal floating
+point notation. The output has the same format as that of
+L</dec_str_to_dec_flt_str()>.
+
+ $str2 = $class -> hex_str_to_dec_flt_str($str1);
+
+Some examples
+
+ Input Output
+ 0xff +255e+0
+
+Some examples
+
+=item oct_str_to_dec_flt_str()
+
+Takes a string representing any valid number using octal notation and converts
+it to a string representing the same number using decimal floating point
+notation. The output has the same format as that of
+L</dec_str_to_dec_flt_str()>.
+
+ $str2 = $class -> oct_str_to_dec_flt_str($str1);
+
+=item bin_str_to_dec_flt_str()
+
+Takes a string representing any valid number using binary notation and converts
+it to a string representing the same number using decimal floating point
+notation. The output has the same format as that of
+L</dec_str_to_dec_flt_str()>.
+
+ $str2 = $class -> bin_str_to_dec_flt_str($str1);
+
+=item dec_str_to_dec_str()
+
+Takes a string representing any valid number using decimal notation and converts
+it to a string representing the same number using decimal notation. If the
+number represents an integer, the output consists of a sign and the absolute
+value. If the number represents a non-integer, the output consists of a sign,
+the integer part of the number, the decimal point ".", and the fraction part of
+the number without any trailing zeros. If the input is invalid, nothing is
+returned.
+
+=item hex_str_to_dec_str()
+
+Takes a string representing any valid number using hexadecimal notation and
+converts it to a string representing the same number using decimal notation. The
+output has the same format as that of L</dec_str_to_dec_str()>.
+
+=item oct_str_to_dec_str()
+
+Takes a string representing any valid number using octal notation and converts
+it to a string representing the same number using decimal notation. The
+output has the same format as that of L</dec_str_to_dec_str()>.
+
+=item bin_str_to_dec_str()
+
+Takes a string representing any valid number using binary notation and converts
+it to a string representing the same number using decimal notation. The output
+has the same format as that of L</dec_str_to_dec_str()>.
+
+=back
+
=head1 ACCURACY and PRECISION
Math::BigInt and Math::BigFloat have full support for accuracy and precision
@@ -6182,7 +7792,7 @@ This is how it works now:
* You can also set P globally by using Math::SomeClass->precision()
likewise.
* Globals are classwide, and not inherited by subclasses.
- * to undefine A, use Math::SomeCLass->accuracy(undef);
+ * to undefine A, use Math::SomeClass->accuracy(undef);
* to undefine P, use Math::SomeClass->precision(undef);
* Setting Math::SomeClass->accuracy() clears automatically
Math::SomeClass->precision(), and vice versa.
@@ -6217,8 +7827,8 @@ This is how it works now:
use Math::BigInt;
Math::BigInt->accuracy(2);
- Math::BigInt::SomeSubClass->accuracy(3);
- $x = Math::BigInt::SomeSubClass->new(1234);
+ Math::BigInt::SomeSubclass->accuracy(3);
+ $x = Math::BigInt::SomeSubclass->new(1234);
$x is now 1230, and not 1200. A subclass might choose to implement
this otherwise, e.g. falling back to the parent's A and P.
@@ -6385,52 +7995,80 @@ instead relying on the internal representation.
=head2 MATH LIBRARY
-Math with the numbers is done (by default) by a module called
-C<Math::BigInt::Calc>. This is equivalent to saying:
+The mathematical computations are performed by a backend library. It is not
+required to specify which backend library to use, but some backend libraries
+are much faster than the default library.
+
+=head3 The default library
+
+The default library is L<Math::BigInt::Calc>, which is implemented in pure Perl
+and hence does not require a compiler.
+
+=head3 Specifying a library
+
+The simple case
+
+ use Math::BigInt;
+
+is equivalent to saying
use Math::BigInt try => 'Calc';
-You can change this backend library by using:
+You can use a different backend library with, e.g.,
use Math::BigInt try => 'GMP';
-B<Note>: General purpose packages should not be explicit about the library to
-use; let the script author decide which is best.
+which attempts to load the L<Math::BigInt::GMP> library, and falls back to the
+default library if the specified library can't be loaded.
+
+Multiple libraries can be specified by separating them by a comma, e.g.,
+
+ use Math::BigInt try => 'GMP,Pari';
-If your script works with huge numbers and Calc is too slow for them, you can
-also for the loading of one of these libraries and if none of them can be used,
-the code dies:
+If you request a specific set of libraries and do not allow fallback to the
+default library, specify them using "only",
use Math::BigInt only => 'GMP,Pari';
-The following would first try to find Math::BigInt::Foo, then
-Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
+If you prefer a specific set of libraries, but want to see a warning if the
+fallback library is used, specify them using "lib",
- use Math::BigInt try => 'Foo,Math::BigInt::Bar';
+ use Math::BigInt lib => 'GMP,Pari';
+
+The following first tries to find Math::BigInt::Foo, then Math::BigInt::Bar, and
+if this also fails, reverts to Math::BigInt::Calc:
-The library that is loaded last is used. Note that this can be overwritten at
-any time by loading a different library, and numbers constructed with different
-libraries cannot be used in math operations together.
+ use Math::BigInt try => 'Foo,Math::BigInt::Bar';
-=head3 What library to use?
+=head3 Which library to use?
B<Note>: General purpose packages should not be explicit about the library to
use; let the script author decide which is best.
-L<Math::BigInt::GMP> and L<Math::BigInt::Pari> are in cases involving big
-numbers much faster than Calc, however it is slower when dealing with very
-small numbers (less than about 20 digits) and when converting very large
-numbers to decimal (for instance for printing, rounding, calculating their
-length in decimal etc).
+L<Math::BigInt::GMP>, L<Math::BigInt::Pari>, and L<Math::BigInt::GMPz> are in
+cases involving big numbers much faster than L<Math::BigInt::Calc>. However
+these libraries are slower when dealing with very small numbers (less than about
+20 digits) and when converting very large numbers to decimal (for instance for
+printing, rounding, calculating their length in decimal etc.).
So please select carefully what library you want to use.
-Different low-level libraries use different formats to store the numbers.
-However, you should B<NOT> depend on the number having a specific format
-internally.
+Different low-level libraries use different formats to store the numbers, so
+mixing them won't work. You should not depend on the number having a specific
+internal format.
See the respective math library module documentation for further details.
+=head3 Loading multiple libraries
+
+The first library that is successfully loaded is the one that will be used. Any
+further attempts at loading a different module will be ignored. This is to avoid
+the situation where module A requires math library X, and module B requires math
+library Y, causing modules A and B to be incompatible. For example,
+
+ use Math::BigInt; # loads default "Calc"
+ use Math::BigFloat only => "GMP"; # ignores "GMP"
+
=head2 SIGN
The sign is either '+', '-', 'NaN', '+inf' or '-inf'.
@@ -6452,7 +8090,7 @@ when dividing any negative number by 0.
$x = Math::BigInt->babs("-12345"); # Math::BigInt "12345"
$x = Math::BigInt->bnorm("-0.00"); # Math::BigInt "0"
$x = bigint(1) + bigint(2); # Math::BigInt "3"
- $x = bigint(1) + "2"; # ditto (auto-Math::BigIntify of "2")
+ $x = bigint(1) + "2"; # ditto ("2" becomes a Math::BigInt)
$x = bigint(1); # Math::BigInt "1"
$x = $x + 5 / 2; # Math::BigInt "3"
$x = $x ** 3; # Math::BigInt "27"
@@ -6491,49 +8129,69 @@ Examples for converting:
my $x = Math::BigInt->new('0b1'.'01' x 123);
print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n";
-=head1 Autocreating constants
+=head1 NUMERIC LITERALS
-After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal
-and binary constants in the given scope are converted to C<Math::BigInt>. This
-conversion happens at compile time.
+After C<use Math::BigInt ':constant'> all numeric literals in the given scope
+are converted to C<Math::BigInt> objects. This conversion happens at compile
+time. Every non-integer is convert to a NaN.
-In particular,
+For example,
- perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
+ perl -MMath::BigInt=:constant -le 'print 2**150'
-prints the integer value of C<2**100>. Note that without conversion of
-constants the expression 2**100 is calculated using Perl scalars.
+prints the exact value of C<2**150>. Note that without conversion of constants
+to objects the expression C<2**150> is calculated using Perl scalars, which
+leads to an inaccurate result.
-Please note that strings and floating point constants are not affected, so that
+Please note that strings are not affected, so that
use Math::BigInt qw/:constant/;
- $x = 1234567890123456789012345678901234567890
- + 123456789123456789;
- $y = '1234567890123456789012345678901234567890'
- + '123456789123456789';
+ $x = "1234567890123456789012345678901234567890"
+ + "123456789123456789";
-does not give you what you expect. You need an explicit Math::BigInt->new()
-around one of the operands. You should also quote large constants to protect
+does give you what you expect. You need an explicit Math::BigInt->new() around
+at least one of the operands. You should also quote large constants to prevent
loss of precision:
use Math::BigInt;
- $x = Math::BigInt->new('1234567889123456789123456789123456789');
+ $x = Math::BigInt->new("1234567889123456789123456789123456789");
+
+Without the quotes Perl first converts the large number to a floating point
+constant at compile time, and then converts the result to a Math::BigInt object
+at run time, which results in an inaccurate result.
+
+=head2 Hexadecimal, octal, and binary floating point literals
+
+Perl (and this module) accepts hexadecimal, octal, and binary floating point
+literals, but use them with care with Perl versions before v5.32.0, because some
+versions of Perl silently give the wrong result. Below are some examples of
+different ways to write the number decimal 314.
-Without the quotes Perl would convert the large number to a floating point
-constant at compile time and then hand the result to Math::BigInt, which
-results in an truncated result or a NaN.
+Hexadecimal floating point literals:
-This also applies to integers that look like floating point constants:
+ 0x1.3ap+8 0X1.3AP+8
+ 0x1.3ap8 0X1.3AP8
+ 0x13a0p-4 0X13A0P-4
- use Math::BigInt ':constant';
+Octal floating point literals (with "0" prefix):
- print ref(123e2),"\n";
- print ref(123.2e2),"\n";
+ 01.164p+8 01.164P+8
+ 01.164p8 01.164P8
+ 011640p-4 011640P-4
-prints nothing but newlines. Use either L<bignum> or L<Math::BigFloat> to get
-this to work.
+Octal floating point literals (with "0o" prefix) (requires v5.34.0):
+
+ 0o1.164p+8 0O1.164P+8
+ 0o1.164p8 0O1.164P8
+ 0o11640p-4 0O11640P-4
+
+Binary floating point literals:
+
+ 0b1.0011101p+8 0B1.0011101P+8
+ 0b1.0011101p8 0B1.0011101P8
+ 0b10011101000p-2 0B10011101000P-2
=head1 PERFORMANCE
@@ -6727,11 +8385,12 @@ strings:
use Test::More tests => 3;
use Math::BigInt;
- $x = Math::BigInt->new('1e56'); $y = 1e56;
+ $x = Math::BigInt->new('1e56');
+ $y = 1e56;
is($x,$y); # fails
- is($x->bsstr(),$y); # okay
+ is($x->bsstr(), $y); # okay
$y = Math::BigInt->new($y);
- is($x,$y); # okay
+ is($x, $y); # okay
Alternatively, simply use C<< <=> >> for comparisons, this always gets it
right. There is not yet a way to get a number automatically represented as a
@@ -6871,17 +8530,13 @@ 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
+=item * GitHub
-L<http://annocpan.org/dist/Math-BigInt>
+L<https://github.com/pjacklam/p5-Math-BigInt>
-=item * CPAN Ratings
+=item * RT: CPAN's request tracker
-L<https://cpanratings.perl.org/dist/Math-BigInt>
+L<https://rt.cpan.org/Dist/Display.html?Name=Math-BigInt>
=item * MetaCPAN
@@ -6891,6 +8546,10 @@ L<https://metacpan.org/release/Math-BigInt>
L<http://matrix.cpantesters.org/?dist=Math-BigInt>
+=item * CPAN Ratings
+
+L<https://cpanratings.perl.org/dist/Math-BigInt>
+
=item * The Bignum mailing list
=over 4
@@ -6942,7 +8601,7 @@ Florian Ragwitz E<lt>flora@cpan.orgE<gt>, 2010.
=item *
-Peter John Acklam E<lt>pjacklam@online.noE<gt>, 2011-.
+Peter John Acklam E<lt>pjacklam@gmail.comE<gt>, 2011-.
=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 cd8f1ee44e..a5429dce62 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm
@@ -7,89 +7,171 @@ use warnings;
use Carp qw< carp croak >;
use Math::BigInt::Lib;
-our $VERSION = '1.999818';
+our $VERSION = '1.999837';
+$VERSION =~ tr/_//d;
our @ISA = ('Math::BigInt::Lib');
# Package to store unsigned big integers in decimal and do math with them
-
+#
# Internally the numbers are stored in an array with at least 1 element, no
# leading zero parts (except the first) and in base 1eX where X is determined
# automatically at loading time to be the maximum possible value
-
+#
# todo:
# - fully remove funky $# stuff in div() (maybe - that code scares me...)
-# USE_MUL: due to problems on certain os (os390, posix-bc) "* 1e-5" is used
-# instead of "/ 1e5" at some places, (marked with USE_MUL). Other platforms
-# BS2000, some Crays need USE_DIV instead.
-# The BEGIN block is used to determine which of the two variants gives the
-# correct result.
-
-# Beware of things like:
-# $i = $i * $y + $car; $car = int($i / $BASE); $i = $i % $BASE;
-# This works on x86, but fails on ARM (SA1100, iPAQ) due to who knows what
-# reasons. So, use this instead (slower, but correct):
-# $i = $i * $y + $car; $car = int($i / $BASE); $i -= $BASE * $car;
-
##############################################################################
# global constants, flags and accessory
# constants for easier life
-my ($BASE, $BASE_LEN, $RBASE, $MAX_VAL);
-my ($AND_BITS, $XOR_BITS, $OR_BITS);
-my ($AND_MASK, $XOR_MASK, $OR_MASK);
-sub _base_len {
- # Set/get the BASE_LEN and assorted other, related values.
- # Used only by the testsuite, the set variant is used only by the BEGIN
- # block below:
-
- my ($class, $b, $int) = @_;
- if (defined $b) {
- no warnings "redefine";
-
- if ($] >= 5.008 && $int && $b > 7) {
- $BASE_LEN = $b;
- *_mul = \&_mul_use_div_64;
- *_div = \&_div_use_div_64;
- $BASE = int("1e" . $BASE_LEN);
- $MAX_VAL = $BASE-1;
- return $BASE_LEN unless wantarray;
- return ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL);
- }
+my $MAX_EXP_F; # the maximum possible base 10 exponent with "no integer"
+my $MAX_EXP_I; # the maximum possible base 10 exponent with "use integer"
+
+my $MAX_BITS; # the maximum possible number of bits for $AND_BITS etc.
+
+my $BASE_LEN; # the current base exponent in use
+my $USE_INT; # whether "use integer" is used in the computations
+
+my $BASE; # the current base, e.g., 10000 if $BASE_LEN is 5
+my $MAX_VAL; # maximum value for an element, i.e., $BASE - 1
+
+my $AND_BITS; # maximum value used in binary and, e.g., 0xffff
+my $OR_BITS; # ditto for binary or
+my $XOR_BITS; # ditto for binary xor
+
+my $AND_MASK; # $AND_BITS + 1, e.g., 0x10000 if $AND_BITS is 0xffff
+my $OR_MASK; # ditto for binary or
+my $XOR_MASK; # ditto for binary xor
+
+sub config {
+ my $self = shift;
- # find whether we can use mul or div in mul()/div()
- $BASE_LEN = $b + 1;
- my $caught = 0;
- while (--$BASE_LEN > 5) {
- $BASE = int("1e" . $BASE_LEN);
- $RBASE = abs('1e-' . $BASE_LEN); # see USE_MUL
- $caught = 0;
- $caught += 1 if (int($BASE * $RBASE) != 1); # should be 1
- $caught += 2 if (int($BASE / $BASE) != 1); # should be 1
- last if $caught != 3;
+ croak "Missing input argument" unless @_;
+
+ # Called as a getter.
+
+ if (@_ == 1) {
+ my $param = shift;
+ croak "Parameter name must be a non-empty string"
+ unless defined $param && length $param;
+ return $BASE_LEN if $param eq 'base_len';
+ return $USE_INT if $param eq 'use_int';
+ croak "Unknown parameter '$param'";
+ }
+
+ # Called as a setter.
+
+ my $opts;
+ while (@_) {
+ my $param = shift;
+ croak "Parameter name must be a non-empty string"
+ unless defined $param && length $param;
+ croak "Missing value for parameter '$param'"
+ unless @_;
+ my $value = shift;
+
+ if ($param eq 'base_len' || $param eq 'use_int') {
+ $opts -> {$param} = $value;
+ next;
}
- $BASE = int("1e" . $BASE_LEN);
- $RBASE = abs('1e-' . $BASE_LEN); # see USE_MUL
- $MAX_VAL = $BASE-1;
- # ($caught & 1) != 0 => cannot use MUL
- # ($caught & 2) != 0 => cannot use DIV
- if ($caught == 2) # 2
+ croak "Unknown parameter '$param'";
+ }
+
+ $BASE_LEN = $opts -> {base_len} if exists $opts -> {base_len};
+ $USE_INT = $opts -> {use_int} if exists $opts -> {use_int};
+ __PACKAGE__ -> _base_len($BASE_LEN, $USE_INT);
+
+ return $self;
+}
+
+sub _base_len {
+ #my $class = shift; # $class is not used
+ shift;
+
+ if (@_) { # if called as setter ...
+ my ($base_len, $use_int) = @_;
+
+ croak "The base length must be a positive integer"
+ unless defined($base_len) && $base_len == int($base_len)
+ && $base_len > 0;
+
+ if ( $use_int && ($base_len > $MAX_EXP_I) ||
+ !$use_int && ($base_len > $MAX_EXP_F))
{
- # must USE_MUL since we cannot use DIV
- *_mul = \&_mul_use_mul;
- *_div = \&_div_use_mul;
- } else # 0 or 1
+ croak "The maximum base length (exponent) is $MAX_EXP_I with",
+ " 'use integer' and $MAX_EXP_F without 'use integer'. The",
+ " requested settings, a base length of $base_len ",
+ $use_int ? "with" : "without", " 'use integer', is invalid.";
+ }
+
+ $BASE_LEN = $base_len;
+ $BASE = 0 + ("1" . ("0" x $BASE_LEN));
+ $MAX_VAL = $BASE - 1;
+ $USE_INT = $use_int ? 1 : 0;
+
{
- # can USE_DIV instead
- *_mul = \&_mul_use_div;
- *_div = \&_div_use_div;
+ no warnings "redefine";
+ if ($use_int) {
+ *_mul = \&_mul_use_int;
+ *_div = \&_div_use_int;
+ } else {
+ *_mul = \&_mul_no_int;
+ *_div = \&_div_no_int;
+ }
}
}
+
+ # Find max bits. This is the largest power of two that is both no larger
+ # than $BASE and no larger than the maximum integer (i.e., ~0). We need
+ # this limitation because _and(), _or(), and _xor() only work on one
+ # element at a time.
+
+ my $umax = ~0; # largest unsigned integer
+ my $tmp = $umax < $BASE ? $umax : $BASE;
+
+ $MAX_BITS = 0;
+ while ($tmp >>= 1) {
+ $MAX_BITS++;
+ }
+
+ # Limit to 32 bits for portability. Is this really necessary? XXX
+
+ $MAX_BITS = 32 if $MAX_BITS > 32;
+
+ # Find out how many bits _and, _or and _xor can take (old default = 16).
+ # Are these tests really necessary? Can't we just use $MAX_BITS? XXX
+
+ for ($AND_BITS = $MAX_BITS ; $AND_BITS > 0 ; $AND_BITS--) {
+ my $x = CORE::oct('0b' . '1' x $AND_BITS);
+ my $y = $x & $x;
+ my $z = 2 * (2 ** ($AND_BITS - 1)) + 1;
+ last unless $AND_BITS < $MAX_BITS && $x == $z && $y == $x;
+ }
+
+ for ($XOR_BITS = $MAX_BITS ; $XOR_BITS > 0 ; $XOR_BITS--) {
+ my $x = CORE::oct('0b' . '1' x $XOR_BITS);
+ my $y = $x ^ $x;
+ my $z = 2 * (2 ** ($XOR_BITS - 1)) + 1;
+ last unless $XOR_BITS < $MAX_BITS && $x == $z && $y == $x;
+ }
+
+ for ($OR_BITS = $MAX_BITS ; $OR_BITS > 0 ; $OR_BITS--) {
+ my $x = CORE::oct('0b' . '1' x $OR_BITS);
+ my $y = $x | $x;
+ my $z = 2 * (2 ** ($OR_BITS - 1)) + 1;
+ last unless $OR_BITS < $MAX_BITS && $x == $z && $y == $x;
+ }
+
+ $AND_MASK = __PACKAGE__->_new(( 2 ** $AND_BITS ));
+ $XOR_MASK = __PACKAGE__->_new(( 2 ** $XOR_BITS ));
+ $OR_MASK = __PACKAGE__->_new(( 2 ** $OR_BITS ));
+
return $BASE_LEN unless wantarray;
- return ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL);
+ return ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL,
+ $MAX_BITS, $MAX_EXP_F, $MAX_EXP_I, $USE_INT);
}
sub _new {
@@ -116,89 +198,98 @@ sub _new {
}
BEGIN {
- # from Daniel Pfeiffer: determine largest group of digits that is precisely
- # multipliable with itself plus carry
- # Test now changed to expect the proper pattern, not a result off by 1 or 2
- my ($e, $num) = 3; # lowest value we will use is 3+1-1 = 3
- do {
- $num = '9' x ++$e;
- $num *= $num + 1;
- } while $num =~ /9{$e}0{$e}/; # must be a certain pattern
- $e--; # last test failed, so retract one step
- # the limits below brush the problems with the test above under the rug:
- # the test should be able to find the proper $e automatically
- $e = 5 if $^O =~ /^uts/; # UTS get's some special treatment
- $e = 5 if $^O =~ /^unicos/; # unicos is also problematic (6 seems to work
- # there, but we play safe)
-
- my $int = 0;
- if ($e > 7) {
- use integer;
- my $e1 = 7;
- $num = 7;
- do {
- $num = ('9' x ++$e1) + 0;
- $num *= $num + 1;
- } while ("$num" =~ /9{$e1}0{$e1}/); # must be a certain pattern
- $e1--; # last test failed, so retract one step
- if ($e1 > 7) {
- $int = 1;
- $e = $e1;
- }
- }
- __PACKAGE__ -> _base_len($e, $int); # set and store
+ # Compute $MAX_EXP_F, the maximum usable base 10 exponent.
- use integer;
- # find out how many bits _and, _or and _xor can take (old default = 16)
- # I don't think anybody has yet 128 bit scalars, so let's play safe.
- local $^W = 0; # don't warn about 'nonportable number'
- $AND_BITS = 15;
- $XOR_BITS = 15;
- $OR_BITS = 15;
-
- # find max bits, we will not go higher than numberofbits that fit into $BASE
- # to make _and etc simpler (and faster for smaller, slower for large numbers)
- my $max = 16;
- while (2 ** $max < $BASE) {
- $max++;
- }
- {
- no integer;
- $max = 16 if $] < 5.006; # older Perls might not take >16 too well
- }
- my ($x, $y, $z);
-
- do {
- $AND_BITS++;
- $x = CORE::oct('0b' . '1' x $AND_BITS);
- $y = $x & $x;
- $z = (2 ** $AND_BITS) - 1;
- } while ($AND_BITS < $max && $x == $z && $y == $x);
- $AND_BITS --; # retreat one step
-
- do {
- $XOR_BITS++;
- $x = CORE::oct('0b' . '1' x $XOR_BITS);
- $y = $x ^ 0;
- $z = (2 ** $XOR_BITS) - 1;
- } while ($XOR_BITS < $max && $x == $z && $y == $x);
- $XOR_BITS --; # retreat one step
-
- do {
- $OR_BITS++;
- $x = CORE::oct('0b' . '1' x $OR_BITS);
- $y = $x | $x;
- $z = (2 ** $OR_BITS) - 1;
- } while ($OR_BITS < $max && $x == $z && $y == $x);
- $OR_BITS--; # retreat one step
-
- $AND_MASK = __PACKAGE__->_new(( 2 ** $AND_BITS ));
- $XOR_MASK = __PACKAGE__->_new(( 2 ** $XOR_BITS ));
- $OR_MASK = __PACKAGE__->_new(( 2 ** $OR_BITS ));
-
- # We can compute the approximate length no faster than the real length:
- *_alen = \&_len;
+ # The largest element in base 10**$BASE_LEN is 10**$BASE_LEN-1. For instance,
+ # with $BASE_LEN = 5, the largest element is 99_999, and the largest carry is
+ #
+ # int( 99_999 * 99_999 / 100_000 ) = 99_998
+ #
+ # so make sure that 99_999 * 99_999 + 99_998 is within the range of integers
+ # that can be represented accuratly.
+ #
+ # Note that on some systems with quadmath support, the following is within
+ # the range of numbers that can be represented exactly, but it still gives
+ # the incorrect value $r = 2 (even though POSIX::fmod($x, $y) gives the
+ # correct value of 1:
+ #
+ # $x = 99999999999999999;
+ # $y = 100000000000000000;
+ # $r = $x * $x % $y; # should be 1
+ #
+ # so also check for this.
+
+ for ($MAX_EXP_F = 1 ; ; $MAX_EXP_F++) { # when $MAX_EXP_F = 5
+ my $MAX_EXP_FM1 = $MAX_EXP_F - 1; # = 4
+ my $bs = "1" . ("0" x $MAX_EXP_F); # = "100000"
+ my $xs = "9" x $MAX_EXP_F; # = "99999"
+ my $cs = ("9" x $MAX_EXP_FM1) . "8"; # = "99998"
+ my $ys = $cs . ("0" x $MAX_EXP_FM1) . "1"; # = "9999800001"
+
+ # Compute and check the product.
+ my $yn = $xs * $xs; # = 9999800001
+ last if $yn != $ys;
+
+ # Compute and check the remainder.
+ my $rn = $yn % $bs; # = 1
+ last if $rn != 1;
+
+ # Compute and check the carry. The division here is exact.
+ my $cn = ($yn - $rn) / $bs; # = 99998
+ last if $cn != $cs;
+
+ # Compute and check product plus carry.
+ my $zs = $cs . ("9" x $MAX_EXP_F); # = "9999899999"
+ my $zn = $yn + $cn; # = 99998999999
+ last if $zn != $zs;
+ last if $zn - ($zn - 1) != 1;
+ }
+ $MAX_EXP_F--; # last test failed, so retract one step
+
+ # Compute $MAX_EXP_I, the maximum usable base 10 exponent within the range
+ # of what is available with "use integer". On older versions of Perl,
+ # integers are converted to floating point numbers, even though they are
+ # within the range of what can be represented as integers. For example, on
+ # some 64 bit Perls, 999999999 * 999999999 becomes 999999998000000000, not
+ # 999999998000000001, even though the latter is less than the maximum value
+ # for a 64 bit integer, 18446744073709551615.
+
+ my $umax = ~0; # largest unsigned integer
+ for ($MAX_EXP_I = int(0.5 * log($umax) / log(10));
+ $MAX_EXP_I > 0;
+ $MAX_EXP_I--)
+ { # when $MAX_EXP_I = 5
+ my $MAX_EXP_IM1 = $MAX_EXP_I - 1; # = 4
+ my $bs = "1" . ("0" x $MAX_EXP_I); # = "100000"
+ my $xs = "9" x $MAX_EXP_I; # = "99999"
+ my $cs = ("9" x $MAX_EXP_IM1) . "8"; # = "99998"
+ my $ys = $cs . ("0" x $MAX_EXP_IM1) . "1"; # = "9999800001"
+
+ # Compute and check the product.
+ my $yn = $xs * $xs; # = 9999800001
+ next if $yn != $ys;
+
+ # Compute and check the remainder.
+ my $rn = $yn % $bs; # = 1
+ next if $rn != 1;
+
+ # Compute and check the carry. The division here is exact.
+ my $cn = ($yn - $rn) / $bs; # = 99998
+ next if $cn != $cs;
+
+ # Compute and check product plus carry.
+ my $zs = $cs . ("9" x $MAX_EXP_I); # = "9999899999"
+ my $zn = $yn + $cn; # = 99998999999
+ next if $zn != $zs;
+ next if $zn - ($zn - 1) != 1;
+ last;
+ }
+
+ ($BASE_LEN, $USE_INT) = $MAX_EXP_F > $MAX_EXP_I
+ ? ($MAX_EXP_F, 0) : ($MAX_EXP_I, 1);
+
+ __PACKAGE__ -> _base_len($BASE_LEN, $USE_INT);
}
###############################################################################
@@ -224,18 +315,20 @@ sub _two {
sub _ten {
# create a 10
my $class = shift;
- bless [ 10 ], $class;
+ my $self = $BASE_LEN == 1 ? [ 0, 1 ] : [ 10 ];
+ bless $self, $class;
}
sub _1ex {
# create a 1Ex
my $class = shift;
- my $rem = $_[0] % $BASE_LEN; # remainder
- my $parts = $_[0] / $BASE_LEN; # parts
+ my $rem = $_[0] % $BASE_LEN; # remainder
+ my $div = ($_[0] - $rem) / $BASE_LEN; # parts
- # 000000, 000000, 100
- bless [ (0) x $parts, '1' . ('0' x $rem) ], $class;
+ # With a $BASE_LEN of 6, 1e14 becomes
+ # [ 000000, 000000, 100 ] -> [ 0, 0, 100 ]
+ bless [ (0) x $div, 0 + ("1" . ("0" x $rem)) ], $class;
}
sub _copy {
@@ -244,8 +337,33 @@ sub _copy {
return bless [ @{ $_[0] } ], $class;
}
-# catch and throw away
-sub import { }
+sub import {
+ my $self = shift;
+
+ my $opts;
+ my ($base_len, $use_int);
+ while (@_) {
+ my $param = shift;
+ croak "Parameter name must be a non-empty string"
+ unless defined $param && length $param;
+ croak "Missing value for parameter '$param'"
+ unless @_;
+ my $value = shift;
+
+ if ($param eq 'base_len' || $param eq 'use_int') {
+ $opts -> {$param} = $value;
+ next;
+ }
+
+ croak "Unknown parameter '$param'";
+ }
+
+ $base_len = exists $opts -> {base_len} ? $opts -> {base_len} : $BASE_LEN;
+ $use_int = exists $opts -> {use_int} ? $opts -> {use_int} : $USE_INT;
+ __PACKAGE__ -> _base_len($base_len, $use_int);
+
+ return $self;
+}
##############################################################################
# convert back to string and number
@@ -319,10 +437,10 @@ sub _add {
# For each in Y, add Y to X and carry. If after that, something is left in
# X, foreach in X add carry to X and then return X, carry. Trades one
# "$j++" for having to shift arrays.
- my $i;
+
my $car = 0;
my $j = 0;
- for $i (@$y) {
+ for my $i (@$y) {
$x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0;
$j++;
}
@@ -368,10 +486,9 @@ sub _sub {
my ($c, $sx, $sy, $s) = @_;
my $car = 0;
- my $i;
my $j = 0;
if (!$s) {
- for $i (@$sx) {
+ for my $i (@$sx) {
last unless defined $sy->[$j] || $car;
$i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0);
$j++;
@@ -379,7 +496,7 @@ sub _sub {
# might leave leading zeros, so fix that
return __strip_zeros($sx);
}
- for $i (@$sx) {
+ for my $i (@$sx) {
# We can't do an early out if $x < $y, since we need to copy the high
# chunks from $y. Found by Bob Mathews.
#last unless defined $sy->[$j] || $car;
@@ -391,76 +508,12 @@ sub _sub {
__strip_zeros($sy);
}
-sub _mul_use_mul {
- # (ref to int_num_array, ref to int_num_array)
- # multiply two numbers in internal representation
- # modifies first arg, second need not be different from first
- my ($c, $xv, $yv) = @_;
-
- if (@$yv == 1) {
- # shortcut for two very short numbers (improved by Nathan Zook) works
- # also if xv and yv are the same reference, and handles also $x == 0
- if (@$xv == 1) {
- if (($xv->[0] *= $yv->[0]) >= $BASE) {
- my $rem = $xv->[0] % $BASE;
- $xv->[1] = ($xv->[0] - $rem) * $RBASE;
- $xv->[0] = $rem;
- }
- return $xv;
- }
- # $x * 0 => 0
- if ($yv->[0] == 0) {
- @$xv = (0);
- return $xv;
- }
-
- # multiply a large number a by a single element one, so speed up
- my $y = $yv->[0];
- my $car = 0;
- my $rem;
- foreach my $i (@$xv) {
- $i = $i * $y + $car;
- $rem = $i % $BASE;
- $car = ($i - $rem) * $RBASE;
- $i = $rem;
- }
- push @$xv, $car if $car != 0;
- return $xv;
- }
-
- # shortcut for result $x == 0 => result = 0
- return $xv if @$xv == 1 && $xv->[0] == 0;
-
- # since multiplying $x with $x fails, make copy in this case
- $yv = $c->_copy($xv) if $xv == $yv; # same references?
-
- my @prod = ();
- my ($prod, $rem, $car, $cty, $xi, $yi);
- for $xi (@$xv) {
- $car = 0;
- $cty = 0;
- # looping through this if $xi == 0 is silly - so optimize it away!
- $xi = (shift(@prod) || 0), next if $xi == 0;
- for $yi (@$yv) {
- $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
- $rem = $prod % $BASE;
- $car = int(($prod - $rem) * $RBASE);
- $prod[$cty++] = $rem;
- }
- $prod[$cty] += $car if $car; # need really to check for 0?
- $xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy
- }
- push @$xv, @prod;
- $xv;
-}
-
-sub _mul_use_div_64 {
+sub _mul_use_int {
# (ref to int_num_array, ref to int_num_array)
# multiply two numbers in internal representation
# modifies first arg, second need not be different from first
# works for 64 bit integer with "use integer"
my ($c, $xv, $yv) = @_;
-
use integer;
if (@$yv == 1) {
@@ -498,13 +551,13 @@ sub _mul_use_div_64 {
$yv = $c->_copy($xv) if $xv == $yv; # same references?
my @prod = ();
- my ($prod, $car, $cty, $xi, $yi);
- for $xi (@$xv) {
+ my ($prod, $car, $cty);
+ for my $xi (@$xv) {
$car = 0;
$cty = 0;
# looping through this if $xi == 0 is silly - so optimize it away!
$xi = (shift(@prod) || 0), next if $xi == 0;
- for $yi (@$yv) {
+ for my $yi (@$yv) {
$prod = $xi * $yi + ($prod[$cty] || 0) + $car;
$prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE;
}
@@ -515,7 +568,7 @@ sub _mul_use_div_64 {
$xv;
}
-sub _mul_use_div {
+sub _mul_no_int {
# (ref to int_num_array, ref to int_num_array)
# multiply two numbers in internal representation
# modifies first arg, second need not be different from first
@@ -559,13 +612,13 @@ sub _mul_use_div {
$yv = $c->_copy($xv) if $xv == $yv; # same references?
my @prod = ();
- my ($prod, $rem, $car, $cty, $xi, $yi);
- for $xi (@$xv) {
+ my ($prod, $rem, $car, $cty);
+ for my $xi (@$xv) {
$car = 0;
$cty = 0;
# looping through this if $xi == 0 is silly - so optimize it away!
$xi = (shift(@prod) || 0), next if $xi == 0;
- for $yi (@$yv) {
+ for my $yi (@$yv) {
$prod = $xi * $yi + ($prod[$cty] || 0) + $car;
$rem = $prod % $BASE;
$car = ($prod - $rem) / $BASE;
@@ -578,166 +631,7 @@ sub _mul_use_div {
$xv;
}
-sub _div_use_mul {
- # ref to array, ref to array, modify first array and return remainder if
- # in list context
-
- my ($c, $x, $yorg) = @_;
-
- # the general div algorithm here is about O(N*N) and thus quite slow, so
- # we first check for some special cases and use shortcuts to handle them.
-
- # if both numbers have only one element:
- if (@$x == 1 && @$yorg == 1) {
- # shortcut, $yorg and $x are two small numbers
- my $rem = [ $x->[0] % $yorg->[0] ];
- bless $rem, $c;
- $x->[0] = ($x->[0] - $rem->[0]) / $yorg->[0];
- return ($x, $rem) if wantarray;
- return $x;
- }
-
- # if x has more than one, but y has only one element:
- if (@$yorg == 1) {
- my $rem;
- $rem = $c->_mod($c->_copy($x), $yorg) if wantarray;
-
- # shortcut, $y is < $BASE
- my $j = @$x;
- my $r = 0;
- my $y = $yorg->[0];
- my $b;
- while ($j-- > 0) {
- $b = $r * $BASE + $x->[$j];
- $r = $b % $y;
- $x->[$j] = ($b - $r) / $y;
- }
- pop(@$x) if @$x > 1 && $x->[-1] == 0; # remove any trailing zero
- return ($x, $rem) if wantarray;
- return $x;
- }
-
- # now x and y have more than one element
-
- # check whether y has more elements than x, if so, the result is 0
- if (@$yorg > @$x) {
- my $rem;
- $rem = $c->_copy($x) if wantarray; # make copy
- @$x = 0; # set to 0
- return ($x, $rem) if wantarray; # including remainder?
- return $x; # only x, which is [0] now
- }
-
- # check whether the numbers have the same number of elements, in that case
- # the result will fit into one element and can be computed efficiently
- if (@$yorg == @$x) {
- my $cmp = 0;
- for (my $j = $#$x ; $j >= 0 ; --$j) {
- last if $cmp = $x->[$j] - $yorg->[$j];
- }
-
- if ($cmp == 0) { # x = y
- @$x = 1;
- return $x, $c->_zero() if wantarray;
- return $x;
- }
-
- if ($cmp < 0) { # x < y
- if (wantarray) {
- my $rem = $c->_copy($x);
- @$x = 0;
- return $x, $rem;
- }
- @$x = 0;
- return $x;
- }
- }
-
- # all other cases:
-
- my $y = $c->_copy($yorg); # always make copy to preserve
-
- my $tmp = $y->[-1] + 1;
- my $rem = $BASE % $tmp;
- my $dd = ($BASE - $rem) / $tmp;
- if ($dd != 1) {
- my $car = 0;
- for my $xi (@$x) {
- $xi = $xi * $dd + $car;
- $xi -= ($car = int($xi * $RBASE)) * $BASE; # see USE_MUL
- }
- push(@$x, $car);
- $car = 0;
- for my $yi (@$y) {
- $yi = $yi * $dd + $car;
- $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL
- }
- } else {
- push(@$x, 0);
- }
-
- # @q will accumulate the final result, $q contains the current computed
- # part of the final result
-
- my @q = ();
- my ($v2, $v1) = @$y[-2, -1];
- $v2 = 0 unless $v2;
- while ($#$x > $#$y) {
- my ($u2, $u1, $u0) = @$x[-3 .. -1];
- $u2 = 0 unless $u2;
- #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
- # if $v1 == 0;
- my $tmp = $u0 * $BASE + $u1;
- my $rem = $tmp % $v1;
- my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1);
- --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2;
- if ($q) {
- my $prd;
- my ($car, $bar) = (0, 0);
- for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
- $prd = $q * $y->[$yi] + $car;
- $prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL
- $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0);
- }
- if ($x->[-1] < $car + $bar) {
- $car = 0;
- --$q;
- for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
- $x->[$xi] -= $BASE
- if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE);
- }
- }
- }
- pop(@$x);
- unshift(@q, $q);
- }
-
- if (wantarray) {
- my $d = bless [], $c;
- if ($dd != 1) {
- my $car = 0;
- my ($prd, $rem);
- for my $xi (reverse @$x) {
- $prd = $car * $BASE + $xi;
- $rem = $prd % $dd;
- $tmp = ($prd - $rem) / $dd;
- $car = $rem;
- unshift @$d, $tmp;
- }
- } else {
- @$d = @$x;
- }
- @$x = @q;
- __strip_zeros($x);
- __strip_zeros($d);
- return ($x, $d);
- }
- @$x = @q;
- __strip_zeros($x);
- $x;
-}
-
-sub _div_use_div_64 {
+sub _div_use_int {
# ref to array, ref to array, modify first array and return remainder if
# in list context
@@ -900,7 +794,7 @@ sub _div_use_div_64 {
$x;
}
-sub _div_use_div {
+sub _div_no_int {
# ref to array, ref to array, modify first array and return remainder if
# in list context
@@ -1157,12 +1051,12 @@ sub _is_zero {
sub _is_even {
# return true if arg is even
- $_[1]->[0] & 1 ? 0 : 1;
+ $_[1]->[0] % 2 ? 0 : 1;
}
sub _is_odd {
# return true if arg is odd
- $_[1]->[0] & 1 ? 1 : 0;
+ $_[1]->[0] % 2 ? 1 : 0;
}
sub _is_one {
@@ -1177,7 +1071,11 @@ sub _is_two {
sub _is_ten {
# return true if arg is ten
- @{$_[1]} == 1 && $_[1]->[0] == 10 ? 1 : 0;
+ if ($BASE_LEN == 1) {
+ @{$_[1]} == 2 && $_[1]->[0] == 0 && $_[1]->[1] == 1 ? 1 : 0;
+ } else {
+ @{$_[1]} == 1 && $_[1]->[0] == 10 ? 1 : 0;
+ }
}
sub __strip_zeros {
@@ -1316,17 +1214,21 @@ sub _mod {
# shifts
sub _rsft {
- my ($c, $x, $y, $n) = @_;
+ my ($c, $x, $n, $b) = @_;
+ return $x if $c->_is_zero($x) || $c->_is_zero($n);
+
+ # For backwards compatibility, allow the base $b to be a scalar.
+
+ $b = $c->_new($b) unless ref $b;
- if ($n != 10) {
- $n = $c->_new($n);
- return scalar $c->_div($x, $c->_pow($n, $y));
+ if ($c -> _acmp($b, $c -> _ten())) {
+ return scalar $c->_div($x, $c->_pow($c->_copy($b), $n));
}
# shortcut (faster) for shifting by 10)
# multiples of $BASE_LEN
my $dst = 0; # destination
- my $src = $c->_num($y); # as normal int
+ my $src = $c->_num($n); # as normal int
my $xlen = (@$x - 1) * $BASE_LEN + length(int($x->[-1]));
if ($src >= $xlen or ($src == $xlen and !defined $x->[1])) {
# 12345 67890 shifted right by more than 10 digits => 0
@@ -1519,27 +1421,50 @@ sub _nok {
return $n;
}
-my @factorials = (
- 1,
- 1,
- 2,
- 2*3,
- 2*3*4,
- 2*3*4*5,
- 2*3*4*5*6,
- 2*3*4*5*6*7,
- );
-
sub _fac {
# factorial of $x
# ref to array, return ref to array
my ($c, $cx) = @_;
- if ((@$cx == 1) && ($cx->[0] <= 7)) {
- $cx->[0] = $factorials[$cx->[0]]; # 0 => 1, 1 => 1, 2 => 2 etc.
+ # We cache the smallest values. Don't assume that a single element has a
+ # value larger than 9 or else it won't work with a $BASE_LEN of 1.
+
+ if (@$cx == 1) {
+ my @factorials =
+ (
+ '1',
+ '1',
+ '2',
+ '6',
+ '24',
+ '120',
+ '720',
+ '5040',
+ '40320',
+ '362880',
+ );
+ if ($cx->[0] <= $#factorials) {
+ my $tmp = $c -> _new($factorials[ $cx->[0] ]);
+ @$cx = @$tmp;
+ return $cx;
+ }
+ }
+
+ # The old code further below doesn't work for small values of $BASE_LEN.
+ # Alas, I have not been able to (or taken the time to) decipher it, so for
+ # the case when $BASE_LEN is small, we call the parent class. This code
+ # works in for every value of $x and $BASE_LEN. We could use this code for
+ # all cases, but it is a little slower than the code further below, so at
+ # least for now we keep the code below.
+
+ if ($BASE_LEN <= 2) {
+ my $tmp = $c -> SUPER::_fac($cx);
+ @$cx = @$tmp;
return $cx;
}
+ # This code does not work for small values of $BASE_LEN.
+
if ((@$cx == 1) && # we do this only if $x >= 12 and $x <= 7000
($cx->[0] >= 12 && $cx->[0] < 7000)) {
@@ -1759,9 +1684,9 @@ sub _log_int {
$log += (@$base - 1) * $BASE_LEN;
# calculate now a guess based on the values obtained above:
- my $res = int($len / $log);
+ my $res = $c->_new(int($len / $log));
- @$x = $res;
+ @$x = @$res;
my $trial = $c->_pow($c->_copy($base), $x);
my $acmp = $c->_acmp($trial, $x_org);
@@ -1795,9 +1720,8 @@ my $steps = 0;
sub steps { $steps };
sub _sqrt {
- # square-root of $x in place
- # Compute a guess of the result (by rule of thumb), then improve it via
- # Newton's method.
+ # square-root of $x in-place
+
my ($c, $x) = @_;
if (@$x == 1) {
@@ -1805,68 +1729,65 @@ sub _sqrt {
$x->[0] = int(sqrt($x->[0]));
return $x;
}
- my $y = $c->_copy($x);
- # hopefully _len/2 is < $BASE, the -1 is to always undershot the guess
- # since our guess will "grow"
- my $l = int(($c->_len($x)-1) / 2);
-
- my $lastelem = $x->[-1]; # for guess
- my $elems = @$x - 1;
- # not enough digits, but could have more?
- if ((length($lastelem) <= 3) && ($elems > 1)) {
- # right-align with zero pad
- my $len = length($lastelem) & 1;
- print "$lastelem => " if DEBUG;
- $lastelem .= substr($x->[-2] . '0' x $BASE_LEN, 0, $BASE_LEN);
- # former odd => make odd again, or former even to even again
- $lastelem = $lastelem / 10 if (length($lastelem) & 1) != $len;
- print "$lastelem\n" if DEBUG;
- }
-
- # construct $x (instead of $c->_lsft($x, $l, 10)
- my $r = $l % $BASE_LEN; # 10000 00000 00000 00000 ($BASE_LEN=5)
- $l = int($l / $BASE_LEN);
- print "l = $l " if DEBUG;
-
- splice @$x, $l; # keep ref($x), but modify it
-
- # we make the first part of the guess not '1000...0' but int(sqrt($lastelem))
- # that gives us:
- # 14400 00000 => sqrt(14400) => guess first digits to be 120
- # 144000 000000 => sqrt(144000) => guess 379
-
- print "$lastelem (elems $elems) => " if DEBUG;
- $lastelem = $lastelem / 10 if ($elems & 1 == 1); # odd or even?
- my $g = sqrt($lastelem);
- $g =~ s/\.//; # 2.345 => 2345
- $r -= 1 if $elems & 1 == 0; # 70 => 7
-
- # padd with zeros if result is too short
- $x->[$l--] = int(substr($g . '0' x $r, 0, $r+1));
- print "now ", $x->[-1] if DEBUG;
- print " would have been ", int('1' . '0' x $r), "\n" if DEBUG;
-
- # If @$x > 1, we could compute the second elem of the guess, too, to create
- # an even better guess. Not implemented yet. Does it improve performance?
- $x->[$l--] = 0 while ($l >= 0); # all other digits of guess are zero
-
- print "start x= ", $c->_str($x), "\n" if DEBUG;
- my $two = $c->_two();
- my $last = $c->_zero();
- my $lastlast = $c->_zero();
- $steps = 0 if DEBUG;
- while ($c->_acmp($last, $x) != 0 && $c->_acmp($lastlast, $x) != 0) {
- $steps++ if DEBUG;
- $lastlast = $c->_copy($last);
- $last = $c->_copy($x);
- $c->_add($x, $c->_div($c->_copy($y), $x));
- $c->_div($x, $two );
- print " x= ", $c->_str($x), "\n" if DEBUG;
- }
- print "\nsteps in sqrt: $steps, " if DEBUG;
- $c->_dec($x) if $c->_acmp($y, $c->_mul($c->_copy($x), $x)) < 0; # overshot?
- print " final ", $x->[-1], "\n" if DEBUG;
- $x;
+
+ # Create an initial guess for the square root.
+
+ my $s;
+ if (@$x % 2) {
+ $s = [ (0) x ((@$x - 1) / 2), int(sqrt($x->[-1])) ];
+ } else {
+ $s = [ (0) x ((@$x - 2) / 2), int(sqrt($x->[-2] + $x->[-1] * $BASE)) ];
+ }
+
+ # Newton's method for the square root of y:
+ #
+ # x(n) * x(n) - y
+ # x(n+1) = x(n) - -----------------
+ # 2 * x(n)
+
+ my $cmp;
+ while (1) {
+ my $sq = $c -> _mul($c -> _copy($s), $s);
+ $cmp = $c -> _acmp($sq, $x);
+
+ # If x(n)*x(n) > y, compute
+ #
+ # x(n) * x(n) - y
+ # x(n+1) = x(n) - -----------------
+ # 2 * x(n)
+
+ if ($cmp > 0) {
+ my $num = $c -> _sub($c -> _copy($sq), $x);
+ my $den = $c -> _mul($c -> _two(), $s);
+ my $delta = $c -> _div($num, $den);
+ last if $c -> _is_zero($delta);
+ $s = $c -> _sub($s, $delta);
+ }
+
+ # If x(n)*x(n) < y, compute
+ #
+ # y - x(n) * x(n)
+ # x(n+1) = x(n) + -----------------
+ # 2 * x(n)
+
+ elsif ($cmp < 0) {
+ my $num = $c -> _sub($c -> _copy($x), $sq);
+ my $den = $c -> _mul($c -> _two(), $s);
+ my $delta = $c -> _div($num, $den);
+ last if $c -> _is_zero($delta);
+ $s = $c -> _add($s, $delta);
+ }
+
+ # If x(n)*x(n) = y, we have the exact result.
+
+ else {
+ last;
+ }
+ }
+
+ $s = $c -> _dec($s) if $cmp > 0; # never overshoot
+ @$x = @$s;
+ return $x;
}
sub _root {
@@ -1876,14 +1797,18 @@ sub _root {
# Small numbers.
- if (@$x == 1 && @$n == 1) {
- # Result can be computed directly. Adjust initial result for numerical
- # errors, e.g., int(1000**(1/3)) is 2, not 3.
- my $y = int($x->[0] ** (1 / $n->[0]));
- my $yp1 = $y + 1;
- $y = $yp1 if $yp1 ** $n->[0] == $x->[0];
- $x->[0] = $y;
- return $x;
+ if (@$x == 1) {
+ return $x if $x -> [0] == 0 || $x -> [0] == 1;
+
+ if (@$n == 1) {
+ # Result can be computed directly. Adjust initial result for
+ # numerical errors, e.g., int(1000**(1/3)) is 2, not 3.
+ my $y = int($x->[0] ** (1 / $n->[0]));
+ my $yp1 = $y + 1;
+ $y = $yp1 if $yp1 ** $n->[0] == $x->[0];
+ $x->[0] = $y;
+ return $x;
+ }
}
# If x <= n, the result is always (truncated to) 1.
@@ -1891,7 +1816,7 @@ sub _root {
if ((@$x > 1 || $x -> [0] > 0) && # if x is non-zero ...
$c -> _acmp($x, $n) <= 0) # ... and x <= n
{
- my $one = $x -> _one();
+ my $one = $c -> _one();
@$x = @$one;
return $x;
}
@@ -2173,7 +2098,6 @@ sub _or {
# $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
# $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
# $c->_add($x, $c->_mul(_new( $c, ($xrr | $yrr) ), $m) );
-
$c->_add($z, $c->_mul([ 0 + $xr->[0] | 0 + $yr->[0] ], $m));
$c->_mul($m, $mask);
}
@@ -2191,94 +2115,70 @@ sub _as_hex {
# convert a decimal number to hex (ref to array, return ref to string)
my ($c, $x) = @_;
- # fits into one element (handle also 0x0 case)
- return sprintf("0x%x", $x->[0]) if @$x == 1;
+ return "0x0" if @$x == 1 && $x->[0] == 0;
my $x1 = $c->_copy($x);
+ my $x10000 = [ 0x10000 ];
+
my $es = '';
- my ($xr, $h, $x10000);
- if ($] >= 5.006) {
- $x10000 = [ 0x10000 ];
- $h = 'h4';
- } else {
- $x10000 = [ 0x1000 ];
- $h = 'h3';
- }
- while (@$x1 != 1 || $x1->[0] != 0) # _is_zero()
- {
+ my $xr;
+ until (@$x1 == 1 && $x1->[0] == 0) { # _is_zero()
($x1, $xr) = $c->_div($x1, $x10000);
- $es .= unpack($h, pack('V', $xr->[0]));
+ $es = sprintf('%04x', $xr->[0]) . $es;
}
- $es = reverse $es;
- $es =~ s/^[0]+//; # strip leading zeros
- '0x' . $es; # return result prepended with 0x
+ #$es = reverse $es;
+ $es =~ s/^0*/0x/;
+ return $es;
}
sub _as_bin {
# convert a decimal number to bin (ref to array, return ref to string)
my ($c, $x) = @_;
- # fits into one element (and Perl recent enough), handle also 0b0 case
- # handle zero case for older Perls
- if ($] <= 5.005 && @$x == 1 && $x->[0] == 0) {
- my $t = '0b0';
- return $t;
- }
- if (@$x == 1 && $] >= 5.006) {
- my $t = sprintf("0b%b", $x->[0]);
- return $t;
- }
+ return "0b0" if @$x == 1 && $x->[0] == 0;
+
my $x1 = $c->_copy($x);
+ my $x10000 = [ 0x10000 ];
+
my $es = '';
- my ($xr, $b, $x10000);
- if ($] >= 5.006) {
- $x10000 = [ 0x10000 ];
- $b = 'b16';
- } else {
- $x10000 = [ 0x1000 ];
- $b = 'b12';
- }
- while (!(@$x1 == 1 && $x1->[0] == 0)) # _is_zero()
- {
+ my $xr;
+
+ until (@$x1 == 1 && $x1->[0] == 0) { # _is_zero()
($x1, $xr) = $c->_div($x1, $x10000);
- $es .= unpack($b, pack('v', $xr->[0]));
+ $es = sprintf('%016b', $xr->[0]) . $es;
}
- $es = reverse $es;
- $es =~ s/^[0]+//; # strip leading zeros
- '0b' . $es; # return result prepended with 0b
+ $es =~ s/^0*/0b/;
+ return $es;
}
sub _as_oct {
# convert a decimal number to octal (ref to array, return ref to string)
my ($c, $x) = @_;
- # fits into one element (handle also 0 case)
- return sprintf("0%o", $x->[0]) if @$x == 1;
+ return "00" if @$x == 1 && $x->[0] == 0;
my $x1 = $c->_copy($x);
+ my $x1000 = [ 1 << 15 ]; # 15 bits = 32768 = 0100000
+
my $es = '';
my $xr;
- my $x1000 = [ 0100000 ];
- while (@$x1 != 1 || $x1->[0] != 0) # _is_zero()
- {
+ until (@$x1 == 1 && $x1->[0] == 0) { # _is_zero()
($x1, $xr) = $c->_div($x1, $x1000);
- $es .= reverse sprintf("%05o", $xr->[0]);
+ $es = sprintf("%05o", $xr->[0]) . $es;
}
- $es = reverse $es;
- $es =~ s/^0+//; # strip leading zeros
- '0' . $es; # return result prepended with 0
+ $es =~ s/^0*/0/; # excactly one leading zero
+ return $es;
}
sub _from_oct {
# convert a octal number to decimal (string, return ref to array)
my ($c, $os) = @_;
- # for older Perls, play safe
- my $m = [ 0100000 ];
- my $d = 5; # 5 digits at a time
+ my $m = $c->_new(1 << 30); # 30 bits at a time (<32 bits!)
+ my $d = 10; # 10 octal digits at a time
my $mul = $c->_one();
my $x = $c->_zero();
@@ -2291,7 +2191,7 @@ sub _from_oct {
$val = CORE::oct($val);
$i -= $d;
$len --;
- my $adder = [ $val ];
+ my $adder = $c -> _new($val);
$c->_add($x, $c->_mul($adder, $mul)) if $val != 0;
$c->_mul($mul, $m) if $len >= 0; # skip last mul
}
@@ -2302,8 +2202,8 @@ sub _from_hex {
# convert a hex number to decimal (string, return ref to array)
my ($c, $hs) = @_;
- my $m = $c->_new(0x10000000); # 28 bit at a time (<32 bit!)
- my $d = 7; # 7 digits at a time
+ my $m = $c->_new(0x10000000); # 28 bit at a time (<32 bit!)
+ my $d = 7; # 7 hexadecimal digits at a time
my $mul = $c->_one();
my $x = $c->_zero();
@@ -2316,7 +2216,7 @@ sub _from_hex {
$val = CORE::hex($val); # hex does not like wrong chars
$i -= $d;
$len --;
- my $adder = [ $val ];
+ my $adder = $c->_new($val);
# if the resulting number was to big to fit into one element, create a
# two-element version (bug found by Mark Lakata - Thanx!)
if (CORE::length($val) > $BASE_LEN) {
@@ -2348,12 +2248,13 @@ sub _from_bin {
# special modulus functions
sub _modinv {
+
# modular multiplicative inverse
my ($c, $x, $y) = @_;
# modulo zero
if ($c->_is_zero($y)) {
- return undef, undef;
+ return;
}
# modulo one
@@ -2384,7 +2285,7 @@ sub _modinv {
}
# if the gcd is not 1, then return NaN
- return (undef, undef) unless $c->_is_one($a);
+ return unless $c->_is_one($a);
($v, $sign == 1 ? '+' : '-');
}
@@ -2471,7 +2372,7 @@ sub _gcd {
=head1 NAME
-Math::BigInt::Calc - Pure Perl module to support Math::BigInt
+Math::BigInt::Calc - pure Perl module to support Math::BigInt
=head1 SYNOPSIS
@@ -2484,25 +2385,76 @@ Math::BigInt::Calc - Pure Perl module to support Math::BigInt
# to use it with Math::BigRat
use Math::BigRat lib => 'Calc';
+ # explicitly set base length and whether to "use integer"
+ use Math::BigInt::Calc base_len => 4, use_int => 1;
+ use Math::BigInt lib => 'Calc';
+
=head1 DESCRIPTION
Math::BigInt::Calc inherits from Math::BigInt::Lib.
-In this library, the numbers are represented in base B = 10**N, where N is the
-largest possible value that does not cause overflow in the intermediate
-computations. The base B elements are stored in an array, with the least
-significant element stored in array element zero. There are no leading zero
-elements, except a single zero element when the number is zero.
+In this library, the numbers are represented interenally in base B = 10**N,
+where N is the largest possible integer that does not cause overflow in the
+intermediate computations. The base B elements are stored in an array, with the
+least significant element stored in array element zero. There are no leading
+zero elements, except a single zero element when the number is zero. For
+instance, if B = 10000, the number 1234567890 is represented internally as
+[7890, 3456, 12].
+
+=head1 OPTIONS
+
+When the module is loaded, it computes the maximum exponent, i.e., power of 10,
+that can be used with and without "use integer" in the computations. The default
+is to use this maximum exponent. If the combination of the 'base_len' value and
+the 'use_int' value exceeds the maximum value, an error is thrown.
+
+=over 4
+
+=item base_len
+
+The base length can be specified explicitly with the 'base_len' option. The
+value must be a positive integer.
+
+ use Math::BigInt::Calc base_len => 4; # use 10000 as internal base
+
+=item use_int
+
+This option is used to specify whether "use integer" should be used in the
+internal computations. The value is interpreted as a boolean value, so use 0 or
+"" for false and anything else for true. If the 'base_len' is not specified
+together with 'use_int', the current value for the base length is used.
+
+ use Math::BigInt::Calc use_int => 1; # use "use integer" internally
+
+=back
+
+=head1 METHODS
+
+This overview constains only the methods that are specific to
+C<Math::BigInt::Calc>. For the other methods, see L<Math::BigInt::Lib>.
+
+=over 4
+
+=item _base_len()
+
+Specify the desired base length and whether to enable "use integer" in the
+computations.
+
+ Math::BigInt::Calc -> _base_len($base_len, $use_int);
+
+Note that it is better to specify the base length and whether to use integers as
+options when the module is loaded, for example like this
+
+ use Math::BigInt::Calc base_len => 6, use_int => 1;
-For instance, if B = 10000, the number 1234567890 is represented internally
-as [7890, 3456, 12].
+=back
=head1 SEE ALSO
L<Math::BigInt::Lib> for a description of the API.
-Alternative libraries L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and
-L<Math::BigInt::Pari>.
+Alternative libraries L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>,
+L<Math::BigInt::Pari>, L<Math::BigInt::GMPz>, and L<Math::BigInt::BitVect>.
Some of the modules that use these libraries L<Math::BigInt>,
L<Math::BigFloat>, and L<Math::BigRat>.
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 4e903bd4f1..ee2c29de3b 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm
@@ -1,28 +1,89 @@
package Math::BigInt::FastCalc;
-use 5.006;
+use 5.006001;
use strict;
use warnings;
+use Carp qw< carp croak >;
+
use Math::BigInt::Calc 1.999801;
-our @ISA = qw< Math::BigInt::Calc >;
+BEGIN {
+ our @ISA = qw< Math::BigInt::Calc >;
+}
+
+our $VERSION = '0.5013';
+
+my $MAX_EXP_F; # the maximum possible base 10 exponent with "no integer"
+my $MAX_EXP_I; # the maximum possible base 10 exponent with "use integer"
+my $BASE_LEN; # the current base exponent in use
+my $USE_INT; # whether "use integer" is used in the computations
+
+sub _base_len {
+ my $class = shift;
+
+ if (@_) { # if called as setter ...
+ my ($base_len, $use_int) = @_;
+
+ croak "The base length must be a positive integer"
+ unless defined($base_len) && $base_len == int($base_len)
+ && $base_len > 0;
+
+ if ( $use_int && ($base_len > $MAX_EXP_I) ||
+ !$use_int && ($base_len > $MAX_EXP_F))
+ {
+ croak "The maximum base length (exponent) is $MAX_EXP_I with",
+ " 'use integer' and $MAX_EXP_F without 'use integer'. The",
+ " requested settings, a base length of $base_len ",
+ $use_int ? "with" : "without", " 'use integer', is invalid.";
+ }
+
+ return $class -> SUPER::_base_len($base_len, $use_int);
+ }
+
+ return $class -> SUPER::_base_len();
+}
-our $VERSION = '0.5009';
+BEGIN {
+
+ my @params = Math::BigInt::FastCalc -> SUPER::_base_len();
+ $BASE_LEN = $params[0];
+ $MAX_EXP_F = $params[8];
+ $MAX_EXP_I = $params[9];
+
+ # With quadmath support it should work with a base length of 17, because the
+ # maximum intermediate value used in the computations is less than 2**113.
+ # However, for some reason a base length of 17 doesn't work, but trial and
+ # error shows that a base length of 15 works for all methods except
+ # _is_odd() and _is_even(). These two methods determine whether the least
+ # significand component is odd or even by converting it to a UV and do a
+ # bitwise & operation. Because of this, we need to limit the base length to
+ # what fits inside an UV.
+
+ require Config;
+ my $max_exp_i = int(8 * $Config::Config{uvsize} * log(2) / log(10));
+ $MAX_EXP_I = $max_exp_i if $max_exp_i < $MAX_EXP_I;
+ $MAX_EXP_F = $MAX_EXP_I if $MAX_EXP_I < $MAX_EXP_F;
+
+ ($BASE_LEN, $USE_INT) = $MAX_EXP_I > $MAX_EXP_F ? ($MAX_EXP_I, 1)
+ : ($MAX_EXP_F, 0);
+
+ Math::BigInt::FastCalc -> SUPER::_base_len($BASE_LEN, $USE_INT);
+}
##############################################################################
# global constants, flags and accessory
-# announce that we are compatible with MBI v1.83 and up
-sub api_version () { 2; }
+# Announce that we are compatible with MBI v1.83 and up. This method has been
+# made redundant. Each backend is now a subclass of Math::BigInt::Lib, which
+# provides the methods not present in the subclasses.
-# use Calc to override the methods that we do not provide in XS
+sub api_version () { 2; }
require XSLoader;
XSLoader::load(__PACKAGE__, $VERSION, Math::BigInt::Calc->_base_len());
##############################################################################
-##############################################################################
1;
@@ -57,12 +118,20 @@ In order to allow for multiple big integer libraries, Math::BigInt was
rewritten to use library modules for core math routines. Any module which
follows the same API as this can be used instead by using the following:
- use Math::BigInt lib => 'libname';
+ use Math::BigInt lib => 'libname';
'libname' is either the long name ('Math::BigInt::Pari'), or only the short
version like 'Pari'. To use this library:
- use Math::BigInt lib => 'FastCalc';
+ use Math::BigInt lib => 'FastCalc';
+
+The default behaviour is to chose the best internal representation of big
+integers, but the base length used in the internal representation can be
+specified explicitly. Note that this must be done before Math::BigInt is loaded.
+For example,
+
+ use Math::BigInt::FastCalc base_len => 3;
+ use Math::BigInt lib => 'FastCalc';
=head1 STORAGE
@@ -73,25 +142,25 @@ stored in decimal form chopped into parts.
The following functions are now implemented in FastCalc.xs:
- _is_odd _is_even _is_one _is_zero
- _is_two _is_ten
- _zero _one _two _ten
- _acmp _len
- _inc _dec
- __strip_zeros _copy
+ _is_odd _is_even _is_one _is_zero
+ _is_two _is_ten
+ _zero _one _two _ten
+ _acmp _len
+ _inc _dec
+ __strip_zeros _copy
=head1 BUGS
Please report any bugs or feature requests to
C<bug-math-bigint-fastcalc at rt.cpan.org>, or through the web interface at
L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt-FastCalc>
-(requires login).
-We will be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
+(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.
+After installing, you can find documentation for this module with the perldoc
+command.
perldoc Math::BigInt::FastCalc
@@ -99,43 +168,25 @@ You can also look for information at:
=over 4
-=item * RT: CPAN's request tracker
+=item GitHub
-L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt-FastCalc>
+L<https://github.com/pjacklam/p5-Math-BigInt-FastCalc>
-=item * AnnoCPAN: Annotated CPAN documentation
+=item RT: CPAN's request tracker
-L<http://annocpan.org/dist/Math-BigInt-FastCalc>
+L<https://rt.cpan.org/Dist/Display.html?Name=Math-BigInt-FastCalc>
-=item * CPAN Ratings
+=item MetaCPAN
-L<http://cpanratings.perl.org/dist/Math-BigInt-FastCalc>
+L<https://metacpan.org/release/Math-BigInt-FastCalc>
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/Math-BigInt-FastCalc/>
-
-=item * CPAN Testers Matrix
+=item CPAN Testers Matrix
L<http://matrix.cpantesters.org/?dist=Math-BigInt-FastCalc>
-=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 CPAN Ratings
-=item * Subscribe/Unsubscribe
-
-L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum>
-
-=back
+L<https://cpanratings.perl.org/dist/Math-BigInt-FastCalc>
=back
@@ -148,12 +199,13 @@ the same terms as Perl itself.
Original math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/>
in late 2000.
-Separated from BigInt and shaped API with the help of John Peacock.
+
+Separated from Math::BigInt and shaped API with the help of John Peacock.
Fixed, sped-up and enhanced by Tels http://bloodgate.com 2001-2003.
Further streamlining (api_version 1 etc.) by Tels 2004-2007.
-Bug-fixing by Peter John Acklam E<lt>pjacklam@online.noE<gt> 2010-2016.
+Maintained by Peter John Acklam E<lt>pjacklam@gmail.comE<gt> 2010-2021.
=head1 SEE ALSO
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 fde281297f..37fa9b94de 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,8 @@ use 5.006001;
use strict;
use warnings;
-our $VERSION = '1.999818';
+our $VERSION = '1.999837';
+$VERSION =~ tr/_//d;
use Carp;
@@ -88,7 +89,7 @@ use overload
$x = $_[0];
$y = ref($_[1]) ? $class -> _num($_[1]) : $_[1];
}
- return $class -> _blsft($x, $y);
+ return $class -> _lsft($x, $y);
},
'>>' => sub {
@@ -101,7 +102,7 @@ use overload
$x = $class -> _copy($_[0]);
$y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
}
- return $class -> _brsft($x, $y);
+ return $class -> _rsft($x, $y);
},
# overload key: num_comparison
@@ -352,6 +353,56 @@ sub _dec {
$class -> _sub($x, $class -> _one());
}
+# Signed addition. If the flag is false, $xa might be modified, but not $ya. If
+# the false is true, $ya might be modified, but not $xa.
+
+sub _sadd {
+ my $class = shift;
+ my ($xa, $xs, $ya, $ys, $flag) = @_;
+ my ($za, $zs);
+
+ # If the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
+
+ if ($xs eq $ys) {
+ if ($flag) {
+ $za = $class -> _add($ya, $xa);
+ } else {
+ $za = $class -> _add($xa, $ya);
+ }
+ $zs = $class -> _is_zero($za) ? '+' : $xs;
+ return $za, $zs;
+ }
+
+ my $acmp = $class -> _acmp($xa, $ya); # abs(x) = abs(y)
+
+ if ($acmp == 0) { # x = -y or -x = y
+ $za = $class -> _zero();
+ $zs = '+';
+ return $za, $zs;
+ }
+
+ if ($acmp > 0) { # abs(x) > abs(y)
+ $za = $class -> _sub($xa, $ya, $flag);
+ $zs = $xs;
+ } else { # abs(x) < abs(y)
+ $za = $class -> _sub($ya, $xa, !$flag);
+ $zs = $ys;
+ }
+ return $za, $zs;
+}
+
+# Signed subtraction. If the flag is false, $xa might be modified, but not $ya.
+# If the false is true, $ya might be modified, but not $xa.
+
+sub _ssub {
+ my $class = shift;
+ my ($xa, $xs, $ya, $ys, $flag) = @_;
+
+ # Swap sign of second operand and let _sadd() do the job.
+ $ys = $ys eq '+' ? '-' : '+';
+ $class -> _sadd($xa, $xs, $ya, $ys, $flag);
+}
+
##############################################################################
# testing
@@ -573,23 +624,54 @@ sub _nok {
return $n;
}
+#sub _fac {
+# # factorial
+# my ($class, $x) = @_;
+#
+# my $two = $class -> _two();
+#
+# if ($class -> _acmp($x, $two) < 0) {
+# return $class -> _one();
+# }
+#
+# my $i = $class -> _copy($x);
+# while ($class -> _acmp($i, $two) > 0) {
+# $i = $class -> _dec($i);
+# $x = $class -> _mul($x, $i);
+# }
+#
+# return $x;
+#}
+
sub _fac {
# factorial
my ($class, $x) = @_;
- my $two = $class -> _two();
+ # This is an implementation of the split recursive algorithm. See
+ # http://www.luschny.de/math/factorial/csharp/FactorialSplit.cs.html
- if ($class -> _acmp($x, $two) < 0) {
- return $class -> _one();
- }
+ my $p = $class -> _one();
+ my $r = $class -> _one();
+ my $two = $class -> _two();
- my $i = $class -> _copy($x);
- while ($class -> _acmp($i, $two) > 0) {
- $i = $class -> _dec($i);
- $x = $class -> _mul($x, $i);
+ my ($log2n) = $class -> _log_int($class -> _copy($x), $two);
+ my $h = $class -> _zero();
+ my $shift = $class -> _zero();
+ my $k = $class -> _one();
+
+ while ($class -> _acmp($h, $x)) {
+ $shift = $class -> _add($shift, $h);
+ $h = $class -> _rsft($class -> _copy($x), $log2n, $two);
+ $log2n = $class -> _dec($log2n) if !$class -> _is_zero($log2n);
+ my $high = $class -> _copy($h);
+ $high = $class -> _dec($high) if $class -> _is_even($h);
+ while ($class -> _acmp($k, $high)) {
+ $k = $class -> _add($k, $two);
+ $p = $class -> _mul($p, $k);
+ }
+ $r = $class -> _mul($r, $p);
}
-
- return $x;
+ return $class -> _lsft($r, $shift, $two);
}
sub _dfac {
@@ -725,7 +807,7 @@ sub _sqrt {
#
# x(i+1) = x(i) - f(x(i)) / f'(x(i))
# = x(i) - (x(i)^2 - y) / (2 * x(i)) # use if x(i)^2 > y
- # = y(i) + (y - x(i)^2) / (2 * x(i)) # use if x(i)^2 < y
+ # = x(i) + (y - x(i)^2) / (2 * x(i)) # use if x(i)^2 < y
# Determine if x, our guess, is too small, correct, or too large.
@@ -1433,7 +1515,9 @@ sub _to_base {
my $collseq;
if (@_) {
- $collseq = shift();
+ $collseq = shift;
+ croak "The collation sequence must be a non-empty string"
+ unless defined($collseq) && length($collseq);
} else {
if ($class -> _acmp($base, $class -> _new("94")) <= 0) {
$collseq = '0123456789' # 48 .. 57
@@ -1461,10 +1545,40 @@ sub _to_base {
my $chr = $collseq[$num];
$str = $chr . $str;
}
- return "0" unless length $str;
+ return $collseq[0] unless length $str;
return $str;
}
+sub _to_base_num {
+ # Convert the number to an array of integers in any base.
+ my ($class, $x, $base) = @_;
+
+ # Make sure the base is an object and >= 2.
+ $base = $class -> _new($base) unless ref($base);
+ my $two = $class -> _two();
+ croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0;
+
+ my $out = [];
+ my $xcopy = $class -> _copy($x);
+ my $rem;
+
+ # Do all except the last (most significant) element.
+ until ($class -> _acmp($xcopy, $base) < 0) {
+ ($xcopy, $rem) = $class -> _div($xcopy, $base);
+ unshift @$out, $rem;
+ }
+
+ # Do the last (most significant element).
+ unless ($class -> _is_zero($xcopy)) {
+ unshift @$out, $xcopy;
+ }
+
+ # $out is empty if $x is zero.
+ unshift @$out, $class -> _zero() unless @$out;
+
+ return $out;
+}
+
sub _from_hex {
# Convert a string of hexadecimal digits to a number.
@@ -1622,6 +1736,32 @@ sub _from_base {
return $x;
}
+sub _from_base_num {
+ # Convert an array in the given base to a number.
+ my ($class, $in, $base) = @_;
+
+ # Make sure the base is an object and >= 2.
+ $base = $class -> _new($base) unless ref($base);
+ my $two = $class -> _two();
+ croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0;
+
+ # @$in = map { ref($_) ? $_ : $class -> _new($_) } @$in;
+
+ my $ele = $in -> [0];
+
+ $ele = $class -> _new($ele) unless ref($ele);
+ my $x = $class -> _copy($ele);
+
+ for my $i (1 .. $#$in) {
+ $x = $class -> _mul($x, $base);
+ $ele = $in -> [$i];
+ $ele = $class -> _new($ele) unless ref($ele);
+ $x = $class -> _add($x, $ele);
+ }
+
+ return $x;
+}
+
##############################################################################
# special modulus functions
@@ -1631,7 +1771,7 @@ sub _modinv {
# modulo zero
if ($class -> _is_zero($y)) {
- return (undef, undef);
+ return;
}
# modulo one
@@ -1661,7 +1801,7 @@ sub _modinv {
}
# if the gcd is not 1, there exists no modular multiplicative inverse
- return (undef, undef) unless $class -> _is_one($a);
+ return unless $class -> _is_one($a);
($v, $sign == 1 ? '+' : '-');
}
@@ -1786,8 +1926,6 @@ sub _lucas {
return @y;
}
- require Scalar::Util;
-
# In scalar context use that lucas(n) = fib(n-1) + fib(n+1).
#
# Remember that _fib() behaves differently in scalar context and list
@@ -1795,8 +1933,8 @@ sub _lucas {
return $class -> _two() if $n == 0;
- return $class -> _add(scalar $class -> _fib($n - 1),
- scalar $class -> _fib($n + 1));
+ return $class -> _add(scalar($class -> _fib($n - 1)),
+ scalar($class -> _fib($n + 1)));
}
sub _fib {
@@ -1876,8 +2014,8 @@ Math::BigInt::Lib - virtual parent class for Math::BigInt libraries
package Math::BigInt::MyBackend;
- use Math::BigInt::lib;
- our @ISA = qw< Math::BigInt::lib >;
+ use Math::BigInt::Lib;
+ our @ISA = qw< Math::BigInt::Lib >;
sub _new { ... }
sub _str { ... }
@@ -2035,6 +2173,16 @@ Some more examples, all returning 250:
$x = $class -> _from_base("42", 62)
$x = $class -> _from_base("2!", 94)
+=item CLASS-E<gt>_from_base_num(ARRAY, BASE)
+
+Returns an object given an array of values and a base. This method is
+equivalent to C<_from_base()>, but works on numbers in an array rather than
+characters in a string. Unlike C<_from_base()>, all input values may be
+arbitrarily large.
+
+ $x = $class -> _from_base_num([1, 1, 0, 1], 2) # $x is 13
+ $x = $class -> _from_base_num([3, 125, 39], 128) # $x is 65191
+
=back
=head3 Mathematical functions
@@ -2043,24 +2191,38 @@ Some more examples, all returning 250:
=item CLASS-E<gt>_add(OBJ1, OBJ2)
-Returns the result of adding OBJ2 to OBJ1.
+Addition. Returns the result of adding OBJ2 to OBJ1.
=item CLASS-E<gt>_mul(OBJ1, OBJ2)
-Returns the result of multiplying OBJ2 and OBJ1.
+Multiplication. Returns the result of multiplying OBJ2 and OBJ1.
=item CLASS-E<gt>_div(OBJ1, OBJ2)
-In scalar context, returns the quotient after dividing OBJ1 by OBJ2 and
-truncating the result to an integer. In list context, return the quotient and
-the remainder.
+Division. In scalar context, returns the quotient after dividing OBJ1 by OBJ2
+and truncating the result to an integer. In list context, return the quotient
+and the remainder.
=item CLASS-E<gt>_sub(OBJ1, OBJ2, FLAG)
=item CLASS-E<gt>_sub(OBJ1, OBJ2)
-Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false or omitted,
-OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified.
+Subtraction. Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false
+or omitted, OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified.
+
+=item CLASS-E<gt>_sadd(OBJ1, SIGN1, OBJ2, SIGN2)
+
+Signed addition. Returns the result of adding OBJ2 with sign SIGN2 to OBJ1 with
+sign SIGN1.
+
+ ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2);
+
+=item CLASS-E<gt>_ssub(OBJ1, SIGN1, OBJ2, SIGN2)
+
+Signed subtraction. Returns the result of subtracting OBJ2 with sign SIGN2 to
+OBJ1 with sign SIGN1.
+
+ ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2);
=item CLASS-E<gt>_dec(OBJ)
@@ -2268,6 +2430,16 @@ COLLSEQ.
See _from_base() for more information.
+=item CLASS-E<gt>_to_base_num(OBJ, BASE)
+
+Converts the given number to the given base. This method is equivalent to
+C<_to_base()>, but returns numbers in an array rather than characters in a
+string. In the output, the first element is the most significant. Unlike
+C<_to_base()>, all input values may be arbitrarily large.
+
+ $x = $class -> _to_base_num(13, 2) # $x is [1, 1, 0, 1]
+ $x = $class -> _to_base_num(65191, 128) # $x is [3, 125, 39]
+
=item CLASS-E<gt>_as_bin(OBJ)
Like C<_to_bin()> but with a '0b' prefix.
@@ -2460,7 +2632,7 @@ the same terms as Perl itself.
=head1 AUTHOR
-Peter John Acklam, E<lt>pjacklam@online.noE<gt>
+Peter John Acklam, E<lt>pjacklam@gmail.comE<gt>
Code and documentation based on the Math::BigInt::Calc module by Tels
E<lt>nospam-abuse@bloodgate.comE<gt>
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 5517bedad9..16ac187abb 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Trace.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Trace.pm
@@ -1,48 +1,76 @@
-#!perl
+# -*- mode: perl; -*-
package Math::BigInt::Trace;
-require 5.010;
use strict;
use warnings;
use Exporter;
use Math::BigInt;
-our ($accuracy, $precision, $round_mode, $div_scale);
-
our @ISA = qw(Exporter Math::BigInt);
-our $VERSION = '0.51';
+our $VERSION = '0.66';
use overload; # inherit overload from Math::BigInt
# Globals
-$accuracy = $precision = undef;
-$round_mode = 'even';
-$div_scale = 40;
+our $accuracy = undef;
+our $precision = undef;
+our $round_mode = 'even';
+our $div_scale = 40;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $value = shift;
+
my $a = $accuracy;
$a = $_[0] if defined $_[0];
+
my $p = $precision;
$p = $_[1] if defined $_[1];
- my $self = Math::BigInt->new($value, $a, $p, $round_mode);
- bless $self, $class;
- print "MBI new '$value' => '$self' (", ref($self), ")";
+
+ my $self = $class -> SUPER::new($value, $a, $p, $round_mode);
+
+ printf "Math::BigInt new '%s' => '%s' (%s)\n",
+ $value, $self, ref($self);
+
return $self;
}
sub import {
- print "MBI import ", join(' ', @_);
- my $self = shift;
- Math::BigInt::import($self, @_); # need it for subclasses
-# $self->export_to_level(1, $self, @_); # need this ?
- @_ = ();
+ my $class = shift;
+
+ printf "%s -> import(%s)\n", $class, join(", ", @_);
+
+ # we catch the constants, the rest goes to parent
+
+ my $constant = grep { $_ eq ':constant' } @_;
+ my @a = grep { $_ ne ':constant' } @_;
+
+ if ($constant) {
+ overload::constant
+
+ integer => sub {
+ $class -> new(shift);
+ },
+
+ float => sub {
+ $class -> new(shift);
+ },
+
+ binary => sub {
+ # E.g., a literal 0377 shall result in an object whose value
+ # is decimal 255, but new("0377") returns decimal 377.
+ return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
+ $class -> new(shift);
+ };
+ }
+
+ $class -> SUPER::import(@a); # need it for subclasses
+ #$self -> export_to_level(1, $class, @_); # need this ?
}
1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat.pm
index e3d172836c..0d0f246795 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat.pm
@@ -16,11 +16,12 @@ use 5.006;
use strict;
use warnings;
-use Carp qw< carp croak >;
+use Carp qw< carp croak >;
+use Scalar::Util qw< blessed >;
-use Math::BigFloat 1.999718;
+use Math::BigFloat ();
-our $VERSION = '0.2614';
+our $VERSION = '0.2624';
our @ISA = qw(Math::BigFloat);
@@ -199,12 +200,6 @@ use overload
BEGIN {
*objectify = \&Math::BigInt::objectify; # inherit this from BigInt
*AUTOLOAD = \&Math::BigFloat::AUTOLOAD; # can't inherit AUTOLOAD
- # We inherit these from BigFloat because currently it is not possible that
- # Math::BigFloat has a different $LIB variable than we, because
- # Math::BigFloat also uses Math::BigInt::config->('lib') (there is always
- # only one library loaded)
- *_e_add = \&Math::BigFloat::_e_add;
- *_e_sub = \&Math::BigFloat::_e_sub;
*as_number = \&as_int;
*is_pos = \&is_positive;
*is_neg = \&is_negative;
@@ -305,20 +300,32 @@ sub new {
unless (defined $d) {
#return $n -> copy($n) if $n -> isa('Math::BigRat');
- return $class -> copy($n) if $n -> isa('Math::BigRat');
- return $class -> bnan() if $n -> is_nan();
- return $class -> binf($n -> sign()) if $n -> is_inf();
+ if ($n -> isa('Math::BigRat')) {
+ return $downgrade -> new($n)
+ if defined($downgrade) && $n -> is_int();
+ return $class -> copy($n);
+ }
+
+ if ($n -> is_nan()) {
+ return $class -> bnan();
+ }
+
+ if ($n -> is_inf()) {
+ return $class -> binf($n -> sign());
+ }
if ($n -> isa('Math::BigInt')) {
- $self -> {_n} = $LIB -> _new($n -> copy() -> babs() -> bstr());
+ $self -> {_n} = $LIB -> _new($n -> copy() -> babs(undef, undef)
+ -> bstr());
$self -> {_d} = $LIB -> _one();
$self -> {sign} = $n -> sign();
+ return $downgrade -> new($n) if defined $downgrade;
return $self;
}
if ($n -> isa('Math::BigFloat')) {
- my $m = $n -> mantissa() -> babs();
- my $e = $n -> exponent();
+ my $m = $n -> mantissa(undef, undef) -> babs(undef, undef);
+ my $e = $n -> exponent(undef, undef);
$self -> {_n} = $LIB -> _new($m -> bstr());
$self -> {_d} = $LIB -> _one();
@@ -329,7 +336,8 @@ sub new {
$self -> {_d} = $LIB -> _lsft($self -> {_d},
$LIB -> _new(-$e -> bstr()), 10);
- my $gcd = $LIB -> _gcd($LIB -> _copy($self -> {_n}), $self -> {_d});
+ my $gcd = $LIB -> _gcd($LIB -> _copy($self -> {_n}),
+ $self -> {_d});
if (!$LIB -> _is_one($gcd)) {
$self -> {_n} = $LIB -> _div($self->{_n}, $gcd);
$self -> {_d} = $LIB -> _div($self->{_d}, $gcd);
@@ -337,6 +345,8 @@ sub new {
}
$self -> {sign} = $n -> sign();
+ return $downgrade -> new($n, undef, undef)
+ if defined($downgrade) && $n -> is_int();
return $self;
}
@@ -353,19 +363,30 @@ sub new {
# At this point both $n and $d are objects.
- return $class -> bnan() if $n -> is_nan() || $d -> is_nan();
+ if ($n -> is_nan() || $d -> is_nan()) {
+ return $class -> bnan();
+ }
# At this point neither $n nor $d is a NaN.
if ($n -> is_zero()) {
- return $class -> bnan() if $d -> is_zero(); # 0/0 = NaN
+ if ($d -> is_zero()) { # 0/0 = NaN
+ return $class -> bnan();
+ }
return $class -> bzero();
}
- return $class -> binf($d -> sign()) if $d -> is_zero();
+ if ($d -> is_zero()) {
+ return $class -> binf($d -> sign());
+ }
# At this point, neither $n nor $d is a NaN or a zero.
+ # Copy them now before manipulating them.
+
+ $n = $n -> copy();
+ $d = $d -> copy();
+
if ($d < 0) { # make sure denominator is positive
$n -> bneg();
$d -> bneg();
@@ -411,6 +432,8 @@ sub new {
$self -> {_d} = $LIB -> _mul($LIB -> _div($LIB -> _copy($q), $gcd_sq),
$LIB -> _div($LIB -> _copy($r), $gcd_pr));
+ return $downgrade -> new($n->bstr())
+ if defined($downgrade) && $self -> is_int();
return $self; # no need for $self -> bnorm() here
}
@@ -516,6 +539,8 @@ sub new {
}
}
+ return $downgrade -> new($self -> bstr())
+ if defined($downgrade) && $self -> is_int();
return $self;
}
@@ -553,6 +578,8 @@ sub bnan {
croak ("Tried to set a variable to NaN in $class->bnan()");
}
+ return $downgrade -> bnan() if defined $downgrade;
+
$self -> {sign} = $nan;
$self -> {_n} = $LIB -> _zero();
$self -> {_d} = $LIB -> _one();
@@ -577,6 +604,8 @@ sub binf {
croak ("Tried to set a variable to +-inf in $class->binf()");
}
+ return $downgrade -> binf($sign) if defined $downgrade;
+
$self -> {sign} = $sign;
$self -> {_n} = $LIB -> _zero();
$self -> {_d} = $LIB -> _one();
@@ -592,11 +621,12 @@ sub bone {
my $selfref = ref $self;
my $class = $selfref || $self;
- $self = bless {}, $class unless $selfref;
-
my $sign = shift();
$sign = '+' unless defined($sign) && $sign eq '-';
+ return $downgrade -> bone($sign) if defined $downgrade;
+
+ $self = bless {}, $class unless $selfref;
$self -> {sign} = $sign;
$self -> {_n} = $LIB -> _one();
$self -> {_d} = $LIB -> _one();
@@ -612,8 +642,9 @@ sub bzero {
my $selfref = ref $self;
my $class = $selfref || $self;
- $self = bless {}, $class unless $selfref;
+ return $downgrade -> bzero() if defined $downgrade;
+ $self = bless {}, $class unless $selfref;
$self -> {sign} = '+';
$self -> {_n} = $LIB -> _zero();
$self -> {_d} = $LIB -> _one();
@@ -644,36 +675,86 @@ sub config {
$cfg;
}
-##############################################################################
+###############################################################################
+# String conversion methods
+###############################################################################
sub bstr {
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
- if ($x->{sign} !~ /^[+-]$/) { # inf, NaN etc
- my $s = $x->{sign};
- $s =~ s/^\+//; # +inf => inf
- return $s;
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
+ # Upgrade?
+
+ return $upgrade -> bstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
my $s = '';
$s = $x->{sign} if $x->{sign} ne '+'; # '+3/2' => '3/2'
- return $s . $LIB->_str($x->{_n}) if $LIB->_is_one($x->{_d});
- $s . $LIB->_str($x->{_n}) . '/' . $LIB->_str($x->{_d});
+ my $str = $x->{sign} eq '-' ? '-' : '';
+ $str .= $LIB->_str($x->{_n});
+ $str .= '/' . $LIB->_str($x->{_d}) unless $LIB -> _is_one($x->{_d});
+ return $str;
}
sub bsstr {
- my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
- if ($x->{sign} !~ /^[+-]$/) { # inf, NaN etc
- my $s = $x->{sign};
- $s =~ s/^\+//; # +inf => inf
- return $s;
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
- my $s = '';
- $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
- $s . $LIB->_str($x->{_n}) . '/' . $LIB->_str($x->{_d});
+ # Upgrade?
+
+ return $upgrade -> bsstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
+ my $str = $x->{sign} eq '-' ? '-' : '';
+ $str .= $LIB->_str($x->{_n});
+ $str .= '/' . $LIB->_str($x->{_d}) unless $LIB -> _is_one($x->{_d});
+ return $str;
+}
+
+sub bfstr {
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+
+ carp "Rounding is not supported for ", (caller(0))[3], "()" if @r;
+
+ # Inf and NaN
+
+ if ($x->{sign} ne '+' && $x->{sign} ne '-') {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
+
+ # Upgrade?
+
+ return $upgrade -> bfstr($x, @r)
+ if defined($upgrade) && !$x -> isa($class);
+
+ # Finite number
+
+ my $str = $x->{sign} eq '-' ? '-' : '';
+ $str .= $LIB->_str($x->{_n});
+ $str .= '/' . $LIB->_str($x->{_d}) unless $LIB -> _is_one($x->{_d});
+ return $str;
}
sub bnorm {
@@ -689,16 +770,24 @@ sub bnorm {
}
# no normalize for NaN, inf etc.
- return $x if $x->{sign} !~ /^[+-]$/;
+ if ($x->{sign} !~ /^[+-]$/) {
+ return $downgrade -> new($x) if defined $downgrade;
+ return $x;
+ }
# normalize zeros to 0/1
if ($LIB->_is_zero($x->{_n})) {
+ return $downgrade -> bzero() if defined($downgrade);
$x->{sign} = '+'; # never leave a -0
$x->{_d} = $LIB->_one() unless $LIB->_is_one($x->{_d});
return $x;
}
- return $x if $LIB->_is_one($x->{_d}); # no need to reduce
+ # n/1
+ if ($LIB->_is_one($x->{_d})) {
+ return $downgrade -> new($x) if defined($downgrade);
+ return $x; # no need to reduce
+ }
# Compute the GCD.
my $gcd = $LIB->_gcd($LIB->_copy($x->{_n}), $x->{_d});
@@ -723,56 +812,10 @@ sub bneg {
# for +0 do not negate (to have always normalized +0). Does nothing for 'NaN'
$x->{sign} =~ tr/+-/-+/
unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_n}));
- $x;
-}
-
-##############################################################################
-# special values
-
-sub _bnan {
- # used by parent class bnan() to initialize number to NaN
- my $self = shift;
-
- if ($_trap_nan) {
- my $class = ref($self);
- # "$self" below will stringify the object, this blows up if $self is a
- # partial object (happens under trap_nan), so fix it beforehand
- $self->{_d} = $LIB->_zero() unless defined $self->{_d};
- $self->{_n} = $LIB->_zero() unless defined $self->{_n};
- croak ("Tried to set $self to NaN in $class\::_bnan()");
- }
- $self->{_n} = $LIB->_zero();
- $self->{_d} = $LIB->_zero();
-}
-
-sub _binf {
- # used by parent class bone() to initialize number to +inf/-inf
- my $self = shift;
-
- if ($_trap_inf) {
- my $class = ref($self);
- # "$self" below will stringify the object, this blows up if $self is a
- # partial object (happens under trap_nan), so fix it beforehand
- $self->{_d} = $LIB->_zero() unless defined $self->{_d};
- $self->{_n} = $LIB->_zero() unless defined $self->{_n};
- croak ("Tried to set $self to inf in $class\::_binf()");
- }
- $self->{_n} = $LIB->_zero();
- $self->{_d} = $LIB->_zero();
-}
-
-sub _bone {
- # used by parent class bone() to initialize number to +1/-1
- my $self = shift;
- $self->{_n} = $LIB->_one();
- $self->{_d} = $LIB->_one();
-}
-sub _bzero {
- # used by parent class bzero() to initialize number to 0
- my $self = shift;
- $self->{_n} = $LIB->_zero();
- $self->{_d} = $LIB->_one();
+ return $downgrade -> new($x)
+ if defined($downgrade) && $LIB -> _is_one($x->{_d});
+ $x;
}
##############################################################################
@@ -788,12 +831,21 @@ sub badd {
($class, $x, $y, @r) = objectify(2, @_);
}
- # +inf + +inf => +inf, -inf + -inf => -inf
- return $x->binf(substr($x->{sign}, 0, 1))
- if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
-
- # +inf + -inf or -inf + +inf => NaN
- return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
+ unless ($x -> is_finite() && $y -> is_finite()) {
+ if ($x -> is_nan() || $y -> is_nan()) {
+ return $x -> bnan(@r);
+ } elsif ($x -> is_inf("+")) {
+ return $x -> bnan(@r) if $y -> is_inf("-");
+ return $x -> binf("+", @r);
+ } elsif ($x -> is_inf("-")) {
+ return $x -> bnan(@r) if $y -> is_inf("+");
+ return $x -> binf("-", @r);
+ } elsif ($y -> is_inf("+")) {
+ return $x -> binf("+", @r);
+ } elsif ($y -> is_inf("-")) {
+ return $x -> binf("-", @r);
+ }
+ }
# 1 1 gcd(3, 4) = 1 1*3 + 1*4 7
# - + - = --------- = --
@@ -813,7 +865,7 @@ sub badd {
my $m = $LIB->_mul($LIB->_copy($y->{_n}), $x->{_d});
# 5 * 3 + 7 * 4
- ($x->{_n}, $x->{sign}) = _e_add($x->{_n}, $m, $x->{sign}, $y->{sign});
+ ($x->{_n}, $x->{sign}) = $LIB -> _sadd($x->{_n}, $x->{sign}, $m, $y->{sign});
# 4 * 3
$x->{_d} = $LIB->_mul($x->{_d}, $y->{_d});
@@ -834,12 +886,12 @@ sub bsub {
# flip sign of $x, call badd(), then flip sign of result
$x->{sign} =~ tr/+-/-+/
- unless $x->{sign} eq '+' && $LIB->_is_zero($x->{_n}); # not -0
- $x->badd($y, @r); # does norm and round
+ unless $x->{sign} eq '+' && $x -> is_zero(); # not -0
+ $x = $x->badd($y, @r); # does norm and round
$x->{sign} =~ tr/+-/-+/
- unless $x->{sign} eq '+' && $LIB->_is_zero($x->{_n}); # not -0
+ unless $x->{sign} eq '+' && $x -> is_zero(); # not -0
- $x;
+ $x->bnorm();
}
sub bmul {
@@ -866,10 +918,13 @@ sub bmul {
}
# x == 0 # also: or y == 1 or y == -1
- return wantarray ? ($x, $class->bzero()) : $x if $x -> is_zero();
+ if ($x -> is_zero()) {
+ $x = $downgrade -> bzero($x) if defined $downgrade;
+ return wantarray ? ($x, $class->bzero()) : $x;
+ }
if ($y -> is_zero()) {
- $x -> bzero();
+ $x = defined($downgrade) ? $downgrade -> bzero($x) : $x -> bzero();
return wantarray ? ($x, $class->bzero()) : $x;
}
@@ -893,7 +948,7 @@ sub bmul {
# compute new sign
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
- $x->round(@r);
+ $x->bnorm()->round(@r);
}
sub bdiv {
@@ -916,7 +971,15 @@ sub bdiv {
# method.
if ($x -> is_nan() || $y -> is_nan()) {
- return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan();
+ if ($wantarray) {
+ return $downgrade -> bnan(), $downgrade -> bnan()
+ if defined($downgrade);
+ return $x -> bnan(), $class -> bnan();
+ } else {
+ return $downgrade -> bnan()
+ if defined($downgrade);
+ return $x -> bnan();
+ }
}
# Divide by zero and modulo zero. This is handled the same way as in
@@ -933,6 +996,11 @@ sub bdiv {
} else {
$quo = $x -> binf($x -> {sign});
}
+
+ $quo = $downgrade -> new($quo)
+ if defined($downgrade) && $quo -> is_int();
+ $rem = $downgrade -> new($rem)
+ if $wantarray && defined($downgrade) && $rem -> is_int();
return $wantarray ? ($quo, $rem) : $quo;
}
@@ -949,6 +1017,11 @@ sub bdiv {
my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
$quo = $x -> binf($sign);
}
+
+ $quo = $downgrade -> new($quo)
+ if defined($downgrade) && $quo -> is_int();
+ $rem = $downgrade -> new($rem)
+ if $wantarray && defined($downgrade) && $rem -> is_int();
return $wantarray ? ($quo, $rem) : $quo;
}
@@ -966,12 +1039,18 @@ sub bdiv {
$rem = $class -> binf($y -> {sign});
$quo = $x -> bone('-');
}
+ $quo = $downgrade -> new($quo)
+ if defined($downgrade) && $quo -> is_int();
+ $rem = $downgrade -> new($rem)
+ if defined($downgrade) && $rem -> is_int();
return ($quo, $rem);
} else {
if ($y -> is_inf()) {
if ($x -> is_nan() || $x -> is_inf()) {
+ return $downgrade -> bnan() if defined $downgrade;
return $x -> bnan();
} else {
+ return $downgrade -> bzero() if defined $downgrade;
return $x -> bzero();
}
}
@@ -982,7 +1061,11 @@ sub bdiv {
# the denominator (divisor) is non-zero.
# x == 0?
- return wantarray ? ($x, $class->bzero()) : $x if $x->is_zero();
+ if ($x->is_zero()) {
+ return $wantarray ? ($downgrade -> bzero(), $downgrade -> bzero())
+ : $downgrade -> bzero() if defined $downgrade;
+ return $wantarray ? ($x, $class->bzero()) : $x;
+ }
# XXX TODO: list context, upgrade
# According to Knuth, this can be optimized by doing gcd twice (for d and n)
@@ -1001,13 +1084,14 @@ sub bdiv {
$x -> bnorm();
if (wantarray) {
my $rem = $x -> copy();
- $x -> bfloor();
- $x -> round(@r);
- $rem -> bsub($x -> copy()) -> bmul($y);
+ $x = $x -> bfloor();
+ $x = $x -> round(@r);
+ $rem = $rem -> bsub($x -> copy()) -> bmul($y);
+ $x = $downgrade -> new($x) if defined($downgrade) && $x -> is_int();
+ $rem = $downgrade -> new($rem) if defined($downgrade) && $rem -> is_int();
return $x, $rem;
} else {
- $x -> round(@r);
- return $x;
+ return $x -> round(@r);
}
}
@@ -1033,6 +1117,7 @@ sub bmod {
# Modulo zero. This is handled the same way as in Math::BigInt -> bmod().
if ($y -> is_zero()) {
+ return $downgrade -> bzero() if defined $downgrade;
return $x;
}
@@ -1048,8 +1133,10 @@ sub bmod {
if ($y -> is_inf()) {
if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
+ return $downgrade -> new($x) if defined($downgrade) && $x -> is_int();
return $x;
} else {
+ return $downgrade -> binf($y -> sign()) if defined($downgrade);
return $x -> binf($y -> sign());
}
}
@@ -1057,7 +1144,10 @@ sub bmod {
# At this point, both the numerator and denominator are finite numbers, and
# the denominator (divisor) is non-zero.
- return $x if $x->is_zero(); # 0 / 7 = 0, mod 0
+ if ($x->is_zero()) { # 0 / 7 = 0, mod 0
+ return $downgrade -> bzero() if defined $downgrade;
+ return $x;
+ }
# Compute $x - $y * floor($x/$y). This can probably be optimized by working
# on a lower level.
@@ -1073,7 +1163,10 @@ sub bdec {
# decrement value (subtract 1)
my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
+ if ($x->{sign} !~ /^[+-]$/) { # NaN, inf, -inf
+ return $downgrade -> new($x) if defined $downgrade;
+ return $x;
+ }
if ($x->{sign} eq '-') {
$x->{_n} = $LIB->_add($x->{_n}, $x->{_d}); # -5/2 => -7/2
@@ -1094,7 +1187,10 @@ sub binc {
# increment value (add 1)
my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
+ if ($x->{sign} !~ /^[+-]$/) { # NaN, inf, -inf
+ return $downgrade -> new($x) if defined $downgrade;
+ return $x;
+ }
if ($x->{sign} eq '-') {
if ($LIB->_acmp($x->{_n}, $x->{_d}) < 0) {
@@ -1110,6 +1206,20 @@ sub binc {
$x->bnorm()->round(@r);
}
+sub binv {
+ my $x = shift;
+ my @r = @_;
+
+ return $x if $x->modify('binv');
+
+ return $x if $x -> is_nan();
+ return $x -> bzero() if $x -> is_inf();
+ return $x -> binf("+") if $x -> is_zero();
+
+ ($x -> {_n}, $x -> {_d}) = ($x -> {_d}, $x -> {_n});
+ $x -> round(@r);
+}
+
##############################################################################
# is_foo methods (the rest is inherited)
@@ -1201,6 +1311,53 @@ sub parts {
($n, $d);
}
+sub dparts {
+ my $x = shift;
+ my $class = ref $x;
+
+ croak("dparts() is an instance method") unless $class;
+
+ if ($x -> is_nan()) {
+ return $class -> bnan(), $class -> bnan() if wantarray;
+ return $class -> bnan();
+ }
+
+ if ($x -> is_inf()) {
+ return $class -> binf($x -> sign()), $class -> bzero() if wantarray;
+ return $class -> binf($x -> sign());
+ }
+
+ # 355/113 => 3 + 16/113
+
+ my ($q, $r) = $LIB -> _div($LIB -> _copy($x -> {_n}), $x -> {_d});
+
+ my $int = Math::BigRat -> new($x -> {sign} . $LIB -> _str($q));
+ return $int unless wantarray;
+
+ my $frc = Math::BigRat -> new($x -> {sign} . $LIB -> _str($r),
+ $LIB -> _str($x -> {_d}));
+
+ return $int, $frc;
+}
+
+sub fparts {
+ my $x = shift;
+ my $class = ref $x;
+
+ croak("fparts() is an instance method") unless $class;
+
+ return ($class -> bnan(),
+ $class -> bnan()) if $x -> is_nan();
+
+ my $numer = $x -> copy();
+ my $denom = $class -> bzero();
+
+ $denom -> {_n} = $numer -> {_d};
+ $numer -> {_d} = $LIB -> _one();
+
+ return ($numer, $denom);
+}
+
sub length {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
@@ -1221,37 +1378,52 @@ sub digit {
sub bceil {
my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
- return $x if ($x->{sign} !~ /^[+-]$/ || # not for NaN, inf
- $LIB->_is_one($x->{_d})); # 22/1 => 22, 0/1 => 0
+ if ($x->{sign} !~ /^[+-]$/ || # NaN or inf or
+ $LIB->_is_one($x->{_d})) # integer
+ {
+ return $downgrade -> new($x) if defined $downgrade;
+ return $x;
+ }
$x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
$x->{_d} = $LIB->_one(); # d => 1
$x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '+'; # +22/7 => 4/1
$x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_zero($x->{_n}); # -0 => 0
+ return $downgrade -> new($x) if defined $downgrade;
$x;
}
sub bfloor {
my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
- return $x if ($x->{sign} !~ /^[+-]$/ || # not for NaN, inf
- $LIB->_is_one($x->{_d})); # 22/1 => 22, 0/1 => 0
+ if ($x->{sign} !~ /^[+-]$/ || # NaN or inf or
+ $LIB->_is_one($x->{_d})) # integer
+ {
+ return $downgrade -> new($x) if defined $downgrade;
+ return $x;
+ }
$x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
$x->{_d} = $LIB->_one(); # d => 1
$x->{_n} = $LIB->_inc($x->{_n}) if $x->{sign} eq '-'; # -22/7 => -4/1
+ return $downgrade -> new($x) if defined $downgrade;
$x;
}
sub bint {
- my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+ my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
- return $x if ($x->{sign} !~ /^[+-]$/ || # +/-inf or NaN
- $LIB -> _is_one($x->{_d})); # already an integer
+ if ($x->{sign} !~ /^[+-]$/ || # NaN or inf or
+ $LIB->_is_one($x->{_d})) # integer
+ {
+ return $downgrade -> new($x) if defined $downgrade;
+ return $x;
+ }
$x->{_n} = $LIB->_div($x->{_n}, $x->{_d}); # 22/7 => 3/1 w/ truncate
$x->{_d} = $LIB->_one(); # d => 1
$x->{sign} = '+' if $x->{sign} eq '-' && $LIB -> _is_zero($x->{_n});
+ return $downgrade -> new($x) if defined $downgrade;
return $x;
}
@@ -1279,6 +1451,8 @@ sub bpow {
($class, $x, $y, @r) = objectify(2, @_);
}
+ return $x if $x->modify('bpow');
+
# $x and/or $y is a NaN
return $x->bnan() if $x->is_nan() || $y->is_nan();
@@ -1304,21 +1478,28 @@ sub bpow {
return $x->binf("+");
}
- if ($x->is_zero()) {
- return $x->binf() if $y->is_negative();
- return $x->bone("+") if $y->is_zero();
+ if ($x -> is_zero()) {
+ return $x -> bone() if $y -> is_zero();
+ return $x -> binf() if $y -> is_negative();
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
}
- # we don't support complex numbers, so return NaN
- return $x->bnan() if $x->is_negative() && !$y->is_int();
+ # We don't support complex numbers, so upgrade or return NaN.
+
+ if ($x -> is_negative() && !$y -> is_int()) {
+ return $upgrade -> bpow($upgrade -> new($x), $y, @r)
+ if defined $upgrade;
+ return $x -> bnan();
+ }
+
+ if ($x -> is_one("+") || $y -> is_one()) {
+ return $x;
+ }
+
+ if ($x -> is_one("-")) {
+ return $x if $y -> is_odd();
+ return $x -> bneg();
+ }
# (a/b)^-(c/d) = (b/a)^(c/d)
($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}) if $y->is_negative();
@@ -1348,11 +1529,11 @@ sub blog {
# $x->blog(undef) signals that the base is Euler's number.
if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
- # E.g., Math::BigFloat->blog(256, 2)
+ # E.g., Math::BigRat->blog(256, 2)
($class, $x, $base, @r) =
defined $_[2] ? objectify(2, @_) : objectify(1, @_);
} else {
- # E.g., Math::BigFloat::blog(256, 2) or $x->blog(2)
+ # E.g., Math::BigRat::blog(256, 2) or $x->blog(2)
($class, $x, $base, @r) =
defined $_[1] ? objectify(2, @_) : objectify(1, @_);
}
@@ -1393,20 +1574,50 @@ sub blog {
return $x -> binf($sign);
}
+ # Now take care of the cases where $x and/or $base is 1/N.
+ #
+ # log(1/N) / log(B) = -log(N)/log(B)
+ # log(1/N) / log(1/B) = log(N)/log(B)
+ # log(N) / log(1/B) = -log(N)/log(B)
+
+ my $neg = 0;
+ if ($x -> numerator() -> is_one()) {
+ $x -> binv();
+ $neg = !$neg;
+ }
+ if (defined(blessed($base)) && $base -> isa($class)) {
+ if ($base -> numerator() -> is_one()) {
+ $base = $base -> copy() -> binv();
+ $neg = !$neg;
+ }
+ }
+
+ # disable upgrading and downgrading
+
+ require Math::BigFloat;
+ my $upg = Math::BigFloat -> upgrade();
+ my $dng = Math::BigFloat -> downgrade();
+ Math::BigFloat -> upgrade(undef);
+ Math::BigFloat -> downgrade(undef);
+
# At this point we are done handling all exception cases and trivial cases.
$base = Math::BigFloat -> new($base) if defined $base;
+ my $xnum = Math::BigFloat -> new($LIB -> _str($x->{_n}));
+ my $xden = Math::BigFloat -> new($LIB -> _str($x->{_d}));
+ my $xstr = $xnum -> bdiv($xden) -> blog($base, @r) -> bsstr();
- my $xn = Math::BigFloat -> new($LIB -> _str($x->{_n}));
- my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
+ # reset upgrading and downgrading
- my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> blog($base, @r) -> bsstr());
+ Math::BigFloat -> upgrade($upg);
+ Math::BigFloat -> downgrade($dng);
- $x -> {sign} = $xtmp -> {sign};
- $x -> {_n} = $xtmp -> {_n};
- $x -> {_d} = $xtmp -> {_d};
+ my $xobj = Math::BigRat -> new($xstr);
+ $x -> {sign} = $xobj -> {sign};
+ $x -> {_n} = $xobj -> {_n};
+ $x -> {_d} = $xobj -> {_d};
- return $x;
+ return $neg ? $x -> bneg() : $x;
}
sub bexp {
@@ -1513,13 +1724,18 @@ sub bnok {
($class, $x, $y, @r) = objectify(2, @_);
}
- my $xint = Math::BigInt -> new($x -> bint() -> bsstr());
- my $yint = Math::BigInt -> new($y -> bint() -> bsstr());
+ return $x->bnan() if $x->is_nan() || $y->is_nan();
+ return $x->bnan() if (($x->is_finite() && !$x->is_int()) ||
+ ($y->is_finite() && !$y->is_int()));
+
+ my $xint = Math::BigInt -> new($x -> bstr());
+ my $yint = Math::BigInt -> new($y -> bstr());
$xint -> bnok($yint);
+ my $xrat = Math::BigRat -> new($xint);
- $x -> {sign} = $xint -> {sign};
- $x -> {_n} = $xint -> {_n};
- $x -> {_d} = $xint -> {_d};
+ $x -> {sign} = $xrat -> {sign};
+ $x -> {_n} = $xrat -> {_n};
+ $x -> {_d} = $xrat -> {_d};
return $x;
}
@@ -1570,7 +1786,7 @@ sub bmodpow {
my $yint = Math::BigInt -> new($y -> copy() -> bint());
my $mint = Math::BigInt -> new($m -> copy() -> bint());
- $xint -> bmodpow($y, $m, @r);
+ $xint -> bmodpow($yint, $mint, @r);
my $xtmp = Math::BigRat -> new($xint -> bsstr());
$x -> {sign} = $xtmp -> {sign};
@@ -1592,7 +1808,7 @@ sub bmodinv {
my $xint = Math::BigInt -> new($x -> copy() -> bint());
my $yint = Math::BigInt -> new($y -> copy() -> bint());
- $xint -> bmodinv($y, @r);
+ $xint -> bmodinv($yint, @r);
my $xtmp = Math::BigRat -> new($xint -> bsstr());
$x -> {sign} = $xtmp -> {sign};
@@ -1651,7 +1867,7 @@ sub bsqrt {
}
sub blsft {
- my ($class, $x, $y, $b, @r) = objectify(2, @_);
+ my ($class, $x, $y, $b) = objectify(2, @_);
$b = 2 if !defined $b;
$b = $class -> new($b) unless ref($b) && $b -> isa($class);
@@ -1665,7 +1881,7 @@ sub blsft {
}
sub brsft {
- my ($class, $x, $y, $b, @r) = objectify(2, @_);
+ my ($class, $x, $y, $b) = objectify(2, @_);
$b = 2 if !defined $b;
$b = $class -> new($b) unless ref($b) && $b -> isa($class);
@@ -1776,15 +1992,24 @@ sub bnot {
# round
sub round {
- $_[0];
+ my $x = shift;
+ return $downgrade -> new($x) if defined($downgrade) &&
+ ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
+ $x;
}
sub bround {
- $_[0];
+ my $x = shift;
+ return $downgrade -> new($x) if defined($downgrade) &&
+ ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
+ $x;
}
sub bfround {
- $_[0];
+ my $x = shift;
+ return $downgrade -> new($x) if defined($downgrade) &&
+ ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
+ $x;
}
##############################################################################
@@ -1803,9 +2028,9 @@ sub bcmp {
if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
# $x is NaN and/or $y is NaN
- return undef if $x->{sign} eq $nan || $y->{sign} eq $nan;
+ return if $x->{sign} eq $nan || $y->{sign} eq $nan;
# $x and $y are both either +inf or -inf
- return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
+ return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
# $x = +inf and $y < +inf
return +1 if $x->{sign} eq '+inf';
# $x = -inf and $y > -inf
@@ -1850,9 +2075,9 @@ sub bacmp {
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) {
# handle +-inf and NaN
- return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
- return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
+ return if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
+ return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/;
return -1;
}
@@ -1864,7 +2089,7 @@ sub bacmp {
sub beq {
my $self = shift;
my $selfref = ref $self;
- my $class = $selfref || $self;
+ #my $class = $selfref || $self;
croak 'beq() is an instance method, not a class method' unless $selfref;
croak 'Wrong number of arguments for beq()' unless @_ == 1;
@@ -1876,7 +2101,7 @@ sub beq {
sub bne {
my $self = shift;
my $selfref = ref $self;
- my $class = $selfref || $self;
+ #my $class = $selfref || $self;
croak 'bne() is an instance method, not a class method' unless $selfref;
croak 'Wrong number of arguments for bne()' unless @_ == 1;
@@ -1888,7 +2113,7 @@ sub bne {
sub blt {
my $self = shift;
my $selfref = ref $self;
- my $class = $selfref || $self;
+ #my $class = $selfref || $self;
croak 'blt() is an instance method, not a class method' unless $selfref;
croak 'Wrong number of arguments for blt()' unless @_ == 1;
@@ -1900,7 +2125,7 @@ sub blt {
sub ble {
my $self = shift;
my $selfref = ref $self;
- my $class = $selfref || $self;
+ #my $class = $selfref || $self;
croak 'ble() is an instance method, not a class method' unless $selfref;
croak 'Wrong number of arguments for ble()' unless @_ == 1;
@@ -1912,7 +2137,7 @@ sub ble {
sub bgt {
my $self = shift;
my $selfref = ref $self;
- my $class = $selfref || $self;
+ #my $class = $selfref || $self;
croak 'bgt() is an instance method, not a class method' unless $selfref;
croak 'Wrong number of arguments for bgt()' unless @_ == 1;
@@ -1924,7 +2149,7 @@ sub bgt {
sub bge {
my $self = shift;
my $selfref = ref $self;
- my $class = $selfref || $self;
+ #my $class = $selfref || $self;
croak 'bge() is an instance method, not a class method'
unless $selfref;
@@ -1943,7 +2168,17 @@ sub numify {
# Non-finite number.
- return $x->bstr() if $x->{sign} !~ /^[+-]$/;
+ if ($x -> is_nan()) {
+ require Math::Complex;
+ my $inf = $Math::Complex::Inf;
+ return $inf - $inf;
+ }
+
+ if ($x -> is_inf()) {
+ require Math::Complex;
+ my $inf = $Math::Complex::Inf;
+ return $x -> is_negative() ? -$inf : $inf;
+ }
# Finite number.
@@ -1956,34 +2191,70 @@ sub numify {
}
sub as_int {
- my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
+ my ($class, $x) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- # NaN, inf etc
- return Math::BigInt->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;
+ return $x -> copy() if $x -> isa("Math::BigInt");
- my $u = Math::BigInt->bzero();
- $u->{value} = $LIB->_div($LIB->_copy($x->{_n}), $x->{_d}); # 22/7 => 3
- $u->bneg if $x->{sign} eq '-'; # no negative zero
- $u;
+ # disable upgrading and downgrading
+
+ require Math::BigInt;
+ my $upg = Math::BigInt -> upgrade();
+ my $dng = Math::BigInt -> downgrade();
+ Math::BigInt -> upgrade(undef);
+ Math::BigInt -> downgrade(undef);
+
+ my $y;
+ if ($x -> is_inf()) {
+ $y = Math::BigInt -> binf($x->sign());
+ } elsif ($x -> is_nan()) {
+ $y = Math::BigInt -> bnan();
+ } else {
+ my $int = $LIB -> _div($LIB -> _copy($x->{_n}), $x->{_d}); # 22/7 => 3
+ $y = Math::BigInt -> new($LIB -> _str($int));
+ $y = $y -> bneg() if $x -> is_neg();
+ }
+
+ # reset upgrading and downgrading
+
+ Math::BigInt -> upgrade($upg);
+ Math::BigInt -> downgrade($dng);
+
+ return $y;
}
sub as_float {
- # return N/D as Math::BigFloat
+ my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);
- # set up parameters
- my ($class, $x, @r) = (ref($_[0]), @_);
- # objectify is costly, so avoid it
- ($class, $x, @r) = objectify(1, @_) unless ref $_[0];
+ return $x -> copy() if $x -> isa("Math::BigFloat");
- # NaN, inf etc
- return Math::BigFloat->new($x->{sign}) if $x->{sign} !~ /^[+-]$/;
+ # disable upgrading and downgrading
- my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
- my $xflt = Math::BigFloat -> new($LIB -> _str($x->{_n}));
- $xflt -> {sign} = $x -> {sign};
- $xflt -> bdiv($xd, @r);
+ require Math::BigFloat;
+ my $upg = Math::BigFloat -> upgrade();
+ my $dng = Math::BigFloat -> downgrade();
+ Math::BigFloat -> upgrade(undef);
+ Math::BigFloat -> downgrade(undef);
+
+ my $y;
+ if ($x -> is_inf()) {
+ $y = Math::BigFloat -> binf($x->sign());
+ } elsif ($x -> is_nan()) {
+ $y = Math::BigFloat -> bnan();
+ } else {
+ $y = Math::BigFloat -> new($LIB -> _str($x->{_n}));
+ $y -> {sign} = $x -> {sign};
+ unless ($LIB -> _is_one($x->{_d})) {
+ my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d}));
+ $y -> bdiv($xd, @r);
+ }
+ }
+
+ # reset upgrading and downgrading
- return $xflt;
+ Math::BigFloat -> upgrade($upg);
+ Math::BigFloat -> downgrade($dng);
+
+ return $y;
}
sub as_bin {
@@ -2019,18 +2290,27 @@ sub as_oct {
sub from_hex {
my $class = shift;
- $class->new(@_);
+ # The relationship should probably go the otherway, i.e, that new() calls
+ # from_hex(). Fixme!
+ my ($x, @r) = @_;
+ $x =~ s|^\s*(?:0?[Xx]_*)?|0x|;
+ $class->new($x, @r);
}
sub from_bin {
my $class = shift;
- $class->new(@_);
+ # The relationship should probably go the otherway, i.e, that new() calls
+ # from_bin(). Fixme!
+ my ($x, @r) = @_;
+ $x =~ s|^\s*(?:0?[Bb]_*)?|0b|;
+ $class->new($x, @r);
}
sub from_oct {
my $class = shift;
+ # Why is this different from from_hex() and from_bin()? Fixme!
my @parts;
for my $c (@_) {
push @parts, Math::BigInt->from_oct($c);
@@ -2043,57 +2323,101 @@ sub from_oct {
sub import {
my $class = shift;
- my $l = scalar @_;
- my $lib = ''; my @a;
- my $try = 'try';
-
- for (my $i = 0; $i < $l ; $i++) {
- if ($_[$i] eq ':constant') {
- # this rest causes overlord er load to step in
- overload::constant float => sub { $class->new(shift); };
+ my @a; # unrecognized arguments
+ my $lib_param = '';
+ my $lib_value = '';
+
+ while (@_) {
+ my $param = shift;
+
+ # Enable overloading of constants.
+
+ if ($param eq ':constant') {
+ overload::constant
+
+ integer => sub {
+ $class -> new(shift);
+ },
+
+ float => sub {
+ $class -> new(shift);
+ },
+
+ binary => sub {
+ # E.g., a literal 0377 shall result in an object whose value
+ # is decimal 255, but new("0377") returns decimal 377.
+ return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
+ $class -> new(shift);
+ };
+ next;
}
- # elsif ($_[$i] eq 'upgrade')
- # {
- # # this causes upgrading
- # $upgrade = $_[$i+1]; # or undef to disable
- # $i++;
- # }
- elsif ($_[$i] eq 'downgrade') {
- # this causes downgrading
- $downgrade = $_[$i+1]; # or undef to disable
- $i++;
- } elsif ($_[$i] =~ /^(lib|try|only)\z/) {
- $lib = $_[$i+1] || ''; # default Calc
- $try = $1; # lib, try or only
- $i++;
- } elsif ($_[$i] eq 'with') {
- # this argument is no longer used
- #$LIB = $_[$i+1] || 'Math::BigInt::Calc'; # default Math::BigInt::Calc
- $i++;
- } else {
- push @a, $_[$i];
+
+ # Upgrading.
+
+ if ($param eq 'upgrade') {
+ $class -> upgrade(shift);
+ next;
}
- }
- require Math::BigInt;
- # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still have GMP
- if ($lib ne '') {
- my @c = split /\s*,\s*/, $lib;
- foreach (@c) {
- $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
+ # Downgrading.
+
+ if ($param eq 'downgrade') {
+ $class -> downgrade(shift);
+ next;
}
- $lib = join(",", @c);
+
+ # Accuracy.
+
+ if ($param eq 'accuracy') {
+ $class -> accuracy(shift);
+ next;
+ }
+
+ # Precision.
+
+ if ($param eq 'precision') {
+ $class -> precision(shift);
+ next;
+ }
+
+ # Rounding mode.
+
+ if ($param eq 'round_mode') {
+ $class -> round_mode(shift);
+ next;
+ }
+
+ # Backend library.
+
+ if ($param =~ /^(lib|try|only)\z/) {
+ # alternative library
+ $lib_param = $param; # "lib", "try", or "only"
+ $lib_value = shift;
+ next;
+ }
+
+ if ($param eq 'with') {
+ # alternative class for our private parts()
+ # XXX: no longer supported
+ # $LIB = shift() || 'Calc';
+ # carp "'with' is no longer supported, use 'lib', 'try', or 'only'";
+ shift;
+ next;
+ }
+
+ # Unrecognized parameter.
+
+ push @a, $param;
}
- my @import = ('objectify');
- push @import, $try => $lib if $lib ne '';
- # LIB already loaded, so feed it our lib arguments
- Math::BigInt->import(@import);
+ require Math::BigInt;
- $LIB = Math::BigFloat->config("lib");
+ my @import = ('objectify');
+ push @import, $lib_param, $lib_value if $lib_param ne '';
+ Math::BigInt -> import(@import);
- # register us with LIB to get notified of future lib changes
- Math::BigInt::_register_callback($class, sub { $LIB = $_[0]; });
+ # find out which one was actually loaded
+ $LIB = Math::BigInt -> config("lib");
# any non :constant stuff is handled by Exporter (loaded by parent class)
# even if @_ is empty, to give it a chance
@@ -2109,7 +2433,7 @@ __END__
=head1 NAME
-Math::BigRat - Arbitrary big rational numbers
+Math::BigRat - arbitrary size rational number math package
=head1 SYNOPSIS
@@ -2201,6 +2525,16 @@ Returns a copy of the denominator (the part under the line) as positive BigInt.
Return a list consisting of (signed) numerator and (unsigned) denominator as
BigInts.
+=item dparts()
+
+Returns the integer part and the fraction part.
+
+=item fparts()
+
+Returns the smallest possible numerator and denominator so that the numerator
+divided by the denominator gives back the original value. For finite numbers,
+both values are integers. Mnemonic: fraction.
+
=item numify()
my $y = $x->numify();
@@ -2513,7 +2847,13 @@ Subtracts $y from $x and returns the result.
In scalar context, divides $x by $y and returns the result. In list context,
does floored division (F-division), returning an integer $q and a remainder $r
so that $x = $q * $y + $r. The remainer (modulo) is equal to what is returned
-by C<$x->bmod($y)>.
+by C<< $x->bmod($y) >>.
+
+=item binv()
+
+ $x->binv();
+
+Inverse of $x.
=item bdec()
@@ -2695,6 +3035,70 @@ supported.
=back
+=head1 NUMERIC LITERALS
+
+After C<use Math::BigRat ':constant'> all numeric literals in the given scope
+are converted to C<Math::BigRat> objects. This conversion happens at compile
+time. Every non-integer is convert to a NaN.
+
+For example,
+
+ perl -MMath::BigRat=:constant -le 'print 2**150'
+
+prints the exact value of C<2**150>. Note that without conversion of constants
+to objects the expression C<2**150> is calculated using Perl scalars, which
+leads to an inaccurate result.
+
+Please note that strings are not affected, so that
+
+ use Math::BigRat qw/:constant/;
+
+ $x = "1234567890123456789012345678901234567890"
+ + "123456789123456789";
+
+does give you what you expect. You need an explicit Math::BigRat->new() around
+at least one of the operands. You should also quote large constants to prevent
+loss of precision:
+
+ use Math::BigRat;
+
+ $x = Math::BigRat->new("1234567889123456789123456789123456789");
+
+Without the quotes Perl first converts the large number to a floating point
+constant at compile time, and then converts the result to a Math::BigRat object
+at run time, which results in an inaccurate result.
+
+=head2 Hexadecimal, octal, and binary floating point literals
+
+Perl (and this module) accepts hexadecimal, octal, and binary floating point
+literals, but use them with care with Perl versions before v5.32.0, because some
+versions of Perl silently give the wrong result. Below are some examples of
+different ways to write the number decimal 314.
+
+Hexadecimal floating point literals:
+
+ 0x1.3ap+8 0X1.3AP+8
+ 0x1.3ap8 0X1.3AP8
+ 0x13a0p-4 0X13A0P-4
+
+Octal floating point literals (with "0" prefix):
+
+ 01.164p+8 01.164P+8
+ 01.164p8 01.164P8
+ 011640p-4 011640P-4
+
+Octal floating point literals (with "0o" prefix) (requires v5.34.0):
+
+ 0o1.164p+8 0O1.164P+8
+ 0o1.164p8 0O1.164P8
+ 0o11640p-4 0O11640P-4
+
+Binary floating point literals:
+
+ 0b1.0011101p+8 0B1.0011101P+8
+ 0b1.0011101p8 0B1.0011101P8
+ 0b10011101000p-2 0B10011101000P-2
+
=head1 BUGS
Please report any bugs or feature requests to
@@ -2714,43 +3118,25 @@ 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-BigRat>
-
-=item * AnnoCPAN: Annotated CPAN documentation
+=item * GitHub
-L<http://annocpan.org/dist/Math-BigRat>
+L<https://github.com/pjacklam/p5-Math-BigRat>
-=item * CPAN Ratings
+=item * RT: CPAN's request tracker
-L<http://cpanratings.perl.org/dist/Math-BigRat>
+L<https://rt.cpan.org/Dist/Display.html?Name=Math-BigRat>
-=item * Search CPAN
+=item * MetaCPAN
-L<http://search.cpan.org/dist/Math-BigRat/>
+L<https://metacpan.org/release/Math-BigRat>
=item * CPAN Testers Matrix
L<http://matrix.cpantesters.org/?dist=Math-BigRat>
-=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>
+=item * CPAN Ratings
-=back
+L<https://cpanratings.perl.org/dist/Math-BigRat>
=back
@@ -2774,7 +3160,7 @@ Tels L<http://bloodgate.com/> 2001-2009.
=item *
-Maintained by Peter John Acklam <pjacklam@online.no> 2011-
+Maintained by Peter John Acklam <pjacklam@gmail.com> 2011-
=back
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat/Trace.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat/Trace.pm
new file mode 100755
index 0000000000..e61df01317
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigRat/Trace.pm
@@ -0,0 +1,76 @@
+# -*- mode: perl; -*-
+
+package Math::BigRat::Trace;
+
+use strict;
+use warnings;
+
+use Exporter;
+use Math::BigRat;
+
+our @ISA = qw(Exporter Math::BigRat);
+
+our $VERSION = '0.66';
+
+use overload; # inherit overload from Math::BigRat
+
+# Globals
+our $accuracy = undef;
+our $precision = undef;
+our $round_mode = 'even';
+our $div_scale = 40;
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ my $value = shift;
+
+ my $a = $accuracy;
+ $a = $_[0] if defined $_[0];
+
+ my $p = $precision;
+ $p = $_[1] if defined $_[1];
+
+ my $self = $class -> SUPER::new($value, $a, $p, $round_mode);
+
+ printf "Math::BigRat new '%s' => '%s' (%s)\n",
+ $value, $self, ref($self);
+
+ return $self;
+}
+
+sub import {
+ my $class = shift;
+
+ printf "%s -> import(%s)\n", $class, join(", ", @_);
+
+ # we catch the constants, the rest goes to parent
+
+ my $constant = grep { $_ eq ':constant' } @_;
+ my @a = grep { $_ ne ':constant' } @_;
+
+ if ($constant) {
+ overload::constant
+
+ integer => sub {
+ $class -> new(shift);
+ },
+
+ float => sub {
+ $class -> new(shift);
+ },
+
+ binary => sub {
+ # E.g., a literal 0377 shall result in an object whose value
+ # is decimal 255, but new("0377") returns decimal 377.
+ return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
+ $class -> new(shift);
+ };
+ }
+
+ $class -> SUPER::import(@a); # need it for subclasses
+ #$self -> export_to_level(1, $class, @_); # need this ?
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/Complex.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/Complex.pm
index 6cab2689bd..e6d15b70b9 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/Complex.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/Complex.pm
@@ -10,7 +10,7 @@ package Math::Complex;
{ use 5.006; }
use strict;
-our $VERSION = 1.59_02;
+our $VERSION = 1.62;
use Config;
@@ -1847,7 +1847,7 @@ number mathematicians call C<j> such that:
is a simple matter of writing:
- $j = ((root(1, 3))[1];
+ $j = (root(1, 3))[1];
The I<k>th root for C<z = [r,t]> is given by:
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/Trig.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/Trig.pm
index 1d9612a41c..218ab690a5 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/Trig.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/Trig.pm
@@ -15,7 +15,7 @@ require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = 1.23;
+our $VERSION = 1.62;
my @angcnv = qw(rad2deg rad2grad
deg2rad deg2grad
@@ -47,8 +47,9 @@ my @pi = qw(pi pi2 pi4 pip2 pip4);
our @EXPORT_OK = (@rdlcnv, @greatcircle, @pi, 'Inf');
# See e.g. the following pages:
-# http://www.movable-type.co.uk/scripts/LatLong.html
-# http://williams.best.vwh.net/avform.htm
+# https://www.movable-type.co.uk/scripts/latlong.html
+# https://edwilliams.org/avform.htm
+# https://en.wikipedia.org/wiki/Great-circle_distance
our %EXPORT_TAGS = ('radial' => [ @rdlcnv ],
'great_circle' => [ @greatcircle ],
@@ -153,12 +154,19 @@ sub great_circle_distance {
$rho = 1 unless defined $rho; # Default to the unit sphere.
- my $lat0 = pip2 - $phi0;
- my $lat1 = pip2 - $phi1;
+ my $dphi = $phi1 - $phi0;
+ my $dtheta = $theta1 - $theta0;
+
+ # A formula that is accurate for all distances is the following special
+ # case of the Vincenty formula for an ellipsoid with equal major and minor
+ # axes. See
+ # https://en.wikipedia.org/wiki/Great-circle_distance#Computational_formulas
- return $rho *
- acos_real( cos( $lat0 ) * cos( $lat1 ) * cos( $theta0 - $theta1 ) +
- sin( $lat0 ) * sin( $lat1 ) );
+ my $c1 = sin($phi1) * sin($dtheta);
+ my $c2 = sin($phi1) * cos($dtheta);
+ my $c3 = sin($phi0) * cos($phi1) - cos($phi0) * $c2;
+ my $c4 = cos($phi0) * cos($phi1) + sin($phi0) * $c2;
+ return $rho * atan2(sqrt($c1 * $c1 + $c3 * $c3), $c4);
}
sub great_circle_direction {
@@ -247,7 +255,7 @@ Math::Trig - trigonometric functions
$rad = deg2rad(120);
- # Import constants pi2, pip2, pip4 (2*pi, pi/2, pi/4).
+ # Import constants pi2, pi4, pip2, pip4 (2*pi, 4*pi, pi/2, pi/4).
use Math::Trig ':pi';
# Import the conversions between cartesian/spherical/cylindrical.
@@ -417,7 +425,7 @@ and the imaginary part of approximately C<-1.317>.
=back
The full circle is 2 I<pi> radians or I<360> degrees or I<400> gradians.
-The result is by default wrapped to be inside the [0, {2pi,360,400}[ circle.
+The result is by default wrapped to be inside the [0, {2pi,360,400}] circle.
If you don't want this, supply a true second argument:
$zillions_of_radians = deg2rad($zillions_of_degrees, 1);
@@ -465,15 +473,15 @@ B<All angles are in radians>.
B<Cartesian> coordinates are the usual rectangular I<(x, y, z)>-coordinates.
-Spherical coordinates, I<(rho, theta, pi)>, are three-dimensional
+Spherical coordinates, I<(rho, theta, phi)>, are three-dimensional
coordinates which define a point in three-dimensional space. They are
based on a sphere surface. The radius of the sphere is B<rho>, also
known as the I<radial> coordinate. The angle in the I<xy>-plane
(around the I<z>-axis) is B<theta>, also known as the I<azimuthal>
coordinate. The angle from the I<z>-axis is B<phi>, also known as the
-I<polar> coordinate. The North Pole is therefore I<0, 0, rho>, and
-the Gulf of Guinea (think of the missing big chunk of Africa) I<0,
-pi/2, rho>. In geographical terms I<phi> is latitude (northward
+I<polar> coordinate. The North Pole is therefore I<rho, 0, 0>, and
+the Gulf of Guinea (think of the missing big chunk of Africa) I<rho,
+0, pi/2>. In geographical terms I<phi> is latitude (northward
positive, southward negative) and I<theta> is longitude (eastward
positive, westward negative).
@@ -537,26 +545,19 @@ points.
=head2 great_circle_distance
-You can compute spherical distances, called B<great circle distances>,
-by importing the great_circle_distance() function:
+Returns the great circle distance between two points on a sphere.
- use Math::Trig 'great_circle_distance';
+ $distance = great_circle_distance($theta0, $phi0, $theta1, $phi1, [, $rho]);
- $distance = great_circle_distance($theta0, $phi0, $theta1, $phi1, [, $rho]);
+Where ($theta0, $phi0) and ($theta1, $phi1) are the spherical coordinates of
+the two points, respectively. The distance is in C<$rho> units. The C<$rho>
+is optional. It defaults to 1 (the unit sphere).
-The I<great circle distance> is the shortest distance between two
-points on a sphere. The distance is in C<$rho> units. The C<$rho> is
-optional, it defaults to 1 (the unit sphere), therefore the distance
-defaults to radians.
-
-If you think geographically the I<theta> are longitudes: zero at the
-Greenwhich meridian, eastward positive, westward negative -- and the
-I<phi> are latitudes: zero at the North Pole, northward positive,
-southward negative. B<NOTE>: this formula thinks in mathematics, not
-geographically: the I<phi> zero is at the North Pole, not at the
-Equator on the west coast of Africa (Bay of Guinea). You need to
-subtract your geographical coordinates from I<pi/2> (also known as 90
-degrees).
+If you are using geographic coordinates, latitude and longitude, you need to
+adjust for the fact that latitude is zero at the equator increasing towards
+the north and decreasing towards the south. Assuming ($lat0, $lon0) and
+($lat1, $lon1) are the geographic coordinates in radians of the two points,
+the distance can be computed with
$distance = great_circle_distance($lon0, pi/2 - $lat0,
$lon1, pi/2 - $lat1, $rho);
@@ -617,15 +618,22 @@ The great_circle_midpoint() is just a special case of
($thetai, $phii) =
great_circle_waypoint($theta0, $phi0, $theta1, $phi1, $way);
-Where the $way is a value from zero ($theta0, $phi0) to one ($theta1,
-$phi1). Note that antipodal points (where their distance is I<pi>
-radians) do not have waypoints between them (they would have an an
-"equator" between them), and therefore C<undef> is returned for
-antipodal points. If the points are the same and the distance
-therefore zero and all waypoints therefore identical, the first point
-(either point) is returned.
+Where $way indicates the position of the waypoint along the great
+circle arc through the starting point ($theta0, $phi0) and the end
+point ($theta1, $phi1) relative to the distance from the starting
+point to the end point. So $way = 0 gives the starting point, $way = 1
+gives the end point, $way < 0 gives a point "behind" the starting
+point, and $way > 1 gives a point beyond the end point. $way defaults
+to 0.5 if not given.
+
+Note that antipodal points (where their distance is I<pi> radians) do
+not have unique waypoints between them, and therefore C<undef> is
+returned in such cases. If the points are the same, so the distance
+between them is zero, all waypoints are identical to the starting/end
+point.
-The thetas, phis, direction, and distance in the above are all in radians.
+The thetas, phis, direction, and distance in the above are all in
+radians.
You can import all the great circle formulas by
@@ -661,11 +669,13 @@ straight north being zero, straight east being pi/2).
The midpoint between London and Tokyo being
- use Math::Trig qw(great_circle_midpoint);
+ use Math::Trig qw(great_circle_midpoint rad2deg);
my @M = great_circle_midpoint(@L, @T);
+ sub SWNE { rad2deg( $_[0] ), 90 - rad2deg( $_[1] ) }
+ my @lonlat = SWNE(@M);
-or about 69 N 89 E, in the frozen wastes of Siberia.
+or about 69 N 89 E, on the Putorana Plateau of Siberia.
B<NOTE>: you B<cannot> get from A to B like this:
@@ -743,6 +753,8 @@ an answer instead of giving a fatal runtime error.
Do not attempt navigation using these formulas.
+=head1 SEE ALSO
+
L<Math::Complex>
=head1 AUTHORS