summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Math
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2019-03-10 21:56:14 +0000
committerKarl Berry <karl@freefriends.org>2019-03-10 21:56:14 +0000
commite0a2a718e89f9700d627f1e6a8eea8f21d2fbeb8 (patch)
tree39972f65008b0d70f306a5f976494d29411bc41e /Master/tlpkg/tlperl/lib/Math
parentb206fdc77d81ed1600949062f08de5690a4bf66f (diff)
tl19 perl 5.28.1 for Windows, from Siep
git-svn-id: svn://tug.org/texlive/trunk@50322 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Math')
-rw-r--r--Master/tlpkg/tlperl/lib/Math/BigFloat.pm133
-rw-r--r--Master/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/Math/BigInt.pm372
-rw-r--r--Master/tlpkg/tlperl/lib/Math/BigInt/Calc.pm13
-rw-r--r--Master/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm4
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Math/BigInt/Lib.pm1043
-rw-r--r--Master/tlpkg/tlperl/lib/Math/BigInt/Trace.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/Math/BigRat.pm28
9 files changed, 1166 insertions, 437 deletions
diff --git a/Master/tlpkg/tlperl/lib/Math/BigFloat.pm b/Master/tlpkg/tlperl/lib/Math/BigFloat.pm
index bcbb2bfd2be..b716b88a348 100644
--- a/Master/tlpkg/tlperl/lib/Math/BigFloat.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigFloat.pm
@@ -19,7 +19,7 @@ use warnings;
use Carp ();
use Math::BigInt ();
-our $VERSION = '1.999806';
+our $VERSION = '1.999811';
require Exporter;
our @ISA = qw/Math::BigInt/;
@@ -529,6 +529,7 @@ sub from_hex {
if ($str =~ s/
^
+ \s*
# sign
( [+-]? )
@@ -555,6 +556,7 @@ sub from_hex {
( \d+ (?: _ \d+ )* )
)?
+ \s*
$
//x)
{
@@ -618,6 +620,7 @@ sub from_oct {
if ($str =~ s/
^
+ \s*
# sign
( [+-]? )
@@ -641,6 +644,7 @@ sub from_oct {
( \d+ (?: _ \d+ )* )
)?
+ \s*
$
//x)
{
@@ -704,6 +708,7 @@ sub from_bin {
if ($str =~ s/
^
+ \s*
# sign
( [+-]? )
@@ -730,6 +735,7 @@ sub from_bin {
( \d+ (?: _ \d+ )* )
)?
+ \s*
$
//x)
{
@@ -2137,16 +2143,24 @@ sub bpow {
}
sub blog {
- my ($class, $x, $base, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(2, @_);
+ # Return the logarithm of the operand. If a second operand is defined, that
+ # value is used as the base, otherwise the base is assumed to be Euler's
+ # constant.
- # If called as $x -> blog() or $x -> blog(undef), don't objectify the
- # undefined base, since undef signals that the base is Euler's number.
- #unless (ref($x) && !defined($base)) {
- # # objectify is costly, so avoid it
- # if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- # ($class, $x, $base, $a, $p, $r) = objectify(2, @_);
- # }
- #}
+ my ($class, $x, $base, $a, $p, $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.
+
+ if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
+ # E.g., Math::BigFloat->blog(256, 2)
+ ($class, $x, $base, $a, $p, $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) =
+ defined $_[1] ? objectify(2, @_) : objectify(1, @_);
+ }
return $x if $x->modify('blog');
@@ -3226,7 +3240,6 @@ sub bfac {
if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
($x->{_es} ne '+')); # digits after dot?
- # use BigInt's bfac() for faster calc
if (! $MBI->_is_zero($x->{_e})) {
$x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
$x->{_e} = $MBI->_zero(); # normalize
@@ -3236,6 +3249,33 @@ sub bfac {
$x->bnorm()->round(@r); # norm again and round result
}
+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);
+
+ # inf => inf
+ return $x if $x->modify('bfac') || $x->{sign} eq '+inf';
+
+ return $x->bnan()
+ if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
+ ($x->{_es} ne '+')); # digits after dot?
+
+ Carp::croak("bdfac() requires a newer version of the $MBI library.")
+ unless $MBI->can('_dfac');
+
+ if (! $MBI->_is_zero($x->{_e})) {
+ $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
+ $x->{_e} = $MBI->_zero(); # normalize
+ $x->{_es} = '+';
+ }
+ $x->{_m} = $MBI->_dfac($x->{_m}); # calculate factorial
+ $x->bnorm()->round(@r); # norm again and round result
+}
+
sub blsft {
# shift left by $y (multiply by $b ** $y)
@@ -3999,8 +4039,63 @@ sub bestr {
return $mant . 'e' . $esgn . $eabs;
}
+sub to_hex {
+ # return number as hexadecimal string (only for integers defined)
+
+ my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+
+ 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?
+
+ my $z = $MBI->_copy($x->{_m});
+ if (! $MBI->_is_zero($x->{_e})) { # > 0
+ $z = $MBI->_lsft($z, $x->{_e}, 10);
+ }
+ my $str = $MBI->_to_hex($z);
+ return $x->{sign} eq '-' ? "-$str" : $str;
+}
+
+sub to_oct {
+ # return number as octal digit string (only for integers defined)
+
+ my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+
+ 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?
+
+ my $z = $MBI->_copy($x->{_m});
+ if (! $MBI->_is_zero($x->{_e})) { # > 0
+ $z = $MBI->_lsft($z, $x->{_e}, 10);
+ }
+ my $str = $MBI->_to_oct($z);
+ return $x->{sign} eq '-' ? "-$str" : $str;
+}
+
+sub to_bin {
+ # return number as binary digit string (only for integers defined)
+
+ my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
+
+ 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?
+
+ my $z = $MBI->_copy($x->{_m});
+ if (! $MBI->_is_zero($x->{_e})) { # > 0
+ $z = $MBI->_lsft($z, $x->{_e}, 10);
+ }
+ my $str = $MBI->_to_bin($z);
+ return $x->{sign} eq '-' ? "-$str" : $str;
+}
+
sub as_hex {
# return number as hexadecimal string (only for integers defined)
+
my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
@@ -4012,16 +4107,17 @@ sub as_hex {
if (! $MBI->_is_zero($x->{_e})) { # > 0
$z = $MBI->_lsft($z, $x->{_e}, 10);
}
- $z = Math::BigInt->new($x->{sign} . $MBI->_num($z));
- $z->as_hex();
+ my $str = $MBI->_as_hex($z);
+ return $x->{sign} eq '-' ? "-$str" : $str;
}
sub as_oct {
# return number as octal digit string (only for integers defined)
+
my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- return '0' if $x->is_zero();
+ return '00' if $x->is_zero();
return $nan if $x->{_es} ne '+'; # how to do 1e-1 in octal?
@@ -4029,12 +4125,13 @@ sub as_oct {
if (! $MBI->_is_zero($x->{_e})) { # > 0
$z = $MBI->_lsft($z, $x->{_e}, 10);
}
- $z = Math::BigInt->new($x->{sign} . $MBI->_num($z));
- $z->as_oct();
+ my $str = $MBI->_as_oct($z);
+ return $x->{sign} eq '-' ? "-$str" : $str;
}
sub as_bin {
# return number as binary digit string (only for integers defined)
+
my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
@@ -4046,8 +4143,8 @@ sub as_bin {
if (! $MBI->_is_zero($x->{_e})) { # > 0
$z = $MBI->_lsft($z, $x->{_e}, 10);
}
- $z = Math::BigInt->new($x->{sign} . $MBI->_num($z));
- $z->as_bin();
+ my $str = $MBI->_as_bin($z);
+ return $x->{sign} eq '-' ? "-$str" : $str;
}
sub numify {
diff --git a/Master/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm b/Master/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm
index 13ec47f274e..04dec98bc5e 100644
--- a/Master/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm
@@ -2,7 +2,7 @@
package Math::BigFloat::Trace;
-require 5.006;
+require 5.010;
use strict;
use warnings;
@@ -13,7 +13,7 @@ our ($accuracy, $precision, $round_mode, $div_scale);
our @ISA = qw(Exporter Math::BigFloat);
-our $VERSION = '0.47';
+our $VERSION = '0.49';
use overload; # inherit overload from Math::BigFloat
diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt.pm b/Master/tlpkg/tlperl/lib/Math/BigInt.pm
index ed6e79fa1c7..9fd9bd02ba3 100644
--- a/Master/tlpkg/tlperl/lib/Math/BigInt.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigInt.pm
@@ -20,7 +20,7 @@ use warnings;
use Carp ();
-our $VERSION = '1.999806';
+our $VERSION = '1.999811';
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(objectify bgcd blcm);
@@ -731,12 +731,14 @@ sub from_hex {
if ($str =~ s/
^
+ \s*
( [+-]? )
(0?x)?
(
[0-9a-fA-F]*
( _ [0-9a-fA-F]+ )*
)
+ \s*
$
//x)
{
@@ -785,11 +787,13 @@ sub from_oct {
if ($str =~ s/
^
+ \s*
( [+-]? )
(
[0-7]*
( _ [0-7]+ )*
)
+ \s*
$
//x)
{
@@ -838,12 +842,14 @@ sub from_bin {
if ($str =~ s/
^
+ \s*
( [+-]? )
(0?b)?
(
[01]*
( _ [01]+ )*
)
+ \s*
$
//x)
{
@@ -884,6 +890,9 @@ sub from_bytes {
return if $selfref && $self->modify('from_bytes');
+ Carp::croak("from_bytes() requires a newer version of the $CALC library.")
+ unless $CALC->can('_from_bytes');
+
my $str = shift;
# If called as a class method, initialize a new object.
@@ -2376,14 +2385,19 @@ sub blog {
# value is used as the base, otherwise the base is assumed to be Euler's
# constant.
+ 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.
- # set up parameters
- my ($class, $x, $base, @r) = (undef, @_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $base, @r) = objectify(2, @_);
+ if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
+ # 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)
+ ($class, $x, $base, @r) =
+ defined $_[1] ? objectify(2, @_) : objectify(1, @_);
}
return $x if $x->modify('blog');
@@ -2708,6 +2722,132 @@ sub bfac {
$x->round(@r);
}
+sub bdfac {
+ # compute double factorial, modify $x in place
+ my ($class, $x, @r) = ref($_[0]) ? (undef, @_) : 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
+
+ Carp::croak("bdfac() requires a newer version of the $CALC library.")
+ unless $CALC->can('_dfac');
+
+ $x->{value} = $CALC->_dfac($x->{value});
+ $x->round(@r);
+}
+
+sub bfib {
+ # compute Fibonacci number(s)
+ my ($class, $x, @r) = objectify(1, @_);
+
+ Carp::croak("bfib() requires a newer version of the $CALC library.")
+ unless $CALC->can('_fib');
+
+ return $x if $x->modify('bfib');
+
+ # List context.
+
+ if (wantarray) {
+ return () if $x -> is_nan();
+ Carp::croak("bfib() can't return an infinitely long list of numbers")
+ if $x -> is_inf();
+
+ # Use the backend library to compute the first $x Fibonacci numbers.
+
+ my @values = $CALC->_fib($x->{value});
+
+ # Make objects out of them. The last element in the array is the
+ # invocand.
+
+ for (my $i = 0 ; $i < $#values ; ++ $i) {
+ my $fib = $class -> bzero();
+ $fib -> {value} = $values[$i];
+ $values[$i] = $fib;
+ }
+
+ $x -> {value} = $values[-1];
+ $values[-1] = $x;
+
+ # If negative, insert sign as appropriate.
+
+ if ($x -> is_neg()) {
+ for (my $i = 2 ; $i <= $#values ; $i += 2) {
+ $values[$i]{sign} = '-';
+ }
+ }
+
+ @values = map { $_ -> round(@r) } @values;
+ return @values;
+ }
+
+ # Scalar context.
+
+ else {
+ return $x if $x->modify('bdfac') || $x -> is_inf('+');
+ return $x->bnan() if $x -> is_nan() || $x -> is_inf('-');
+
+ $x->{sign} = $x -> is_neg() && $x -> is_even() ? '-' : '+';
+ $x->{value} = $CALC->_fib($x->{value});
+ return $x->round(@r);
+ }
+}
+
+sub blucas {
+ # compute Lucas number(s)
+ my ($class, $x, @r) = objectify(1, @_);
+
+ Carp::croak("blucas() requires a newer version of the $CALC library.")
+ unless $CALC->can('_lucas');
+
+ return $x if $x->modify('blucas');
+
+ # List context.
+
+ if (wantarray) {
+ return () if $x -> is_nan();
+ Carp::croak("blucas() can't return an infinitely long list of numbers")
+ if $x -> is_inf();
+
+ # Use the backend library to compute the first $x Lucas numbers.
+
+ my @values = $CALC->_lucas($x->{value});
+
+ # Make objects out of them. The last element in the array is the
+ # invocand.
+
+ for (my $i = 0 ; $i < $#values ; ++ $i) {
+ my $lucas = $class -> bzero();
+ $lucas -> {value} = $values[$i];
+ $values[$i] = $lucas;
+ }
+
+ $x -> {value} = $values[-1];
+ $values[-1] = $x;
+
+ # If negative, insert sign as appropriate.
+
+ if ($x -> is_neg()) {
+ for (my $i = 2 ; $i <= $#values ; $i += 2) {
+ $values[$i]{sign} = '-';
+ }
+ }
+
+ @values = map { $_ -> round(@r) } @values;
+ return @values;
+ }
+
+ # Scalar context.
+
+ else {
+ return $x if $x -> is_inf('+');
+ return $x->bnan() if $x -> is_nan() || $x -> is_inf('-');
+
+ $x->{sign} = $x -> is_neg() && $x -> is_even() ? '-' : '+';
+ $x->{value} = $CALC->_lucas($x->{value});
+ return $x->round(@r);
+ }
+}
+
sub blsft {
# (BINT or num_str, BINT or num_str) return BINT
# compute x << y, base n, y >= 0
@@ -3485,51 +3625,88 @@ sub bdstr {
return $x->{sign} eq '-' ? "-$str" : $str;
}
-sub as_hex {
+sub to_hex {
# return as hex string, with prefixed 0x
my $x = shift;
$x = $class->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $s = '';
- $s = $x->{sign} if $x->{sign} eq '-';
- $s . $CALC->_as_hex($x->{value});
+ my $hex = $CALC->_to_hex($x->{value});
+ return $x->{sign} eq '-' ? "-$hex" : $hex;
}
-sub as_oct {
+sub to_oct {
# return as octal string, with prefixed 0
my $x = shift;
$x = $class->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $oct = $CALC->_as_oct($x->{value});
+ my $oct = $CALC->_to_oct($x->{value});
return $x->{sign} eq '-' ? "-$oct" : $oct;
}
-sub as_bin {
+sub to_bin {
# return as binary string, with prefixed 0b
my $x = shift;
$x = $class->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $s = '';
- $s = $x->{sign} if $x->{sign} eq '-';
- return $s . $CALC->_as_bin($x->{value});
+ my $bin = $CALC->_to_bin($x->{value});
+ return $x->{sign} eq '-' ? "-$bin" : $bin;
}
-sub as_bytes {
+sub to_bytes {
# return a byte string
my $x = shift;
$x = $class->new($x) if !ref($x);
- Carp::croak("as_bytes() requires a finite, non-negative integer")
+ Carp::croak("to_bytes() requires a finite, non-negative integer")
if $x -> is_neg() || ! $x -> is_int();
- return $CALC->_as_bytes($x->{value});
+
+ Carp::croak("to_bytes() requires a newer version of the $CALC library.")
+ unless $CALC->can('_to_bytes');
+
+ return $CALC->_to_bytes($x->{value});
+}
+
+sub as_hex {
+ # return as hex string, with prefixed 0x
+ my $x = shift;
+ $x = $class->new($x) if !ref($x);
+
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+
+ my $hex = $CALC->_as_hex($x->{value});
+ return $x->{sign} eq '-' ? "-$hex" : $hex;
+}
+
+sub as_oct {
+ # return as octal string, with prefixed 0
+ my $x = shift;
+ $x = $class->new($x) if !ref($x);
+
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+
+ my $oct = $CALC->_as_oct($x->{value});
+ return $x->{sign} eq '-' ? "-$oct" : $oct;
}
+sub as_bin {
+ # return as binary string, with prefixed 0b
+ my $x = shift;
+ $x = $class->new($x) if !ref($x);
+
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+
+ my $bin = $CALC->_as_bin($x->{value});
+ return $x->{sign} eq '-' ? "-$bin" : $bin;
+}
+
+*as_bytes = \&to_bytes;
+
###############################################################################
# Other conversion methods
###############################################################################
@@ -3578,7 +3755,8 @@ sub objectify {
# Class->badd(Class->(1), 2); => classname x (scalar), ref x, scalar y
# Math::BigInt::badd(1, 2); => scalar x, scalar y
- # A shortcut for the common case $x->unary_op():
+ # A shortcut for the common case $x->unary_op(), in which case the argument
+ # list is (0, $x) or (1, $x).
return (ref($_[1]), $_[1]) if @_ == 2 && ($_[0] || 0) == 1 && ref($_[1]);
@@ -3591,7 +3769,6 @@ sub objectify {
# Get the number of arguments to objectify.
my $count = shift;
- $count ||= @_;
# Initialize the output array.
@@ -3601,17 +3778,18 @@ sub objectify {
# class name. Otherwise, if the first argument looks like a class name,
# then use that as our class name. Otherwise, use the default class name.
- {
- if (ref($a[0])) { # reference?
- unshift @a, ref($a[0]);
- last;
- }
- if ($a[0] =~ /^[A-Z].*::/) { # string with class name?
- last;
- }
- unshift @a, $class; # default class name
+ my $class;
+ if (ref($a[0])) { # reference?
+ $class = ref($a[0]);
+ } elsif ($a[0] =~ /^[A-Z].*::/) { # string with class name?
+ $class = shift @a;
+ } else {
+ $class = __PACKAGE__; # default class name
}
+ $count ||= @a;
+ unshift @a, $class;
+
no strict 'refs';
# What we upgrade to, if anything.
@@ -3629,12 +3807,6 @@ sub objectify {
for my $i (1 .. $count) {
- # Don't do anything with undefs. This special treatment is necessary
- # because blog() might have a second operand which is undef, to signify
- # that the default Euler base should be used.
-
- next unless defined $a[$i];
-
my $ref = ref $a[$i];
# Perl scalars are fed to the appropriate constructor.
@@ -4268,10 +4440,15 @@ Math::BigInt - Arbitrary size integer/float math package
$x->bnstr(); # string in normalized notation
$x->bestr(); # string in engineering notation
$x->bdstr(); # string in decimal 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->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->as_bytes(); # as byte string
# Other conversion methods
@@ -5103,6 +5280,86 @@ Calculates the N'th root of C<$x>.
$x->bfac(); # factorial of $x (1*2*3*4*..*$x)
+Returns the factorial of C<$x>, i.e., the product of all positive integers up
+to and including C<$x>.
+
+=item bdfac()
+
+ $x->bdfac(); # double factorial of $x (1*2*3*4*..*$x)
+
+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.
+
+=item bfib()
+
+ $F = $n->bfib(); # a single Fibonacci number
+ @F = $n->bfib(); # a list of Fibonacci numbers
+
+In scalar context, returns a single Fibonacci number. In list context, returns
+a list of Fibonacci numbers. The invocand is the last element in the output.
+
+The Fibonacci sequence is defined by
+
+ F(0) = 0
+ F(1) = 1
+ F(n) = F(n-1) + F(n-2)
+
+In list context, F(0) and F(n) is the first and last number in the output,
+respectively. For example, if $n is 12, then C<< @F = $n->bfib() >> returns the
+following values, F(0) to F(12):
+
+ 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144
+
+The sequence can also be extended to negative index n using the re-arranged
+recurrence relation
+
+ F(n-2) = F(n) - F(n-1)
+
+giving the bidirectional sequence
+
+ n -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7
+ F(n) 13 -8 5 -3 2 -1 1 0 1 1 2 3 5 8 13
+
+If $n is -12, the following values, F(0) to F(12), are returned:
+
+ 0, 1, -1, 2, -3, 5, -8, 13, -21, 34, -55, 89, -144
+
+=item blucas()
+
+ $F = $n->blucas(); # a single Lucas number
+ @F = $n->blucas(); # a list of Lucas numbers
+
+In scalar context, returns a single Lucas number. In list context, returns a
+list of Lucas numbers. The invocand is the last element in the output.
+
+The Lucas sequence is defined by
+
+ L(0) = 2
+ L(1) = 1
+ L(n) = L(n-1) + L(n-2)
+
+In list context, L(0) and L(n) is the first and last number in the output,
+respectively. For example, if $n is 12, then C<< @L = $n->blucas() >> returns
+the following values, L(0) to L(12):
+
+ 2, 1, 3, 4, 7, 11, 18, 29, 47, 76, 123, 199, 322
+
+The sequence can also be extended to negative index n using the re-arranged
+recurrence relation
+
+ L(n-2) = L(n) - L(n-1)
+
+giving the bidirectional sequence
+
+ n -7 -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6 7
+ L(n) 29 -18 11 -7 4 -3 1 2 1 3 4 7 11 18 29
+
+If $n is -12, the following values, L(0) to L(-12), are returned:
+
+ 2, 1, -3, 4, -7, 11, -18, 29, -47, 76, -123, 199, -322
+
=item brsft()
$x->brsft($n); # right shift $n places in base 2
@@ -5378,34 +5635,53 @@ corresponds to the output from C<dparts()>.
12000 is returned as "12000"
10000 is returned as "10000"
+=item to_hex()
+
+ $x->to_hex();
+
+Returns a hexadecimal string representation of the number.
+
+=item to_bin()
+
+ $x->to_bin();
+
+Returns a binary string representation of the number.
+
+=item to_oct()
+
+ $x->to_oct();
+
+Returns an octal string representation of the number.
+
+=item to_bytes()
+
+ $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.
+
=item as_hex()
$x->as_hex();
-Returns a string representing the number using hexadecimal notation. The output
-is prefixed by "0x".
+As, C<to_hex()>, but with a "0x" prefix.
=item as_bin()
$x->as_bin();
-Returns a string representing the number using binary notation. The output is
-prefixed by "0b".
+As, C<to_bin()>, but with a "0b" prefix.
=item as_oct()
$x->as_oct();
-Returns a string representing the number using octal notation. The output is
-prefixed by "0".
+As, C<to_oct()>, but with a "0" prefix.
=item as_bytes()
- $x = Math::BigInt->new("1667327589");
- $s = $x->as_bytes(); # $s = "cafe"
-
-Returns a byte string representing the number using big endian byte order. The
-invocand must be a non-negative, finite integer.
+This is just an alias for C<to_bytes()>.
=back
diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/Calc.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/Calc.pm
index 5717e764e10..571006963f0 100644
--- a/Master/tlpkg/tlperl/lib/Math/BigInt/Calc.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigInt/Calc.pm
@@ -7,7 +7,7 @@ use warnings;
use Carp;
use Math::BigInt::Lib;
-our $VERSION = '1.999806';
+our $VERSION = '1.999811';
our @ISA = ('Math::BigInt::Lib');
@@ -1889,7 +1889,7 @@ sub _sqrt {
}
sub _root {
- # Take n'th root of $x in place (n >= 2)
+ # Take n'th root of $x in place.
my ($c, $x, $n) = @_;
@@ -1915,8 +1915,8 @@ sub _root {
return $x;
}
- # If $n is a power of two, we take sqrt($x) repeatedly and find the proper
- # result, because, e.g., sqrt(sqrt($x)) == root($x, 4)
+ # If $n is a power of two, take sqrt($x) repeatedly, e.g., root($x, 4) =
+ # sqrt(sqrt($x)), root($x, 8) = sqrt(sqrt(sqrt($x))).
my $b = $c -> _as_bin($n);
if ($b =~ /0b1(0+)$/) {
@@ -2485,13 +2485,8 @@ sub _gcd {
return $x;
}
-##############################################################################
-##############################################################################
-
1;
-__END__
-
=pod
=head1 NAME
diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm
index 572f9de52fd..69c02caffef 100644
--- a/Master/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm
@@ -4,7 +4,7 @@ use 5.006001;
use strict;
use warnings;
-our $VERSION = '1.999806';
+our $VERSION = '1.999811';
package Math::BigInt;
diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm
index 6920f5637af..8d0ba4097af 100644
--- a/Master/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm
@@ -4,11 +4,11 @@ use 5.006;
use strict;
use warnings;
-use Math::BigInt::Calc '1.999801';
+use Math::BigInt::Calc 1.999801;
our @ISA = qw< Math::BigInt::Calc >;
-our $VERSION = '0.5005';
+our $VERSION = '0.5006';
##############################################################################
# global constants, flags and accessory
diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
index dea1b0c0a38..23a44aa9559 100755
--- a/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
@@ -4,7 +4,7 @@ use 5.006001;
use strict;
use warnings;
-our $VERSION = '1.999806';
+our $VERSION = '1.999811';
use Carp;
@@ -237,7 +237,7 @@ use overload
return $class -> _sqrt($class -> _copy($_[0]));
},
- 'int' => sub { $_[0] -> copy() -> bint(); },
+ 'int' => sub { $_[0] },
# overload key: conversion
@@ -389,8 +389,7 @@ sub _digit {
sub _zeros {
my ($class, $x) = @_;
my $str = $class -> _str($x);
- $str =~ /[^0](0*)\z/;
- CORE::length($1);
+ $str =~ /[^0](0*)\z/ ? CORE::length($1) : 0;
}
##############################################################################
@@ -452,12 +451,17 @@ sub _mod {
croak "@{[(caller 0)[3]]} requires non-zero second operand"
if $class -> _is_zero($y);
- my $r = $class -> _copy($x);
- while ($class -> _acmp($r, $y) >= 0) {
- $r = $class -> _sub($r, $y);
+ if ($class -> can('_div')) {
+ $x = $class -> _copy($x);
+ my ($q, $r) = $class -> _div($x, $y);
+ return $r;
+ } else {
+ my $r = $class -> _copy($x);
+ while ($class -> _acmp($r, $y) >= 0) {
+ $r = $class -> _sub($r, $y);
+ }
+ return $r;
}
-
- return $r;
}
##############################################################################
@@ -477,7 +481,6 @@ sub _lsft {
sub _pow {
# power of $x to $y
- # ref to array, ref to array, return ref to array
my ($class, $x, $y) = @_;
if ($class -> _is_zero($y)) {
@@ -511,9 +514,6 @@ sub _pow {
sub _nok {
# Return binomial coefficient (n over k).
- # Given refs to arrays, return ref to array.
- # First input argument is modified.
-
my ($class, $n, $k) = @_;
# If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as
@@ -528,15 +528,19 @@ sub _nok {
# Example:
#
- # / 7 \ 7! 1*2*3*4 * 5*6*7 5 * 6 * 7 6 7
- # | | = --------- = --------------- = --------- = 5 * - * -
- # \ 3 / (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3
+ # / 7 \ 7! 1*2*3*4 * 5*6*7 5 * 6 * 7
+ # | | = --------- = --------------- = --------- = ((5 * 6) / 2 * 7) / 3
+ # \ 3 / (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3
+ #
+ # Equivalently, _nok(11, 5) is computed as
+ #
+ # (((((((7 * 8) / 2) * 9) / 3) * 10) / 4) * 11) / 5
if ($class -> _is_zero($k)) {
return $class -> _one();
}
- # Make a copy of the original n, since we'll be modifying n in-place.
+ # Make a copy of the original n, in case the subclass modifies n in-place.
my $n_orig = $class -> _copy($n);
@@ -546,21 +550,15 @@ sub _nok {
$n = $class -> _inc($n);
my $f = $class -> _copy($n);
- $class -> _inc($f);
+ $f = $class -> _inc($f);
my $d = $class -> _two();
# while f <= n (the original n, that is) ...
while ($class -> _acmp($f, $n_orig) <= 0) {
-
- # n = (n * f / d) == 5 * 6 / 2 (cf. example above)
-
$n = $class -> _mul($n, $f);
$n = $class -> _div($n, $d);
-
- # f = 7, d = 3 (cf. example above)
-
$f = $class -> _inc($f);
$d = $class -> _inc($d);
}
@@ -587,10 +585,29 @@ sub _fac {
return $x;
}
+sub _dfac {
+ # double 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 -> _sub($i, $two);
+ $x = $class -> _mul($x, $i);
+ }
+
+ return $x;
+}
+
sub _log_int {
# calculate integer log of $x to base $base
+ # calculate integer log of $x to base $base
# ref to array, ref to array - return ref to array
-
my ($class, $x, $base) = @_;
# X == 0 => NaN
@@ -664,177 +681,303 @@ sub _log_int {
}
sub _sqrt {
- # square-root of $x in place
- my ($class, $x) = @_;
+ # square-root of $y in place
+ my ($class, $y) = @_;
- return $x if $class -> _is_zero($x);
+ return $y if $class -> _is_zero($y);
- my $x_str = $class -> _str($x);
- my $x_len = length($x_str);
+ my $y_str = $class -> _str($y);
+ my $y_len = length($y_str);
- # Compute the guess $y.
+ # Compute the guess $x.
- my $ym;
- my $ye;
- if ($x_len % 2 == 0) {
- $ym = sqrt("." . $x_str);
- $ye = $x_len / 2;
- $ym = sprintf "%.0f", int($ym * 1e15);
- $ye -= 15;
+ my $xm;
+ my $xe;
+ if ($y_len % 2 == 0) {
+ $xm = sqrt("." . $y_str);
+ $xe = $y_len / 2;
+ $xm = sprintf "%.0f", int($xm * 1e15);
+ $xe -= 15;
} else {
- $ym = sqrt(".0" . $x_str);
- $ye = ($x_len + 1) / 2;
- $ym = sprintf "%.0f", int($ym * 1e16);
- $ye -= 16;
+ $xm = sqrt(".0" . $y_str);
+ $xe = ($y_len + 1) / 2;
+ $xm = sprintf "%.0f", int($xm * 1e16);
+ $xe -= 16;
}
- my $y;
- if ($ye < 0) {
- $y = substr $ym, 0, length($ym) + $ye;
+ my $x;
+ if ($xe < 0) {
+ $x = substr $xm, 0, length($xm) + $xe;
} else {
- $y = $ym . ("0" x $ye);
+ $x = $xm . ("0" x $xe);
}
- $y = $class -> _new($y);
+ $x = $class -> _new($x);
- # Newton's method for computing square root of x. Generally, the algorithm
- # below should undershoot.
+ # Newton's method for computing square root of y
#
- # y(i+1) = y(i) - f(y(i)) / f'(y(i))
- # = y(i) - (y(i)^2 - x) / (2 * y(i))
- # = y(i) + (x - y(i)^2) / (2 * y(i))
+ # 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
- my $two = $class -> _two();
- my $zero = $class -> _zero();
- my $over;
- my $acmp;
+ # Determine if x, our guess, is too small, correct, or too large.
- {
- my $ysq = $class -> _mul($class -> _copy($y), $y); # y(i)^2
- $acmp = $class -> _acmp($x, $ysq); # x <=> y(i)^2
- last if $acmp == 0;
- if ($acmp < 0) { # if we overshot
- $over = 1;
- last;
+ my $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2
+ my $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y
+
+ # Only assign a value to this variable if we will be using it.
+
+ my $two;
+ $two = $class -> _two() if $acmp != 0;
+
+ # If x is too small, do one iteration of Newton's method. Since the
+ # function f(x) = x^2 - y is concave and monotonically increasing, the next
+ # guess for x will either be correct or too large.
+
+ if ($acmp < 0) {
+
+ # x(i+1) = x(i) + (y - x(i)^2) / (2 * x(i))
+
+ my $numer = $class -> _sub($class -> _copy($y), $xsq); # y - x(i)^2
+ my $denom = $class -> _mul($class -> _copy($two), $x); # 2 * x(i)
+ my $delta = $class -> _div($numer, $denom);
+
+ unless ($class -> _is_zero($delta)) {
+ $x = $class -> _add($x, $delta);
+ $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2
+ $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y
}
+ }
- my $num = $class -> _sub($class -> _copy($x), $ysq); # x - y(i)^2
- my $den = $class -> _mul($class -> _copy($two), $y); # 2 * y(i)
+ # If our guess for x is too large, apply Newton's method repeatedly until
+ # we either have got the correct value, or the delta is zero.
- my $delta = $class -> _div($num, $den);
- last if $class -> _acmp($delta, $zero) == 0;
- $y = $class -> _add($y, $delta);
- redo;
+ while ($acmp > 0) {
+
+ # x(i+1) = x(i) - (x(i)^2 - y) / (2 * x(i))
+
+ my $numer = $class -> _sub($xsq, $y); # x(i)^2 - y
+ my $denom = $class -> _mul($class -> _copy($two), $x); # 2 * x(i)
+ my $delta = $class -> _div($numer, $denom);
+ last if $class -> _is_zero($delta);
+
+ $x = $class -> _sub($x, $delta);
+ $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2
+ $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y
}
- # If we did overshoot, adjust now.
+ # When the delta is zero, our value for x might still be too large. We
+ # require that the outout is either exact or too small (i.e., rounded down
+ # to the nearest integer), so do a final check.
- while ($acmp < 0) {
- $class -> _dec($y);
- my $ysq = $class -> _mul($class -> _copy($y), $y); # y(i)^2
- $acmp = $class -> _acmp($x, $ysq); # x <=> y(i)^2
+ while ($acmp > 0) {
+ $x = $class -> _dec($x);
+ $xsq = $class -> _mul($class -> _copy($x), $x); # x(i)^2
+ $acmp = $class -> _acmp($xsq, $y); # x(i)^2 <=> y
}
- return $y;
+ return $x;
}
sub _root {
- my ($class, $x, $n) = @_;
+ my ($class, $y, $n) = @_;
- return undef if $class -> _is_zero($n);
-
- return $x if $class -> _is_zero($x) || $class -> _is_one($x) ||
+ return $y if $class -> _is_zero($y) || $class -> _is_one($y) ||
$class -> _is_one($n);
- my $x_str = $class -> _str($x);
- my $x_len = length($x_str);
-
- return $class -> _one() if $class -> _acmp($x, $n) <= 0;
+ # If y <= n, the result is always (truncated to) 1.
- # Compute the guess $y.
+ return $class -> _one() if $class -> _acmp($y, $n) <= 0;
- my $n_num = $class -> _num($n);
- my $p = int(($x_len - 1) / $n_num);
- my $q = $x_len - $p * $n_num;
+ # Compute the initial guess x of y^(1/n). When n is large, Newton's method
+ # converges slowly if the "guess" (initial value) is poor, so we need a
+ # good guess. It the guess is too small, the next guess will be too large,
+ # and from then on all guesses are too large.
my $DEBUG = 0;
+ # Split y into mantissa and exponent in base 10, so that
+ #
+ # y = xm * 10^xe, where 0 < xm < 1 and xe is an integer
+
+ my $y_str = $class -> _str($y);
+ my $ym = "." . $y_str;
+ my $ye = length($y_str);
+
+ # From this compute the approximate base 10 logarithm of y
+ #
+ # log_10(y) = log_10(ym) + log_10(ye^10)
+ # = log(ym)/log(10) + ye
+
+ my $log10y = log($ym) / log(10) + $ye;
+
+ # And from this compute the approximate base 10 logarithm of x, where
+ # x = y^(1/n)
+ #
+ # log_10(x) = log_10(y)/n
+
+ my $log10x = $log10y / $class -> _num($n);
+
+ # From this compute xm and xe, the mantissa and exponent (in base 10) of x,
+ # where 1 < xm <= 10 and xe is an integer.
+
+ my $xe = int $log10x;
+ my $xm = 10 ** ($log10x - $xe);
+
+ # Scale the mantissa and exponent to increase the integer part of ym, which
+ # gives us better accuracy.
+
if ($DEBUG) {
print "\n";
- print substr($x_str, 0, $p), " ", "0" x $q, "\n";
+ print "y_str = $y_str\n";
+ print "ym = $ym\n";
+ print "ye = $ye\n";
+ print "log10y = $log10y\n";
+ print "log10x = $log10x\n";
+ print "xm = $xm\n";
+ print "xe = $xe\n";
+ }
+
+ my $d = $xe < 15 ? $xe : 15;
+ $xm *= 10 ** $d;
+ $xe -= $d;
+
+ if ($DEBUG) {
print "\n";
+ print "xm = $xm\n";
+ print "xe = $xe\n";
}
- my $ymant = substr($x_str, 0, $q) ** (1 / $n_num);
- my $yexpo = $p;
+ # If the mantissa is not an integer, round up to nearest integer, and then
+ # convert the number to a string. It is important to always round up due to
+ # how Newton's method behaves in this case. If the initial guess is too
+ # small, the next guess will be too large, after which every succeeding
+ # guess converges the correct value from above. Now, if the initial guess
+ # is too small and n is large, the next guess will be much too large and
+ # require a large number of iterations to get close to the solution.
+ # Because of this, we are likely to find the solution faster if we make
+ # sure the initial guess is not too small.
+
+ my $xm_int = int($xm);
+ my $x_str = sprintf '%.0f', $xm > $xm_int ? $xm_int + 1 : $xm_int;
+ $x_str .= "0" x $xe;
- my $y = (1 + int $ymant) . ("0" x $p);
- $y = $class -> _new($y);
+ my $x = $class -> _new($x_str);
if ($DEBUG) {
+ print "xm = $xm\n";
+ print "xe = $xe\n";
print "\n";
- print "p = $p\n";
- print "q = $q\n";
- print "\n";
- print "ym = $ymant\n";
- print "ye = $yexpo\n";
- print "\n";
- print "y = $y (initial guess)\n";
+ print "x_str = $x_str (initial guess)\n";
print "\n";
}
- # Newton's method for computing n'th root of x. Generally, the algorithm
- # below should undershoot.
+ # Use Newton's method for computing n'th root of y.
#
- # y(i+1) = y(i) - f(y(i)) / f'(y(i))
- # = y(i) - (y(i)^n - x) / (n * y(i)^(n-1))
- # = y(i) + (x - y(i)^n) / (n * y(i)^(n-1))
+ # x(i+1) = x(i) - f(x(i)) / f'(x(i))
+ # = x(i) - (x(i)^n - y) / (n * x(i)^(n-1)) # use if x(i)^n > y
+ # = x(i) + (y - x(i)^n) / (n * x(i)^(n-1)) # use if x(i)^n < y
- my $nm1 = $class -> _dec($class -> _copy($n)); # n - 1
- my $zero = $class -> _zero();
- my $over;
- my $acmp;
+ # Determine if x, our guess, is too small, correct, or too large. Rather
+ # than computing x(i)^n and x(i)^(n-1) directly, compute x(i)^(n-1) and
+ # then the same value multiplied by x.
- {
- my $ypowm1 = $class -> _pow($class -> _copy($y), $nm1); # y(i)^(n-1)
- my $ypow = $class -> _mul($class -> _copy($ypowm1), $y); # y(i)^n
- $acmp = $class -> _acmp($x, $ypow); # x <=> y(i)^n
- last if $acmp == 0;
-
- my $num = $acmp > 0
- ? $class -> _sub($class -> _copy($x), $ypow) # x - y(i)^n
- : $class -> _sub($ypow, $class -> _copy($x)); # y(i)^n - x
- my $den = $class -> _mul($class -> _copy($n), $ypowm1); # n * y(i)^(n-1)
- my $delta = $class -> _div($num, $den);
- last if $class -> _acmp($delta, $zero) == 0;
-
- $y = $acmp > 0
- ? $class -> _add($y, $delta)
- : $class -> _sub($y, $delta);
+ my $nm1 = $class -> _dec($class -> _copy($n)); # n-1
+ my $xpownm1 = $class -> _pow($class -> _copy($x), $nm1); # x(i)^(n-1)
+ my $xpown = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n
+ my $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y
+
+ if ($DEBUG) {
+ print "\n";
+ print "x = ", $class -> _str($x), "\n";
+ print "x^n = ", $class -> _str($xpown), "\n";
+ print "y = ", $class -> _str($y), "\n";
+ print "acmp = $acmp\n";
+ }
+
+ # If x is too small, do one iteration of Newton's method. Since the
+ # function f(x) = x^n - y is concave and monotonically increasing, the next
+ # guess for x will either be correct or too large.
+
+ if ($acmp < 0) {
+
+ # x(i+1) = x(i) + (y - x(i)^n) / (n * x(i)^(n-1))
+
+ my $numer = $class -> _sub($class -> _copy($y), $xpown); # y - x(i)^n
+ my $denom = $class -> _mul($class -> _copy($n), $xpownm1); # n * x(i)^(n-1)
+ my $delta = $class -> _div($numer, $denom);
if ($DEBUG) {
- print "y = $y\n";
+ print "\n";
+ print "numer = ", $class -> _str($numer), "\n";
+ print "denom = ", $class -> _str($denom), "\n";
+ print "delta = ", $class -> _str($delta), "\n";
}
- redo;
+ unless ($class -> _is_zero($delta)) {
+ $x = $class -> _add($x, $delta);
+ $xpownm1 = $class -> _pow($class -> _copy($x), $nm1); # x(i)^(n-1)
+ $xpown = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n
+ $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y
+
+ if ($DEBUG) {
+ print "\n";
+ print "x = ", $class -> _str($x), "\n";
+ print "x^n = ", $class -> _str($xpown), "\n";
+ print "y = ", $class -> _str($y), "\n";
+ print "acmp = $acmp\n";
+ }
+ }
}
- # Never overestimate. The output should always be exact or truncated.
+ # If our guess for x is too large, apply Newton's method repeatedly until
+ # we either have got the correct value, or the delta is zero.
+
+ while ($acmp > 0) {
+
+ # x(i+1) = x(i) - (x(i)^n - y) / (n * x(i)^(n-1))
+
+ my $numer = $class -> _sub($class -> _copy($xpown), $y); # x(i)^n - y
+ my $denom = $class -> _mul($class -> _copy($n), $xpownm1); # n * x(i)^(n-1)
+
+ if ($DEBUG) {
+ print "numer = ", $class -> _str($numer), "\n";
+ print "denom = ", $class -> _str($denom), "\n";
+ }
+
+ my $delta = $class -> _div($numer, $denom);
+
+ if ($DEBUG) {
+ print "delta = ", $class -> _str($delta), "\n";
+ }
+
+ last if $class -> _is_zero($delta);
+
+ $x = $class -> _sub($x, $delta);
+ $xpownm1 = $class -> _pow($class -> _copy($x), $nm1); # x(i)^(n-1)
+ $xpown = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n
+ $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y
- while ($acmp < 0) {
- $class -> _dec($y);
if ($DEBUG) {
- print "y = $y\n";
+ print "\n";
+ print "x = ", $class -> _str($x), "\n";
+ print "x^n = ", $class -> _str($xpown), "\n";
+ print "y = ", $class -> _str($y), "\n";
+ print "acmp = $acmp\n";
}
- my $ypow = $class -> _pow($class -> _copy($y), $n); # y(i)^n
- $acmp = $class -> _acmp($x, $ypow); # x <=> y(i)^2
}
- if ($DEBUG) {
- print "\n";
+ # When the delta is zero, our value for x might still be too large. We
+ # require that the outout is either exact or too small (i.e., rounded down
+ # to the nearest integer), so do a final check.
+
+ while ($acmp > 0) {
+ $x = $class -> _dec($x);
+ $xpown = $class -> _pow($class -> _copy($x), $n); # x(i)^n
+ $acmp = $class -> _acmp($xpown, $y); # x(i)^n <=> y
}
- return $y;
+ return $x;
}
##############################################################################
@@ -933,114 +1076,182 @@ sub _or {
return $z;
}
-sub _as_hex {
- # convert a decimal number to hex
+sub _to_bin {
+ # convert the number to a string of binary digits without prefix
my ($class, $x) = @_;
- my $str = '';
- my $tmp = $class -> _copy($x);
- my $zero = $class -> _zero();
- my $base = $class -> _new("16");
+ my $str = '';
+ my $tmp = $class -> _copy($x);
+ my $chunk = $class -> _new("16777216"); # 2^24 = 24 binary digits
my $rem;
- while ($tmp > $zero) {
- ($tmp, $rem) = $class -> _div($tmp, $base);
- $str = sprintf("%0x", $rem) . $str;
+ until ($class -> _acmp($tmp, $chunk) < 0) {
+ ($tmp, $rem) = $class -> _div($tmp, $chunk);
+ $str = sprintf("%024b", $class -> _num($rem)) . $str;
+ }
+ unless ($class -> _is_zero($tmp)) {
+ $str = sprintf("%b", $class -> _num($tmp)) . $str;
}
- $str = '0' if length($str) == 0;
- return '0x' . $str;
+ return length($str) ? $str : '0';
}
-sub _as_bin {
- # convert a decimal number to bin
+sub _to_oct {
+ # convert the number to a string of octal digits without prefix
my ($class, $x) = @_;
- my $str = '';
- my $tmp = $class -> _copy($x);
- my $zero = $class -> _zero();
- my $base = $class -> _new("2");
+ my $str = '';
+ my $tmp = $class -> _copy($x);
+ my $chunk = $class -> _new("16777216"); # 2^24 = 8 octal digits
my $rem;
- while ($tmp > $zero) {
- ($tmp, $rem) = $class -> _div($tmp, $base);
- $str = ($class -> _is_zero($rem) ? '0' : '1') . $str;
+ until ($class -> _acmp($tmp, $chunk) < 0) {
+ ($tmp, $rem) = $class -> _div($tmp, $chunk);
+ $str = sprintf("%08o", $class -> _num($rem)) . $str;
+ }
+ unless ($class -> _is_zero($tmp)) {
+ $str = sprintf("%o", $class -> _num($tmp)) . $str;
}
- $str = '0' if length($str) == 0;
- return '0b' . $str;
+ return length($str) ? $str : '0';
}
-sub _as_oct {
- # convert a decimal number to octal
+sub _to_hex {
+ # convert the number to a string of hexadecimal digits without prefix
my ($class, $x) = @_;
- my $str = '';
- my $tmp = $class -> _copy($x);
- my $zero = $class -> _zero();
- my $base = $class -> _new("8");
+ my $str = '';
+ my $tmp = $class -> _copy($x);
+ my $chunk = $class -> _new("16777216"); # 2^24 = 6 hexadecimal digits
my $rem;
- while ($tmp > $zero) {
- ($tmp, $rem) = $class -> _div($tmp, $base);
- $str = sprintf("%0o", $rem) . $str;
+ until ($class -> _acmp($tmp, $chunk) < 0) {
+ ($tmp, $rem) = $class -> _div($tmp, $chunk);
+ $str = sprintf("%06x", $class -> _num($rem)) . $str;
}
- $str = '0' if length($str) == 0;
- return '0' . $str; # yes, 0 becomes "00".
+ unless ($class -> _is_zero($tmp)) {
+ $str = sprintf("%x", $class -> _num($tmp)) . $str;
+ }
+ return length($str) ? $str : '0';
}
-sub _as_bytes {
- # convert a decimal number to a byte string
+sub _as_bin {
+ # convert the number to a string of binary digits with prefix
my ($class, $x) = @_;
- my $str = '';
- my $tmp = $class -> _copy($x);
- my $base = $class -> _new("256");
+ return '0b' . $class -> _to_bin($x);
+}
+
+sub _as_oct {
+ # convert the number to a string of octal digits with prefix
+ my ($class, $x) = @_;
+ return '0' . $class -> _to_oct($x); # yes, 0 becomes "00"
+}
+
+sub _as_hex {
+ # convert the number to a string of hexadecimal digits with prefix
+ my ($class, $x) = @_;
+ return '0x' . $class -> _to_hex($x);
+}
+
+sub _to_bytes {
+ # convert the number to a string of bytes
+ my ($class, $x) = @_;
+ my $str = '';
+ my $tmp = $class -> _copy($x);
+ my $chunk = $class -> _new("65536");
my $rem;
until ($class -> _is_zero($tmp)) {
- ($tmp, $rem) = $class -> _div($tmp, $base);
- my $byte = pack 'C', $rem;
- $str = $byte . $str;
+ ($tmp, $rem) = $class -> _div($tmp, $chunk);
+ $str = pack('n', $class -> _num($rem)) . $str;
}
- return "\x00" unless length($str);
- return $str;
+ $str =~ s/^\0+//;
+ return length($str) ? $str : "\x00";
}
-sub _from_oct {
- # convert a octal string to a decimal number
- my ($class, $str) = @_;
- $str =~ s/^0+//;
- my $x = $class -> _zero();
- my $base = $class -> _new("8");
- my $n = length($str);
- for (my $i = 0 ; $i < $n ; ++$i) {
- $x = $class -> _mul($x, $base);
- $x = $class -> _add($x, $class -> _new(substr($str, $i, 1)));
+*_as_bytes = \&_to_bytes;
+
+sub _from_hex {
+ # Convert a string of hexadecimal digits to a number.
+
+ my ($class, $hex) = @_;
+ $hex =~ s/^0[xX]//;
+
+ # Find the largest number of hexadecimal digits that we can safely use with
+ # 32 bit integers. There are 4 bits pr hexadecimal digit, and we use only
+ # 31 bits to play safe. This gives us int(31 / 4) = 7.
+
+ my $len = length $hex;
+ my $rem = 1 + ($len - 1) % 7;
+
+ # Do the first chunk.
+
+ my $ret = $class -> _new(int hex substr $hex, 0, $rem);
+ return $ret if $rem == $len;
+
+ # Do the remaining chunks, if any.
+
+ my $shift = $class -> _new(1 << (4 * 7));
+ for (my $offset = $rem ; $offset < $len ; $offset += 7) {
+ my $part = int hex substr $hex, $offset, 7;
+ $ret = $class -> _mul($ret, $shift);
+ $ret = $class -> _add($ret, $class -> _new($part));
}
- return $x;
+
+ return $ret;
}
-sub _from_hex {
- # convert a hexadecimal string to a decimal number
- my ($class, $str) = @_;
- $str =~ s/^0[Xx]//;
- my $x = $class -> _zero();
- my $base = $class -> _new("16");
- my $n = length($str);
- for (my $i = 0 ; $i < $n ; ++$i) {
- $x = $class -> _mul($x, $base);
- $x = $class -> _add($x, $class -> _new(hex substr($str, $i, 1)));
+sub _from_oct {
+ # Convert a string of octal digits to a number.
+
+ my ($class, $oct) = @_;
+
+ # Find the largest number of octal digits that we can safely use with 32
+ # bit integers. There are 3 bits pr octal digit, and we use only 31 bits to
+ # play safe. This gives us int(31 / 3) = 10.
+
+ my $len = length $oct;
+ my $rem = 1 + ($len - 1) % 10;
+
+ # Do the first chunk.
+
+ my $ret = $class -> _new(int oct substr $oct, 0, $rem);
+ return $ret if $rem == $len;
+
+ # Do the remaining chunks, if any.
+
+ my $shift = $class -> _new(1 << (3 * 10));
+ for (my $offset = $rem ; $offset < $len ; $offset += 10) {
+ my $part = int oct substr $oct, $offset, 10;
+ $ret = $class -> _mul($ret, $shift);
+ $ret = $class -> _add($ret, $class -> _new($part));
}
- return $x;
+
+ return $ret;
}
sub _from_bin {
- # convert a binary string to a decimal number
- my ($class, $str) = @_;
- $str =~ s/^0[Bb]//;
- my $x = $class -> _zero();
- my $base = $class -> _new("2");
- my $n = length($str);
- for (my $i = 0 ; $i < $n ; ++$i) {
- $x = $class -> _mul($x, $base);
- $x = $class -> _add($x, $class -> _new(substr($str, $i, 1)));
+ # Convert a string of binary digits to a number.
+
+ my ($class, $bin) = @_;
+ $bin =~ s/^0[bB]//;
+
+ # The largest number of binary digits that we can safely use with 32 bit
+ # integers is 31. We use only 31 bits to play safe.
+
+ my $len = length $bin;
+ my $rem = 1 + ($len - 1) % 31;
+
+ # Do the first chunk.
+
+ my $ret = $class -> _new(int oct '0b' . substr $bin, 0, $rem);
+ return $ret if $rem == $len;
+
+ # Do the remaining chunks, if any.
+
+ my $shift = $class -> _new(1 << 31);
+ for (my $offset = $rem ; $offset < $len ; $offset += 31) {
+ my $part = int oct '0b' . substr $bin, $offset, 31;
+ $ret = $class -> _mul($ret, $shift);
+ $ret = $class -> _add($ret, $class -> _new($part));
}
- return $x;
+
+ return $ret;
}
sub _from_bytes {
- # convert a byte string to a decimal number
+ # convert string of bytes to a number
my ($class, $str) = @_;
my $x = $class -> _zero();
my $base = $class -> _new("256");
@@ -1091,7 +1302,7 @@ sub _modinv {
redo;
}
- # if the gcd is not 1, then return NaN
+ # if the gcd is not 1, there exists no modular multiplicative inverse
return (undef, undef) unless $class -> _is_one($a);
($v, $sign == 1 ? '+' : '-');
@@ -1194,6 +1405,100 @@ sub _lcm {
return $x;
}
+sub _lucas {
+ my ($class, $n) = @_;
+
+ $n = $class -> _num($n) if ref $n;
+
+ # In list context, use lucas(n) = lucas(n-1) + lucas(n-2)
+
+ if (wantarray) {
+ my @y;
+
+ push @y, $class -> _two();
+ return @y if $n == 0;
+
+ push @y, $class -> _one();
+ return @y if $n == 1;
+
+ for (my $i = 2 ; $i <= $n ; ++ $i) {
+ $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]);
+ }
+
+ 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
+ # context, so we must add scalar() to get the desired behaviour.
+
+ return $class -> _two() if $n == 0;
+
+ return $class -> _add(scalar $class -> _fib($n - 1),
+ scalar $class -> _fib($n + 1));
+}
+
+sub _fib {
+ my ($class, $n) = @_;
+
+ $n = $class -> _num($n) if ref $n;
+
+ # In list context, use fib(n) = fib(n-1) + fib(n-2)
+
+ if (wantarray) {
+ my @y;
+
+ push @y, $class -> _zero();
+ return @y if $n == 0;
+
+ push @y, $class -> _one();
+ return @y if $n == 1;
+
+ for (my $i = 2 ; $i <= $n ; ++ $i) {
+ $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]);
+ }
+
+ return @y;
+ }
+
+ # In scalar context use a fast algorithm that is much faster than the
+ # recursive algorith used in list context.
+
+ my $cache = {};
+ my $two = $class -> _two();
+ my $fib;
+
+ $fib = sub {
+ my $n = shift;
+ return $class -> _zero() if $n <= 0;
+ return $class -> _one() if $n <= 2;
+ return $cache -> {$n} if exists $cache -> {$n};
+
+ my $k = int($n / 2);
+ my $a = $fib -> ($k + 1);
+ my $b = $fib -> ($k);
+ my $y;
+
+ if ($n % 2 == 1) {
+ # a*a + b*b
+ $y = $class -> _add($class -> _mul($class -> _copy($a), $a),
+ $class -> _mul($class -> _copy($b), $b));
+ } else {
+ # (2*a - b)*b
+ $y = $class -> _mul($class -> _sub($class -> _mul(
+ $class -> _copy($two), $a), $b), $b);
+ }
+
+ $cache -> {$n} = $y;
+ return $y;
+ };
+
+ return $fib -> ($n);
+}
+
##############################################################################
##############################################################################
@@ -1209,13 +1514,31 @@ Math::BigInt::Lib - virtual parent class for Math::BigInt libraries
=head1 SYNOPSIS
+ # In the backend library for Math::BigInt et al.
+
+ package Math::BigInt::MyBackend;
+
+ use Math::BigInt::lib;
+ our @ISA = qw< Math::BigInt::lib >;
+
+ sub _new { ... }
+ sub _str { ... }
+ sub _add { ... }
+ str _sub { ... }
+ ...
+
+ # In your main program.
+
+ use Math::BigInt lib => 'MyBackend';
+
+=head1 DESCRIPTION
+
This module provides support for big integer calculations. It is not intended
to be used directly, but rather as a parent class for backend libraries used by
-Math::BigInt, Math::BigFloat, Math::BigRat, and related modules. Backend
-libraries include Math::BigInt::Calc, Math::BigInt::FastCalc,
-Math::BigInt::GMP, Math::BigInt::Pari and others.
+Math::BigInt, Math::BigFloat, Math::BigRat, and related modules.
-=head1 DESCRIPTION
+Other backend libraries include Math::BigInt::Calc, Math::BigInt::FastCalc,
+Math::BigInt::GMP, and Math::BigInt::Pari.
In order to allow for multiple big integer libraries, Math::BigInt was
rewritten to use a plug-in library for core math routines. Any module which
@@ -1230,12 +1553,12 @@ version, like 'Pari'.
A library only needs to deal with unsigned big integers. Testing of input
parameter validity is done by the caller, so there is no need to worry about
-underflow (e.g., in C<_sub()> and C<_dec()>) nor about division by zero (e.g.,
-in C<_div()>) or similar cases.
+underflow (e.g., in C<_sub()> and C<_dec()>) or about division by zero (e.g.,
+in C<_div()> and C<_mod()>)) or similar cases.
Some libraries use methods that don't modify their argument, and some libraries
-don't even use objects. Because of this, liberary methods are always called as
-class methods, not instance methods:
+don't even use objects, but rather unblessed references. Because of this,
+liberary methods are always called as class methods, not instance methods:
$x = Class -> method($x, $y); # like this
$x = $x -> method($y); # not like this ...
@@ -1244,7 +1567,7 @@ class methods, not instance methods:
And with boolean methods
$bool = Class -> method($x, $y); # like this
- $bool = $x -> method($y); # not like this ...
+ $bool = $x -> method($y); # not like this
Return values are always objects, strings, Perl scalars, or true/false for
comparison routines.
@@ -1253,7 +1576,7 @@ comparison routines.
=over 4
-=item api_version()
+=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.
@@ -1270,45 +1593,45 @@ However, computations will be very slow without _mul() and _div().
=over 4
-=item _new(STR)
+=item CLASS-E<gt>_new(STR)
Convert a string representing an unsigned decimal number to an object
-representing the same number. The input is normalize, i.e., it matches
+representing the same number. The input is normalized, i.e., it matches
C<^(0|[1-9]\d*)$>.
-=item _zero()
+=item CLASS-E<gt>_zero()
Return an object representing the number zero.
-=item _one()
+=item CLASS-E<gt>_one()
Return an object representing the number one.
-=item _two()
+=item CLASS-E<gt>_two()
Return an object representing the number two.
-=item _ten()
+=item CLASS-E<gt>_ten()
Return an object representing the number ten.
-=item _from_bin(STR)
+=item CLASS-E<gt>_from_bin(STR)
Return an object given a string representing a binary number. The input has a
'0b' prefix and matches the regular expression C<^0[bB](0|1[01]*)$>.
-=item _from_oct(STR)
+=item CLASS-E<gt>_from_oct(STR)
Return an object given a string representing an octal number. The input has a
'0' prefix and matches the regular expression C<^0[1-7]*$>.
-=item _from_hex(STR)
+=item CLASS-E<gt>_from_hex(STR)
Return an object given a string representing a hexadecimal number. The input
has a '0x' prefix and matches the regular expression
C<^0x(0|[1-9a-fA-F][\da-fA-F]*)$>.
-=item _from_bytes(STR)
+=item CLASS-E<gt>_from_bytes(STR)
Returns an object given a byte string representing the number. The byte string
is in big endian byte order, so the two-byte input string "\x01\x00" should
@@ -1320,129 +1643,143 @@ give an output value representing the number 256.
=over 4
-=item _add(OBJ1, OBJ2)
+=item CLASS-E<gt>_add(OBJ1, OBJ2)
Returns the result of adding OBJ2 to OBJ1.
-=item _mul(OBJ1, OBJ2)
+=item CLASS-E<gt>_mul(OBJ1, OBJ2)
Returns the result of multiplying OBJ2 and OBJ1.
-=item _div(OBJ1, OBJ2)
+=item CLASS-E<gt>_div(OBJ1, OBJ2)
-Returns the result of dividing OBJ1 by OBJ2 and truncating the result to an
-integer.
+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 _sub(OBJ1, OBJ2, FLAG)
+=item CLASS-E<gt>_sub(OBJ1, OBJ2, FLAG)
-=item _sub(OBJ1, OBJ2)
+=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.
-=item _dec(OBJ)
+=item CLASS-E<gt>_dec(OBJ)
+
+Returns the result after decrementing OBJ by one.
-Decrement OBJ by one.
+=item CLASS-E<gt>_inc(OBJ)
-=item _inc(OBJ)
+Returns the result after incrementing OBJ by one.
-Increment OBJ by one.
+=item CLASS-E<gt>_mod(OBJ1, OBJ2)
-=item _mod(OBJ1, OBJ2)
+Returns OBJ1 modulo OBJ2, i.e., the remainder after dividing OBJ1 by OBJ2.
-Return OBJ1 modulo OBJ2, i.e., the remainder after dividing OBJ1 by OBJ2.
+=item CLASS-E<gt>_sqrt(OBJ)
-=item _sqrt(OBJ)
+Returns the square root of OBJ, truncated to an integer.
-Return the square root of the object, truncated to integer.
+=item CLASS-E<gt>_root(OBJ, N)
-=item _root(OBJ, N)
+Returns the Nth root of OBJ, truncated to an integer.
-Return Nth root of the object, truncated to int. N is E<gt>= 3.
+=item CLASS-E<gt>_fac(OBJ)
-=item _fac(OBJ)
+Returns the factorial of OBJ, i.e., the product of all positive integers up to
+and including OBJ.
-Return factorial of object (1*2*3*4*...).
+=item CLASS-E<gt>_dfac(OBJ)
-=item _pow(OBJ1, OBJ2)
+Returns the double factorial of OBJ. If OBJ is an even integer, returns the
+product of all positive, even integers up to and including OBJ, i.e.,
+2*4*6*...*OBJ. If OBJ is an odd integer, returns the product of all positive,
+odd integers, i.e., 1*3*5*...*OBJ.
-Return OBJ1 to the power of OBJ2. By convention, 0**0 = 1.
+=item CLASS-E<gt>_pow(OBJ1, OBJ2)
-=item _modinv(OBJ1, OBJ2)
+Returns OBJ1 raised to the power of OBJ2. By convention, 0**0 = 1.
-Return modular multiplicative inverse, i.e., return OBJ3 so that
+=item CLASS-E<gt>_modinv(OBJ1, OBJ2)
+
+Returns the modular multiplicative inverse, i.e., return OBJ3 so that
(OBJ3 * OBJ1) % OBJ2 = 1 % OBJ2
-The result is returned as two arguments. If the modular multiplicative
-inverse does not exist, both arguments are undefined. Otherwise, the
-arguments are a number (object) and its sign ("+" or "-").
+The result is returned as two arguments. If the modular multiplicative inverse
+does not exist, both arguments are undefined. Otherwise, the arguments are a
+number (object) and its sign ("+" or "-").
-The output value, with its sign, must either be a positive value in the
-range 1,2,...,OBJ2-1 or the same value subtracted OBJ2. For instance, if the
-input arguments are objects representing the numbers 7 and 5, the method
-must either return an object representing the number 3 and a "+" sign, since
-(3*7) % 5 = 1 % 5, or an object representing the number 2 and "-" sign,
-since (-2*7) % 5 = 1 % 5.
+The output value, with its sign, must either be a positive value in the range
+1,2,...,OBJ2-1 or the same value subtracted OBJ2. For instance, if the input
+arguments are objects representing the numbers 7 and 5, the method must either
+return an object representing the number 3 and a "+" sign, since (3*7) % 5 = 1
+% 5, or an object representing the number 2 and a "-" sign, since (-2*7) % 5 = 1
+% 5.
-=item _modpow(OBJ1, OBJ2, OBJ3)
+=item CLASS-E<gt>_modpow(OBJ1, OBJ2, OBJ3)
-Return modular exponentiation, (OBJ1 ** OBJ2) % OBJ3.
+Returns the modular exponentiation, i.e., (OBJ1 ** OBJ2) % OBJ3.
-=item _rsft(OBJ, N, B)
+=item CLASS-E<gt>_rsft(OBJ, N, B)
-Shift object N digits right in base B and return the resulting object. This is
+Returns the result after shifting OBJ N digits to thee right in base B. This is
equivalent to performing integer division by B**N and discarding the remainder,
-except that it might be much faster, depending on how the number is represented
-internally.
+except that it might be much faster.
For instance, if the object $obj represents the hexadecimal number 0xabcde,
then C<_rsft($obj, 2, 16)> returns an object representing the number 0xabc. The
"remainer", 0xde, is discarded and not returned.
-=item _lsft(OBJ, N, B)
+=item CLASS-E<gt>_lsft(OBJ, N, B)
-Shift the object N digits left in base B. This is equivalent to multiplying by
-B**N, except that it might be much faster, depending on how the number is
-represented internally.
+Returns the result after shifting OBJ N digits to the left in base B. This is
+equivalent to multiplying by B**N, except that it might be much faster.
-=item _log_int(OBJ, B)
+=item CLASS-E<gt>_log_int(OBJ, B)
-Return integer log of OBJ to base BASE. This method has two output arguments,
-the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ is the exact
-result, 0 if the result was truncted to give OBJ, and undef if it is unknown
-whether OBJ is the exact result.
+Returns the logarithm of OBJ to base BASE truncted to an integer. This method
+has two output arguments, the OBJECT and a STATUS. The STATUS is Perl scalar;
+it is 1 if OBJ is the exact result, 0 if the result was truncted to give OBJ,
+and undef if it is unknown whether OBJ is the exact result.
-=item _gcd(OBJ1, OBJ2)
+=item CLASS-E<gt>_gcd(OBJ1, OBJ2)
-Return the greatest common divisor of OBJ1 and OBJ2.
+Returns the greatest common divisor of OBJ1 and OBJ2.
-=item _lcm(OBJ1, OBJ2)
+=item CLASS-E<gt>_lcm(OBJ1, OBJ2)
Return the least common multiple of OBJ1 and OBJ2.
+=item CLASS-E<gt>_fib(OBJ)
+
+In scalar context, returns the nth Fibonacci number: _fib(0) returns 0, _fib(1)
+returns 1, _fib(2) returns 1, _fib(3) returns 2 etc. In list context, returns
+the Fibonacci numbers from F(0) to F(n): 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, ...
+
+=item CLASS-E<gt>_lucas(OBJ)
+
+In scalar context, returns the nth Lucas number: _lucas(0) returns 2, _lucas(1)
+returns 1, _lucas(2) returns 3, etc. In list context, returns the Lucas numbers
+from L(0) to L(n): 2, 1, 3, 4, 7, 11, 18, 29,47, 76, ...
+
=back
=head3 Bitwise operators
-Each of these methods may modify the first input argument.
-
=over 4
-=item _and(OBJ1, OBJ2)
+=item CLASS-E<gt>_and(OBJ1, OBJ2)
-Return bitwise and. If necessary, the smallest number is padded with leading
-zeros.
+Returns bitwise and.
-=item _or(OBJ1, OBJ2)
+=item CLASS-E<gt>_or(OBJ1, OBJ2)
-Return bitwise or. If necessary, the smallest number is padded with leading
-zeros.
+Return bitwise or.
-=item _xor(OBJ1, OBJ2)
+=item CLASS-E<gt>_xor(OBJ1, OBJ2)
-Return bitwise exclusive or. If necessary, the smallest number is padded
-with leading zeros.
+Return bitwise exclusive or.
=back
@@ -1450,34 +1787,34 @@ with leading zeros.
=over 4
-=item _is_zero(OBJ)
+=item CLASS-E<gt>_is_zero(OBJ)
Returns a true value if OBJ is zero, and false value otherwise.
-=item _is_one(OBJ)
+=item CLASS-E<gt>_is_one(OBJ)
Returns a true value if OBJ is one, and false value otherwise.
-=item _is_two(OBJ)
+=item CLASS-E<gt>_is_two(OBJ)
Returns a true value if OBJ is two, and false value otherwise.
-=item _is_ten(OBJ)
+=item CLASS-E<gt>_is_ten(OBJ)
Returns a true value if OBJ is ten, and false value otherwise.
-=item _is_even(OBJ)
+=item CLASS-E<gt>_is_even(OBJ)
Return a true value if OBJ is an even integer, and a false value otherwise.
-=item _is_odd(OBJ)
+=item CLASS-E<gt>_is_odd(OBJ)
Return a true value if OBJ is an even integer, and a false value otherwise.
-=item _acmp(OBJ1, OBJ2)
+=item CLASS-E<gt>_acmp(OBJ1, OBJ2)
-Compare OBJ1 and OBJ2 and return -1, 0, or 1, if OBJ1 is less than, equal
-to, or larger than OBJ2, respectively.
+Compare OBJ1 and OBJ2 and return -1, 0, or 1, if OBJ1 is numerically less than,
+equal to, or larger than OBJ2, respectively.
=back
@@ -1485,35 +1822,44 @@ to, or larger than OBJ2, respectively.
=over 4
-=item _str(OBJ)
+=item CLASS-E<gt>_str(OBJ)
+
+Returns a string representing OBJ in decimal notation. The returned string
+should have no leading zeros, i.e., it should match C<^(0|[1-9]\d*)$>.
+
+=item CLASS-E<gt>_to_bin(OBJ)
+
+Returns the binary string representation of OBJ.
+
+=item CLASS-E<gt>_to_oct(OBJ)
-Return a string representing the object. The returned string should have no
-leading zeros, i.e., it should match C<^(0|[1-9]\d*)$>.
+Returns the octal string representation of the number.
-=item _as_bin(OBJ)
+=item CLASS-E<gt>_to_hex(OBJ)
-Return the binary string representation of the number. The string must have a
-'0b' prefix.
+Returns the hexadecimal string representation of the number.
-=item _as_oct(OBJ)
+=item CLASS-E<gt>_to_bytes(OBJ)
-Return the octal string representation of the number. The string must have
-a '0x' prefix.
+Returns a byte string representation of OBJ. The byte string is in big endian
+byte order, so if OBJ represents the number 256, the output should be the
+two-byte string "\x01\x00".
-Note: This method was required from Math::BigInt version 1.78, but the required
-API version number was not incremented, so there are older libraries that
-support API version 1, but do not support C<_as_oct()>.
+=item CLASS-E<gt>_as_bin(OBJ)
-=item _as_hex(OBJ)
+Like C<_to_bin()> but with a '0b' prefix.
-Return the hexadecimal string representation of the number. The string must
-have a '0x' prefix.
+=item CLASS-E<gt>_as_oct(OBJ)
-=item _as_bytes(OBJ)
+Like C<_to_oct()> but with a '0' prefix.
-Return a byte string representation of the number. The byte string is in big
-endian byte order, so if the object represents the number 256, the output
-should be the two-byte string "\x01\x00".
+=item CLASS-E<gt>_as_hex(OBJ)
+
+Like C<_to_hex()> but with a '0x' prefix.
+
+=item CLASS-E<gt>_as_bytes(OBJ)
+
+This is an alias to C<_to_bytes()>.
=back
@@ -1521,10 +1867,11 @@ should be the two-byte string "\x01\x00".
=over 4
-=item _num(OBJ)
+=item CLASS-E<gt>_num(OBJ)
-Given an object, return a Perl scalar number (int/float) representing this
-number.
+Returns a Perl scalar number representing the number OBJ as close as
+possible. Since Perl scalars have limited precision, the returned value might
+not be exactly the same as OBJ.
=back
@@ -1532,32 +1879,40 @@ number.
=over 4
-=item _copy(OBJ)
+=item CLASS-E<gt>_copy(OBJ)
-Return a true copy of the object.
+Returns a true copy OBJ.
-=item _len(OBJ)
+=item CLASS-E<gt>_len(OBJ)
-Returns the number of the decimal digits in the number. The output is a
-Perl scalar.
+Returns the number of the decimal digits in OBJ. The output is a Perl scalar.
-=item _zeros(OBJ)
+=item CLASS-E<gt>_zeros(OBJ)
-Return the number of trailing decimal zeros. The output is a Perl scalar.
+Returns the number of trailing decimal zeros. The output is a Perl scalar. The
+number zero has no trailing decimal zeros.
-=item _digit(OBJ, N)
+=item CLASS-E<gt>_digit(OBJ, N)
-Return the Nth digit as a Perl scalar. N is a Perl scalar, where zero refers to
-the rightmost (least significant) digit, and negative values count from the
-left (most significant digit). If $obj represents the number 123, then
-I<$obj->_digit(0)> is 3 and I<_digit(123, -1)> is 1.
+Returns the Nth digit in OBJ as a Perl scalar. N is a Perl scalar, where zero
+refers to the rightmost (least significant) digit, and negative values count
+from the left (most significant digit). If $obj represents the number 123, then
-=item _check(OBJ)
+ CLASS->_digit($obj, 0) # returns 3
+ CLASS->_digit($obj, 1) # returns 2
+ CLASS->_digit($obj, 2) # returns 1
+ CLASS->_digit($obj, -1) # returns 1
-Return true if the object is invalid and false otherwise. Preferably, the true
+=item CLASS-E<gt>_check(OBJ)
+
+Returns true if the object is invalid and false otherwise. Preferably, the true
value is a string describing the problem with the object. This is a check
routine to test the internal state of the object for corruption.
+=item CLASS-E<gt>_set(OBJ)
+
+xxx
+
=back
=head2 API version 2
@@ -1568,7 +1923,7 @@ The following methods are required for an API version of 2 or greater.
=over 4
-=item _1ex(N)
+=item CLASS-E<gt>_1ex(N)
Return an object representing the number 10**N where N E<gt>= 0 is a Perl
scalar.
@@ -1579,7 +1934,7 @@ scalar.
=over 4
-=item _nok(OBJ1, OBJ2)
+=item CLASS-E<gt>_nok(OBJ1, OBJ2)
Return the binomial coefficient OBJ1 over OBJ1.
@@ -1589,7 +1944,7 @@ Return the binomial coefficient OBJ1 over OBJ1.
=over 4
-=item _alen(OBJ)
+=item CLASS-E<gt>_alen(OBJ)
Return the approximate number of decimal digits of the object. The output is a
Perl scalar.
@@ -1606,15 +1961,15 @@ slow) fallback routines to emulate these:
=over 4
-=item _signed_or(OBJ1, OBJ2, SIGN1, SIGN2)
+=item CLASS-E<gt>_signed_or(OBJ1, OBJ2, SIGN1, SIGN2)
Return the signed bitwise or.
-=item _signed_and(OBJ1, OBJ2, SIGN1, SIGN2)
+=item CLASS-E<gt>_signed_and(OBJ1, OBJ2, SIGN1, SIGN2)
Return the signed bitwise and.
-=item _signed_xor(OBJ1, OBJ2, SIGN1, SIGN2)
+=item CLASS-E<gt>_signed_xor(OBJ1, OBJ2, SIGN1, SIGN2)
Return the signed bitwise exclusive or.
diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/Trace.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/Trace.pm
index dc915983f0f..5f83c79210f 100644
--- a/Master/tlpkg/tlperl/lib/Math/BigInt/Trace.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigInt/Trace.pm
@@ -2,7 +2,7 @@
package Math::BigInt::Trace;
-require 5.006;
+require 5.010;
use strict;
use warnings;
@@ -13,7 +13,7 @@ our ($accuracy, $precision, $round_mode, $div_scale);
our @ISA = qw(Exporter Math::BigInt);
-our $VERSION = '0.47';
+our $VERSION = '0.49';
use overload; # inherit overload from Math::BigInt
diff --git a/Master/tlpkg/tlperl/lib/Math/BigRat.pm b/Master/tlpkg/tlperl/lib/Math/BigRat.pm
index c604a2706f7..520b443b015 100644
--- a/Master/tlpkg/tlperl/lib/Math/BigRat.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigRat.pm
@@ -18,9 +18,9 @@ use warnings;
use Carp ();
-use Math::BigFloat '1.999718';
+use Math::BigFloat 1.999718;
-our $VERSION = '0.2611';
+our $VERSION = '0.2613';
our @ISA = qw(Math::BigFloat);
@@ -887,9 +887,11 @@ sub bmul {
my $gcd_sq = $LIB -> _gcd($LIB -> _copy($y->{_n}), $x->{_d});
$x->{_n} = $LIB -> _mul(scalar $LIB -> _div($x->{_n}, $gcd_pr),
- scalar $LIB -> _div($y->{_n}, $gcd_sq));
+ scalar $LIB -> _div($LIB -> _copy($y->{_n}),
+ $gcd_sq));
$x->{_d} = $LIB -> _mul(scalar $LIB -> _div($x->{_d}, $gcd_sq),
- scalar $LIB -> _div($y->{_d}, $gcd_pr));
+ scalar $LIB -> _div($LIB -> _copy($y->{_d}),
+ $gcd_pr));
# compute new sign
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-';
@@ -1348,15 +1350,19 @@ sub blog {
# value is used as the base, otherwise the base is assumed to be Euler's
# constant.
+ 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.
- # set up parameters
- my ($class, $x, $base, @r) = (ref($_[0]), @_);
-
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $base, @r) = objectify(1, @_);
+ if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
+ # E.g., Math::BigFloat->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)
+ ($class, $x, $base, @r) =
+ defined $_[1] ? objectify(2, @_) : objectify(1, @_);
}
return $x if $x->modify('blog');
@@ -1417,7 +1423,7 @@ sub bexp {
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
- ($class, $x, $y, @r) = objectify(2, @_);
+ ($class, $x, $y, @r) = objectify(1, @_);
}
return $x->binf(@r) if $x->{sign} eq '+inf';