my $class = "Math::BigInt";
use 5.006002;
-$VERSION = '1.991';
+$VERSION = '1.992';
@ISA = qw(Exporter);
@EXPORT_OK = qw(objectify bgcd blcm);
# import done
}
-sub from_hex
- {
- # create a bigint from a hexadecimal string
- my ($self, $hs) = @_;
+sub from_hex {
+ # Create a bigint from a hexadecimal string.
- my $rc = __from_hex($hs);
+ my ($self, $str) = @_;
- return $self->bnan() unless defined $rc;
+ if ($str =~ s/
+ ^
+ ( [+-]? )
+ (0?x)?
+ (
+ [0-9a-fA-F]*
+ ( _ [0-9a-fA-F]+ )*
+ )
+ $
+ //x)
+ {
+ # Get a "clean" version of the string, i.e., non-emtpy and with no
+ # underscores or invalid characters.
- $rc;
- }
+ my $sign = $1;
+ my $chrs = $3;
+ $chrs =~ tr/_//d;
+ $chrs = '0' unless CORE::length $chrs;
-sub from_bin
- {
- # create a bigint from a hexadecimal string
- my ($self, $bs) = @_;
+ # Initialize output.
- my $rc = __from_bin($bs);
+ my $x = Math::BigInt->bzero();
- return $self->bnan() unless defined $rc;
+ # The library method requires a prefix.
- $rc;
- }
+ $x->{value} = $CALC->_from_hex('0x' . $chrs);
-sub from_oct
- {
- # create a bigint from a hexadecimal string
- my ($self, $os) = @_;
+ # Place the sign.
- my $x = $self->bzero();
-
- # strip underscores
- $os =~ s/([0-7])_([0-7])/$1$2/g;
- $os =~ s/([0-7])_([0-7])/$1$2/g;
-
- return $x->bnan() if $os !~ /^[\-\+]?0[0-7]+\z/;
+ if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
+ $x->{sign} = '-';
+ }
- my $sign = '+'; $sign = '-' if $os =~ /^-/;
+ return $x;
+ }
- $os =~ s/^[+-]//; # strip sign
- $x->{value} = $CALC->_from_oct($os);
- $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
- $x;
- }
+ # CORE::hex() parses as much as it can, and ignores any trailing garbage.
+ # For backwards compatibility, we return NaN.
-sub __from_hex
- {
- # internal
- # convert a (ref to) big hex string to BigInt, return undef for error
- my $hs = shift;
+ return $self->bnan();
+}
- my $x = Math::BigInt->bzero();
-
- # strip underscores
- $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
- $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
-
- return $x->bnan() if $hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
+sub from_oct {
+ # Create a bigint from an octal string.
- my $sign = '+'; $sign = '-' if $hs =~ /^-/;
+ my ($self, $str) = @_;
- $hs =~ s/^[+-]//; # strip sign
- $x->{value} = $CALC->_from_hex($hs);
- $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
- $x;
- }
+ if ($str =~ s/
+ ^
+ ( [+-]? )
+ (
+ [0-7]*
+ ( _ [0-7]+ )*
+ )
+ $
+ //x)
+ {
+ # Get a "clean" version of the string, i.e., non-emtpy and with no
+ # underscores or invalid characters.
-sub __from_bin
- {
- # internal
- # convert a (ref to) big binary string to BigInt, return undef for error
- my $bs = shift;
+ my $sign = $1;
+ my $chrs = $2;
+ $chrs =~ tr/_//d;
+ $chrs = '0' unless CORE::length $chrs;
- my $x = Math::BigInt->bzero();
+ # Initialize output.
- # strip underscores
- $bs =~ s/([01])_([01])/$1$2/g;
- $bs =~ s/([01])_([01])/$1$2/g;
- return $x->bnan() if $bs !~ /^[+-]?0b[01]+$/;
+ my $x = Math::BigInt->bzero();
- my $sign = '+'; $sign = '-' if $bs =~ /^\-/;
- $bs =~ s/^[+-]//; # strip sign
+ # The library method requires a prefix.
- $x->{value} = $CALC->_from_bin($bs);
- $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
- $x;
- }
+ $x->{value} = $CALC->_from_oct('0' . $chrs);
+
+ # Place the sign.
+
+ if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
+ $x->{sign} = '-';
+ }
+
+ return $x;
+ }
+
+ # CORE::oct() parses as much as it can, and ignores any trailing garbage.
+ # For backwards compatibility, we return NaN.
+
+ return $self->bnan();
+}
+
+sub from_bin {
+ # Create a bigint from a binary string.
+
+ my ($self, $str) = @_;
+
+ if ($str =~ s/
+ ^
+ ( [+-]? )
+ (0?b)?
+ (
+ [01]*
+ ( _ [01]+ )*
+ )
+ $
+ //x)
+ {
+ # Get a "clean" version of the string, i.e., non-emtpy and with no
+ # underscores or invalid characters.
+
+ my $sign = $1;
+ my $chrs = $3;
+ $chrs =~ tr/_//d;
+ $chrs = '0' unless CORE::length $chrs;
+
+ # Initialize output.
+
+ my $x = Math::BigInt->bzero();
+
+ # The library method requires a prefix.
+
+ $x->{value} = $CALC->_from_bin('0b' . $chrs);
+
+ # Place the sign.
+
+ if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
+ $x->{sign} = '-';
+ }
+
+ return $x;
+ }
+
+ # For consistency with from_hex() and from_oct(), we return NaN when the
+ # input is invalid.
+
+ return $self->bnan();
+}
sub _split
{
# invalid starting char?
return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
- return __from_hex($x) if $x =~ /^[\-\+]?0x/; # hex string
- return __from_bin($x) if $x =~ /^[\-\+]?0b/; # binary string
-
+ return Math::BigInt->from_hex($x) if $x =~ /^[+-]?0x/; # hex string
+ return Math::BigInt->from_bin($x) if $x =~ /^[+-]?0b/; # binary string
+
# strip underscores between digits
$x =~ s/([0-9])_([0-9])/$1$2/g;
$x =~ s/([0-9])_([0-9])/$1$2/g; # do twice for 1_2_3
use strict;
# use warnings; # dont use warnings for older Perls
-our $VERSION = '1.991';
+our $VERSION = '1.992';
# Package to store unsigned big integers in decimal and do math with them
# if possible, use mod shortcut
my ($c,$x,$yo) = @_;
- # slow way since $y to big
+ # slow way since $y too big
if (scalar @$yo > 1)
{
my ($xo,$rem) = _div($c,$x,$yo);
- return $rem;
+ @$x = @$rem;
+ return $x;
}
my $y = $yo->[0];
- # both are single element arrays
+
+ # if both are single element arrays
if (scalar @$x == 1)
{
$x->[0] %= $y;
return $x;
}
- # @y is a single element, but @x has more than one element
+ # if @$x has more than one element, but @$y is a single element
my $b = $BASE % $y;
if ($b == 0)
{
}
elsif ($b == 1)
{
- # else need to go through all elements: O(N), but loop is a bit simplified
+ # else need to go through all elements in @$x: O(N), but loop is a bit
+ # simplified
my $r = 0;
foreach (@$x)
{
}
else
{
- # else need to go through all elements: O(N)
- my $r = 0; my $bm = 1;
+ # else need to go through all elements in @$x: O(N)
+ my $r = 0;
+ my $bm = 1;
foreach (@$x)
{
$r = ($_ * $bm + $r) % $y;
$r = 0 if $r == $y;
$x->[0] = $r;
}
- splice (@$x,1); # keep one element of $x
- $x;
+ @$x = $x->[0]; # keep one element of @$x
+ return $x;
}
##############################################################################
$cx;
}
-sub _nok
- {
- # n over k
- # ref to array, return ref to array
- my ($c,$n,$k) = @_;
+sub _nok {
+ # Return binomial coefficient (n over k).
+ # Given refs to arrays, return ref to array.
+ # First input argument is modified.
- # ( 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
+ my ($c, $n, $k) = @_;
+
+ # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as
+ # nok(n, n-k), to minimize the number if iterations in the loop.
- if (!_is_zero($c,$k))
{
- my $x = _copy($c,$n);
- _sub($c,$n,$k);
- _inc($c,$n);
- my $f = _copy($c,$n); _inc($c,$f); # n = 5, f = 6, d = 2
- my $d = _two($c);
- while (_acmp($c,$f,$x) <= 0) # f <= n ?
- {
- # n = (n * f / d) == 5 * 6 / 2
- $n = _mul($c,$n,$f); $n = _div($c,$n,$d);
- # f = 7, d = 3
- _inc($c,$f); _inc($c,$d);
- }
+ my $twok = _mul($c, _two($c), _copy($c, $k)); # 2 * k
+ if (_acmp($c, $twok, $n) > 0) { # if 2*k > n
+ $k = _sub($c, _copy($c, $n), $k); # k = n - k
+ }
}
- else
- {
- # keep ref to $n and set it to 1
- splice (@$n,1); $n->[0] = 1;
+
+ # 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
+
+ if (_is_zero($c, $k)) {
+ @$n = 1;
}
- $n;
- }
+
+ else {
+
+ # Make a copy of the original n, since we'll be modifing n in-place.
+
+ my $n_orig = _copy($c, $n);
+
+ # n = 5, f = 6, d = 2 (cf. example above)
+
+ _sub($c, $n, $k);
+ _inc($c, $n);
+
+ my $f = _copy($c, $n);
+ _inc($c, $f);
+
+ my $d = _two($c);
+
+ # while f <= n (the original n, that is) ...
+
+ while (_acmp($c, $f, $n_orig) <= 0) {
+
+ # n = (n * f / d) == 5 * 6 / 2 (cf. example above)
+
+ _mul($c, $n, $f);
+ _div($c, $n, $d);
+
+ # f = 7, d = 3 (cf. example above)
+
+ _inc($c, $f);
+ _inc($c, $d);
+ }
+
+ }
+
+ return $n;
+}
my @factorials = (
1,
sub _modinv
{
- # modular inverse
+ # modular multiplicative inverse
my ($c,$x,$y) = @_;
- my $u = _zero($c); my $u1 = _one($c);
- my $a = _copy($c,$y); my $b = _copy($c,$x);
+ # modulo zero
+ if (_is_zero($c, $y)) {
+ return (undef, undef);
+ }
+
+ # modulo one
+ if (_is_one($c, $y)) {
+ return (_zero($c), '+');
+ }
+
+ my $u = _zero($c);
+ my $v = _one($c);
+ my $a = _copy($c,$y);
+ my $b = _copy($c,$x);
- # Euclid's Algorithm for bgcd(), only that we calc bgcd() ($a) and the
- # result ($u) at the same time. See comments in BigInt for why this works.
+ # Euclid's Algorithm for bgcd(), only that we calc bgcd() ($a) and the result
+ # ($u) at the same time. See comments in BigInt for why this works.
my $q;
- ($a, $q, $b) = ($b, _div($c,$a,$b)); # step 1
my $sign = 1;
- while (!_is_zero($c,$b))
- {
- my $t = _add($c, # step 2:
- _mul($c,_copy($c,$u1), $q) , # t = u1 * q
- $u ); # + u
- $u = $u1; # u = u1, u1 = t
- $u1 = $t;
- $sign = -$sign;
- ($a, $q, $b) = ($b, _div($c,$a,$b)); # step 1
- }
+ {
+ ($a, $q, $b) = ($b, _div($c, $a, $b)); # step 1
+ last if _is_zero($c, $b);
+
+ my $t = _add($c, # step 2:
+ _mul($c, _copy($c, $v), $q) , # t = v * q
+ $u ); # + u
+ $u = $v; # u = v
+ $v = $t; # v = t
+ $sign = -$sign;
+ redo;
+ }
# if the gcd is not 1, then return NaN
- return (undef,undef) unless _is_one($c,$a);
-
- ($u1, $sign == 1 ? '+' : '-');
+ return (undef, undef) unless _is_one($c, $a);
+
+ ($v, $sign == 1 ? '+' : '-');
}
sub _modpow
$num;
}
-sub _gcd
- {
- # greatest common divisor
- my ($c,$x,$y) = @_;
+sub _gcd {
+ # Greatest common divisor.
- while ( (scalar @$y != 1) || ($y->[0] != 0) ) # while ($y != 0)
- {
- my $t = _copy($c,$y);
- $y = _mod($c, $x, $y);
- $x = $t;
+ my ($c, $x, $y) = @_;
+
+ # gcd(0,0) = 0
+ # gcd(0,a) = a, if a != 0
+
+ if (@$x == 1 && $x->[0] == 0) {
+ if (@$y == 1 && $y->[0] == 0) {
+ @$x = 0;
+ } else {
+ @$x = @$y;
+ }
+ return $x;
}
- $x;
- }
+
+ # Until $y is zero ...
+
+ until (@$y == 1 && $y->[0] == 0) {
+
+ # Compute remainder.
+
+ _mod($c, $x, $y);
+
+ # Swap $x and $y.
+
+ my $tmp = [ @$x ];
+ @$x = @$y;
+ $y = $tmp; # no deref here; that would modify input $y
+ }
+
+ return $x;
+}
##############################################################################
##############################################################################
projects / platform / upstream / perl.git / commitdiff