summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Math
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2021-04-02 03:20:54 +0000
committerNorbert Preining <norbert@preining.info>2021-04-02 03:20:54 +0000
commit3f173002d4a4a84e7d1fa5a74755fdd00d08a9c2 (patch)
tree5ed380344702de1f9ab53b68b6c3bcd6b8458087 /systems/texlive/tlnet/tlpkg/tlperl/lib/Math
parentf78ba658b3ecd56053fe0837a4404d0c6c16a707 (diff)
CTAN sync 202104020320
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Math')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm471
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm399
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm609
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm2
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm93
5 files changed, 1094 insertions, 480 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm
index 8a92b5818d..f1d7a1a0a0 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigFloat.pm
@@ -19,8 +19,9 @@ use warnings;
use Carp qw< carp croak >;
use Math::BigInt ();
-our $VERSION = '1.999816';
+our $VERSION = '1.999818';
+require Exporter;
our @ISA = qw/Math::BigInt/;
our @EXPORT_OK = qw/bpi/;
@@ -28,8 +29,6 @@ our @EXPORT_OK = qw/bpi/;
our ($AUTOLOAD, $accuracy, $precision, $div_scale, $round_mode, $rnd_mode,
$upgrade, $downgrade, $_trap_nan, $_trap_inf);
-my $class = "Math::BigFloat";
-
use overload
# overload key: with_assign
@@ -273,7 +272,7 @@ sub AUTOLOAD {
my $name = $AUTOLOAD;
$name =~ s/(.*):://; # split package
- my $c = $1 || $class;
+ my $c = $1 || __PACKAGE__;
no strict 'refs';
$c->import() if $IMPORT == 0;
if (!_method_alias($name)) {
@@ -418,7 +417,8 @@ sub new {
return $self;
}
- # Handle hexadecimal numbers.
+ # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they
+ # have a "0x" or "0X" prefix.
if ($wanted =~ /^\s*[+-]?0[Xx]/) {
$self = $class -> from_hex($wanted);
@@ -426,7 +426,42 @@ sub new {
return $self;
}
- # Handle binary numbers.
+ # Handle octal numbers. We auto-detect octal numbers if they have a "0"
+ # prefix and a binary exponent.
+
+ if ($wanted =~ /
+ ^
+ \s*
+
+ # sign
+ [+-]?
+
+ # prefix
+ 0
+
+ # significand using the octal digits 0..7
+ [0-7]+ (?: _ [0-7]+ )*
+ (?:
+ \.
+ (?: [0-7]+ (?: _ [0-7]+ )* )?
+ )?
+
+ # exponent (power of 2) using decimal digits
+ [Pp]
+ [+-]?
+ \d+ (?: _ \d+ )*
+
+ \s*
+ $
+ /x)
+ {
+ $self = $class -> from_oct($wanted);
+ $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
+ return $self;
+ }
+
+ # Handle binary numbers. We auto-detect binary numbers if they have a "0b"
+ # or "0B" prefix.
if ($wanted =~ /^\s*[+-]?0[Bb]/) {
$self = $class -> from_bin($wanted);
@@ -781,6 +816,165 @@ sub from_bin {
return $self->bnan();
}
+sub from_ieee754 {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
+
+ # Don't modify constant (read-only) objects.
+
+ return 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
+
+ if ($format =~ /^binary(\d+)\z/) {
+ $k = $1;
+ $b = 2;
+ } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) {
+ $k = $1;
+ $b = 10;
+ $enc = $2 || 'dpd'; # default is dencely-packed decimals (DPD)
+ } elsif ($format eq 'half') {
+ $k = 16;
+ $b = 2;
+ } elsif ($format eq 'single') {
+ $k = 32;
+ $b = 2;
+ } elsif ($format eq 'double') {
+ $k = 64;
+ $b = 2;
+ } elsif ($format eq 'quadruple') {
+ $k = 128;
+ $b = 2;
+ } elsif ($format eq 'octuple') {
+ $k = 256;
+ $b = 2;
+ } elsif ($format eq 'sexdecuple') {
+ $k = 512;
+ $b = 2;
+ }
+
+ if ($b == 2) {
+
+ # Get the parameters for this format.
+
+ my $p; # precision (in bits)
+ my $t; # number of bits in significand
+ my $w; # number of bits in exponent
+
+ if ($k == 16) { # binary16 (half-precision)
+ $p = 11;
+ $t = 10;
+ $w = 5;
+ } elsif ($k == 32) { # binary32 (single-precision)
+ $p = 24;
+ $t = 23;
+ $w = 8;
+ } elsif ($k == 64) { # binary64 (double-precision)
+ $p = 53;
+ $t = 52;
+ $w = 11;
+ } else { # binaryN (quadruple-precision and above)
+ if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) {
+ croak "Number of bits must be 16, 32, 64, or >= 128 and",
+ " a multiple of 32";
+ }
+ $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13;
+ $t = $p - 1;
+ $w = $k - $t - 1;
+ }
+
+ # The maximum exponent, minimum exponent, and exponent bias.
+
+ my $emax = Math::BigInt -> new(2) -> bpow($w - 1) -> bdec();
+ my $emin = 1 - $emax;
+ my $bias = $emax;
+
+ # Undefined input.
+
+ unless (defined $in) {
+ carp("Input is undefined");
+ return $self -> bzero();
+ }
+
+ # Make sure input string is a string of zeros and ones.
+
+ my $len = CORE::length $in;
+ if (8 * $len == $k) { # bytes
+ $in = unpack "B*", $in;
+ } elsif (4 * $len == $k) { # hexadecimal
+ if ($in =~ /([^\da-f])/i) {
+ croak "Illegal hexadecimal digit '$1'";
+ }
+ $in = unpack "B*", pack "H*", $in;
+ } elsif ($len == $k) { # bits
+ if ($in =~ /([^01])/) {
+ croak "Illegal binary digit '$1'";
+ }
+ } else {
+ croak "Unknown input -- $in";
+ }
+
+ # Split bit string into sign, exponent, and mantissa/significand.
+
+ my $sign = substr($in, 0, 1) eq '1' ? '-' : '+';
+ my $expo = $class -> from_bin(substr($in, 1, $w));
+ my $mant = $class -> from_bin(substr($in, $w + 1));
+
+ my $x;
+
+ $expo -> bsub($bias); # subtract bias
+
+ if ($expo < $emin) { # zero and subnormals
+ if ($mant == 0) { # zero
+ $x = $class -> bzero();
+ } 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 '-';
+ }
+ }
+
+ elsif ($expo > $emax) { # inf and nan
+ if ($mant == 0) { # inf
+ $x = $class -> binf($sign);
+ } else { # nan
+ $x = $class -> bnan();
+ }
+ }
+
+ else { # normals
+ $mant = $class -> new(2) -> bpow($t) -> badd($mant);
+ if ($expo < $t) {
+ # compute (1/$b)**(N) rather than ($b)**(-N)
+ $x = $class -> new("0.5"); # 1/$b
+ $x -> bpow($t - $expo) -> bmul($mant);
+ } else {
+ $x = $class -> new(2);
+ $x -> bpow($expo - $t) -> bmul($mant);
+ }
+ $x -> bneg() if $sign eq '-';
+ }
+
+ if ($selfref) {
+ $self -> {sign} = $x -> {sign};
+ $self -> {_m} = $x -> {_m};
+ $self -> {_es} = $x -> {_es};
+ $self -> {_e} = $x -> {_e};
+ } else {
+ $self = $x;
+ }
+ return $self;
+ }
+
+ croak("The format '$format' is not yet supported.");
+}
+
sub bzero {
# create/assign '+0'
@@ -3023,7 +3217,7 @@ sub bsqrt {
return $x if $x->modify('bsqrt');
- return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
+ 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();
@@ -3783,7 +3977,7 @@ sub mantissa {
if ($x->{sign} !~ /^[+-]$/) {
my $s = $x->{sign};
- $s =~ s/^[+]//;
+ $s =~ s/^\+//;
return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
}
my $m = Math::BigInt->new($LIB->_str($x->{_m}), undef, undef);
@@ -3798,7 +3992,7 @@ sub exponent {
if ($x->{sign} !~ /^[+-]$/) {
my $s = $x->{sign};
-$s =~ s/^[+-]//;
+ $s =~ s/^[+-]//;
return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
}
Math::BigInt->new($x->{_es} . $LIB->_str($x->{_e}), undef, undef);
@@ -3810,9 +4004,9 @@ sub parts {
if ($x->{sign} !~ /^[+-]$/) {
my $s = $x->{sign};
-$s =~ s/^[+]//;
-my $se = $s;
-$se =~ s/^[-]//;
+ $s =~ s/^\+//;
+ my $se = $s;
+ $se =~ s/^-//;
return ($class->new($s), $class->new($se)); # +inf => inf and -inf, +inf => inf
}
my $m = Math::BigInt->bzero();
@@ -3981,9 +4175,9 @@ sub bstr {
}
my $es = '0';
-my $len = 1;
-my $cad = 0;
-my $dot = '.';
+ my $len = 1;
+ my $cad = 0;
+ my $dot = '.';
# $x is zero?
my $not_zero = !($x->{sign} eq '+' && $LIB->_is_zero($x->{_m}));
@@ -4007,8 +4201,8 @@ my $dot = '.';
} elsif ($e > 0) {
# expand with zeros
$es .= '0' x $e;
-$len += $e;
-$cad = 0;
+ $len += $e;
+ $cad = 0;
}
} # if not zero
@@ -4160,6 +4354,197 @@ sub to_bin {
return $x->{sign} eq '-' ? "-$str" : $str;
}
+sub to_ieee754 {
+ my $x = shift;
+ my $format = shift;
+ my $class = ref $x;
+
+ my $enc; # significand encoding (applies only to decimal)
+ my $k; # storage width in bits
+ my $b; # base
+
+ if ($format =~ /^binary(\d+)\z/) {
+ $k = $1;
+ $b = 2;
+ } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) {
+ $k = $1;
+ $b = 10;
+ $enc = $2 || 'dpd'; # default is dencely-packed decimals (DPD)
+ } elsif ($format eq 'half') {
+ $k = 16;
+ $b = 2;
+ } elsif ($format eq 'single') {
+ $k = 32;
+ $b = 2;
+ } elsif ($format eq 'double') {
+ $k = 64;
+ $b = 2;
+ } elsif ($format eq 'quadruple') {
+ $k = 128;
+ $b = 2;
+ } elsif ($format eq 'octuple') {
+ $k = 256;
+ $b = 2;
+ } elsif ($format eq 'sexdecuple') {
+ $k = 512;
+ $b = 2;
+ }
+
+ if ($b == 2) {
+
+ # Get the parameters for this format.
+
+ my $p; # precision (in bits)
+ my $t; # number of bits in significand
+ my $w; # number of bits in exponent
+
+ if ($k == 16) { # binary16 (half-precision)
+ $p = 11;
+ $t = 10;
+ $w = 5;
+ } elsif ($k == 32) { # binary32 (single-precision)
+ $p = 24;
+ $t = 23;
+ $w = 8;
+ } elsif ($k == 64) { # binary64 (double-precision)
+ $p = 53;
+ $t = 52;
+ $w = 11;
+ } else { # binaryN (quadruple-precition and above)
+ if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) {
+ croak "Number of bits must be 16, 32, 64, or >= 128 and",
+ " a multiple of 32";
+ }
+ $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13;
+ $t = $p - 1;
+ $w = $k - $t - 1;
+ }
+
+ # The maximum exponent, minimum exponent, and exponent bias.
+
+ my $emax = $class -> new(2) -> bpow($w - 1) -> bdec();
+ my $emin = 1 - $emax;
+ my $bias = $emax;
+
+ # Get numerical sign, exponent, and mantissa/significand for bit
+ # string.
+
+ my $sign = 0;
+ my $expo;
+ my $mant;
+
+ if ($x -> is_nan()) { # nan
+ $sign = 1;
+ $expo = $emax -> copy() -> binc();
+ $mant = $class -> new(2) -> bpow($t - 1);
+ } elsif ($x -> is_inf()) { # inf
+ $sign = 1 if $x -> is_neg();
+ $expo = $emax -> copy() -> binc();
+ $mant = $class -> bzero();
+ } elsif ($x -> is_zero()) { # zero
+ $expo = $emin -> copy() -> bdec();
+ $mant = $class -> bzero();
+ } else { # normal and subnormal
+
+ $sign = 1 if $x -> is_neg();
+
+ # Now we need to compute the mantissa and exponent in base $b.
+
+ my $binv = $class -> new("0.5");
+ my $b = $class -> new(2);
+ my $one = $class -> bone();
+
+ # We start off by initializing the exponent to zero and the
+ # mantissa to the input value. Then we increase the mantissa and
+ # decrease the exponent, or vice versa, until the mantissa is in
+ # the desired range or we hit one of the limits for the exponent.
+
+ $mant = $x -> copy() -> babs();
+
+ # We need to find the base 2 exponent. First make an estimate of
+ # the base 2 exponent, before adjusting it below. We could skip
+ # this estimation and go straight to the while-loops below, but the
+ # loops are slow, especially when the final exponent is far from
+ # zero and even more so if the number of digits is large. This
+ # initial estimation speeds up the computation dramatically.
+ #
+ # log2($m * 10**$e) = log10($m + 10**$e) * log(10)/log(2)
+ # = (log10($m) + $e) * log(10)/log(2)
+ # = (log($m)/log(10) + $e) * log(10)/log(2)
+
+ my ($m, $e) = $x -> nparts();
+ my $ms = $m -> numify();
+ my $es = $e -> numify();
+
+ my $expo_est = (log(abs($ms))/log(10) + $es) * log(10)/log(2);
+ $expo_est = int($expo_est);
+
+ # Limit the exponent.
+
+ if ($expo_est > $emax) {
+ $expo_est = $emax;
+ } elsif ($expo_est < $emin) {
+ $expo_est = $emin;
+ }
+
+ # Don't multiply by a number raised to a negative exponent. This
+ # will cause a division, whose result is truncated to some fixed
+ # number of digits. Instead, multiply by the inverse number raised
+ # to a positive exponent.
+
+ $expo = $class -> new($expo_est);
+ if ($expo_est > 0) {
+ $mant -> bmul($binv -> copy() -> bpow($expo));
+ } elsif ($expo_est < 0) {
+ my $expo_abs = $expo -> copy() -> bneg();
+ $mant -> bmul($b -> copy() -> bpow($expo_abs));
+ }
+
+ # Final adjustment.
+
+ while ($mant >= $b && $expo <= $emax) {
+ $mant -> bmul($binv);
+ $expo -> binc();
+ }
+
+ while ($mant < $one && $expo >= $emin) {
+ $mant -> bmul($b);
+ $expo -> bdec();
+ }
+
+ # Encode as infinity, normal number or subnormal number?
+
+ if ($expo > $emax) { # overflow => infinity
+ $expo = $emax -> copy() -> binc();
+ $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 -> badd($bias); # add bias
+
+ my $signbit = "$sign";
+
+ my $mantbits = $mant -> to_bin();
+ $mantbits = ("0" x ($t - CORE::length($mantbits))) . $mantbits;
+
+ my $expobits = $expo -> to_bin();
+ $expobits = ("0" x ($w - CORE::length($expobits))) . $expobits;
+
+ my $bin = $signbit . $expobits . $mantbits;
+ return pack "B*", $bin;
+ }
+
+ croak("The format '$format' is not yet supported.");
+}
+
sub as_hex {
# return number as hexadecimal string (only for integers defined)
@@ -4231,7 +4616,7 @@ sub numify {
}
# Create a string and let Perl's atoi()/atof() handle the rest.
- return 0 + $x -> bsstr();
+ return 0 + $x -> bnstr();
}
###############################################################################
@@ -4242,7 +4627,7 @@ sub import {
my $class = shift;
my $l = scalar @_;
my $lib = '';
-my @a;
+ my @a;
my $lib_kind = 'try';
$IMPORT=1;
for (my $i = 0; $i < $l ; $i++) {
@@ -4314,7 +4699,7 @@ sub _len_to_steps {
# D = 50 => N => 42, so L = 40 and R = 50
my $l = 40;
-my $r = $d;
+ my $r = $d;
# Otherwise this does not work under -Mbignum and we do not yet have "no bignum;" :(
$l = $l->numify if ref($l);
@@ -4370,7 +4755,6 @@ sub _log {
$over->bmul($u);
$factor = $class->new(3); $f = $class->new(2);
- my $steps = 0;
$limit = $class->new("1E-". ($scale-1));
while (3 < 5) {
@@ -4717,7 +5101,6 @@ sub _pow {
$over = $u->copy();
$limit = $class->new("1E-". ($scale-1));
- #my $steps = 0;
while (3 < 5) {
# we calculate the next term, and add it to the last
# when the next term is below our limit, it won't affect the outcome
@@ -4731,8 +5114,6 @@ sub _pow {
$factor->binc();
last if $x->{sign} !~ /^[-+]$/;
-
- #$steps++;
}
if ($do_invert) {
@@ -4795,6 +5176,7 @@ Math::BigFloat - Arbitrary size floating point math package
$x = Math::BigFloat->from_oct('0377'); # ditto
$x = Math::BigFloat->from_bin('0b1.1001p-4'); # from binary
$x = Math::BigFloat->from_bin('0101'); # ditto
+ $x = Math::BigFloat->from_ieee754($b, "binary64"); # from IEEE-754 bytes
$x = Math::BigFloat->bzero(); # create a +0
$x = Math::BigFloat->bone(); # create a +1
$x = Math::BigFloat->bone('-'); # create a -1
@@ -4926,6 +5308,7 @@ Math::BigFloat - Arbitrary size floating point math package
$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
+ $x->to_ieee754($format); # to bytes encoded according to IEEE 754-2008
# Other conversion methods
@@ -5106,6 +5489,17 @@ using decimal digits.
If called as an instance method, the value is assigned to the invocand.
+=item from_ieee754()
+
+Interpret the input as a value encoded as described in IEEE754-2008. The input
+can be given as a byte string, hex string or binary string. The input is
+assumed to be in big-endian byte-order.
+
+ # both $dbl and $mbf are 3.141592...
+ $bytes = "\x40\x09\x21\xfb\x54\x44\x2d\x18";
+ $dbl = unpack "d>", $bytes;
+ $mbf = Math::BigFloat -> from_ieee754($bytes, "binary64");
+
=item bpi()
print Math::BigFloat->bpi(100), "\n";
@@ -5225,6 +5619,29 @@ C<ref($x)-E<gt>new()> can parse to create an object.
In Math::BigFloat, C<as_float()> has the same effect as C<copy()>.
+=item to_ieee754()
+
+Encodes the invocand as a byte string in the given format as specified in IEEE
+754-2008. Note that the encoded value is the nearest possible representation of
+the value. This value might not be exactly the same as the value in the
+invocand.
+
+ # $x = 3.1415926535897932385
+ $x = Math::BigFloat -> bpi(30);
+
+ $b = $x -> to_ieee754("binary64"); # encode as 8 bytes
+ $h = unpack "H*", $b; # "400921fb54442d18"
+
+ # 3.141592653589793115997963...
+ $y = Math::BigFloat -> from_ieee754($h, "binary64");
+
+All binary formats in IEEE 754-2008 are accepted. For convenience, som aliases
+are recognized: "half" for "binary16", "single" for "binary32", "double" for
+"binary64", "quadruple" for "binary128", "octuple" for "binary256", and
+"sexdecuple" for "binary512".
+
+See also L<https://en.wikipedia.org/wiki/IEEE_754>.
+
=back
=head2 ACCURACY AND PRECISION
@@ -5552,11 +5969,11 @@ L<http://annocpan.org/dist/Math-BigInt>
=item * CPAN Ratings
-L<http://cpanratings.perl.org/dist/Math-BigInt>
+L<https://cpanratings.perl.org/dist/Math-BigInt>
-=item * Search CPAN
+=item * MetaCPAN
-L<http://search.cpan.org/dist/Math-BigInt/>
+L<https://metacpan.org/release/Math-BigInt>
=item * CPAN Testers Matrix
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm
index a443cd4a5d..185f802835 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt.pm
@@ -1,3 +1,5 @@
+# -*- coding: utf-8-unix -*-
+
package Math::BigInt;
#
@@ -20,14 +22,12 @@ use warnings;
use Carp qw< carp croak >;
-our $VERSION = '1.999816';
+our $VERSION = '1.999818';
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(objectify bgcd blcm);
-my $class = "Math::BigInt";
-
# Inside overload, the first arg is always an object. If the original code had
# it reversed (like $x = 2 * $y), then the third parameter is true.
# In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes
@@ -232,9 +232,7 @@ my $LIB = 'Math::BigInt::Calc'; # module to do the low level math
# default is Calc.pm
my $IMPORT = 0; # was import() called yet?
# used to make require work
-my %WARN; # warn only once for low-level libs
my %CALLBACKS; # callbacks to notify on lib loads
-my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
@@ -1135,7 +1133,7 @@ sub bpi {
if (@_ == 1) {
# called like Math::BigInt::bpi(10);
$n = $self;
- $self = $class;
+ $self = __PACKAGE__;
}
$self = ref($self) if ref($self);
@@ -1234,6 +1232,24 @@ sub is_negative {
$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,@_);
+
+ return 1 if $x->{sign} =~ /^\+/;
+ return 1 if $x -> is_zero();
+ return 0;
+}
+
+sub is_non_positive {
+ # Return true if argument is non-positive (<= 0).
+ my ($class, $x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+ return 1 if $x->{sign} =~ /^\-/;
+ return 1 if $x -> is_zero();
+ return 0;
+}
+
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, @_);
@@ -2354,7 +2370,7 @@ sub bmodpow {
$num->{value} = $value;
$num->{sign} = $sign;
- return $num;
+ return $num -> round(@r);
}
sub bpow {
@@ -2401,21 +2417,14 @@ sub bpow {
$r[3] = $y; # no push!
- # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
-
- my $new_sign = '+';
- $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
+ # 0 ** -y => ( 1 / (0 ** y)) => 1 / 0 => +inf
+ return $x->binf() if $y->is_negative() && $x->is_zero();
- # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
- return $x->binf()
- if $y->{sign} eq '-' && $x->{sign} eq '+' && $LIB->_is_zero($x->{value});
# 1 ** -y => 1 / (1 ** |y|)
- # so do test for negative $y after above's clause
- return $x->bnan() if $y->{sign} eq '-' && !$LIB->_is_one($x->{value});
+ return $x->bzero() if $y->is_negative() && !$LIB->_is_one($x->{value});
$x->{value} = $LIB->_pow($x->{value}, $y->{value});
- $x->{sign} = $new_sign;
- $x->{sign} = '+' if $LIB->_is_zero($y->{value});
+ $x->{sign} = $x->is_negative() && $y->is_odd() ? '-' : '+';
$x->round(@r);
}
@@ -2483,7 +2492,7 @@ sub blog {
return $x;
}
- my ($rc, $exact) = $LIB->_log_int($x->{value}, $base->{value});
+ my ($rc) = $LIB->_log_int($x->{value}, $base->{value});
return $x->bnan() unless defined $rc; # not possible to take log?
$x->{value} = $rc;
$x->round(@r);
@@ -2602,6 +2611,126 @@ sub bnok {
$n->round(@r);
}
+sub buparrow {
+ my $a = shift;
+ my $y = $a -> uparrow(@_);
+ $a -> {value} = $y -> {value};
+ return $a;
+}
+
+sub uparrow {
+ # Knuth's up-arrow notation buparrow(a, n, b)
+ #
+ # The following is a simple, recursive implementation of the up-arrow
+ # notation, just to show the idea. Such implementations cause "Deep
+ # recursion on subroutine ..." warnings, so we use a faster, non-recursive
+ # algorithm below with @_ as a stack.
+ #
+ # sub buparrow {
+ # my ($a, $n, $b) = @_;
+ # return $a ** $b if $n == 1;
+ # return $a * $b if $n == 0;
+ # return 1 if $b == 0;
+ # return buparrow($a, $n - 1, buparrow($a, $n, $b - 1));
+ # }
+
+ my ($a, $b, $n) = @_;
+ my $class = ref $a;
+ croak("a must be non-negative") if $a < 0;
+ croak("n must be non-negative") if $n < 0;
+ croak("b must be non-negative") if $b < 0;
+
+ while (@_ >= 3) {
+
+ # return $a ** $b if $n == 1;
+
+ if ($_[-2] == 1) {
+ my ($a, $n, $b) = splice @_, -3;
+ push @_, $a ** $b;
+ next;
+ }
+
+ # return $a * $b if $n == 0;
+
+ if ($_[-2] == 0) {
+ my ($a, $n, $b) = splice @_, -3;
+ push @_, $a * $b;
+ next;
+ }
+
+ # return 1 if $b == 0;
+
+ if ($_[-1] == 0) {
+ splice @_, -3;
+ push @_, $class -> bone();
+ next;
+ }
+
+ # return buparrow($a, $n - 1, buparrow($a, $n, $b - 1));
+
+ my ($a, $n, $b) = splice @_, -3;
+ push @_, ($a, $n - 1,
+ $a, $n, $b - 1);
+
+ }
+
+ pop @_;
+}
+
+sub backermann {
+ my $m = shift;
+ my $y = $m -> ackermann(@_);
+ $m -> {value} = $y -> {value};
+ return $m;
+}
+
+sub ackermann {
+ # Ackermann's function ackermann(m, n)
+ #
+ # The following is a simple, recursive implementation of the ackermann
+ # function, just to show the idea. Such implementations cause "Deep
+ # recursion on subroutine ..." warnings, so we use a faster, non-recursive
+ # algorithm below with @_ as a stack.
+ #
+ # sub ackermann {
+ # my ($m, $n) = @_;
+ # return $n + 1 if $m == 0;
+ # return ackermann($m - 1, 1) if $m > 0 && $n == 0;
+ # return ackermann($m - 1, ackermann($m, $n - 1) if $m > 0 && $n > 0;
+ # }
+
+ my ($m, $n) = @_;
+ my $class = ref $m;
+ croak("m must be non-negative") if $m < 0;
+ croak("n must be non-negative") if $n < 0;
+
+ my $two = $class -> new("2");
+ my $three = $class -> new("3");
+ my $thirteen = $class -> new("13");
+
+ $n = pop;
+ $n = $class -> new($n) unless ref($n);
+ while (@_) {
+ my $m = pop;
+ if ($m > $three) {
+ push @_, (--$m) x $n;
+ while (--$m >= $three) {
+ push @_, $m;
+ }
+ $n = $thirteen;
+ } elsif ($m == $three) {
+ $n = $class -> bone() -> blsft($n + $three) -> bsub($three);
+ } elsif ($m == $two) {
+ $n -> bmul($two) -> badd($three);
+ } elsif ($m >= 0) {
+ $n -> badd($m) -> binc();
+ } else {
+ die "negative m!";
+ }
+ }
+ $n;
+}
+
sub bsin {
# Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the
# result truncated to an integer.
@@ -2654,9 +2783,9 @@ sub batan {
return $upgrade->new($x)->batan(@r) if defined $upgrade;
# calculate the result and truncate it to integer
- my $t = Math::BigFloat->new($x)->batan(@r);
+ my $tmp = Math::BigFloat->new($x)->batan(@r);
- $x->{value} = $LIB->_new($x->as_int()->bstr());
+ $x->{value} = $LIB->_new($tmp->as_int()->bstr());
$x->round(@r);
}
@@ -2902,12 +3031,19 @@ sub blsft {
# (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]), @_);
+ my ($class, $x, $y, $b, @r);
- # 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('blsft');
@@ -2915,7 +3051,15 @@ sub blsft {
$y -> {sign} !~ /^[+-]$/);
return $x -> round(@r) if $y -> is_zero();
- $b = 2 if !defined $b;
+ $b = defined($b) ? $b -> numify() : 2;
+
+ # 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;
+
return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-';
$x -> {value} = $LIB -> _lsft($x -> {value}, $y -> {value}, $b);
@@ -3146,7 +3290,7 @@ sub bround {
# do not return $x->bnorm(), but $x
my $x = shift;
- $x = $class->new($x) unless ref $x;
+ $x = __PACKAGE__->new($x) unless ref $x;
my ($scale, $mode) = $x->_scale_a(@_);
return $x if !defined $scale || $x->modify('bround'); # no-op
@@ -3264,7 +3408,7 @@ sub fround {
# Exists to make life easier for switch between MBF and MBI (should we
# autoload fxxx() like MBF does for bxxx()?)
my $x = shift;
- $x = $class->new($x) unless ref $x;
+ $x = __PACKAGE__->new($x) unless ref $x;
$x->bround(@_);
}
@@ -3356,6 +3500,31 @@ sub digit {
$LIB->_digit($x->{value}, $n || 0);
}
+sub bdigitsum {
+ # like digitsum(), but assigns the result to the invocand
+ my $x = shift;
+
+ return $x if $x -> is_nan();
+ return $x -> bnan() if $x -> is_inf();
+
+ $x -> {value} = $LIB -> _digitsum($x -> {value});
+ $x -> {sign} = '+';
+ return $x;
+}
+
+sub digitsum {
+ # compute sum of decimal digits and return it
+ my $x = shift;
+ my $class = ref $x;
+
+ 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;
+}
+
sub length {
my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);
@@ -3652,7 +3821,7 @@ sub bdstr {
sub to_hex {
# return as hex string, with prefixed 0x
my $x = shift;
- $x = $class->new($x) if !ref($x);
+ $x = __PACKAGE__->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
@@ -3663,7 +3832,7 @@ sub to_hex {
sub to_oct {
# return as octal string, with prefixed 0
my $x = shift;
- $x = $class->new($x) if !ref($x);
+ $x = __PACKAGE__->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
@@ -3674,7 +3843,7 @@ sub to_oct {
sub to_bin {
# return as binary string, with prefixed 0b
my $x = shift;
- $x = $class->new($x) if !ref($x);
+ $x = __PACKAGE__->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
@@ -3685,7 +3854,7 @@ sub to_bin {
sub to_bytes {
# return a byte string
my $x = shift;
- $x = $class->new($x) if !ref($x);
+ $x = __PACKAGE__->new($x) if !ref($x);
croak("to_bytes() requires a finite, non-negative integer")
if $x -> is_neg() || ! $x -> is_int();
@@ -3699,13 +3868,13 @@ sub to_bytes {
sub to_base {
# return a base anything string
my $x = shift;
- $x = $class->new($x) if !ref($x);
+ $x = __PACKAGE__->new($x) if !ref($x);
croak("the value to convert must be a finite, non-negative integer")
if $x -> is_neg() || !$x -> is_int();
my $base = shift;
- $base = $class->new($base) unless ref($base);
+ $base = __PACKAGE__->new($base) unless ref($base);
croak("the base must be a finite integer >= 2")
if $base < 2 || ! $base -> is_int();
@@ -3729,7 +3898,7 @@ sub to_base {
sub as_hex {
# return as hex string, with prefixed 0x
my $x = shift;
- $x = $class->new($x) if !ref($x);
+ $x = __PACKAGE__->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
@@ -3740,7 +3909,7 @@ sub as_hex {
sub as_oct {
# return as octal string, with prefixed 0
my $x = shift;
- $x = $class->new($x) if !ref($x);
+ $x = __PACKAGE__->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
@@ -3751,7 +3920,7 @@ sub as_oct {
sub as_bin {
# return as binary string, with prefixed 0b
my $x = shift;
- $x = $class->new($x) if !ref($x);
+ $x = __PACKAGE__->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
@@ -3768,7 +3937,7 @@ sub as_bin {
sub numify {
# Make a Perl scalar number from a Math::BigInt object.
my $x = shift;
- $x = $class->new($x) unless ref $x;
+ $x = __PACKAGE__->new($x) unless ref $x;
if ($x -> is_nan()) {
require Math::Complex;
@@ -3817,7 +3986,7 @@ sub objectify {
# Check the context.
unless (wantarray) {
- croak("${class}::objectify() needs list context");
+ croak(__PACKAGE__ . "::objectify() needs list context");
}
# Get the number of arguments to objectify.
@@ -3935,10 +4104,9 @@ sub objectify {
sub import {
my $class = shift;
$IMPORT++; # remember we did import()
- my @a;
- my $l = scalar @_;
+ my @a; # unrecognized arguments
my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die
- for (my $i = 0; $i < $l ; $i++) {
+ for (my $i = 0; $i <= $#_ ; $i++) {
if ($_[$i] eq ':constant') {
# this causes overlord er load to step in
overload::constant
@@ -3951,7 +4119,9 @@ sub import {
} elsif ($_[$i] =~ /^(lib|try|only)\z/) {
# this causes a different low lib to take care...
$LIB = $_[$i+1] || '';
- # lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback)
+ # 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++;
@@ -3968,77 +4138,34 @@ sub import {
# try to load core math lib
my @c = split /\s*,\s*/, $LIB;
foreach (@c) {
- $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
+ 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
+ $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 if ($lib || '') eq '';
+ next unless defined($lib) && CORE::length($lib);
$lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
$lib =~ s/\.pm$//;
- if ($] < 5.006) {
- # Perl < 5.6.0 dies with "out of memory!" when eval("") and ':constant' is
- # used in the same script, or eval("") inside import().
- my @parts = split /::/, $lib; # Math::BigInt => Math BigInt
- my $file = pop @parts;
- $file .= '.pm'; # BigInt => BigInt.pm
- require File::Spec;
- $file = File::Spec->catfile (@parts, $file);
- eval {
- require "$file";
- $lib->import(@c);
- }
- } else {
- eval "use $lib qw/@c/;";
- }
+ 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 '') {
- my $ok = 1;
- # loaded it ok, see if the api_version() is high enough
- if ($lib->can('api_version') && $lib->api_version() >= 1.0) {
- $ok = 0;
- # api_version matches, check if it really provides anything we need
- for my $method (qw/
- one two ten
- str num
- add mul div sub dec inc
- acmp len digit is_one is_zero is_even is_odd
- is_two is_ten
- zeros new copy check
- from_hex from_oct from_bin as_hex as_bin as_oct
- rsft lsft xor and or
- mod sqrt root fac pow modinv modpow log_int gcd
- /) {
- if (!$lib->can("_$method")) {
- if (($WARN{$lib} || 0) < 2) {
- carp("$lib is missing method '_$method'");
- $WARN{$lib} = 1; # still warn about the lib
- }
- $ok++;
- last;
- }
- }
- }
- if ($ok == 0) {
- $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
- } else {
- if (($WARN{$lib} || 0) < 2) {
- my $ver = eval "\$$lib\::VERSION" || 'unknown';
- carp("Cannot load outdated $lib v$ver, please upgrade");
- $WARN{$lib} = 2; # never warn again
- }
+ $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
}
}
if ($LIB eq '') {
@@ -4210,7 +4337,7 @@ sub _split {
sub _trailing_zeros {
# return the amount of trailing zeros in $x (as scalar)
my $x = shift;
- $x = $class->new($x) unless ref $x;
+ $x = __PACKAGE__->new($x) unless ref $x;
return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
@@ -4423,6 +4550,8 @@ Math::BigInt - Arbitrary size integer/float math package
$x->blog($base); # logarithm of $x to base $base (e.g., base 2)
$x->bexp(); # calculate e ** $x where e is Euler's number
$x->bnok($y); # x over y (binomial coefficient n over k)
+ $x->buparrow($n, $y); # Knuth's up-arrow notation
+ $x->backermann($y); # the Ackermann function
$x->bsin(); # sine
$x->bcos(); # cosine
$x->batan(); # inverse tangent
@@ -4987,6 +5116,18 @@ neither positive nor negative.
Returns true if the invocand is negative and false otherwise. A C<NaN> is
neither positive nor negative.
+=item is_non_positive()
+
+ $x->is_non_positive(); # true if <= 0
+
+Returns true if the invocand is negative or zero.
+
+=item is_non_negative()
+
+ $x->is_non_negative(); # true if >= 0
+
+Returns true if the invocand is positive or zero.
+
=item is_odd()
$x->is_odd(); # true if odd, false for even
@@ -5292,6 +5433,38 @@ pseudo-code:
The behaviour is identical to the behaviour of the Maple and Mathematica
function for negative integers n, k.
+=item buparrow()
+
+=item uparrow()
+
+ $a -> buparrow($n, $b); # modifies $a
+ $x = $a -> uparrow($n, $b); # does not modify $a
+
+This method implements Knuth's up-arrow notation, where $n is a non-negative
+integer representing the number of up-arrows. $n = 0 gives multiplication, $n =
+1 gives exponentiation, $n = 2 gives tetration, $n = 3 gives hexation etc. The
+following illustrates the relation between the first values of $n.
+
+See L<https://en.wikipedia.org/wiki/Knuth%27s_up-arrow_notation>.
+
+=item backermann()
+
+=item ackermann()
+
+ $m -> backermann($n); # modifies $a
+ $x = $m -> ackermann($n); # does not modify $a
+
+This method implements the Ackermann function:
+
+ / n + 1 if m = 0
+ A(m, n) = | A(m-1, 1) if m > 0 and n = 0
+ \ A(m-1, A(m, n-1)) if m > 0 and n > 0
+
+Its value grows rapidly, even for small inputs. For example, A(4, 2) is an
+integer of 19729 decimal digits.
+
+See https://en.wikipedia.org/wiki/Ackermann_function
+
=item bsin()
my $x = Math::BigInt->new(1);
@@ -5590,6 +5763,18 @@ If you want $x to have a certain sign, use one of the following methods:
If C<$n> is negative, returns the digit counting from left.
+=item digitsum()
+
+ $x->digitsum();
+
+Computes the sum of the base 10 digits and returns it.
+
+=item bdigitsum()
+
+ $x->bdigitsum();
+
+Computes the sum of the base 10 digits and assigns the result to the invocand.
+
=item length()
$x->length();
@@ -6696,11 +6881,11 @@ L<http://annocpan.org/dist/Math-BigInt>
=item * CPAN Ratings
-L<http://cpanratings.perl.org/dist/Math-BigInt>
+L<https://cpanratings.perl.org/dist/Math-BigInt>
-=item * Search CPAN
+=item * MetaCPAN
-L<http://search.cpan.org/dist/Math-BigInt/>
+L<https://metacpan.org/release/Math-BigInt>
=item * CPAN Testers Matrix
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 2bb06a0976..cd8f1ee44e 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Calc.pm
@@ -7,7 +7,7 @@ use warnings;
use Carp qw< carp croak >;
use Math::BigInt::Lib;
-our $VERSION = '1.999816';
+our $VERSION = '1.999818';
our @ISA = ('Math::BigInt::Lib');
@@ -35,9 +35,6 @@ our @ISA = ('Math::BigInt::Lib');
##############################################################################
# global constants, flags and accessory
-# announce that we are compatible with MBI v1.83 and up
-sub api_version () { 2; }
-
# constants for easier life
my ($BASE, $BASE_LEN, $RBASE, $MAX_VAL);
my ($AND_BITS, $XOR_BITS, $OR_BITS);
@@ -50,9 +47,7 @@ sub _base_len {
my ($class, $b, $int) = @_;
if (defined $b) {
- # avoid redefinitions
- undef &_mul;
- undef &_div;
+ no warnings "redefine";
if ($] >= 5.008 && $int && $b > 7) {
$BASE_LEN = $b;
@@ -403,13 +398,14 @@ sub _mul_use_mul {
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
+ # 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) {
- $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $BASE;
+ my $rem = $xv->[0] % $BASE;
+ $xv->[1] = ($xv->[0] - $rem) * $RBASE;
+ $xv->[0] = $rem;
}
- ;
return $xv;
}
# $x * 0 => 0
@@ -417,56 +413,44 @@ sub _mul_use_mul {
@$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;
- $car = int($i * $RBASE);
- $i -= $car * $BASE;
+ $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 = [ @$xv ] if $xv == $yv; # same references?
+ $yv = $c->_copy($xv) if $xv == $yv; # same references?
my @prod = ();
- my ($prod, $car, $cty, $xi, $yi);
-
+ my ($prod, $rem, $car, $cty, $xi, $yi);
for $xi (@$xv) {
$car = 0;
$cty = 0;
-
- # slow variant
- # for $yi (@$yv)
- # {
- # $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
- # $prod[$cty++] =
- # $prod - ($car = int($prod * RBASE)) * $BASE; # see USE_MUL
- # }
- # $prod[$cty] += $car if $car; # need really to check for 0?
- # $xi = shift @prod;
-
- # faster variant
# looping through this if $xi == 0 is silly - so optimize it away!
- $xi = (shift @prod || 0), next if $xi == 0;
+ $xi = (shift(@prod) || 0), next if $xi == 0;
for $yi (@$yv) {
$prod = $xi * $yi + ($prod[$cty] || 0) + $car;
- ## this is actually a tad slower
- ## $prod = $prod[$cty]; $prod += ($car + $xi * $yi); # no ||0 here
- $prod[$cty++] =
- $prod - ($car = int($prod * $RBASE)) * $BASE; # see USE_MUL
+ $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
+ $prod[$cty] += $car if $car; # need really to check for 0?
+ $xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy
}
push @$xv, @prod;
- # can't have leading zeros
- # __strip_zeros($xv);
$xv;
}
@@ -478,11 +462,11 @@ sub _mul_use_div_64 {
my ($c, $xv, $yv) = @_;
use integer;
+
if (@$yv == 1) {
- # shortcut for two small numbers, also handles $x == 0
+ # 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) {
- # 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->[0] *= $yv->[0]) >= $BASE) {
$xv->[0] =
$xv->[0] - ($xv->[1] = $xv->[0] / $BASE) * $BASE;
@@ -494,6 +478,7 @@ sub _mul_use_div_64 {
@$xv = (0);
return $xv;
}
+
# multiply a large number a by a single element one, so speed up
my $y = $yv->[0];
my $car = 0;
@@ -505,11 +490,12 @@ sub _mul_use_div_64 {
push @$xv, $car if $car != 0;
return $xv;
}
+
# shortcut for result $x == 0 => result = 0
- return $xv if ( ((@$xv == 1) && ($xv->[0] == 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?
+ $yv = $c->_copy($xv) if $xv == $yv; # same references?
my @prod = ();
my ($prod, $car, $cty, $xi, $yi);
@@ -517,13 +503,13 @@ sub _mul_use_div_64 {
$car = 0;
$cty = 0;
# looping through this if $xi == 0 is silly - so optimize it away!
- $xi = (shift @prod || 0), next if $xi == 0;
+ $xi = (shift(@prod) || 0), next if $xi == 0;
for $yi (@$yv) {
$prod = $xi * $yi + ($prod[$cty] || 0) + $car;
$prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE;
}
- $prod[$cty] += $car if $car; # need really to check for 0?
- $xi = shift @prod || 0; # || 0 makes v5.005_3 happy
+ $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;
@@ -536,15 +522,14 @@ sub _mul_use_div {
my ($c, $xv, $yv) = @_;
if (@$yv == 1) {
- # shortcut for two small numbers, also handles $x == 0
+ # 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) {
- # 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->[0] *= $yv->[0]) >= $BASE) {
- $xv->[0] =
- $xv->[0] - ($xv->[1] = int($xv->[0] / $BASE)) * $BASE;
+ my $rem = $xv->[0] % $BASE;
+ $xv->[1] = ($xv->[0] - $rem) / $BASE;
+ $xv->[0] = $rem;
}
- ;
return $xv;
}
# $x * 0 => 0
@@ -552,42 +537,44 @@ sub _mul_use_div {
@$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;
- $car = int($i / $BASE);
- $i -= $car * $BASE;
- # This (together with use integer;) does not work on 32-bit Perls
- #$i = $i * $y + $car; $i -= ($car = $i / $BASE) * $BASE;
+ $rem = $i % $BASE;
+ $car = ($i - $rem) / $BASE;
+ $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)) );
+ 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?
+ $yv = $c->_copy($xv) if $xv == $yv; # same references?
my @prod = ();
- my ($prod, $car, $cty, $xi, $yi);
+ 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;
+ $xi = (shift(@prod) || 0), next if $xi == 0;
for $yi (@$yv) {
$prod = $xi * $yi + ($prod[$cty] || 0) + $car;
- $prod[$cty++] = $prod - ($car = int($prod / $BASE)) * $BASE;
+ $rem = $prod % $BASE;
+ $car = ($prod - $rem) / $BASE;
+ $prod[$cty++] = $rem;
}
- $prod[$cty] += $car if $car; # need really to check for 0?
- $xi = shift @prod || 0; # || 0 makes v5.005_3 happy
+ $prod[$cty] += $car if $car; # need really to check for 0?
+ $xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy
}
push @$xv, @prod;
- # can't have leading zeros
- # __strip_zeros($xv);
$xv;
}
@@ -595,28 +582,19 @@ sub _div_use_mul {
# ref to array, ref to array, modify first array and return remainder if
# in list context
- # see comments in _div_use_div() for more explanations
-
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.
- # This works, because we store the numbers in a chunked format where each
- # element contains 5..7 digits (depending on system).
-
# if both numbers have only one element:
if (@$x == 1 && @$yorg == 1) {
# shortcut, $yorg and $x are two small numbers
- if (wantarray) {
- my $rem = [ $x->[0] % $yorg->[0] ];
- bless $rem, $c;
- $x->[0] = int($x->[0] / $yorg->[0]);
- return ($x, $rem);
- } else {
- $x->[0] = int($x->[0] / $yorg->[0]);
- return $x;
- }
+ 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:
@@ -631,120 +609,120 @@ sub _div_use_mul {
my $b;
while ($j-- > 0) {
$b = $r * $BASE + $x->[$j];
- $x->[$j] = int($b/$y);
$r = $b % $y;
+ $x->[$j] = ($b - $r) / $y;
}
- pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero
+ 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 yet, the result will be 0
+ # 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
+ $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 $yorg has more digits than $x (it's leading element is longer than
- # the one from $x), the result will also be 0:
- if (length(int($yorg->[-1])) > length(int($x->[-1]))) {
- my $rem = $c->_copy($x) if wantarray; # make copy
- @$x = 0; # set to 0
- return ($x, $rem) if wantarray; # including remainder?
+ if ($cmp == 0) { # x = y
+ @$x = 1;
+ return $x, $c->_zero() if wantarray;
return $x;
}
- # now calculate $x / $yorg
- if (length(int($yorg->[-1])) == length(int($x->[-1]))) {
- # same length, so make full compare
- my $a = 0;
- my $j = @$x - 1;
- # manual way (abort if unequal, good for early ne)
- while ($j >= 0) {
- last if ($a = $x->[$j] - $yorg->[$j]);
- $j--;
- }
- # $a contains the result of the compare between X and Y
- # a < 0: x < y, a == 0: x == y, a > 0: x > y
- if ($a <= 0) {
- # a = 0 => x == y => rem 0
- # a < 0 => x < y => rem = x
- my $rem = $a == 0 ? $c->_zero() : $c->_copy($x);
- @$x = 0; # if $a < 0
- $x->[0] = 1 if $a == 0; # $x == $y
- return ($x, $rem) if wantarray;
- return $x;
+ if ($cmp < 0) { # x < y
+ if (wantarray) {
+ my $rem = $c->_copy($x);
+ @$x = 0;
+ return $x, $rem;
}
- # $x >= $y, so proceed normally
+ @$x = 0;
+ return $x;
}
}
# all other cases:
- my $y = $c->_copy($yorg); # always make copy to preserve
+ my $y = $c->_copy($yorg); # always make copy to preserve
- my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0);
-
- $car = $bar = $prd = 0;
- if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
- for $xi (@$x) {
+ 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
+ $xi -= ($car = int($xi * $RBASE)) * $BASE; # see USE_MUL
}
push(@$x, $car);
$car = 0;
- for $yi (@$y) {
+ for my $yi (@$y) {
$yi = $yi * $dd + $car;
- $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL
+ $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL
}
} else {
push(@$x, 0);
}
- @q = ();
- ($v2, $v1) = @$y[-2, -1];
+
+ # @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) {
- ($u2, $u1, $u0) = @$x[-3 .. -1];
+ 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;
- $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1));
- --$q while ($v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2);
+ 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) {
- ($car, $bar) = (0, 0);
- for ($yi = 0, $xi = $#$x - $#$y-1; $yi <= $#$y; ++$yi, ++$xi) {
+ 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));
+ $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 ($yi = 0, $xi = $#$x - $#$y-1; $yi <= $#$y; ++$yi, ++$xi) {
+ for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
$x->[$xi] -= $BASE
- if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE));
+ if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE);
}
}
}
pop(@$x);
unshift(@q, $q);
}
+
if (wantarray) {
my $d = bless [], $c;
if ($dd != 1) {
- $car = 0;
- for $xi (reverse @$x) {
+ my $car = 0;
+ my ($prd, $rem);
+ for my $xi (reverse @$x) {
$prd = $car * $BASE + $xi;
- $car = $prd - ($tmp = int($prd / $dd)) * $dd; # see USE_MUL
- unshift(@$d, $tmp);
+ $rem = $prd % $dd;
+ $tmp = ($prd - $rem) / $dd;
+ $car = $rem;
+ unshift @$d, $tmp;
}
} else {
@$d = @$x;
@@ -762,29 +740,29 @@ sub _div_use_mul {
sub _div_use_div_64 {
# ref to array, ref to array, modify first array and return remainder if
# in list context
- # This version works on 64 bit integers
- my ($c, $x, $yorg) = @_;
+ # This version works on integers
use integer;
+
+ 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.
- # This works, because we store the numbers in a chunked format where each
- # element contains 5..7 digits (depending on system).
-
# if both numbers have only one element:
if (@$x == 1 && @$yorg == 1) {
# shortcut, $yorg and $x are two small numbers
if (wantarray) {
my $rem = [ $x->[0] % $yorg->[0] ];
bless $rem, $c;
- $x->[0] = int($x->[0] / $yorg->[0]);
+ $x->[0] = $x->[0] / $yorg->[0];
return ($x, $rem);
} else {
- $x->[0] = int($x->[0] / $yorg->[0]);
+ $x->[0] = $x->[0] / $yorg->[0];
return $x;
}
}
+
# if x has more than one, but y has only one element:
if (@$yorg == 1) {
my $rem;
@@ -797,78 +775,67 @@ sub _div_use_div_64 {
my $b;
while ($j-- > 0) {
$b = $r * $BASE + $x->[$j];
- $x->[$j] = int($b/$y);
$r = $b % $y;
+ $x->[$j] = $b / $y;
}
- pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero
+ 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 yet, the result will be 0
+ # 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
+ $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 $rem;
- # if $yorg has more digits than $x (it's leading element is longer than
- # the one from $x), the result will also be 0:
- if (length(int($yorg->[-1])) > length(int($x->[-1]))) {
- $rem = $c->_copy($x) if wantarray; # make copy
- @$x = 0; # set to 0
- return ($x, $rem) if wantarray; # including remainder?
- return $x;
+ my $cmp = 0;
+ for (my $j = $#$x ; $j >= 0 ; --$j) {
+ last if $cmp = $x->[$j] - $yorg->[$j];
}
- # now calculate $x / $yorg
- if (length(int($yorg->[-1])) == length(int($x->[-1]))) {
- # same length, so make full compare
+ if ($cmp == 0) { # x = y
+ @$x = 1;
+ return $x, $c->_zero() if wantarray;
+ return $x;
+ }
- my $a = 0;
- my $j = @$x - 1;
- # manual way (abort if unequal, good for early ne)
- while ($j >= 0) {
- last if ($a = $x->[$j] - $yorg->[$j]);
- $j--;
- }
- # $a contains the result of the compare between X and Y
- # a < 0: x < y, a == 0: x == y, a > 0: x > y
- if ($a <= 0) {
- $rem = $c->_zero(); # a = 0 => x == y => rem 0
- $rem = $c->_copy($x) if $a != 0; # a < 0 => x < y => rem = x
- @$x = 0; # if $a < 0
- $x->[0] = 1 if $a == 0; # $x == $y
- return ($x, $rem) if wantarray; # including remainder?
- return $x;
+ if ($cmp < 0) { # x < y
+ if (wantarray) {
+ my $rem = $c->_copy($x);
+ @$x = 0;
+ return $x, $rem;
}
- # $x >= $y, so proceed normally
+ @$x = 0;
+ return $x;
}
}
# all other cases:
- my $y = $c->_copy($yorg); # always make copy to preserve
-
- my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0);
+ my $y = $c->_copy($yorg); # always make copy to preserve
- $car = $bar = $prd = 0;
- if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
- for $xi (@$x) {
+ my $tmp;
+ my $dd = $BASE / ($y->[-1] + 1);
+ if ($dd != 1) {
+ my $car = 0;
+ for my $xi (@$x) {
$xi = $xi * $dd + $car;
- $xi -= ($car = int($xi / $BASE)) * $BASE;
+ $xi -= ($car = $xi / $BASE) * $BASE;
}
push(@$x, $car);
$car = 0;
- for $yi (@$y) {
+ for my $yi (@$y) {
$yi = $yi * $dd + $car;
- $yi -= ($car = int($yi / $BASE)) * $BASE;
+ $yi -= ($car = $yi / $BASE) * $BASE;
}
} else {
push(@$x, 0);
@@ -877,43 +844,48 @@ sub _div_use_div_64 {
# @q will accumulate the final result, $q contains the current computed
# part of the final result
- @q = ();
- ($v2, $v1) = @$y[-2, -1];
+ my @q = ();
+ my ($v2, $v1) = @$y[-2, -1];
$v2 = 0 unless $v2;
while ($#$x > $#$y) {
- ($u2, $u1, $u0) = @$x[-3..-1];
+ 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;
- $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1));
- --$q while ($v2 * $q > ($u0 * $BASE +$ u1- $q*$v1) * $BASE + $u2);
+ 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) {
- ($car, $bar) = (0, 0);
- for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
+ 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 / $BASE)) * $BASE;
- $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
+ $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0);
}
if ($x->[-1] < $car + $bar) {
$car = 0;
--$q;
- for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
+ for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
$x->[$xi] -= $BASE
- if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE));
+ if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE);
}
}
}
pop(@$x);
unshift(@q, $q);
}
+
if (wantarray) {
my $d = bless [], $c;
if ($dd != 1) {
- $car = 0;
- for $xi (reverse @$x) {
+ my $car = 0;
+ my $prd;
+ for my $xi (reverse @$x) {
$prd = $car * $BASE + $xi;
- $car = $prd - ($tmp = int($prd / $dd)) * $dd;
- unshift(@$d, $tmp);
+ $car = $prd - ($tmp = $prd / $dd) * $dd;
+ unshift @$d, $tmp;
}
} else {
@$d = @$x;
@@ -931,27 +903,22 @@ sub _div_use_div_64 {
sub _div_use_div {
# 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.
- # This works, because we store the numbers in a chunked format where each
- # element contains 5..7 digits (depending on system).
-
# if both numbers have only one element:
if (@$x == 1 && @$yorg == 1) {
# shortcut, $yorg and $x are two small numbers
- if (wantarray) {
- my $rem = [ $x->[0] % $yorg->[0] ];
- bless $rem, $c;
- $x->[0] = int($x->[0] / $yorg->[0]);
- return ($x, $rem);
- } else {
- $x->[0] = int($x->[0] / $yorg->[0]);
- return $x;
- }
+ 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;
@@ -964,80 +931,72 @@ sub _div_use_div {
my $b;
while ($j-- > 0) {
$b = $r * $BASE + $x->[$j];
- $x->[$j] = int($b/$y);
$r = $b % $y;
+ $x->[$j] = ($b - $r) / $y;
}
- pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero
+ 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 yet, the result will be 0
+ # 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
+ $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 $rem;
- # if $yorg has more digits than $x (it's leading element is longer than
- # the one from $x), the result will also be 0:
- if (length(int($yorg->[-1])) > length(int($x->[-1]))) {
- $rem = $c->_copy($x) if wantarray; # make copy
- @$x = 0; # set to 0
- return ($x, $rem) if wantarray; # including remainder?
- return $x;
+ my $cmp = 0;
+ for (my $j = $#$x ; $j >= 0 ; --$j) {
+ last if $cmp = $x->[$j] - $yorg->[$j];
}
- # now calculate $x / $yorg
- if (length(int($yorg->[-1])) == length(int($x->[-1]))) {
- # same length, so make full compare
+ if ($cmp == 0) { # x = y
+ @$x = 1;
+ return $x, $c->_zero() if wantarray;
+ return $x;
+ }
- my $a = 0;
- my $j = @$x - 1;
- # manual way (abort if unequal, good for early ne)
- while ($j >= 0) {
- last if ($a = $x->[$j] - $yorg->[$j]);
- $j--;
- }
- # $a contains the result of the compare between X and Y
- # a < 0: x < y, a == 0: x == y, a > 0: x > y
- if ($a <= 0) {
- $rem = $c->_zero(); # a = 0 => x == y => rem 0
- $rem = $c->_copy($x) if $a != 0; # a < 0 => x < y => rem = x
+ if ($cmp < 0) { # x < y
+ if (wantarray) {
+ my $rem = $c->_copy($x);
@$x = 0;
- $x->[0] = 0; # if $a < 0
- $x->[0] = 1 if $a == 0; # $x == $y
- return ($x, $rem) if wantarray; # including remainder?
- return $x;
+ return $x, $rem;
}
- # $x >= $y, so proceed normally
-
+ @$x = 0;
+ return $x;
}
}
# all other cases:
- my $y = $c->_copy($yorg); # always make copy to preserve
-
- my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, @d, $tmp, $q, $u2, $u1, $u0);
+ my $y = $c->_copy($yorg); # always make copy to preserve
- $car = $bar = $prd = 0;
- if (($dd = int($BASE / ($y->[-1] + 1))) != 1) {
- for $xi (@$x) {
+ 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 / $BASE)) * $BASE;
+ $rem = $xi % $BASE;
+ $car = ($xi - $rem) / $BASE;
+ $xi = $rem;
}
push(@$x, $car);
$car = 0;
- for $yi (@$y) {
+ for my $yi (@$y) {
$yi = $yi * $dd + $car;
- $yi -= ($car = int($yi / $BASE)) * $BASE;
+ $rem = $yi % $BASE;
+ $car = ($yi - $rem) / $BASE;
+ $yi = $rem;
}
} else {
push(@$x, 0);
@@ -1046,43 +1005,52 @@ sub _div_use_div {
# @q will accumulate the final result, $q contains the current computed
# part of the final result
- @q = ();
- ($v2, $v1) = @$y[-2, -1];
+ my @q = ();
+ my ($v2, $v1) = @$y[-2, -1];
$v2 = 0 unless $v2;
while ($#$x > $#$y) {
- ($u2, $u1, $u0) = @$x[-3..-1];
+ 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;
- $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1));
- --$q while ($v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2);
+ 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) {
- ($car, $bar) = (0, 0);
- for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
+ 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 / $BASE)) * $BASE;
- $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
+ $rem = $prd % $BASE;
+ $car = ($prd - $rem) / $BASE;
+ $prd -= $car * $BASE;
+ $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0);
}
if ($x->[-1] < $car + $bar) {
$car = 0;
--$q;
- for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
+ for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
$x->[$xi] -= $BASE
- if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE));
+ if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE);
}
}
}
pop(@$x);
unshift(@q, $q);
}
+
if (wantarray) {
my $d = bless [], $c;
if ($dd != 1) {
- $car = 0;
- for $xi (reverse @$x) {
+ my $car = 0;
+ my ($prd, $rem);
+ for my $xi (reverse @$x) {
$prd = $car * $BASE + $xi;
- $car = $prd - ($tmp = int($prd / $dd)) * $dd;
- unshift(@$d, $tmp);
+ $rem = $prd % $dd;
+ $tmp = ($prd - $rem) / $dd;
+ $car = $rem;
+ unshift @$d, $tmp;
}
} else {
@$d = @$x;
@@ -1385,7 +1353,7 @@ sub _rsft {
$dst++;
}
splice(@$x, $dst) if $dst > 0; # kill left-over array elems
- pop @$x if $x->[-1] == 0 && @$x > 1; # kill last element if 0
+ pop(@$x) if $x->[-1] == 0 && @$x > 1; # kill last element if 0
} # else rem == 0
$x;
}
@@ -1393,49 +1361,64 @@ sub _rsft {
sub _lsft {
my ($c, $x, $n, $b) = @_;
- return $x if $c->_is_zero($x);
-
- # Handle the special case when the base is a power of 10. Don't check
- # whether log($b)/log(10) is an integer, because log(1000)/log(10) is not
- # exactly 3.
-
- my $log10 = sprintf "%.0f", log($b) / log(10);
- if ($b == 10 ** $log10) {
- $b = 10;
- $n = $c->_mul($n, $c->_new($log10));
-
- # shortcut (faster) for shifting by 10) since we are in base 10eX
- # multiples of $BASE_LEN:
- my $src = @$x; # source
- my $len = $c->_num($n); # shift-len as normal int
- my $rem = $len % $BASE_LEN; # remainder to shift
- my $dst = $src + int($len / $BASE_LEN); # destination
- my $vd; # further speedup
- $x->[$src] = 0; # avoid first ||0 for speed
- my $z = '0' x $BASE_LEN;
- while ($src >= 0) {
- $vd = $x->[$src];
- $vd = $z . $vd;
- $vd = substr($vd, -$BASE_LEN + $rem, $BASE_LEN - $rem);
- $vd .= $src > 0 ? substr($z . $x->[$src - 1], -$BASE_LEN, $rem)
- : '0' x $rem;
- $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN;
- $x->[$dst] = int($vd);
- $dst--;
- $src--;
+ 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 the base is a power of 10, use shifting, since the internal
+ # representation is in base 10eX.
+
+ my $bstr = $c->_str($b);
+ if ($bstr =~ /^1(0+)\z/) {
+
+ # Adjust $n so that we're shifting in base 10. Do this by multiplying
+ # $n by the base 10 logarithm of $b: $b ** $n = 10 ** (log10($b) * $n).
+
+ my $log10b = length($1);
+ $n = $c->_mul($c->_new($log10b), $n);
+ $n = $c->_num($n); # shift-len as normal int
+
+ # $q is the number of places to shift the elements within the array,
+ # and $r is the number of places to shift the values within the
+ # elements.
+
+ my $r = $n % $BASE_LEN;
+ my $q = ($n - $r) / $BASE_LEN;
+
+ # If we must shift the values within the elements ...
+
+ if ($r) {
+ my $i = @$x; # index
+ $x->[$i] = 0; # initialize most significant element
+ my $z = '0' x $BASE_LEN;
+ my $vd;
+ while ($i >= 0) {
+ $vd = $x->[$i];
+ $vd = $z . $vd;
+ $vd = substr($vd, $r - $BASE_LEN, $BASE_LEN - $r);
+ $vd .= $i > 0 ? substr($z . $x->[$i - 1], -$BASE_LEN, $r)
+ : '0' x $r;
+ $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN;
+ $x->[$i] = int($vd); # e.g., "0...048" -> 48 etc.
+ $i--;
+ }
+
+ pop(@$x) if $x->[-1] == 0; # if most significant element is zero
}
- # set lowest parts to 0
- while ($dst >= 0) {
- $x->[$dst--] = 0;
+
+ # If we must shift the elements within the array ...
+
+ if ($q) {
+ unshift @$x, (0) x $q;
}
- # fix spurious last zero element
- splice @$x, -1 if $x->[-1] == 0;
- return $x;
+
} else {
- $b = $c->_new($b);
- #print $c->_str($b);
- return $c->_mul($x, $c->_pow($b, $n));
+ $x = $c->_mul($x, $c->_pow($b, $n));
}
+
+ return $x;
}
sub _pow {
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 3e772e92a3..4e903bd4f1 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm
@@ -8,7 +8,7 @@ use Math::BigInt::Calc 1.999801;
our @ISA = qw< Math::BigInt::Calc >;
-our $VERSION = '0.5008';
+our $VERSION = '0.5009';
##############################################################################
# global constants, flags and accessory
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
index 883f31f4c9..fde281297f 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
@@ -4,7 +4,7 @@ use 5.006001;
use strict;
use warnings;
-our $VERSION = '1.999816';
+our $VERSION = '1.999818';
use Carp;
@@ -251,13 +251,6 @@ use overload
;
-# Do we need api_version() at all, now that we have a virtual parent class that
-# will provide any missing methods? Fixme!
-
-sub api_version () {
- croak "@{[(caller 0)[3]]} method not implemented";
-}
-
sub _new {
croak "@{[(caller 0)[3]]} method not implemented";
}
@@ -386,6 +379,20 @@ sub _digit {
substr($class ->_str($x), -($n+1), 1);
}
+sub _digitsum {
+ my ($class, $x) = @_;
+
+ my $len = $class -> _len($x);
+ my $sum = $class -> _zero();
+ for (my $i = 0 ; $i < $len ; ++$i) {
+ my $digit = $class -> _digit($x, $i);
+ $digit = $class -> _new($digit);
+ $sum = $class -> _add($sum, $digit);
+ }
+
+ return $sum;
+}
+
sub _zeros {
my ($class, $x) = @_;
my $str = $class -> _str($x);
@@ -1428,16 +1435,20 @@ sub _to_base {
if (@_) {
$collseq = shift();
} else {
- if ($class -> _acmp($base, $class -> _new("62")) <= 0) {
- $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
- . 'abcdefghijklmnopqrstuvwxyz';
+ if ($class -> _acmp($base, $class -> _new("94")) <= 0) {
+ $collseq = '0123456789' # 48 .. 57
+ . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' # 65 .. 90
+ . 'abcdefghijklmnopqrstuvwxyz' # 97 .. 122
+ . '!"#$%&\'()*+,-./' # 33 .. 47
+ . ':;<=>?@' # 58 .. 64
+ . '[\\]^_`' # 91 .. 96
+ . '{|}~'; # 123 .. 126
} else {
- croak "When base > 62, a collation sequence must be given";
+ croak "When base > 94, a collation sequence must be given";
}
}
my @collseq = split '', $collseq;
- my %collseq = map { $_ => $collseq[$_] } 0 .. $#collseq;
my $str = '';
my $tmp = $class -> _copy($x);
@@ -1573,11 +1584,16 @@ sub _from_base {
if ($class -> _acmp($base, $class -> _new("36")) <= 0) {
$str = uc $str;
$collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
- } elsif ($class -> _acmp($base, $class -> _new("62")) <= 0) {
- $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
- . 'abcdefghijklmnopqrstuvwxyz';
+ } elsif ($class -> _acmp($base, $class -> _new("94")) <= 0) {
+ $collseq = '0123456789' # 48 .. 57
+ . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' # 65 .. 90
+ . 'abcdefghijklmnopqrstuvwxyz' # 97 .. 122
+ . '!"#$%&\'()*+,-./' # 33 .. 47
+ . ':;<=>?@' # 58 .. 64
+ . '[\\]^_`' # 91 .. 96
+ . '{|}~'; # 123 .. 126
} else {
- croak "When base > 62, a collation sequence must be given";
+ croak "When base > 94, a collation sequence must be given";
}
$collseq = substr $collseq, 0, $class -> _num($base);
}
@@ -1920,11 +1936,8 @@ comparison routines.
=item CLASS-E<gt>api_version()
-Return API version as a Perl scalar, 1 for Math::BigInt v1.70, 2 for
-Math::BigInt v1.83.
-
-This method is no longer used. Methods that are not implemented by a subclass
-will be inherited from this class.
+This method is no longer used and can be omitted. Methods that are not
+implemented by a subclass will be inherited from this class.
=back
@@ -1986,10 +1999,20 @@ COLLSEQ. Each character in STR represents a numerical value identical to the
character's position in COLLSEQ. All characters in STR must be present in
COLLSEQ.
-If BASE is less than or equal to 62, and a collation sequence is not specified,
-a default collation sequence consisting of the 62 characters 0..9, A..Z, and
-a..z is used. If the default collation sequence is used, and the BASE is less
-than or equal to 36, the letter case in STR is ignored.
+If BASE is less than or equal to 94, and a collation sequence is not specified,
+the following default collation sequence is used. It contains of all the 94
+printable ASCII characters except space/blank:
+
+ 0123456789 # ASCII 48 to 57
+ ABCDEFGHIJKLMNOPQRSTUVWXYZ # ASCII 65 to 90
+ abcdefghijklmnopqrstuvwxyz # ASCII 97 to 122
+ !"#$%&'()*+,-./ # ASCII 33 to 47
+ :;<=>?@ # ASCII 58 to 64
+ [\]^_` # ASCII 91 to 96
+ {|}~ # ASCII 123 to 126
+
+If the default collation sequence is used, and the BASE is less than or equal
+to 36, the letter case in STR is ignored.
For instance, with base 3 and collation sequence "-/|", the character "-"
represents 0, "/" represents 1, and "|" represents 2. So if STR is "/|-", the
@@ -2005,10 +2028,12 @@ conversion. All examples return 250.
Some more examples, all returning 250:
- $x = $class -> _from_base("100021", 3, "012")
- $x = $class -> _from_base("3322", 4, "0123")
- $x = $class -> _from_base("2000", 5, "01234")
+ $x = $class -> _from_base("100021", 3)
+ $x = $class -> _from_base("3322", 4)
+ $x = $class -> _from_base("2000", 5)
$x = $class -> _from_base("caaa", 5, "abcde")
+ $x = $class -> _from_base("42", 62)
+ $x = $class -> _from_base("2!", 94)
=back
@@ -2301,6 +2326,10 @@ from the left (most significant digit). If $obj represents the number 123, then
CLASS->_digit($obj, 2) # returns 1
CLASS->_digit($obj, -1) # returns 1
+=item CLASS-E<gt>_digitsum(OBJ)
+
+Returns the sum of the base 10 digits.
+
=item CLASS-E<gt>_check(OBJ)
Returns true if the object is invalid and false otherwise. Preferably, the true
@@ -2394,11 +2423,11 @@ L<http://annocpan.org/dist/Math-BigInt>
=item * CPAN Ratings
-L<http://cpanratings.perl.org/dist/Math-BigInt>
+L<https://cpanratings.perl.org/dist/Math-BigInt>
-=item * Search CPAN
+=item * MetaCPAN
-L<http://search.cpan.org/dist/Math-BigInt/>
+L<https://metacpan.org/release/Math-BigInt>
=item * CPAN Testers Matrix