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