summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Math/BigInt/Lib.pm236
1 files changed, 204 insertions, 32 deletions
diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
index fde281297fb..37fa9b94de5 100755
--- a/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm
@@ -4,7 +4,8 @@ use 5.006001;
use strict;
use warnings;
-our $VERSION = '1.999818';
+our $VERSION = '1.999837';
+$VERSION =~ tr/_//d;
use Carp;
@@ -88,7 +89,7 @@ use overload
$x = $_[0];
$y = ref($_[1]) ? $class -> _num($_[1]) : $_[1];
}
- return $class -> _blsft($x, $y);
+ return $class -> _lsft($x, $y);
},
'>>' => sub {
@@ -101,7 +102,7 @@ use overload
$x = $class -> _copy($_[0]);
$y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
}
- return $class -> _brsft($x, $y);
+ return $class -> _rsft($x, $y);
},
# overload key: num_comparison
@@ -352,6 +353,56 @@ sub _dec {
$class -> _sub($x, $class -> _one());
}
+# Signed addition. If the flag is false, $xa might be modified, but not $ya. If
+# the false is true, $ya might be modified, but not $xa.
+
+sub _sadd {
+ my $class = shift;
+ my ($xa, $xs, $ya, $ys, $flag) = @_;
+ my ($za, $zs);
+
+ # If the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
+
+ if ($xs eq $ys) {
+ if ($flag) {
+ $za = $class -> _add($ya, $xa);
+ } else {
+ $za = $class -> _add($xa, $ya);
+ }
+ $zs = $class -> _is_zero($za) ? '+' : $xs;
+ return $za, $zs;
+ }
+
+ my $acmp = $class -> _acmp($xa, $ya); # abs(x) = abs(y)
+
+ if ($acmp == 0) { # x = -y or -x = y
+ $za = $class -> _zero();
+ $zs = '+';
+ return $za, $zs;
+ }
+
+ if ($acmp > 0) { # abs(x) > abs(y)
+ $za = $class -> _sub($xa, $ya, $flag);
+ $zs = $xs;
+ } else { # abs(x) < abs(y)
+ $za = $class -> _sub($ya, $xa, !$flag);
+ $zs = $ys;
+ }
+ return $za, $zs;
+}
+
+# Signed subtraction. If the flag is false, $xa might be modified, but not $ya.
+# If the false is true, $ya might be modified, but not $xa.
+
+sub _ssub {
+ my $class = shift;
+ my ($xa, $xs, $ya, $ys, $flag) = @_;
+
+ # Swap sign of second operand and let _sadd() do the job.
+ $ys = $ys eq '+' ? '-' : '+';
+ $class -> _sadd($xa, $xs, $ya, $ys, $flag);
+}
+
##############################################################################
# testing
@@ -573,23 +624,54 @@ sub _nok {
return $n;
}
+#sub _fac {
+# # factorial
+# my ($class, $x) = @_;
+#
+# my $two = $class -> _two();
+#
+# if ($class -> _acmp($x, $two) < 0) {
+# return $class -> _one();
+# }
+#
+# my $i = $class -> _copy($x);
+# while ($class -> _acmp($i, $two) > 0) {
+# $i = $class -> _dec($i);
+# $x = $class -> _mul($x, $i);
+# }
+#
+# return $x;
+#}
+
sub _fac {
# factorial
my ($class, $x) = @_;
- my $two = $class -> _two();
+ # This is an implementation of the split recursive algorithm. See
+ # http://www.luschny.de/math/factorial/csharp/FactorialSplit.cs.html
- if ($class -> _acmp($x, $two) < 0) {
- return $class -> _one();
- }
+ my $p = $class -> _one();
+ my $r = $class -> _one();
+ my $two = $class -> _two();
- my $i = $class -> _copy($x);
- while ($class -> _acmp($i, $two) > 0) {
- $i = $class -> _dec($i);
- $x = $class -> _mul($x, $i);
+ my ($log2n) = $class -> _log_int($class -> _copy($x), $two);
+ my $h = $class -> _zero();
+ my $shift = $class -> _zero();
+ my $k = $class -> _one();
+
+ while ($class -> _acmp($h, $x)) {
+ $shift = $class -> _add($shift, $h);
+ $h = $class -> _rsft($class -> _copy($x), $log2n, $two);
+ $log2n = $class -> _dec($log2n) if !$class -> _is_zero($log2n);
+ my $high = $class -> _copy($h);
+ $high = $class -> _dec($high) if $class -> _is_even($h);
+ while ($class -> _acmp($k, $high)) {
+ $k = $class -> _add($k, $two);
+ $p = $class -> _mul($p, $k);
+ }
+ $r = $class -> _mul($r, $p);
}
-
- return $x;
+ return $class -> _lsft($r, $shift, $two);
}
sub _dfac {
@@ -725,7 +807,7 @@ sub _sqrt {
#
# x(i+1) = x(i) - f(x(i)) / f'(x(i))
# = x(i) - (x(i)^2 - y) / (2 * x(i)) # use if x(i)^2 > y
- # = y(i) + (y - x(i)^2) / (2 * x(i)) # use if x(i)^2 < y
+ # = x(i) + (y - x(i)^2) / (2 * x(i)) # use if x(i)^2 < y
# Determine if x, our guess, is too small, correct, or too large.
@@ -1433,7 +1515,9 @@ sub _to_base {
my $collseq;
if (@_) {
- $collseq = shift();
+ $collseq = shift;
+ croak "The collation sequence must be a non-empty string"
+ unless defined($collseq) && length($collseq);
} else {
if ($class -> _acmp($base, $class -> _new("94")) <= 0) {
$collseq = '0123456789' # 48 .. 57
@@ -1461,10 +1545,40 @@ sub _to_base {
my $chr = $collseq[$num];
$str = $chr . $str;
}
- return "0" unless length $str;
+ return $collseq[0] unless length $str;
return $str;
}
+sub _to_base_num {
+ # Convert the number to an array of integers in any base.
+ my ($class, $x, $base) = @_;
+
+ # Make sure the base is an object and >= 2.
+ $base = $class -> _new($base) unless ref($base);
+ my $two = $class -> _two();
+ croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0;
+
+ my $out = [];
+ my $xcopy = $class -> _copy($x);
+ my $rem;
+
+ # Do all except the last (most significant) element.
+ until ($class -> _acmp($xcopy, $base) < 0) {
+ ($xcopy, $rem) = $class -> _div($xcopy, $base);
+ unshift @$out, $rem;
+ }
+
+ # Do the last (most significant element).
+ unless ($class -> _is_zero($xcopy)) {
+ unshift @$out, $xcopy;
+ }
+
+ # $out is empty if $x is zero.
+ unshift @$out, $class -> _zero() unless @$out;
+
+ return $out;
+}
+
sub _from_hex {
# Convert a string of hexadecimal digits to a number.
@@ -1622,6 +1736,32 @@ sub _from_base {
return $x;
}
+sub _from_base_num {
+ # Convert an array in the given base to a number.
+ my ($class, $in, $base) = @_;
+
+ # Make sure the base is an object and >= 2.
+ $base = $class -> _new($base) unless ref($base);
+ my $two = $class -> _two();
+ croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0;
+
+ # @$in = map { ref($_) ? $_ : $class -> _new($_) } @$in;
+
+ my $ele = $in -> [0];
+
+ $ele = $class -> _new($ele) unless ref($ele);
+ my $x = $class -> _copy($ele);
+
+ for my $i (1 .. $#$in) {
+ $x = $class -> _mul($x, $base);
+ $ele = $in -> [$i];
+ $ele = $class -> _new($ele) unless ref($ele);
+ $x = $class -> _add($x, $ele);
+ }
+
+ return $x;
+}
+
##############################################################################
# special modulus functions
@@ -1631,7 +1771,7 @@ sub _modinv {
# modulo zero
if ($class -> _is_zero($y)) {
- return (undef, undef);
+ return;
}
# modulo one
@@ -1661,7 +1801,7 @@ sub _modinv {
}
# if the gcd is not 1, there exists no modular multiplicative inverse
- return (undef, undef) unless $class -> _is_one($a);
+ return unless $class -> _is_one($a);
($v, $sign == 1 ? '+' : '-');
}
@@ -1786,8 +1926,6 @@ sub _lucas {
return @y;
}
- require Scalar::Util;
-
# In scalar context use that lucas(n) = fib(n-1) + fib(n+1).
#
# Remember that _fib() behaves differently in scalar context and list
@@ -1795,8 +1933,8 @@ sub _lucas {
return $class -> _two() if $n == 0;
- return $class -> _add(scalar $class -> _fib($n - 1),
- scalar $class -> _fib($n + 1));
+ return $class -> _add(scalar($class -> _fib($n - 1)),
+ scalar($class -> _fib($n + 1)));
}
sub _fib {
@@ -1876,8 +2014,8 @@ Math::BigInt::Lib - virtual parent class for Math::BigInt libraries
package Math::BigInt::MyBackend;
- use Math::BigInt::lib;
- our @ISA = qw< Math::BigInt::lib >;
+ use Math::BigInt::Lib;
+ our @ISA = qw< Math::BigInt::Lib >;
sub _new { ... }
sub _str { ... }
@@ -2035,6 +2173,16 @@ Some more examples, all returning 250:
$x = $class -> _from_base("42", 62)
$x = $class -> _from_base("2!", 94)
+=item CLASS-E<gt>_from_base_num(ARRAY, BASE)
+
+Returns an object given an array of values and a base. This method is
+equivalent to C<_from_base()>, but works on numbers in an array rather than
+characters in a string. Unlike C<_from_base()>, all input values may be
+arbitrarily large.
+
+ $x = $class -> _from_base_num([1, 1, 0, 1], 2) # $x is 13
+ $x = $class -> _from_base_num([3, 125, 39], 128) # $x is 65191
+
=back
=head3 Mathematical functions
@@ -2043,24 +2191,38 @@ Some more examples, all returning 250:
=item CLASS-E<gt>_add(OBJ1, OBJ2)
-Returns the result of adding OBJ2 to OBJ1.
+Addition. Returns the result of adding OBJ2 to OBJ1.
=item CLASS-E<gt>_mul(OBJ1, OBJ2)
-Returns the result of multiplying OBJ2 and OBJ1.
+Multiplication. Returns the result of multiplying OBJ2 and OBJ1.
=item CLASS-E<gt>_div(OBJ1, OBJ2)
-In scalar context, returns the quotient after dividing OBJ1 by OBJ2 and
-truncating the result to an integer. In list context, return the quotient and
-the remainder.
+Division. In scalar context, returns the quotient after dividing OBJ1 by OBJ2
+and truncating the result to an integer. In list context, return the quotient
+and the remainder.
=item CLASS-E<gt>_sub(OBJ1, OBJ2, FLAG)
=item CLASS-E<gt>_sub(OBJ1, OBJ2)
-Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false or omitted,
-OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified.
+Subtraction. Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false
+or omitted, OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified.
+
+=item CLASS-E<gt>_sadd(OBJ1, SIGN1, OBJ2, SIGN2)
+
+Signed addition. Returns the result of adding OBJ2 with sign SIGN2 to OBJ1 with
+sign SIGN1.
+
+ ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2);
+
+=item CLASS-E<gt>_ssub(OBJ1, SIGN1, OBJ2, SIGN2)
+
+Signed subtraction. Returns the result of subtracting OBJ2 with sign SIGN2 to
+OBJ1 with sign SIGN1.
+
+ ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2);
=item CLASS-E<gt>_dec(OBJ)
@@ -2268,6 +2430,16 @@ COLLSEQ.
See _from_base() for more information.
+=item CLASS-E<gt>_to_base_num(OBJ, BASE)
+
+Converts the given number to the given base. This method is equivalent to
+C<_to_base()>, but returns numbers in an array rather than characters in a
+string. In the output, the first element is the most significant. Unlike
+C<_to_base()>, all input values may be arbitrarily large.
+
+ $x = $class -> _to_base_num(13, 2) # $x is [1, 1, 0, 1]
+ $x = $class -> _to_base_num(65191, 128) # $x is [3, 125, 39]
+
=item CLASS-E<gt>_as_bin(OBJ)
Like C<_to_bin()> but with a '0b' prefix.
@@ -2460,7 +2632,7 @@ the same terms as Perl itself.
=head1 AUTHOR
-Peter John Acklam, E<lt>pjacklam@online.noE<gt>
+Peter John Acklam, E<lt>pjacklam@gmail.comE<gt>
Code and documentation based on the Math::BigInt::Calc module by Tels
E<lt>nospam-abuse@bloodgate.comE<gt>