diff options
| author | Steve Hay <steve.m.hay@googlemail.com> | 2019-10-16 08:06:47 +0100 |
|---|---|---|
| committer | Steve Hay <steve.m.hay@googlemail.com> | 2019-10-16 08:06:47 +0100 |
| commit | 669a1300d162433f684126609d77549fa2bb6d80 (patch) | |
| tree | b6f5cd23c56546f80ec8d47c1098b7939727c119 | |
| parent | f2c50040ce0dcb4f046ea35d05bb9f5ebc7cdb11 (diff) | |
| download | perl-669a1300d162433f684126609d77549fa2bb6d80.tar.gz | |
Upgrade Math::BigInt from version 1.999816 to 1.999817
29 files changed, 2905 insertions, 1046 deletions
@@ -1294,9 +1294,11 @@ cpan/Math-BigInt/lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigIn cpan/Math-BigInt/lib/Math/BigInt/Lib.pm cpan/Math-BigInt/t/_e_math.t Helper routine in BigFloat for _e math cpan/Math-BigInt/t/alias.inc Support for BigInt tests +cpan/Math-BigInt/t/backermann-mbi.t Test Math::BigInt cpan/Math-BigInt/t/bare_mbf.t Test MBF under Math::BigInt::BareCalc cpan/Math-BigInt/t/bare_mbi.t Test MBI under Math::BigInt::BareCalc cpan/Math-BigInt/t/bare_mif.t Rounding tests under BareCalc +cpan/Math-BigInt/t/bdigitsum-mbi.t Test Math::BigInt cpan/Math-BigInt/t/bdstr-mbf.t Test Math::BigInt cpan/Math-BigInt/t/bdstr-mbi.t Test Math::BigInt cpan/Math-BigInt/t/bestr-mbf.t Test Math::BigInt @@ -1318,6 +1320,7 @@ cpan/Math-BigInt/t/bnstr-mbf.t Test Math::BigInt cpan/Math-BigInt/t/bnstr-mbi.t Test Math::BigInt cpan/Math-BigInt/t/bsstr-mbf.t Test Math::BigInt cpan/Math-BigInt/t/bsstr-mbi.t Test Math::BigInt +cpan/Math-BigInt/t/buparrow-mbi.t Test Math::BigInt cpan/Math-BigInt/t/calling.t Test calling conventions cpan/Math-BigInt/t/calling-class-methods.t Test Math::BigInt cpan/Math-BigInt/t/calling-instance-methods.t Test Math::BigInt @@ -1334,6 +1337,7 @@ cpan/Math-BigInt/t/from_bin-mbf.t Test Math::BigInt cpan/Math-BigInt/t/from_bin-mbi.t cpan/Math-BigInt/t/from_hex-mbf.t Test Math::BigInt cpan/Math-BigInt/t/from_hex-mbi.t +cpan/Math-BigInt/t/from_ieee754-mbf.t Test Math::BigInt cpan/Math-BigInt/t/from_oct-mbf.t Test Math::BigInt cpan/Math-BigInt/t/from_oct-mbi.t cpan/Math-BigInt/t/inf_nan.t Special tests for inf and *NaN* handling @@ -1373,6 +1377,7 @@ cpan/Math-BigInt/t/sub_mbf.t Empty subclass test of BigFloat cpan/Math-BigInt/t/sub_mbi.t Empty subclass test of BigInt cpan/Math-BigInt/t/sub_mif.t Test A & P with subclasses using mbimbf.inc cpan/Math-BigInt/t/to_base-mbi.t +cpan/Math-BigInt/t/to_ieee754-mbf.t Test Math::BigInt cpan/Math-BigInt/t/trap.t Test whether trap_nan and trap_inf work cpan/Math-BigInt/t/upgrade.inc Actual tests for upgrade.t cpan/Math-BigInt/t/upgrade.t Test if use Math::BigInt(); under upgrade works diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 9ab84aa0b4..a59557743c 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -714,7 +714,7 @@ use File::Glob qw(:case); }, 'Math::BigInt' => { - 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999816.tar.gz', + 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999817.tar.gz', 'FILES' => q[cpan/Math-BigInt], 'EXCLUDED' => [ qr{^examples/}, diff --git a/cpan/Math-BigInt/lib/Math/BigFloat.pm b/cpan/Math-BigInt/lib/Math/BigFloat.pm index 8a92b5818d..1b7b2f24ae 100644 --- a/cpan/Math-BigInt/lib/Math/BigFloat.pm +++ b/cpan/Math-BigInt/lib/Math/BigFloat.pm @@ -19,8 +19,9 @@ use warnings; use Carp qw< carp croak >; use Math::BigInt (); -our $VERSION = '1.999816'; +our $VERSION = '1.999817'; +require Exporter; our @ISA = qw/Math::BigInt/; our @EXPORT_OK = qw/bpi/; @@ -28,8 +29,6 @@ our @EXPORT_OK = qw/bpi/; our ($AUTOLOAD, $accuracy, $precision, $div_scale, $round_mode, $rnd_mode, $upgrade, $downgrade, $_trap_nan, $_trap_inf); -my $class = "Math::BigFloat"; - use overload # overload key: with_assign @@ -273,7 +272,7 @@ sub AUTOLOAD { my $name = $AUTOLOAD; $name =~ s/(.*):://; # split package - my $c = $1 || $class; + my $c = $1 || __PACKAGE__; no strict 'refs'; $c->import() if $IMPORT == 0; if (!_method_alias($name)) { @@ -418,7 +417,8 @@ sub new { return $self; } - # Handle hexadecimal numbers. + # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they + # have a "0x" or "0X" prefix. if ($wanted =~ /^\s*[+-]?0[Xx]/) { $self = $class -> from_hex($wanted); @@ -426,7 +426,42 @@ sub new { return $self; } - # Handle binary numbers. + # Handle octal numbers. We auto-detect octal numbers if they have a "0" + # prefix and a binary exponent. + + if ($wanted =~ / + ^ + \s* + + # sign + [+-]? + + # prefix + 0 + + # significand using the octal digits 0..7 + [0-7]+ (?: _ [0-7]+ )* + (?: + \. + (?: [0-7]+ (?: _ [0-7]+ )* )? + )? + + # exponent (power of 2) using decimal digits + [Pp] + [+-]? + \d+ (?: _ \d+ )* + + \s* + $ + /x) + { + $self = $class -> from_oct($wanted); + $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; + return $self; + } + + # Handle binary numbers. We auto-detect binary numbers if they have a "0b" + # or "0B" prefix. if ($wanted =~ /^\s*[+-]?0[Bb]/) { $self = $class -> from_bin($wanted); @@ -781,6 +816,165 @@ sub from_bin { return $self->bnan(); } +sub from_ieee754 { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + # Don't modify constant (read-only) objects. + + return if $selfref && $self->modify('from_ieee754'); + + my $in = shift; # input string (or raw bytes) + my $format = shift; # format ("binary32", "decimal64" etc.) + my $enc; # significand encoding (applies only to decimal) + my $k; # storage width in bits + my $b; # base + + if ($format =~ /^binary(\d+)\z/) { + $k = $1; + $b = 2; + } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) { + $k = $1; + $b = 10; + $enc = $2 || 'dpd'; # default is dencely-packed decimals (DPD) + } elsif ($format eq 'half') { + $k = 16; + $b = 2; + } elsif ($format eq 'single') { + $k = 32; + $b = 2; + } elsif ($format eq 'double') { + $k = 64; + $b = 2; + } elsif ($format eq 'quadruple') { + $k = 128; + $b = 2; + } elsif ($format eq 'octuple') { + $k = 256; + $b = 2; + } elsif ($format eq 'sexdecuple') { + $k = 512; + $b = 2; + } + + if ($b == 2) { + + # Get the parameters for this format. + + my $p; # precision (in bits) + my $t; # number of bits in significand + my $w; # number of bits in exponent + + if ($k == 16) { # binary16 (half-precision) + $p = 11; + $t = 10; + $w = 5; + } elsif ($k == 32) { # binary32 (single-precision) + $p = 24; + $t = 23; + $w = 8; + } elsif ($k == 64) { # binary64 (double-precision) + $p = 53; + $t = 52; + $w = 11; + } else { # binaryN (quadruple-precision and above) + if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) { + croak "Number of bits must be 16, 32, 64, or >= 128 and", + " a multiple of 32"; + } + $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13; + $t = $p - 1; + $w = $k - $t - 1; + } + + # The maximum exponent, minimum exponent, and exponent bias. + + my $emax = Math::BigInt -> new(2) -> bpow($w - 1) -> bdec(); + my $emin = 1 - $emax; + my $bias = $emax; + + # Undefined input. + + unless (defined $in) { + carp("Input is undefined"); + return $self -> bzero(); + } + + # Make sure input string is a string of zeros and ones. + + my $len = CORE::length $in; + if (8 * $len == $k) { # bytes + $in = unpack "B*", $in; + } elsif (4 * $len == $k) { # hexadecimal + if ($in =~ /([^\da-f])/i) { + croak "Illegal hexadecimal digit '$1'"; + } + $in = unpack "B*", pack "H*", $in; + } elsif ($len == $k) { # bits + if ($in =~ /([^01])/) { + croak "Illegal binary digit '$1'"; + } + } else { + croak "Unknown input -- $in"; + } + + # Split bit string into sign, exponent, and mantissa/significand. + + my $sign = substr($in, 0, 1) eq '1' ? '-' : '+'; + my $expo = $class -> from_bin(substr($in, 1, $w)); + my $mant = $class -> from_bin(substr($in, $w + 1)); + + my $x; + + $expo -> bsub($bias); # subtract bias + + if ($expo < $emin) { # zero and subnormals + if ($mant == 0) { # zero + $x = $class -> bzero(); + } else { # subnormals + # compute (1/$b)**(N) rather than ($b)**(-N) + $x = $class -> new("0.5"); # 1/$b + $x -> bpow($bias + $t - 1) -> bmul($mant); + $x -> bneg() if $sign eq '-'; + } + } + + elsif ($expo > $emax) { # inf and nan + if ($mant == 0) { # inf + $x = $class -> binf($sign); + } else { # nan + $x = $class -> bnan(); + } + } + + else { # normals + $mant = $class -> new(2) -> bpow($t) -> badd($mant); + if ($expo < $t) { + # compute (1/$b)**(N) rather than ($b)**(-N) + $x = $class -> new("0.5"); # 1/$b + $x -> bpow($t - $expo) -> bmul($mant); + } else { + $x = $class -> new(2); + $x -> bpow($expo - $t) -> bmul($mant); + } + $x -> bneg() if $sign eq '-'; + } + + if ($selfref) { + $self -> {sign} = $x -> {sign}; + $self -> {_m} = $x -> {_m}; + $self -> {_es} = $x -> {_es}; + $self -> {_e} = $x -> {_e}; + } else { + $self = $x; + } + return $self; + } + + croak("The format '$format' is not yet supported."); +} + sub bzero { # create/assign '+0' @@ -3023,7 +3217,7 @@ sub bsqrt { return $x if $x->modify('bsqrt'); - return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0 + return $x->bnan() if $x->{sign} !~ /^\+/; # NaN, -inf or < 0 return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf return $x->round($a, $p, $r) if $x->is_zero() || $x->is_one(); @@ -3783,7 +3977,7 @@ sub mantissa { if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; - $s =~ s/^[+]//; + $s =~ s/^\+//; return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf } my $m = Math::BigInt->new($LIB->_str($x->{_m}), undef, undef); @@ -3798,7 +3992,7 @@ sub exponent { if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; -$s =~ s/^[+-]//; + $s =~ s/^[+-]//; return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf } Math::BigInt->new($x->{_es} . $LIB->_str($x->{_e}), undef, undef); @@ -3810,9 +4004,9 @@ sub parts { if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; -$s =~ s/^[+]//; -my $se = $s; -$se =~ s/^[-]//; + $s =~ s/^\+//; + my $se = $s; + $se =~ s/^-//; return ($class->new($s), $class->new($se)); # +inf => inf and -inf, +inf => inf } my $m = Math::BigInt->bzero(); @@ -3981,9 +4175,9 @@ sub bstr { } my $es = '0'; -my $len = 1; -my $cad = 0; -my $dot = '.'; + my $len = 1; + my $cad = 0; + my $dot = '.'; # $x is zero? my $not_zero = !($x->{sign} eq '+' && $LIB->_is_zero($x->{_m})); @@ -4007,8 +4201,8 @@ my $dot = '.'; } elsif ($e > 0) { # expand with zeros $es .= '0' x $e; -$len += $e; -$cad = 0; + $len += $e; + $cad = 0; } } # if not zero @@ -4160,6 +4354,178 @@ sub to_bin { return $x->{sign} eq '-' ? "-$str" : $str; } +sub to_ieee754 { + my $x = shift; + my $format = shift; + my $class = ref $x; + + my $enc; # significand encoding (applies only to decimal) + my $k; # storage width in bits + my $b; # base + + if ($format =~ /^binary(\d+)\z/) { + $k = $1; + $b = 2; + } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) { + $k = $1; + $b = 10; + $enc = $2 || 'dpd'; # default is dencely-packed decimals (DPD) + } elsif ($format eq 'half') { + $k = 16; + $b = 2; + } elsif ($format eq 'single') { + $k = 32; + $b = 2; + } elsif ($format eq 'double') { + $k = 64; + $b = 2; + } elsif ($format eq 'quadruple') { + $k = 128; + $b = 2; + } elsif ($format eq 'octuple') { + $k = 256; + $b = 2; + } elsif ($format eq 'sexdecuple') { + $k = 512; + $b = 2; + } + + if ($b == 2) { + + # Get the parameters for this format. + + my $p; # precision (in bits) + my $t; # number of bits in significand + my $w; # number of bits in exponent + + if ($k == 16) { # binary16 (half-precision) + $p = 11; + $t = 10; + $w = 5; + } elsif ($k == 32) { # binary32 (single-precision) + $p = 24; + $t = 23; + $w = 8; + } elsif ($k == 64) { # binary64 (double-precision) + $p = 53; + $t = 52; + $w = 11; + } else { # binaryN (quadruple-precition and above) + if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) { + croak "Number of bits must be 16, 32, 64, or >= 128 and", + " a multiple of 32"; + } + $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13; + $t = $p - 1; + $w = $k - $t - 1; + } + + # The maximum exponent, minimum exponent, and exponent bias. + + my $emax = $class -> new(2) -> bpow($w - 1) -> bdec(); + my $emin = 1 - $emax; + my $bias = $emax; + + # Get numerical sign, exponent, and mantissa/significand for bit + # string. + + my $sign = 0; + my $expo; + my $mant; + + if ($x -> is_nan()) { # nan + $sign = 1; + $expo = $emax -> copy() -> binc(); + $mant = $class -> new(2) -> bpow($t - 1); + } elsif ($x -> is_inf()) { # inf + $sign = 1 if $x -> is_neg(); + $expo = $emax -> copy() -> binc(); + $mant = $class -> bzero(); + } elsif ($x -> is_zero()) { # zero + $expo = $emin -> copy() -> bdec(); + $mant = $class -> bzero(); + } else { # normal and subnormal + + $sign = 1 if $x -> is_neg(); + + # Get the mantissa and exponent in base $b. + + my $binv = $class -> new("0.5"); + my $b = $class -> new(2); + my $one = $class -> bone(); + + $expo = $class -> bzero(); + $mant = $x -> copy() -> babs(); + + # We need to find the base 2 exponent. First make an estimate of + # the base 2 exponent, before adjusting it below. We could skip + # this estimation and go straight to the while-loops below, but the + # loops are slow, especially when the final exponent is far from + # zero and even more so if the number of digits is large. This + # initial estimation speeds up the computation dramatically. + # + # log2($m * 10**$e) = log10($m + 10**$e) * log(10)/log(2) + # = (log10($m) + $e) * log(10)/log(2) + # = (log($m)/log(10) + $e) * log(10)/log(2) + + my ($m, $e) = $x -> nparts(); + my $ms = $m -> numify(); + my $es = $e -> numify(); + $expo = (log(abs($ms))/log(10) + $es) * log(10)/log(2); + $expo = int($expo); + if ($expo > $emax) { + $expo = $emax; + } elsif ($expo < $emin) { + $expo = $emin; + } + $expo = $class -> new($expo); + $mant -> bmul($binv -> copy() -> bpow($expo)); + + # Final adjustment. + + while ($mant >= $b && $expo <= $emax) { + $mant -> bmul($binv); + $expo -> binc(); + } + + while ($mant < $one && $expo >= $emin) { + $mant -> bmul($b); + $expo -> bdec(); + } + + # Encode as infinity, normal number or subnormal number? + + if ($expo > $emax) { # overflow => infinity + $expo = $emax -> copy() -> binc(); + $mant = $class -> bzero(); + } elsif ($expo < $emin) { # subnormal number + my $const = $class -> new(2) -> bpow($t - 1); + $mant -> bmul($const); + $mant -> bfround(0); + } else { # normal number + $mant -> bdec(); # remove implicit leading bit + my $const = $class -> new(2) -> bpow($t); + $mant -> bmul($const) -> bfround(0); + } + } + + $expo -> badd($bias); # add bias + + my $signbit = "$sign"; + + my $mantbits = $mant -> to_bin(); + $mantbits = ("0" x ($t - CORE::length($mantbits))) . $mantbits; + + my $expobits = $expo -> to_bin(); + $expobits = ("0" x ($w - CORE::length($expobits))) . $expobits; + + my $bin = $signbit . $expobits . $mantbits; + return pack "B*", $bin; + } + + croak("The format '$format' is not yet supported."); +} + sub as_hex { # return number as hexadecimal string (only for integers defined) @@ -4242,7 +4608,7 @@ sub import { my $class = shift; my $l = scalar @_; my $lib = ''; -my @a; + my @a; my $lib_kind = 'try'; $IMPORT=1; for (my $i = 0; $i < $l ; $i++) { @@ -4314,7 +4680,7 @@ sub _len_to_steps { # D = 50 => N => 42, so L = 40 and R = 50 my $l = 40; -my $r = $d; + my $r = $d; # Otherwise this does not work under -Mbignum and we do not yet have "no bignum;" :( $l = $l->numify if ref($l); @@ -4370,7 +4736,6 @@ sub _log { $over->bmul($u); $factor = $class->new(3); $f = $class->new(2); - my $steps = 0; $limit = $class->new("1E-". ($scale-1)); while (3 < 5) { @@ -4717,7 +5082,6 @@ sub _pow { $over = $u->copy(); $limit = $class->new("1E-". ($scale-1)); - #my $steps = 0; while (3 < 5) { # we calculate the next term, and add it to the last # when the next term is below our limit, it won't affect the outcome @@ -4731,8 +5095,6 @@ sub _pow { $factor->binc(); last if $x->{sign} !~ /^[-+]$/; - - #$steps++; } if ($do_invert) { @@ -4795,6 +5157,7 @@ Math::BigFloat - Arbitrary size floating point math package $x = Math::BigFloat->from_oct('0377'); # ditto $x = Math::BigFloat->from_bin('0b1.1001p-4'); # from binary $x = Math::BigFloat->from_bin('0101'); # ditto + $x = Math::BigFloat->from_ieee754($b, "binary64"); # from IEEE-754 bytes $x = Math::BigFloat->bzero(); # create a +0 $x = Math::BigFloat->bone(); # create a +1 $x = Math::BigFloat->bone('-'); # create a -1 @@ -4926,6 +5289,7 @@ Math::BigFloat - Arbitrary size floating point math package $x->as_hex(); # as signed hexadecimal string with prefixed 0x $x->as_bin(); # as signed binary string with prefixed 0b $x->as_oct(); # as signed octal string with prefixed 0 + $x->to_ieee754($format); # to bytes encoded according to IEEE 754-2008 # Other conversion methods @@ -5106,6 +5470,17 @@ using decimal digits. If called as an instance method, the value is assigned to the invocand. +=item from_ieee754() + +Interpret the input as a value encoded as described in IEEE754-2008. The input +can be given as a byte string, hex string or binary string. The input is +assumed to be in big-endian byte-order. + + # both $dbl and $mbf are 3.141592... + $bytes = "\x40\x09\x21\xfb\x54\x44\x2d\x18"; + $dbl = unpack "d>", $bytes; + $mbf = Math::BigFloat -> from_ieee754($bytes, "binary64"); + =item bpi() print Math::BigFloat->bpi(100), "\n"; @@ -5225,6 +5600,29 @@ C<ref($x)-E<gt>new()> can parse to create an object. In Math::BigFloat, C<as_float()> has the same effect as C<copy()>. +=item to_ieee754() + +Encodes the invocand as a byte string in the given format as specified in IEEE +754-2008. Note that the encoded value is the nearest possible representation of +the value. This value might not be exactly the same as the value in the +invocand. + + # $x = 3.1415926535897932385 + $x = Math::BigFloat -> bpi(30); + + $b = $x -> to_ieee754("binary64"); # encode as 8 bytes + $h = unpack "H*", $b; # "400921fb54442d18" + + # 3.141592653589793115997963... + $y = Math::BigFloat -> from_ieee754($h, "binary64"); + +All binary formats in IEEE 754-2008 are accepted. For convenience, som aliases +are recognized: "half" for "binary16", "single" for "binary32", "double" for +"binary64", "quadruple" for "binary128", "octuple" for "binary256", and +"sexdecuple" for "binary512". + +See also L<https://en.wikipedia.org/wiki/IEEE_754>. + =back =head2 ACCURACY AND PRECISION @@ -5552,11 +5950,11 @@ L<http://annocpan.org/dist/Math-BigInt> =item * CPAN Ratings -L<http://cpanratings.perl.org/dist/Math-BigInt> +L<https://cpanratings.perl.org/dist/Math-BigInt> -=item * Search CPAN +=item * MetaCPAN -L<http://search.cpan.org/dist/Math-BigInt/> +L<https://metacpan.org/release/Math-BigInt> =item * CPAN Testers Matrix diff --git a/cpan/Math-BigInt/lib/Math/BigInt.pm b/cpan/Math-BigInt/lib/Math/BigInt.pm index a443cd4a5d..127f46b4f9 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt.pm @@ -1,3 +1,5 @@ +# -*- coding: utf-8-unix -*- + package Math::BigInt; # @@ -20,14 +22,12 @@ use warnings; use Carp qw< carp croak >; -our $VERSION = '1.999816'; +our $VERSION = '1.999817'; require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw(objectify bgcd blcm); -my $class = "Math::BigInt"; - # Inside overload, the first arg is always an object. If the original code had # it reversed (like $x = 2 * $y), then the third parameter is true. # In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes @@ -232,9 +232,7 @@ my $LIB = 'Math::BigInt::Calc'; # module to do the low level math # default is Calc.pm my $IMPORT = 0; # was import() called yet? # used to make require work -my %WARN; # warn only once for low-level libs my %CALLBACKS; # callbacks to notify on lib loads -my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math ############################################################################## # the old code had $rnd_mode, so we need to support it, too @@ -1135,7 +1133,7 @@ sub bpi { if (@_ == 1) { # called like Math::BigInt::bpi(10); $n = $self; - $self = $class; + $self = __PACKAGE__; } $self = ref($self) if ref($self); @@ -1234,6 +1232,24 @@ sub is_negative { $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not } +sub is_non_negative { + # Return true if argument is non-negative (>= 0). + my ($class, $x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return 1 if $x->{sign} =~ /^\+/; + return 1 if $x -> is_zero(); + return 0; +} + +sub is_non_positive { + # Return true if argument is non-positive (<= 0). + my ($class, $x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return 1 if $x->{sign} =~ /^\-/; + return 1 if $x -> is_zero(); + return 0; +} + sub is_odd { # return true when arg (BINT or num_str) is odd, false for even my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); @@ -2354,7 +2370,7 @@ sub bmodpow { $num->{value} = $value; $num->{sign} = $sign; - return $num; + return $num -> round(@r); } sub bpow { @@ -2401,21 +2417,14 @@ sub bpow { $r[3] = $y; # no push! - # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu - - my $new_sign = '+'; - $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+'); + # 0 ** -y => ( 1 / (0 ** y)) => 1 / 0 => +inf + return $x->binf() if $y->is_negative() && $x->is_zero(); - # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf - return $x->binf() - if $y->{sign} eq '-' && $x->{sign} eq '+' && $LIB->_is_zero($x->{value}); # 1 ** -y => 1 / (1 ** |y|) - # so do test for negative $y after above's clause - return $x->bnan() if $y->{sign} eq '-' && !$LIB->_is_one($x->{value}); + return $x->bzero() if $y->is_negative() && !$LIB->_is_one($x->{value}); $x->{value} = $LIB->_pow($x->{value}, $y->{value}); - $x->{sign} = $new_sign; - $x->{sign} = '+' if $LIB->_is_zero($y->{value}); + $x->{sign} = $x->is_negative() && $y->is_odd() ? '-' : '+'; $x->round(@r); } @@ -2483,7 +2492,7 @@ sub blog { return $x; } - my ($rc, $exact) = $LIB->_log_int($x->{value}, $base->{value}); + my ($rc) = $LIB->_log_int($x->{value}, $base->{value}); return $x->bnan() unless defined $rc; # not possible to take log? $x->{value} = $rc; $x->round(@r); @@ -2602,6 +2611,126 @@ sub bnok { $n->round(@r); } +sub buparrow { + my $a = shift; + my $y = $a -> uparrow(@_); + $a -> {value} = $y -> {value}; + return $a; +} + +sub uparrow { + # Knuth's up-arrow notation buparrow(a, n, b) + # + # The following is a simple, recursive implementation of the up-arrow + # notation, just to show the idea. Such implementations cause "Deep + # recursion on subroutine ..." warnings, so we use a faster, non-recursive + # algorithm below with @_ as a stack. + # + # sub buparrow { + # my ($a, $n, $b) = @_; + # return $a ** $b if $n == 1; + # return $a * $b if $n == 0; + # return 1 if $b == 0; + # return buparrow($a, $n - 1, buparrow($a, $n, $b - 1)); + # } + + my ($a, $b, $n) = @_; + my $class = ref $a; + croak("a must be non-negative") if $a < 0; + croak("n must be non-negative") if $n < 0; + croak("b must be non-negative") if $b < 0; + + while (@_ >= 3) { + + # return $a ** $b if $n == 1; + + if ($_[-2] == 1) { + my ($a, $n, $b) = splice @_, -3; + push @_, $a ** $b; + next; + } + + # return $a * $b if $n == 0; + + if ($_[-2] == 0) { + my ($a, $n, $b) = splice @_, -3; + push @_, $a * $b; + next; + } + + # return 1 if $b == 0; + + if ($_[-1] == 0) { + splice @_, -3; + push @_, $class -> bone(); + next; + } + + # return buparrow($a, $n - 1, buparrow($a, $n, $b - 1)); + + my ($a, $n, $b) = splice @_, -3; + push @_, ($a, $n - 1, + $a, $n, $b - 1); + + } + + pop @_; +} + +sub backermann { + my $m = shift; + my $y = $m -> ackermann(@_); + $m -> {value} = $y -> {value}; + return $m; +} + +sub ackermann { + # Ackermann's function ackermann(m, n) + # + # The following is a simple, recursive implementation of the ackermann + # function, just to show the idea. Such implementations cause "Deep + # recursion on subroutine ..." warnings, so we use a faster, non-recursive + # algorithm below with @_ as a stack. + # + # sub ackermann { + # my ($m, $n) = @_; + # return $n + 1 if $m == 0; + # return ackermann($m - 1, 1) if $m > 0 && $n == 0; + # return ackermann($m - 1, ackermann($m, $n - 1) if $m > 0 && $n > 0; + # } + + my ($m, $n) = @_; + my $class = ref $m; + croak("m must be non-negative") if $m < 0; + croak("n must be non-negative") if $n < 0; + + my $two = $class -> new("2"); + my $three = $class -> new("3"); + my $thirteen = $class -> new("13"); + + $n = pop; + $n = $class -> new($n) unless ref($n); + while (@_) { + my $m = pop; + if ($m > $three) { + push @_, (--$m) x $n; + while (--$m >= $three) { + push @_, $m; + } + $n = $thirteen; + } elsif ($m == $three) { + $n = $class -> bone() -> blsft($n + $three) -> bsub($three); + } elsif ($m == $two) { + $n -> bmul($two) -> badd($three); + } elsif ($m >= 0) { + $n -> badd($m) -> binc(); + } else { + die "negative m!"; + } + } + $n; +} + sub bsin { # Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the # result truncated to an integer. @@ -2654,9 +2783,9 @@ sub batan { return $upgrade->new($x)->batan(@r) if defined $upgrade; # calculate the result and truncate it to integer - my $t = Math::BigFloat->new($x)->batan(@r); + my $tmp = Math::BigFloat->new($x)->batan(@r); - $x->{value} = $LIB->_new($x->as_int()->bstr()); + $x->{value} = $LIB->_new($tmp->as_int()->bstr()); $x->round(@r); } @@ -2902,12 +3031,19 @@ sub blsft { # (BINT or num_str, BINT or num_str) return BINT # compute x << y, base n, y >= 0 - # set up parameters - my ($class, $x, $y, $b, @r) = (ref($_[0]), @_); + my ($class, $x, $y, $b, @r); - # objectify is costly, so avoid it - if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, $b, @r) = objectify(2, @_); + # Objectify the base only when it is defined, since an undefined base, as + # in $x->blsft(3) or $x->blog(3, undef) means use the default base 2. + + if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) { + # E.g., Math::BigInt->blog(256, 5, 2) + ($class, $x, $y, $b, @r) = + defined $_[3] ? objectify(3, @_) : objectify(2, @_); + } else { + # E.g., Math::BigInt::blog(256, 5, 2) or $x->blog(5, 2) + ($class, $x, $y, $b, @r) = + defined $_[2] ? objectify(3, @_) : objectify(2, @_); } return $x if $x -> modify('blsft'); @@ -2915,7 +3051,15 @@ sub blsft { $y -> {sign} !~ /^[+-]$/); return $x -> round(@r) if $y -> is_zero(); - $b = 2 if !defined $b; + $b = defined($b) ? $b -> numify() : 2; + + # While some of the libraries support an arbitrarily large base, not all of + # them do, so rather than returning an incorrect result in those cases, + # disallow bases that don't work with all libraries. + + my $uintmax = ~0; + croak("Base is too large.") if $b > $uintmax; + return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-'; $x -> {value} = $LIB -> _lsft($x -> {value}, $y -> {value}, $b); @@ -3146,7 +3290,7 @@ sub bround { # do not return $x->bnorm(), but $x my $x = shift; - $x = $class->new($x) unless ref $x; + $x = __PACKAGE__->new($x) unless ref $x; my ($scale, $mode) = $x->_scale_a(@_); return $x if !defined $scale || $x->modify('bround'); # no-op @@ -3264,7 +3408,7 @@ sub fround { # Exists to make life easier for switch between MBF and MBI (should we # autoload fxxx() like MBF does for bxxx()?) my $x = shift; - $x = $class->new($x) unless ref $x; + $x = __PACKAGE__->new($x) unless ref $x; $x->bround(@_); } @@ -3356,6 +3500,31 @@ sub digit { $LIB->_digit($x->{value}, $n || 0); } +sub bdigitsum { + # like digitsum(), but assigns the result to the invocand + my $x = shift; + + return $x if $x -> is_nan(); + return $x -> bnan() if $x -> is_inf(); + + $x -> {value} = $LIB -> _digitsum($x -> {value}); + $x -> {sign} = '+'; + return $x; +} + +sub digitsum { + # compute sum of decimal digits and return it + my $x = shift; + my $class = ref $x; + + return $class -> bnan() if $x -> is_nan(); + return $class -> bnan() if $x -> is_inf(); + + my $y = $class -> bzero(); + $y -> {value} = $LIB -> _digitsum($x -> {value}); + return $y; +} + sub length { my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); @@ -3652,7 +3821,7 @@ sub bdstr { sub to_hex { # return as hex string, with prefixed 0x my $x = shift; - $x = $class->new($x) if !ref($x); + $x = __PACKAGE__->new($x) if !ref($x); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc @@ -3663,7 +3832,7 @@ sub to_hex { sub to_oct { # return as octal string, with prefixed 0 my $x = shift; - $x = $class->new($x) if !ref($x); + $x = __PACKAGE__->new($x) if !ref($x); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc @@ -3674,7 +3843,7 @@ sub to_oct { sub to_bin { # return as binary string, with prefixed 0b my $x = shift; - $x = $class->new($x) if !ref($x); + $x = __PACKAGE__->new($x) if !ref($x); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc @@ -3685,7 +3854,7 @@ sub to_bin { sub to_bytes { # return a byte string my $x = shift; - $x = $class->new($x) if !ref($x); + $x = __PACKAGE__->new($x) if !ref($x); croak("to_bytes() requires a finite, non-negative integer") if $x -> is_neg() || ! $x -> is_int(); @@ -3699,13 +3868,13 @@ sub to_bytes { sub to_base { # return a base anything string my $x = shift; - $x = $class->new($x) if !ref($x); + $x = __PACKAGE__->new($x) if !ref($x); croak("the value to convert must be a finite, non-negative integer") if $x -> is_neg() || !$x -> is_int(); my $base = shift; - $base = $class->new($base) unless ref($base); + $base = __PACKAGE__->new($base) unless ref($base); croak("the base must be a finite integer >= 2") if $base < 2 || ! $base -> is_int(); @@ -3729,7 +3898,7 @@ sub to_base { sub as_hex { # return as hex string, with prefixed 0x my $x = shift; - $x = $class->new($x) if !ref($x); + $x = __PACKAGE__->new($x) if !ref($x); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc @@ -3740,7 +3909,7 @@ sub as_hex { sub as_oct { # return as octal string, with prefixed 0 my $x = shift; - $x = $class->new($x) if !ref($x); + $x = __PACKAGE__->new($x) if !ref($x); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc @@ -3751,7 +3920,7 @@ sub as_oct { sub as_bin { # return as binary string, with prefixed 0b my $x = shift; - $x = $class->new($x) if !ref($x); + $x = __PACKAGE__->new($x) if !ref($x); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc @@ -3768,7 +3937,7 @@ sub as_bin { sub numify { # Make a Perl scalar number from a Math::BigInt object. my $x = shift; - $x = $class->new($x) unless ref $x; + $x = __PACKAGE__->new($x) unless ref $x; if ($x -> is_nan()) { require Math::Complex; @@ -3817,7 +3986,7 @@ sub objectify { # Check the context. unless (wantarray) { - croak("${class}::objectify() needs list context"); + croak(__PACKAGE__ . "::objectify() needs list context"); } # Get the number of arguments to objectify. @@ -3935,10 +4104,9 @@ sub objectify { sub import { my $class = shift; $IMPORT++; # remember we did import() - my @a; - my $l = scalar @_; + my @a; # unrecognized arguments my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die - for (my $i = 0; $i < $l ; $i++) { + for (my $i = 0; $i <= $#_ ; $i++) { if ($_[$i] eq ':constant') { # this causes overlord er load to step in overload::constant @@ -3951,7 +4119,9 @@ sub import { } elsif ($_[$i] =~ /^(lib|try|only)\z/) { # this causes a different low lib to take care... $LIB = $_[$i+1] || ''; - # lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback) + # try => 0 (no warn) + # lib => 1 (warn on fallback) + # only => 2 (die on fallback) $warn_or_die = 1 if $_[$i] eq 'lib'; $warn_or_die = 2 if $_[$i] eq 'only'; $i++; @@ -3968,77 +4138,34 @@ sub import { # try to load core math lib my @c = split /\s*,\s*/, $LIB; foreach (@c) { - $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters + tr/a-zA-Z0-9://cd; # limit to sane characters } push @c, \'Calc' # if all fail, try these if $warn_or_die < 2; # but not for "only" - $LIB = ''; # signal error + $LIB = ''; # signal error foreach my $l (@c) { # fallback libraries are "marked" as \'string', extract string if nec. my $lib = $l; $lib = $$l if ref($l); - next if ($lib || '') eq ''; + next unless defined($lib) && CORE::length($lib); $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i; $lib =~ s/\.pm$//; - if ($] < 5.006) { - # Perl < 5.6.0 dies with "out of memory!" when eval("") and ':constant' is - # used in the same script, or eval("") inside import(). - my @parts = split /::/, $lib; # Math::BigInt => Math BigInt - my $file = pop @parts; - $file .= '.pm'; # BigInt => BigInt.pm - require File::Spec; - $file = File::Spec->catfile (@parts, $file); - eval { - require "$file"; - $lib->import(@c); - } - } else { - eval "use $lib qw/@c/;"; - } + my @parts = split /::/, $lib; # Math::BigInt => Math BigInt + $parts[-1] .= '.pm'; # BigInt => BigInt.pm + require File::Spec; + my $file = File::Spec->catfile(@parts); + eval { require $file; }; if ($@ eq '') { - my $ok = 1; - # loaded it ok, see if the api_version() is high enough - if ($lib->can('api_version') && $lib->api_version() >= 1.0) { - $ok = 0; - # api_version matches, check if it really provides anything we need - for my $method (qw/ - one two ten - str num - add mul div sub dec inc - acmp len digit is_one is_zero is_even is_odd - is_two is_ten - zeros new copy check - from_hex from_oct from_bin as_hex as_bin as_oct - rsft lsft xor and or - mod sqrt root fac pow modinv modpow log_int gcd - /) { - if (!$lib->can("_$method")) { - if (($WARN{$lib} || 0) < 2) { - carp("$lib is missing method '_$method'"); - $WARN{$lib} = 1; # still warn about the lib - } - $ok++; - last; - } - } - } - if ($ok == 0) { - $LIB = $lib; - if ($warn_or_die > 0 && ref($l)) { - my $msg = "Math::BigInt: couldn't load specified" - . " math lib(s), fallback to $lib"; - carp($msg) if $warn_or_die == 1; - croak($msg) if $warn_or_die == 2; - } - last; # found a usable one, break - } else { - if (($WARN{$lib} || 0) < 2) { - my $ver = eval "\$$lib\::VERSION" || 'unknown'; - carp("Cannot load outdated $lib v$ver, please upgrade"); - $WARN{$lib} = 2; # never warn again - } + $lib->import(); + $LIB = $lib; + if ($warn_or_die > 0 && ref($l)) { + my $msg = "Math::BigInt: couldn't load specified" + . " math lib(s), fallback to $lib"; + carp($msg) if $warn_or_die == 1; + croak($msg) if $warn_or_die == 2; } + last; # found a usable one, break } } if ($LIB eq '') { @@ -4210,7 +4337,7 @@ sub _split { sub _trailing_zeros { # return the amount of trailing zeros in $x (as scalar) my $x = shift; - $x = $class->new($x) unless ref $x; + $x = __PACKAGE__->new($x) unless ref $x; return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc @@ -4423,6 +4550,8 @@ Math::BigInt - Arbitrary size integer/float math package $x->blog($base); # logarithm of $x to base $base (e.g., base 2) $x->bexp(); # calculate e ** $x where e is Euler's number $x->bnok($y); # x over y (binomial coefficient n over k) + $x->buparrow($n, $y); # Knuth's up-arrow notation + $x->backermann($y); # the Ackermann function $x->bsin(); # sine $x->bcos(); # cosine $x->batan(); # inverse tangent @@ -4987,6 +5116,18 @@ neither positive nor negative. Returns true if the invocand is negative and false otherwise. A C<NaN> is neither positive nor negative. +=item is_non_positive() + + $x->is_non_positive(); # true if <= 0 + +Returns true if the invocand is negative or zero. + +=item is_non_negative() + + $x->is_non_negative(); # true if >= 0 + +Returns true if the invocand is positive or zero. + =item is_odd() $x->is_odd(); # true if odd, false for even @@ -5292,6 +5433,38 @@ pseudo-code: The behaviour is identical to the behaviour of the Maple and Mathematica function for negative integers n, k. +=item buparrow() + +=item uparrow() + + $a -> buparrow($n, $b); # modifies $a + $x = $a -> uparrow($n, $b); # does not modify $a + +This method implements Knuth's up-arrow notation, where $n is a non-negative +integer representing the number of up-arrows. $n = 0 gives multiplication, $n = +1 gives exponentiation, $n = 2 gives tetration, $n = 3 gives hexation etc. The +following illustrates the relation between the first values of $n. + +See L<https://en.wikipedia.org/wiki/Knuth%27s_up-arrow_notation>. + +=item backermann() + +=item ackermann() + + $m -> backermann($n); # modifies $a + $x = $m -> ackermann($n); # does not modify $a + +This method implements the Ackermann function: + + / n + 1 if m = 0 + A(m, n) = | A(m-1, 1) if m > 0 and n = 0 + \ A(m-1, A(m, n-1)) if m > 0 and n > 0 + +Its value grows rapidly, even for small inputs. For example, A(4, 2) is an +integer of 19729 decimal digits. + +See https://en.wikipedia.org/wiki/Ackermann_function + =item bsin() my $x = Math::BigInt->new(1); @@ -5590,6 +5763,18 @@ If you want $x to have a certain sign, use one of the following methods: If C<$n> is negative, returns the digit counting from left. +=item digitsum() + + $x->digitsum(); + +Computes the sum of the base 10 digits and returns it. + +=item bdigitsum() + + $x->bdigitsum(); + +Computes the sum of the base 10 digits and assigns the result to the invocand. + =item length() $x->length(); @@ -6696,11 +6881,11 @@ L<http://annocpan.org/dist/Math-BigInt> =item * CPAN Ratings -L<http://cpanratings.perl.org/dist/Math-BigInt> +L<https://cpanratings.perl.org/dist/Math-BigInt> -=item * Search CPAN +=item * MetaCPAN -L<http://search.cpan.org/dist/Math-BigInt/> +L<https://metacpan.org/release/Math-BigInt> =item * CPAN Testers Matrix diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm index 2bb06a0976..8634125ae0 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/Calc.pm @@ -7,7 +7,7 @@ use warnings; use Carp qw< carp croak >; use Math::BigInt::Lib; -our $VERSION = '1.999816'; +our $VERSION = '1.999817'; our @ISA = ('Math::BigInt::Lib'); @@ -35,9 +35,6 @@ our @ISA = ('Math::BigInt::Lib'); ############################################################################## # global constants, flags and accessory -# announce that we are compatible with MBI v1.83 and up -sub api_version () { 2; } - # constants for easier life my ($BASE, $BASE_LEN, $RBASE, $MAX_VAL); my ($AND_BITS, $XOR_BITS, $OR_BITS); @@ -50,9 +47,7 @@ sub _base_len { my ($class, $b, $int) = @_; if (defined $b) { - # avoid redefinitions - undef &_mul; - undef &_div; + no warnings "redefine"; if ($] >= 5.008 && $int && $b > 7) { $BASE_LEN = $b; @@ -403,13 +398,14 @@ sub _mul_use_mul { my ($c, $xv, $yv) = @_; if (@$yv == 1) { - # shortcut for two very short numbers (improved by Nathan Zook) - # works also if xv and yv are the same reference, and handles also $x == 0 + # shortcut for two very short numbers (improved by Nathan Zook) works + # also if xv and yv are the same reference, and handles also $x == 0 if (@$xv == 1) { if (($xv->[0] *= $yv->[0]) >= $BASE) { - $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $BASE; + my $rem = $xv->[0] % $BASE; + $xv->[1] = ($xv->[0] - $rem) * $RBASE; + $xv->[0] = $rem; } - ; return $xv; } # $x * 0 => 0 @@ -417,56 +413,44 @@ sub _mul_use_mul { @$xv = (0); return $xv; } + # multiply a large number a by a single element one, so speed up my $y = $yv->[0]; my $car = 0; + my $rem; foreach my $i (@$xv) { $i = $i * $y + $car; - $car = int($i * $RBASE); - $i -= $car * $BASE; + $rem = $i % $BASE; + $car = ($i - $rem) * $RBASE; + $i = $rem; } push @$xv, $car if $car != 0; return $xv; } + # shortcut for result $x == 0 => result = 0 return $xv if @$xv == 1 && $xv->[0] == 0; # since multiplying $x with $x fails, make copy in this case - $yv = [ @$xv ] if $xv == $yv; # same references? + $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); - my ($prod, $car, $cty, $xi, $yi); - + my ($prod, $rem, $car, $cty, $xi, $yi); for $xi (@$xv) { $car = 0; $cty = 0; - - # slow variant - # for $yi (@$yv) - # { - # $prod = $xi * $yi + ($prod[$cty] || 0) + $car; - # $prod[$cty++] = - # $prod - ($car = int($prod * RBASE)) * $BASE; # see USE_MUL - # } - # $prod[$cty] += $car if $car; # need really to check for 0? - # $xi = shift @prod; - - # faster variant # looping through this if $xi == 0 is silly - so optimize it away! - $xi = (shift @prod || 0), next if $xi == 0; + $xi = (shift(@prod) || 0), next if $xi == 0; for $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; - ## this is actually a tad slower - ## $prod = $prod[$cty]; $prod += ($car + $xi * $yi); # no ||0 here - $prod[$cty++] = - $prod - ($car = int($prod * $RBASE)) * $BASE; # see USE_MUL + $rem = $prod % $BASE; + $car = int(($prod - $rem) * $RBASE); + $prod[$cty++] = $rem; } - $prod[$cty] += $car if $car; # need really to check for 0? - $xi = shift @prod || 0; # || 0 makes v5.005_3 happy + $prod[$cty] += $car if $car; # need really to check for 0? + $xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; - # can't have leading zeros - # __strip_zeros($xv); $xv; } @@ -478,11 +462,11 @@ sub _mul_use_div_64 { my ($c, $xv, $yv) = @_; use integer; + if (@$yv == 1) { - # shortcut for two small numbers, also handles $x == 0 + # shortcut for two very short numbers (improved by Nathan Zook) works + # also if xv and yv are the same reference, and handles also $x == 0 if (@$xv == 1) { - # shortcut for two very short numbers (improved by Nathan Zook) - # works also if xv and yv are the same reference, and handles also $x == 0 if (($xv->[0] *= $yv->[0]) >= $BASE) { $xv->[0] = $xv->[0] - ($xv->[1] = $xv->[0] / $BASE) * $BASE; @@ -494,6 +478,7 @@ sub _mul_use_div_64 { @$xv = (0); return $xv; } + # multiply a large number a by a single element one, so speed up my $y = $yv->[0]; my $car = 0; @@ -505,11 +490,12 @@ sub _mul_use_div_64 { push @$xv, $car if $car != 0; return $xv; } + # shortcut for result $x == 0 => result = 0 - return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) ); + return $xv if @$xv == 1 && $xv->[0] == 0; # since multiplying $x with $x fails, make copy in this case - $yv = $c->_copy($xv) if $xv == $yv; # same references? + $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); my ($prod, $car, $cty, $xi, $yi); @@ -517,13 +503,13 @@ sub _mul_use_div_64 { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! - $xi = (shift @prod || 0), next if $xi == 0; + $xi = (shift(@prod) || 0), next if $xi == 0; for $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; $prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE; } - $prod[$cty] += $car if $car; # need really to check for 0? - $xi = shift @prod || 0; # || 0 makes v5.005_3 happy + $prod[$cty] += $car if $car; # need really to check for 0? + $xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; $xv; @@ -536,15 +522,14 @@ sub _mul_use_div { my ($c, $xv, $yv) = @_; if (@$yv == 1) { - # shortcut for two small numbers, also handles $x == 0 + # shortcut for two very short numbers (improved by Nathan Zook) works + # also if xv and yv are the same reference, and handles also $x == 0 if (@$xv == 1) { - # shortcut for two very short numbers (improved by Nathan Zook) - # works also if xv and yv are the same reference, and handles also $x == 0 if (($xv->[0] *= $yv->[0]) >= $BASE) { - $xv->[0] = - $xv->[0] - ($xv->[1] = int($xv->[0] / $BASE)) * $BASE; + my $rem = $xv->[0] % $BASE; + $xv->[1] = ($xv->[0] - $rem) / $BASE; + $xv->[0] = $rem; } - ; return $xv; } # $x * 0 => 0 @@ -552,42 +537,44 @@ sub _mul_use_div { @$xv = (0); return $xv; } + # multiply a large number a by a single element one, so speed up my $y = $yv->[0]; my $car = 0; + my $rem; foreach my $i (@$xv) { $i = $i * $y + $car; - $car = int($i / $BASE); - $i -= $car * $BASE; - # This (together with use integer;) does not work on 32-bit Perls - #$i = $i * $y + $car; $i -= ($car = $i / $BASE) * $BASE; + $rem = $i % $BASE; + $car = ($i - $rem) / $BASE; + $i = $rem; } push @$xv, $car if $car != 0; return $xv; } + # shortcut for result $x == 0 => result = 0 - return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) ); + return $xv if @$xv == 1 && $xv->[0] == 0; # since multiplying $x with $x fails, make copy in this case - $yv = $c->_copy($xv) if $xv == $yv; # same references? + $yv = $c->_copy($xv) if $xv == $yv; # same references? my @prod = (); - my ($prod, $car, $cty, $xi, $yi); + my ($prod, $rem, $car, $cty, $xi, $yi); for $xi (@$xv) { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! - $xi = (shift @prod || 0), next if $xi == 0; + $xi = (shift(@prod) || 0), next if $xi == 0; for $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; - $prod[$cty++] = $prod - ($car = int($prod / $BASE)) * $BASE; + $rem = $prod % $BASE; + $car = ($prod - $rem) / $BASE; + $prod[$cty++] = $rem; } - $prod[$cty] += $car if $car; # need really to check for 0? - $xi = shift @prod || 0; # || 0 makes v5.005_3 happy + $prod[$cty] += $car if $car; # need really to check for 0? + $xi = shift(@prod) || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; - # can't have leading zeros - # __strip_zeros($xv); $xv; } @@ -595,28 +582,19 @@ sub _div_use_mul { # ref to array, ref to array, modify first array and return remainder if # in list context - # see comments in _div_use_div() for more explanations - my ($c, $x, $yorg) = @_; # the general div algorithm here is about O(N*N) and thus quite slow, so # we first check for some special cases and use shortcuts to handle them. - # This works, because we store the numbers in a chunked format where each - # element contains 5..7 digits (depending on system). - # if both numbers have only one element: if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers - if (wantarray) { - my $rem = [ $x->[0] % $yorg->[0] ]; - bless $rem, $c; - $x->[0] = int($x->[0] / $yorg->[0]); - return ($x, $rem); - } else { - $x->[0] = int($x->[0] / $yorg->[0]); - return $x; - } + my $rem = [ $x->[0] % $yorg->[0] ]; + bless $rem, $c; + $x->[0] = ($x->[0] - $rem->[0]) / $yorg->[0]; + return ($x, $rem) if wantarray; + return $x; } # if x has more than one, but y has only one element: @@ -631,120 +609,120 @@ sub _div_use_mul { my $b; while ($j-- > 0) { $b = $r * $BASE + $x->[$j]; - $x->[$j] = int($b/$y); $r = $b % $y; + $x->[$j] = ($b - $r) / $y; } - pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero + pop(@$x) if @$x > 1 && $x->[-1] == 0; # remove any trailing zero return ($x, $rem) if wantarray; return $x; } # now x and y have more than one element - # check whether y has more elements than x, if yet, the result will be 0 + # check whether y has more elements than x, if so, the result is 0 if (@$yorg > @$x) { my $rem; - $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? - return $x; # only x, which is [0] now + $rem = $c->_copy($x) if wantarray; # make copy + @$x = 0; # set to 0 + return ($x, $rem) if wantarray; # including remainder? + return $x; # only x, which is [0] now } + # check whether the numbers have the same number of elements, in that case # the result will fit into one element and can be computed efficiently if (@$yorg == @$x) { + my $cmp = 0; + for (my $j = $#$x ; $j >= 0 ; --$j) { + last if $cmp = $x->[$j] - $yorg->[$j]; + } - # if $yorg has more digits than $x (it's leading element is longer than - # the one from $x), the result will also be 0: - if (length(int($yorg->[-1])) > length(int($x->[-1]))) { - my $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? + if ($cmp == 0) { # x = y + @$x = 1; + return $x, $c->_zero() if wantarray; return $x; } - # now calculate $x / $yorg - if (length(int($yorg->[-1])) == length(int($x->[-1]))) { - # same length, so make full compare - my $a = 0; - my $j = @$x - 1; - # manual way (abort if unequal, good for early ne) - while ($j >= 0) { - last if ($a = $x->[$j] - $yorg->[$j]); - $j--; - } - # $a contains the result of the compare between X and Y - # a < 0: x < y, a == 0: x == y, a > 0: x > y - if ($a <= 0) { - # a = 0 => x == y => rem 0 - # a < 0 => x < y => rem = x - my $rem = $a == 0 ? $c->_zero() : $c->_copy($x); - @$x = 0; # if $a < 0 - $x->[0] = 1 if $a == 0; # $x == $y - return ($x, $rem) if wantarray; - return $x; + if ($cmp < 0) { # x < y + if (wantarray) { + my $rem = $c->_copy($x); + @$x = 0; + return $x, $rem; } - # $x >= $y, so proceed normally + @$x = 0; + return $x; } } # all other cases: - my $y = $c->_copy($yorg); # always make copy to preserve + my $y = $c->_copy($yorg); # always make copy to preserve - my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0); - - $car = $bar = $prd = 0; - if (($dd = int($BASE / ($y->[-1] + 1))) != 1) { - for $xi (@$x) { + my $tmp = $y->[-1] + 1; + my $rem = $BASE % $tmp; + my $dd = ($BASE - $rem) / $tmp; + if ($dd != 1) { + my $car = 0; + for my $xi (@$x) { $xi = $xi * $dd + $car; - $xi -= ($car = int($xi * $RBASE)) * $BASE; # see USE_MUL + $xi -= ($car = int($xi * $RBASE)) * $BASE; # see USE_MUL } push(@$x, $car); $car = 0; - for $yi (@$y) { + for my $yi (@$y) { $yi = $yi * $dd + $car; - $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL + $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL } } else { push(@$x, 0); } - @q = (); - ($v2, $v1) = @$y[-2, -1]; + + # @q will accumulate the final result, $q contains the current computed + # part of the final result + + my @q = (); + my ($v2, $v1) = @$y[-2, -1]; $v2 = 0 unless $v2; while ($#$x > $#$y) { - ($u2, $u1, $u0) = @$x[-3 .. -1]; + my ($u2, $u1, $u0) = @$x[-3 .. -1]; $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; - $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1)); - --$q while ($v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2); + my $tmp = $u0 * $BASE + $u1; + my $rem = $tmp % $v1; + my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1); + --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2; if ($q) { - ($car, $bar) = (0, 0); - for ($yi = 0, $xi = $#$x - $#$y-1; $yi <= $#$y; ++$yi, ++$xi) { + my $prd; + my ($car, $bar) = (0, 0); + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $prd = $q * $y->[$yi] + $car; - $prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL - $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + $prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL + $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; - for ($yi = 0, $xi = $#$x - $#$y-1; $yi <= $#$y; ++$yi, ++$xi) { + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $x->[$xi] -= $BASE - if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); + if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE); } } } pop(@$x); unshift(@q, $q); } + if (wantarray) { my $d = bless [], $c; if ($dd != 1) { - $car = 0; - for $xi (reverse @$x) { + my $car = 0; + my ($prd, $rem); + for my $xi (reverse @$x) { $prd = $car * $BASE + $xi; - $car = $prd - ($tmp = int($prd / $dd)) * $dd; # see USE_MUL - unshift(@$d, $tmp); + $rem = $prd % $dd; + $tmp = ($prd - $rem) / $dd; + $car = $rem; + unshift @$d, $tmp; } } else { @$d = @$x; @@ -762,29 +740,29 @@ sub _div_use_mul { sub _div_use_div_64 { # ref to array, ref to array, modify first array and return remainder if # in list context - # This version works on 64 bit integers - my ($c, $x, $yorg) = @_; + # This version works on integers use integer; + + my ($c, $x, $yorg) = @_; + # the general div algorithm here is about O(N*N) and thus quite slow, so # we first check for some special cases and use shortcuts to handle them. - # This works, because we store the numbers in a chunked format where each - # element contains 5..7 digits (depending on system). - # if both numbers have only one element: if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers if (wantarray) { my $rem = [ $x->[0] % $yorg->[0] ]; bless $rem, $c; - $x->[0] = int($x->[0] / $yorg->[0]); + $x->[0] = $x->[0] / $yorg->[0]; return ($x, $rem); } else { - $x->[0] = int($x->[0] / $yorg->[0]); + $x->[0] = $x->[0] / $yorg->[0]; return $x; } } + # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; @@ -797,78 +775,67 @@ sub _div_use_div_64 { my $b; while ($j-- > 0) { $b = $r * $BASE + $x->[$j]; - $x->[$j] = int($b/$y); $r = $b % $y; + $x->[$j] = $b / $y; } - pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero + pop(@$x) if @$x > 1 && $x->[-1] == 0; # remove any trailing zero return ($x, $rem) if wantarray; return $x; } + # now x and y have more than one element - # check whether y has more elements than x, if yet, the result will be 0 + # check whether y has more elements than x, if so, the result is 0 if (@$yorg > @$x) { my $rem; - $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? - return $x; # only x, which is [0] now + $rem = $c->_copy($x) if wantarray; # make copy + @$x = 0; # set to 0 + return ($x, $rem) if wantarray; # including remainder? + return $x; # only x, which is [0] now } + # check whether the numbers have the same number of elements, in that case # the result will fit into one element and can be computed efficiently if (@$yorg == @$x) { - my $rem; - # if $yorg has more digits than $x (it's leading element is longer than - # the one from $x), the result will also be 0: - if (length(int($yorg->[-1])) > length(int($x->[-1]))) { - $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? - return $x; + my $cmp = 0; + for (my $j = $#$x ; $j >= 0 ; --$j) { + last if $cmp = $x->[$j] - $yorg->[$j]; } - # now calculate $x / $yorg - if (length(int($yorg->[-1])) == length(int($x->[-1]))) { - # same length, so make full compare + if ($cmp == 0) { # x = y + @$x = 1; + return $x, $c->_zero() if wantarray; + return $x; + } - my $a = 0; - my $j = @$x - 1; - # manual way (abort if unequal, good for early ne) - while ($j >= 0) { - last if ($a = $x->[$j] - $yorg->[$j]); - $j--; - } - # $a contains the result of the compare between X and Y - # a < 0: x < y, a == 0: x == y, a > 0: x > y - if ($a <= 0) { - $rem = $c->_zero(); # a = 0 => x == y => rem 0 - $rem = $c->_copy($x) if $a != 0; # a < 0 => x < y => rem = x - @$x = 0; # if $a < 0 - $x->[0] = 1 if $a == 0; # $x == $y - return ($x, $rem) if wantarray; # including remainder? - return $x; + if ($cmp < 0) { # x < y + if (wantarray) { + my $rem = $c->_copy($x); + @$x = 0; + return $x, $rem; } - # $x >= $y, so proceed normally + @$x = 0; + return $x; } } # all other cases: - my $y = $c->_copy($yorg); # always make copy to preserve - - my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, $tmp, $q, $u2, $u1, $u0); + my $y = $c->_copy($yorg); # always make copy to preserve - $car = $bar = $prd = 0; - if (($dd = int($BASE / ($y->[-1] + 1))) != 1) { - for $xi (@$x) { + my $tmp; + my $dd = $BASE / ($y->[-1] + 1); + if ($dd != 1) { + my $car = 0; + for my $xi (@$x) { $xi = $xi * $dd + $car; - $xi -= ($car = int($xi / $BASE)) * $BASE; + $xi -= ($car = $xi / $BASE) * $BASE; } push(@$x, $car); $car = 0; - for $yi (@$y) { + for my $yi (@$y) { $yi = $yi * $dd + $car; - $yi -= ($car = int($yi / $BASE)) * $BASE; + $yi -= ($car = $yi / $BASE) * $BASE; } } else { push(@$x, 0); @@ -877,43 +844,48 @@ sub _div_use_div_64 { # @q will accumulate the final result, $q contains the current computed # part of the final result - @q = (); - ($v2, $v1) = @$y[-2, -1]; + my @q = (); + my ($v2, $v1) = @$y[-2, -1]; $v2 = 0 unless $v2; while ($#$x > $#$y) { - ($u2, $u1, $u0) = @$x[-3..-1]; + my ($u2, $u1, $u0) = @$x[-3 .. -1]; $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; - $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1)); - --$q while ($v2 * $q > ($u0 * $BASE +$ u1- $q*$v1) * $BASE + $u2); + my $tmp = $u0 * $BASE + $u1; + my $rem = $tmp % $v1; + my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1); + --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2; if ($q) { - ($car, $bar) = (0, 0); - for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { + my $prd; + my ($car, $bar) = (0, 0); + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $prd = $q * $y->[$yi] + $car; $prd -= ($car = int($prd / $BASE)) * $BASE; - $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; - for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $x->[$xi] -= $BASE - if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); + if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE); } } } pop(@$x); unshift(@q, $q); } + if (wantarray) { my $d = bless [], $c; if ($dd != 1) { - $car = 0; - for $xi (reverse @$x) { + my $car = 0; + my $prd; + for my $xi (reverse @$x) { $prd = $car * $BASE + $xi; - $car = $prd - ($tmp = int($prd / $dd)) * $dd; - unshift(@$d, $tmp); + $car = $prd - ($tmp = $prd / $dd) * $dd; + unshift @$d, $tmp; } } else { @$d = @$x; @@ -931,27 +903,22 @@ sub _div_use_div_64 { sub _div_use_div { # ref to array, ref to array, modify first array and return remainder if # in list context + my ($c, $x, $yorg) = @_; # the general div algorithm here is about O(N*N) and thus quite slow, so # we first check for some special cases and use shortcuts to handle them. - # This works, because we store the numbers in a chunked format where each - # element contains 5..7 digits (depending on system). - # if both numbers have only one element: if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers - if (wantarray) { - my $rem = [ $x->[0] % $yorg->[0] ]; - bless $rem, $c; - $x->[0] = int($x->[0] / $yorg->[0]); - return ($x, $rem); - } else { - $x->[0] = int($x->[0] / $yorg->[0]); - return $x; - } + my $rem = [ $x->[0] % $yorg->[0] ]; + bless $rem, $c; + $x->[0] = ($x->[0] - $rem->[0]) / $yorg->[0]; + return ($x, $rem) if wantarray; + return $x; } + # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; @@ -964,80 +931,72 @@ sub _div_use_div { my $b; while ($j-- > 0) { $b = $r * $BASE + $x->[$j]; - $x->[$j] = int($b/$y); $r = $b % $y; + $x->[$j] = ($b - $r) / $y; } - pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero + pop(@$x) if @$x > 1 && $x->[-1] == 0; # remove any trailing zero return ($x, $rem) if wantarray; return $x; } + # now x and y have more than one element - # check whether y has more elements than x, if yet, the result will be 0 + # check whether y has more elements than x, if so, the result is 0 if (@$yorg > @$x) { my $rem; - $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? - return $x; # only x, which is [0] now + $rem = $c->_copy($x) if wantarray; # make copy + @$x = 0; # set to 0 + return ($x, $rem) if wantarray; # including remainder? + return $x; # only x, which is [0] now } + # check whether the numbers have the same number of elements, in that case # the result will fit into one element and can be computed efficiently if (@$yorg == @$x) { - my $rem; - # if $yorg has more digits than $x (it's leading element is longer than - # the one from $x), the result will also be 0: - if (length(int($yorg->[-1])) > length(int($x->[-1]))) { - $rem = $c->_copy($x) if wantarray; # make copy - @$x = 0; # set to 0 - return ($x, $rem) if wantarray; # including remainder? - return $x; + my $cmp = 0; + for (my $j = $#$x ; $j >= 0 ; --$j) { + last if $cmp = $x->[$j] - $yorg->[$j]; } - # now calculate $x / $yorg - if (length(int($yorg->[-1])) == length(int($x->[-1]))) { - # same length, so make full compare + if ($cmp == 0) { # x = y + @$x = 1; + return $x, $c->_zero() if wantarray; + return $x; + } - my $a = 0; - my $j = @$x - 1; - # manual way (abort if unequal, good for early ne) - while ($j >= 0) { - last if ($a = $x->[$j] - $yorg->[$j]); - $j--; - } - # $a contains the result of the compare between X and Y - # a < 0: x < y, a == 0: x == y, a > 0: x > y - if ($a <= 0) { - $rem = $c->_zero(); # a = 0 => x == y => rem 0 - $rem = $c->_copy($x) if $a != 0; # a < 0 => x < y => rem = x + if ($cmp < 0) { # x < y + if (wantarray) { + my $rem = $c->_copy($x); @$x = 0; - $x->[0] = 0; # if $a < 0 - $x->[0] = 1 if $a == 0; # $x == $y - return ($x, $rem) if wantarray; # including remainder? - return $x; + return $x, $rem; } - # $x >= $y, so proceed normally - + @$x = 0; + return $x; } } # all other cases: - my $y = $c->_copy($yorg); # always make copy to preserve - - my ($car, $bar, $prd, $dd, $xi, $yi, @q, $v2, $v1, @d, $tmp, $q, $u2, $u1, $u0); + my $y = $c->_copy($yorg); # always make copy to preserve - $car = $bar = $prd = 0; - if (($dd = int($BASE / ($y->[-1] + 1))) != 1) { - for $xi (@$x) { + my $tmp = $y->[-1] + 1; + my $rem = $BASE % $tmp; + my $dd = ($BASE - $rem) / $tmp; + if ($dd != 1) { + my $car = 0; + for my $xi (@$x) { $xi = $xi * $dd + $car; - $xi -= ($car = int($xi / $BASE)) * $BASE; + $rem = $xi % $BASE; + $car = ($xi - $rem) / $BASE; + $xi = $rem; } push(@$x, $car); $car = 0; - for $yi (@$y) { + for my $yi (@$y) { $yi = $yi * $dd + $car; - $yi -= ($car = int($yi / $BASE)) * $BASE; + $rem = $yi % $BASE; + $car = ($yi - $rem) / $BASE; + $yi = $rem; } } else { push(@$x, 0); @@ -1046,43 +1005,52 @@ sub _div_use_div { # @q will accumulate the final result, $q contains the current computed # part of the final result - @q = (); - ($v2, $v1) = @$y[-2, -1]; + my @q = (); + my ($v2, $v1) = @$y[-2, -1]; $v2 = 0 unless $v2; while ($#$x > $#$y) { - ($u2, $u1, $u0) = @$x[-3..-1]; + my ($u2, $u1, $u0) = @$x[-3 .. -1]; $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; - $q = (($u0 == $v1) ? $MAX_VAL : int(($u0 * $BASE + $u1) / $v1)); - --$q while ($v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2); + my $tmp = $u0 * $BASE + $u1; + my $rem = $tmp % $v1; + my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1); + --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2; if ($q) { - ($car, $bar) = (0, 0); - for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { + my $prd; + my ($car, $bar) = (0, 0); + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $prd = $q * $y->[$yi] + $car; - $prd -= ($car = int($prd / $BASE)) * $BASE; - $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + $rem = $prd % $BASE; + $car = ($prd - $rem) / $BASE; + $prd -= $car * $BASE; + $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; - for ($yi = 0, $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { + for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) { $x->[$xi] -= $BASE - if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); + if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE); } } } pop(@$x); unshift(@q, $q); } + if (wantarray) { my $d = bless [], $c; if ($dd != 1) { - $car = 0; - for $xi (reverse @$x) { + my $car = 0; + my ($prd, $rem); + for my $xi (reverse @$x) { $prd = $car * $BASE + $xi; - $car = $prd - ($tmp = int($prd / $dd)) * $dd; - unshift(@$d, $tmp); + $rem = $prd % $dd; + $tmp = ($prd - $rem) / $dd; + $car = $rem; + unshift @$d, $tmp; } } else { @$d = @$x; @@ -1385,7 +1353,7 @@ sub _rsft { $dst++; } splice(@$x, $dst) if $dst > 0; # kill left-over array elems - pop @$x if $x->[-1] == 0 && @$x > 1; # kill last element if 0 + pop(@$x) if $x->[-1] == 0 && @$x > 1; # kill last element if 0 } # else rem == 0 $x; } @@ -1393,49 +1361,64 @@ sub _rsft { sub _lsft { my ($c, $x, $n, $b) = @_; - return $x if $c->_is_zero($x); - - # Handle the special case when the base is a power of 10. Don't check - # whether log($b)/log(10) is an integer, because log(1000)/log(10) is not - # exactly 3. - - my $log10 = sprintf "%.0f", log($b) / log(10); - if ($b == 10 ** $log10) { - $b = 10; - $n = $c->_mul($n, $c->_new($log10)); - - # shortcut (faster) for shifting by 10) since we are in base 10eX - # multiples of $BASE_LEN: - my $src = @$x; # source - my $len = $c->_num($n); # shift-len as normal int - my $rem = $len % $BASE_LEN; # remainder to shift - my $dst = $src + int($len / $BASE_LEN); # destination - my $vd; # further speedup - $x->[$src] = 0; # avoid first ||0 for speed - my $z = '0' x $BASE_LEN; - while ($src >= 0) { - $vd = $x->[$src]; - $vd = $z . $vd; - $vd = substr($vd, -$BASE_LEN + $rem, $BASE_LEN - $rem); - $vd .= $src > 0 ? substr($z . $x->[$src - 1], -$BASE_LEN, $rem) - : '0' x $rem; - $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN; - $x->[$dst] = int($vd); - $dst--; - $src--; + return $x if $c->_is_zero($x) || $c->_is_zero($n); + + # For backwards compatibility, allow the base $b to be a scalar. + + $b = $c->_new($b) unless ref $b; + + # If the base is a power of 10, use shifting, since the internal + # representation is in base 10eX. + + my $bstr = $c->_str($b); + if ($bstr =~ /^1(0+)\z/) { + + # Adjust $n so that we're shifting in base 10. Do this by multiplying + # $n by the base 10 logarithm of $b: $b ** $n = 10 ** (log10($b) * $n). + + my $log10b = length($1); + $n = $c->_mul($c->_new($log10b), $n); + $n = $c->_num($n); # shift-len as normal int + + # $q is the number of places to shift the elements within the array, + # and $r is the number of places to shift the values within the + # elements. + + my $r = $n % $BASE_LEN; + my $q = ($n - $r) / $BASE_LEN; + + # If we must shift the values within the elements ... + + if ($r) { + my $i = @$x; # index + $x->[$i] = 0; # initialize most significant element + my $z = '0' x $BASE_LEN; + my $vd; + while ($i >= 0) { + $vd = $x->[$i]; + $vd = $z . $vd; + $vd = substr($vd, $r - $BASE_LEN, $BASE_LEN - $r); + $vd .= $i > 0 ? substr($z . $x->[$i - 1], -$BASE_LEN, $r) + : '0' x $r; + $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN; + $x->[$i] = int($vd); # e.g., "0...048" -> 48 etc. + $i--; + } + + pop(@$x) if $x->[-1] == 0; # if most significant element is zero } - # set lowest parts to 0 - while ($dst >= 0) { - $x->[$dst--] = 0; + + # If we must shift the elements within the array ... + + if ($q) { + unshift @$x, (0) x $q; } - # fix spurious last zero element - splice @$x, -1 if $x->[-1] == 0; - return $x; + } else { - $b = $c->_new($b); - #print $c->_str($b); - return $c->_mul($x, $c->_pow($b, $n)); + $x = $c->_mul($x, $c->_pow($b, $n)); } + + return $x; } sub _pow { diff --git a/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm b/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm index 883f31f4c9..619c8d9aab 100644 --- a/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm +++ b/cpan/Math-BigInt/lib/Math/BigInt/Lib.pm @@ -4,7 +4,7 @@ use 5.006001; use strict; use warnings; -our $VERSION = '1.999816'; +our $VERSION = '1.999817'; use Carp; @@ -251,13 +251,6 @@ use overload ; -# Do we need api_version() at all, now that we have a virtual parent class that -# will provide any missing methods? Fixme! - -sub api_version () { - croak "@{[(caller 0)[3]]} method not implemented"; -} - sub _new { croak "@{[(caller 0)[3]]} method not implemented"; } @@ -386,6 +379,20 @@ sub _digit { substr($class ->_str($x), -($n+1), 1); } +sub _digitsum { + my ($class, $x) = @_; + + my $len = $class -> _len($x); + my $sum = $class -> _zero(); + for (my $i = 0 ; $i < $len ; ++$i) { + my $digit = $class -> _digit($x, $i); + $digit = $class -> _new($digit); + $sum = $class -> _add($sum, $digit); + } + + return $sum; +} + sub _zeros { my ($class, $x) = @_; my $str = $class -> _str($x); @@ -1428,16 +1435,20 @@ sub _to_base { if (@_) { $collseq = shift(); } else { - if ($class -> _acmp($base, $class -> _new("62")) <= 0) { - $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - . 'abcdefghijklmnopqrstuvwxyz'; + if ($class -> _acmp($base, $class -> _new("94")) <= 0) { + $collseq = '0123456789' # 48 .. 57 + . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' # 65 .. 90 + . 'abcdefghijklmnopqrstuvwxyz' # 97 .. 122 + . '!"#$%&\'()*+,-./' # 33 .. 47 + . ':;<=>?@' # 58 .. 64 + . '[\\]^_`' # 91 .. 96 + . '{|}~'; # 123 .. 126 } else { - croak "When base > 62, a collation sequence must be given"; + croak "When base > 94, a collation sequence must be given"; } } my @collseq = split '', $collseq; - my %collseq = map { $_ => $collseq[$_] } 0 .. $#collseq; my $str = ''; my $tmp = $class -> _copy($x); @@ -1573,11 +1584,16 @@ sub _from_base { if ($class -> _acmp($base, $class -> _new("36")) <= 0) { $str = uc $str; $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; - } elsif ($class -> _acmp($base, $class -> _new("62")) <= 0) { - $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - . 'abcdefghijklmnopqrstuvwxyz'; + } elsif ($class -> _acmp($base, $class -> _new("94")) <= 0) { + $collseq = '0123456789' # 48 .. 57 + . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' # 65 .. 90 + . 'abcdefghijklmnopqrstuvwxyz' # 97 .. 122 + . '!"#$%&\'()*+,-./' # 33 .. 47 + . ':;<=>?@' # 58 .. 64 + . '[\\]^_`' # 91 .. 96 + . '{|}~'; # 123 .. 126 } else { - croak "When base > 62, a collation sequence must be given"; + croak "When base > 94, a collation sequence must be given"; } $collseq = substr $collseq, 0, $class -> _num($base); } @@ -1920,11 +1936,8 @@ comparison routines. =item CLASS-E<gt>api_version() -Return API version as a Perl scalar, 1 for Math::BigInt v1.70, 2 for -Math::BigInt v1.83. - -This method is no longer used. Methods that are not implemented by a subclass -will be inherited from this class. +This method is no longer used and can be omitted. Methods that are not +implemented by a subclass will be inherited from this class. =back @@ -1986,10 +1999,20 @@ COLLSEQ. Each character in STR represents a numerical value identical to the character's position in COLLSEQ. All characters in STR must be present in COLLSEQ. -If BASE is less than or equal to 62, and a collation sequence is not specified, -a default collation sequence consisting of the 62 characters 0..9, A..Z, and -a..z is used. If the default collation sequence is used, and the BASE is less -than or equal to 36, the letter case in STR is ignored. +If BASE is less than or equal to 94, and a collation sequence is not specified, +the following default collation sequence is used. It contains of all the 94 +printable ASCII characters except space/blank: + + 0123456789 # ASCII 48 to 57 + ABCDEFGHIJKLMNOPQRSTUVWXYZ # ASCII 65 to 90 + abcdefghijklmnopqrstuvwxyz # ASCII 97 to 122 + !"#$%&'()*+,-./ # ASCII 33 to 47 + :;<=>?@ # ASCII 58 to 64 + [\]^_` # ASCII 91 to 96 + {|}~ # ASCII 123 to 126 + +If the default collation sequence is used, and the BASE is less than or equal +to 36, the letter case in STR is ignored. For instance, with base 3 and collation sequence "-/|", the character "-" represents 0, "/" represents 1, and "|" represents 2. So if STR is "/|-", the @@ -2005,10 +2028,12 @@ conversion. All examples return 250. Some more examples, all returning 250: - $x = $class -> _from_base("100021", 3, "012") - $x = $class -> _from_base("3322", 4, "0123") - $x = $class -> _from_base("2000", 5, "01234") + $x = $class -> _from_base("100021", 3) + $x = $class -> _from_base("3322", 4) + $x = $class -> _from_base("2000", 5) $x = $class -> _from_base("caaa", 5, "abcde") + $x = $class -> _from_base("42", 62) + $x = $class -> _from_base("2!", 94) =back @@ -2301,6 +2326,10 @@ from the left (most significant digit). If $obj represents the number 123, then CLASS->_digit($obj, 2) # returns 1 CLASS->_digit($obj, -1) # returns 1 +=item CLASS-E<gt>_digitsum(OBJ) + +Returns the sum of the base 10 digits. + =item CLASS-E<gt>_check(OBJ) Returns true if the object is invalid and false otherwise. Preferably, the true @@ -2394,11 +2423,11 @@ L<http://annocpan.org/dist/Math-BigInt> =item * CPAN Ratings -L<http://cpanratings.perl.org/dist/Math-BigInt> +L<https://cpanratings.perl.org/dist/Math-BigInt> -=item * Search CPAN +=item * MetaCPAN -L<http://search.cpan.org/dist/Math-BigInt/> +L<https://metacpan.org/release/Math-BigInt> =item * CPAN Testers Matrix diff --git a/cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm b/cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm index 73b79d94fb..f521e52e23 100644 --- a/cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm +++ b/cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm @@ -17,11 +17,6 @@ my $BASE_LEN = 9; my $BASE = 0 + ("1" . ("0" x $BASE_LEN)); my $MAX_VAL = $BASE - 1; -# Do we need api_version() at all, now that we have a virtual parent class that -# will provide any missing methods? Fixme! - -sub api_version () { 2; } - sub _new { my ($class, $str) = @_; croak "Invalid input string '$str'" unless $str =~ /^([1-9]\d*|0)\z/; @@ -490,529 +485,4 @@ sub _check { return 0; } -############################################################################## -############################################################################## - 1; - -__END__ - -=pod - -=head1 NAME - -Math::BigInt::Calc - Pure Perl module to support Math::BigInt - -=head1 SYNOPSIS - -This library provides support for big integer calculations. It is not -intended to be used by other modules. Other modules which support the same -API (see below) can also be used to support Math::BigInt, like -Math::BigInt::GMP and Math::BigInt::Pari. - -=head1 DESCRIPTION - -In this library, the numbers are represented in base B = 10**N, where N is -the largest possible value that does not cause overflow in the intermediate -computations. The base B elements are stored in an array, with the least -significant element stored in array element zero. There are no leading zero -elements, except a single zero element when the number is zero. - -For instance, if B = 10000, the number 1234567890 is represented internally -as [3456, 7890, 12]. - -=head1 THE Math::BigInt API - -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 -conforms to the API can be used by Math::BigInt by using this in your program: - - use Math::BigInt lib => 'libname'; - -'libname' is either the long name, like 'Math::BigInt::Pari', or only the short -version, like 'Pari'. - -=head2 General Notes - -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. - -For some methods, the first parameter can be modified. That includes the -possibility that you return a reference to a completely different object -instead. Although keeping the reference and just changing its contents is -preferred over creating and returning a different reference. - -Return values are always objects, strings, Perl scalars, or true/false for -comparison routines. - -=head2 API version 1 - -The following methods must be defined in order to support the use by -Math::BigInt v1.70 or later. - -=head3 API version - -=over 4 - -=item I<api_version()> - -Return API version as a Perl scalar, 1 for Math::BigInt v1.70, 2 for -Math::BigInt v1.83. - -=back - -=head3 Constructors - -=over 4 - -=item I<_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 -C<^(0|[1-9]\d*)$>. - -=item I<_zero()> - -Return an object representing the number zero. - -=item I<_one()> - -Return an object representing the number one. - -=item I<_two()> - -Return an object representing the number two. - -=item I<_ten()> - -Return an object representing the number ten. - -=item I<_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 I<_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 I<_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]*)$>. - -=back - -=head3 Mathematical functions - -Each of these methods may modify the first input argument, except I<_bgcd()>, -which shall not modify any input argument, and I<_sub()> which may modify the -second input argument. - -=over 4 - -=item I<_add(OBJ1, OBJ2)> - -Returns the result of adding OBJ2 to OBJ1. - -=item I<_mul(OBJ1, OBJ2)> - -Returns the result of multiplying OBJ2 and OBJ1. - -=item I<_div(OBJ1, OBJ2)> - -Returns the result of dividing OBJ1 by OBJ2 and truncating the result to an -integer. - -=item I<_sub(OBJ1, OBJ2, FLAG)> - -=item I<_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 I<_dec(OBJ)> - -Decrement OBJ by one. - -=item I<_inc(OBJ)> - -Increment OBJ by one. - -=item I<_mod(OBJ1, OBJ2)> - -Return OBJ1 modulo OBJ2, i.e., the remainder after dividing OBJ1 by OBJ2. - -=item I<_sqrt(OBJ)> - -Return the square root of the object, truncated to integer. - -=item I<_root(OBJ, N)> - -Return Nth root of the object, truncated to int. N is E<gt>= 3. - -=item I<_fac(OBJ)> - -Return factorial of object (1*2*3*4*...). - -=item I<_pow(OBJ1, OBJ2)> - -Return OBJ1 to the power of OBJ2. By convention, 0**0 = 1. - -=item I<_modinv(OBJ1, OBJ2)> - -Return 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 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. - -=item I<_modpow(OBJ1, OBJ2, OBJ3)> - -Return modular exponentiation, (OBJ1 ** OBJ2) % OBJ3. - -=item I<_rsft(OBJ, N, B)> - -Shift object N digits right in base B and return the resulting object. 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. - -For instance, if the object $obj represents the hexadecimal number 0xabcde, -then C<< $obj->_rsft(2, 16) >> returns an object representing the number 0xabc. -The "remainer", 0xde, is discarded and not returned. - -=item I<_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. - -=item I<_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. - -=item I<_gcd(OBJ1, OBJ2)> - -Return the greatest common divisor of OBJ1 and OBJ2. - -=back - -=head3 Bitwise operators - -Each of these methods may modify the first input argument. - -=over 4 - -=item I<_and(OBJ1, OBJ2)> - -Return bitwise and. If necessary, the smallest number is padded with leading -zeros. - -=item I<_or(OBJ1, OBJ2)> - -Return bitwise or. If necessary, the smallest number is padded with leading -zeros. - -=item I<_xor(OBJ1, OBJ2)> - -Return bitwise exclusive or. If necessary, the smallest number is padded -with leading zeros. - -=back - -=head3 Boolean operators - -=over 4 - -=item I<_is_zero(OBJ)> - -Returns a true value if OBJ is zero, and false value otherwise. - -=item I<_is_one(OBJ)> - -Returns a true value if OBJ is one, and false value otherwise. - -=item I<_is_two(OBJ)> - -Returns a true value if OBJ is two, and false value otherwise. - -=item I<_is_ten(OBJ)> - -Returns a true value if OBJ is ten, and false value otherwise. - -=item I<_is_even(OBJ)> - -Return a true value if OBJ is an even integer, and a false value otherwise. - -=item I<_is_odd(OBJ)> - -Return a true value if OBJ is an even integer, and a false value otherwise. - -=item I<_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. - -=back - -=head3 String conversion - -=over 4 - -=item I<_str(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*)$>. - -=item I<_as_bin(OBJ)> - -Return the binary string representation of the number. The string must have a -'0b' prefix. - -=item I<_as_oct(OBJ)> - -Return the octal string representation of the number. The string must have -a '0x' prefix. - -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 I<_as_hex(OBJ)> - -Return the hexadecimal string representation of the number. The string must -have a '0x' prefix. - -=back - -=head3 Numeric conversion - -=over 4 - -=item I<_num(OBJ)> - -Given an object, return a Perl scalar number (int/float) representing this -number. - -=back - -=head3 Miscellaneous - -=over 4 - -=item I<_copy(OBJ)> - -Return a true copy of the object. - -=item I<_len(OBJ)> - -Returns the number of the decimal digits in the number. The output is a -Perl scalar. - -=item I<_zeros(OBJ)> - -Return the number of trailing decimal zeros. The output is a Perl scalar. - -=item I<_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. - -=item I<_check(OBJ)> - -Return a true value if the object is OK, and a false value otherwise. This is a -check routine to test the internal state of the object for corruption. - -=back - -=head2 API version 2 - -The following methods are required for an API version of 2 or greater. - -=head3 Constructors - -=over 4 - -=item I<_1ex(N)> - -Return an object representing the number 10**N where N E<gt>= 0 is a Perl -scalar. - -=back - -=head3 Mathematical functions - -=over 4 - -=item I<_nok(OBJ1, OBJ2)> - -Return the binomial coefficient OBJ1 over OBJ1. - -=back - -=head3 Miscellaneous - -=over 4 - -=item I<_alen(OBJ)> - -Return the approximate number of decimal digits of the object. The output is -one Perl scalar. - -=back - -=head2 API optional methods - -The following methods are optional, and can be defined if the underlying lib -has a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence -slow) fallback routines to emulate these: - -=head3 Signed bitwise operators. - -Each of these methods may modify the first input argument. - -=over 4 - -=item I<_signed_or(OBJ1, OBJ2, SIGN1, SIGN2)> - -Return the signed bitwise or. - -=item I<_signed_and(OBJ1, OBJ2, SIGN1, SIGN2)> - -Return the signed bitwise and. - -=item I<_signed_xor(OBJ1, OBJ2, SIGN1, SIGN2)> - -Return the signed bitwise exclusive or. - -=back - -=head1 WRAP YOUR OWN - -If you want to port your own favourite c-lib for big numbers to the -Math::BigInt interface, you can take any of the already existing modules as a -rough guideline. You should really wrap up the latest Math::BigInt and -Math::BigFloat testsuites with your module, and replace in them any of the -following: - - use Math::BigInt; - -by this: - - use Math::BigInt lib => 'yourlib'; - -This way you ensure that your library really works 100% within Math::BigInt. - -=head1 BUGS - -Please report any bugs or feature requests to -C<bug-math-bigint at rt.cpan.org>, or through the web interface at -L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt> -(requires login). -We will be notified, and then you'll automatically be notified of progress on -your bug as I make changes. - -=head1 SUPPORT - -You can find documentation for this module with the perldoc command. - - perldoc Math::BigInt::Calc - -You can also look for information at: - -=over 4 - -=item * RT: CPAN's request tracker - -L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt> - -=item * AnnoCPAN: Annotated CPAN documentation - -L<http://annocpan.org/dist/Math-BigInt> - -=item * CPAN Ratings - -L<http://cpanratings.perl.org/dist/Math-BigInt> - -=item * Search CPAN - -L<http://search.cpan.org/dist/Math-BigInt/> - -=item * CPAN Testers Matrix - -L<http://matrix.cpantesters.org/?dist=Math-BigInt> - -=item * The Bignum mailing list - -=over 4 - -=item * Post to mailing list - -C<bignum at lists.scsys.co.uk> - -=item * View mailing list - -L<http://lists.scsys.co.uk/pipermail/bignum/> - -=item * Subscribe/Unsubscribe - -L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum> - -=back - -=back - -=head1 LICENSE - -This program is free software; you may redistribute it and/or modify it under -the same terms as Perl itself. - -=head1 AUTHORS - -=over 4 - -=item * - -Original math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/> -in late 2000. - -=item * - -Separated from BigInt and shaped API with the help of John Peacock. - -=item * - -Fixed, speed-up, streamlined and enhanced by Tels 2001 - 2007. - -=item * - -API documentation corrected and extended by Peter John Acklam, -E<lt>pjacklam@online.noE<gt> - -=back - -=head1 SEE ALSO - -L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::GMP>, -L<Math::BigInt::FastCalc> and L<Math::BigInt::Pari>. - -=cut diff --git a/cpan/Math-BigInt/t/Math/BigInt/Scalar.pm b/cpan/Math-BigInt/t/Math/BigInt/Scalar.pm index 1bfd338d98..d703806bcc 100644 --- a/cpan/Math-BigInt/t/Math/BigInt/Scalar.pm +++ b/cpan/Math-BigInt/t/Math/BigInt/Scalar.pm @@ -14,8 +14,6 @@ our @ISA = qw(Exporter); our $VERSION = '0.13'; -sub api_version() { 1; } - ############################################################################## # global constants, flags and accessory diff --git a/cpan/Math-BigInt/t/backermann-mbi.t b/cpan/Math-BigInt/t/backermann-mbi.t new file mode 100644 index 0000000000..45fcac6dbd --- /dev/null +++ b/cpan/Math-BigInt/t/backermann-mbi.t @@ -0,0 +1,507 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 858; + +my $class; + +BEGIN { + $class = 'Math::BigInt'; + use_ok($class); +} + +can_ok($class, 'backermann', 'ackermann'); + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($m, $n, $expected) = split /:/; + + # backermann() modifies the invocand. + + { + my ($x, $y); + my $test = qq|\$x = $class->new("$m"); \$y = \$x->backermann("$n");|; + + subtest $test, + sub { + plan tests => 4; + + eval $test; + is($@, "", "'$test' gives emtpy \$\@"); + + is(ref($y), $class, + "'$test' output arg is a $class"); + + is($y -> bstr(), $expected, + "'$test' output arg has the right value"); + + is($x -> bstr(), $expected, + "'$test' invocand has the right value"); + }; + } + + # ackermann() does not modify the invocand. + + { + my ($x, $y); + my $test = qq|\$x = $class->new("$m"); \$y = \$x->ackermann("$n");|; + + subtest $test, + sub { + plan tests => 4; + + eval $test; + is($@, "", "'$test' gives emtpy \$\@"); + + is(ref($y), $class, + "'$test' output arg is a $class"); + + is($y -> bstr(), $expected, + "'$test' output arg has the right value"); + + is($x -> bstr(), $m, + "'$test' invocand has the right value"); + }; + } +} + +__DATA__ + +0:0:1 +0:1:2 +0:2:3 +0:3:4 +0:4:5 +0:5:6 +0:6:7 +0:7:8 +0:8:9 +0:9:10 +0:10:11 +0:11:12 +0:12:13 +0:13:14 +0:14:15 +0:15:16 +0:16:17 +0:17:18 +0:18:19 +0:19:20 +0:20:21 +0:21:22 +0:22:23 +0:23:24 +0:24:25 +0:25:26 +0:26:27 +0:27:28 +0:28:29 +0:29:30 +0:30:31 +0:31:32 +0:32:33 +0:33:34 +0:34:35 +0:35:36 +0:36:37 +0:37:38 +0:38:39 +0:39:40 +0:40:41 +0:41:42 +0:42:43 +0:43:44 +0:44:45 +0:45:46 +0:46:47 +0:47:48 +0:48:49 +0:49:50 +0:50:51 +0:51:52 +0:52:53 +0:53:54 +0:54:55 +0:55:56 +0:56:57 +0:57:58 +0:58:59 +0:59:60 +0:60:61 +0:61:62 +0:62:63 +0:63:64 +0:64:65 +0:65:66 +0:66:67 +0:67:68 +0:68:69 +0:69:70 +0:70:71 +0:71:72 +0:72:73 +0:73:74 +0:74:75 +0:75:76 +0:76:77 +0:77:78 +0:78:79 +0:79:80 +0:80:81 +0:81:82 +0:82:83 +0:83:84 +0:84:85 +0:85:86 +0:86:87 +0:87:88 +0:88:89 +0:89:90 +0:90:91 +0:91:92 +0:92:93 +0:93:94 +0:94:95 +0:95:96 +0:96:97 +0:97:98 +0:98:99 +0:99:100 +0:100:101 +0:1000:1001 +0:100000:100001 +0:10000000:10000001 +0:10000000000:10000000001 +0:10000000000000:10000000000001 +0:10000000000000000000000000000000000:10000000000000000000000000000000001 +0:12345678987654321012345678987654321:12345678987654321012345678987654322 + +1:0:2 +1:1:3 +1:2:4 +1:3:5 +1:4:6 +1:5:7 +1:6:8 +1:7:9 +1:8:10 +1:9:11 +1:10:12 +1:11:13 +1:12:14 +1:13:15 +1:14:16 +1:15:17 +1:16:18 +1:17:19 +1:18:20 +1:19:21 +1:20:22 +1:21:23 +1:22:24 +1:23:25 +1:24:26 +1:25:27 +1:26:28 +1:27:29 +1:28:30 +1:29:31 +1:30:32 +1:31:33 +1:32:34 +1:33:35 +1:34:36 +1:35:37 +1:36:38 +1:37:39 +1:38:40 +1:39:41 +1:40:42 +1:41:43 +1:42:44 +1:43:45 +1:44:46 +1:45:47 +1:46:48 +1:47:49 +1:48:50 +1:49:51 +1:50:52 +1:51:53 +1:52:54 +1:53:55 +1:54:56 +1:55:57 +1:56:58 +1:57:59 +1:58:60 +1:59:61 +1:60:62 +1:61:63 +1:62:64 +1:63:65 +1:64:66 +1:65:67 +1:66:68 +1:67:69 +1:68:70 +1:69:71 +1:70:72 +1:71:73 +1:72:74 +1:73:75 +1:74:76 +1:75:77 +1:76:78 +1:77:79 +1:78:80 +1:79:81 +1:80:82 +1:81:83 +1:82:84 +1:83:85 +1:84:86 +1:85:87 +1:86:88 +1:87:89 +1:88:90 +1:89:91 +1:90:92 +1:91:93 +1:92:94 +1:93:95 +1:94:96 +1:95:97 +1:96:98 +1:97:99 +1:98:100 +1:99:101 +1:100:102 +1:1000:1002 +1:100000:100002 +1:10000000:10000002 +1:10000000000:10000000002 +1:10000000000000:10000000000002 +1:10000000000000000000000000000000000:10000000000000000000000000000000002 +1:12345678987654321012345678987654321:12345678987654321012345678987654323 + +2:0:3 +2:1:5 +2:2:7 +2:3:9 +2:4:11 +2:5:13 +2:6:15 +2:7:17 +2:8:19 +2:9:21 +2:10:23 +2:11:25 +2:12:27 +2:13:29 +2:14:31 +2:15:33 +2:16:35 +2:17:37 +2:18:39 +2:19:41 +2:20:43 +2:21:45 +2:22:47 +2:23:49 +2:24:51 +2:25:53 +2:26:55 +2:27:57 +2:28:59 +2:29:61 +2:30:63 +2:31:65 +2:32:67 +2:33:69 +2:34:71 +2:35:73 +2:36:75 +2:37:77 +2:38:79 +2:39:81 +2:40:83 +2:41:85 +2:42:87 +2:43:89 +2:44:91 +2:45:93 +2:46:95 +2:47:97 +2:48:99 +2:49:101 +2:50:103 +2:51:105 +2:52:107 +2:53:109 +2:54:111 +2:55:113 +2:56:115 +2:57:117 +2:58:119 +2:59:121 +2:60:123 +2:61:125 +2:62:127 +2:63:129 +2:64:131 +2:65:133 +2:66:135 +2:67:137 +2:68:139 +2:69:141 +2:70:143 +2:71:145 +2:72:147 +2:73:149 +2:74:151 +2:75:153 +2:76:155 +2:77:157 +2:78:159 +2:79:161 +2:80:163 +2:81:165 +2:82:167 +2:83:169 +2:84:171 +2:85:173 +2:86:175 +2:87:177 +2:88:179 +2:89:181 +2:90:183 +2:91:185 +2:92:187 +2:93:189 +2:94:191 +2:95:193 +2:96:195 +2:97:197 +2:98:199 +2:99:201 +2:100:203 +2:1000:2003 +2:100000:200003 +2:10000000:20000003 +2:10000000000:20000000003 +2:10000000000000:20000000000003 +2:10000000000000000000000000000000000:20000000000000000000000000000000003 +2:12345678987654321012345678987654321:24691357975308642024691357975308645 + +3:0:5 +3:1:13 +3:2:29 +3:3:61 +3:4:125 +3:5:253 +3:6:509 +3:7:1021 +3:8:2045 +3:9:4093 +3:10:8189 +3:11:16381 +3:12:32765 +3:13:65533 +3:14:131069 +3:15:262141 +3:16:524285 +3:17:1048573 +3:18:2097149 +3:19:4194301 +3:20:8388605 +3:21:16777213 +3:22:33554429 +3:23:67108861 +3:24:134217725 +3:25:268435453 +3:26:536870909 +3:27:1073741821 +3:28:2147483645 +3:29:4294967293 +3:30:8589934589 +3:31:17179869181 +3:32:34359738365 +3:33:68719476733 +3:34:137438953469 +3:35:274877906941 +3:36:549755813885 +3:37:1099511627773 +3:38:2199023255549 +3:39:4398046511101 +3:40:8796093022205 +3:41:17592186044413 +3:42:35184372088829 +3:43:70368744177661 +3:44:140737488355325 +3:45:281474976710653 +3:46:562949953421309 +3:47:1125899906842621 +3:48:2251799813685245 +3:49:4503599627370493 +3:50:9007199254740989 +3:51:18014398509481981 +3:52:36028797018963965 +3:53:72057594037927933 +3:54:144115188075855869 +3:55:288230376151711741 +3:56:576460752303423485 +3:57:1152921504606846973 +3:58:2305843009213693949 +3:59:4611686018427387901 +3:60:9223372036854775805 +3:61:18446744073709551613 +3:62:36893488147419103229 +3:63:73786976294838206461 +3:64:147573952589676412925 +3:65:295147905179352825853 +3:66:590295810358705651709 +3:67:1180591620717411303421 +3:68:2361183241434822606845 +3:69:4722366482869645213693 +3:70:9444732965739290427389 +3:71:18889465931478580854781 +3:72:37778931862957161709565 +3:73:75557863725914323419133 +3:74:151115727451828646838269 +3:75:302231454903657293676541 +3:76:604462909807314587353085 +3:77:1208925819614629174706173 +3:78:2417851639229258349412349 +3:79:4835703278458516698824701 +3:80:9671406556917033397649405 +3:81:19342813113834066795298813 +3:82:38685626227668133590597629 +3:83:77371252455336267181195261 +3:84:154742504910672534362390525 +3:85:309485009821345068724781053 +3:86:618970019642690137449562109 +3:87:1237940039285380274899124221 +3:88:2475880078570760549798248445 +3:89:4951760157141521099596496893 +3:90:9903520314283042199192993789 +3:91:19807040628566084398385987581 +3:92:39614081257132168796771975165 +3:93:79228162514264337593543950333 +3:94:158456325028528675187087900669 +3:95:316912650057057350374175801341 +3:96:633825300114114700748351602685 +3:97:1267650600228229401496703205373 +3:98:2535301200456458802993406410749 +3:99:5070602400912917605986812821501 +3:100:10141204801825835211973625643005 + +4:0:13 +4:1:65533 + +5:0:65533 diff --git a/cpan/Math-BigInt/t/bare_mbf.t b/cpan/Math-BigInt/t/bare_mbf.t index 51377400c1..c8184cb861 100644 --- a/cpan/Math-BigInt/t/bare_mbf.t +++ b/cpan/Math-BigInt/t/bare_mbf.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 2818; +use Test::More tests => 2830; use lib 't'; diff --git a/cpan/Math-BigInt/t/bare_mbi.t b/cpan/Math-BigInt/t/bare_mbi.t index 7003104913..7c24404738 100644 --- a/cpan/Math-BigInt/t/bare_mbi.t +++ b/cpan/Math-BigInt/t/bare_mbi.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 4026; # tests in require'd file +use Test::More tests => 4038; # tests in require'd file use lib 't'; diff --git a/cpan/Math-BigInt/t/bdigitsum-mbi.t b/cpan/Math-BigInt/t/bdigitsum-mbi.t new file mode 100644 index 0000000000..45c9bd7256 --- /dev/null +++ b/cpan/Math-BigInt/t/bdigitsum-mbi.t @@ -0,0 +1,113 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 48; + +use Math::BigInt; + +my $x; +my $y; + +############################################################################### +# bdigitsum() + +# Finite numbers. + +$x = Math::BigInt -> new("123"); +isa_ok($x, 'Math::BigInt'); +$y = $x -> bdigitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "6"); +is($y, "6"); + +$x = Math::BigInt -> new("0"); +isa_ok($x, 'Math::BigInt'); +$y = $x -> bdigitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "0"); +is($y, "0"); + +$x = Math::BigInt -> new("-123"); +isa_ok($x, 'Math::BigInt'); +$y = $x -> bdigitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "6"); +is($y, "6"); + +# Infinity + +$x = Math::BigInt -> binf("+"); +isa_ok($x, 'Math::BigInt'); +$y = $x -> bdigitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "NaN"); +is($y, "NaN"); + +$x = Math::BigInt -> binf("-"); +isa_ok($x, 'Math::BigInt'); +$y = $x -> bdigitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "NaN"); +is($y, "NaN"); + +# NaN + +$x = Math::BigInt -> bnan(); +isa_ok($x, 'Math::BigInt'); +$y = $x -> bdigitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "NaN"); +is($y, "NaN"); + +############################################################################### +# digitsum() + +# Finite numbers. + +$x = Math::BigInt -> new("123"); +isa_ok($x, 'Math::BigInt'); +$y = $x -> digitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "123"); +is($y, "6"); + +$x = Math::BigInt -> new("0"); +isa_ok($x, 'Math::BigInt'); +$y = $x -> digitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "0"); +is($y, "0"); + +$x = Math::BigInt -> new("-123"); +isa_ok($x, 'Math::BigInt'); +$y = $x -> digitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "-123"); +is($y, "6"); + +# Infinity + +$x = Math::BigInt -> binf("+"); +isa_ok($x, 'Math::BigInt'); +$y = $x -> digitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "inf"); +is($y, "NaN"); + +$x = Math::BigInt -> binf("-"); +isa_ok($x, 'Math::BigInt'); +$y = $x -> digitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "-inf"); +is($y, "NaN"); + +# NaN + +$x = Math::BigInt -> bnan(); +isa_ok($x, 'Math::BigInt'); +$y = $x -> digitsum(); +isa_ok($y, 'Math::BigInt'); +is($x, "NaN"); +is($y, "NaN"); diff --git a/cpan/Math-BigInt/t/bigfltpm.inc b/cpan/Math-BigInt/t/bigfltpm.inc index 4858e2e983..af6e422e88 100644 --- a/cpan/Math-BigInt/t/bigfltpm.inc +++ b/cpan/Math-BigInt/t/bigfltpm.inc @@ -37,7 +37,7 @@ while (<DATA>) { $try = qq|\$x = $CLASS->new("$args[0]");|; if ($f eq "bnorm") { $try .= qq| \$x;|; - } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) { + } elsif ($f =~ /^is_(zero|one|odd|even||(non_)?(negative|positive)|nan|int)$/) { $try .= qq| \$x->$f();|; } elsif ($f eq "is_inf") { $try .= qq| \$x->is_inf("$args[1]");|; @@ -2183,6 +2183,22 @@ NaN:0 -inf:1 +inf:0 +&is_non_positive +0:1 +1:0 +-1:1 +NaN:0 +-inf:1 ++inf:0 + +&is_non_negative +0:1 +1:1 +-1:0 +NaN:0 +-inf:0 ++inf:1 + &parts 0:0 0 1:1 0 diff --git a/cpan/Math-BigInt/t/bigfltpm.t b/cpan/Math-BigInt/t/bigfltpm.t index 992ee0416a..8b0079fedc 100644 --- a/cpan/Math-BigInt/t/bigfltpm.t +++ b/cpan/Math-BigInt/t/bigfltpm.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 2818 # tests in require'd file +use Test::More tests => 2830 # tests in require'd file + 19; # tests in this file use Math::BigInt only => 'Calc'; diff --git a/cpan/Math-BigInt/t/bigintc.t b/cpan/Math-BigInt/t/bigintc.t index 517da4601d..f9c16d233b 100644 --- a/cpan/Math-BigInt/t/bigintc.t +++ b/cpan/Math-BigInt/t/bigintc.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 379; +use Test::More tests => 460; use Math::BigInt::Calc; @@ -261,6 +261,27 @@ $y = $LIB->_new("45"); is($LIB->_str($LIB->_rsft($x, $y, 10)), 0, qq|$LIB->_str($LIB->_rsft(\$x, \$y, 10)) = 0|); +# _lsft() with large bases + +for my $xstr ("1", "2", "3") { + for my $nstr ("1", "2", "3") { + for my $bpow (25, 50, 75) { + my $bstr = "1" . ("0" x $bpow); + my $expected = $xstr . ("0" x ($bpow * $nstr)); + my $xobj = $LIB->_new($xstr); + my $nobj = $LIB->_new($nstr); + my $bobj = $LIB->_new($bstr); + + is($LIB->_str($LIB->_lsft($xobj, $nobj, $bobj)), $expected, + qq|$LIB->_str($LIB->_lsft($LIB->_new("$xstr"), | + . qq|$LIB->_new("$nstr"), | + . qq|$LIB->_new("$bstr")))|); + is($LIB->_str($nobj), $nstr, q|$n is unmodified|); + is($LIB->_str($bobj), $bstr, q|$b is unmodified|); + } + } +} + # _acmp $x = $LIB->_new("123456789"); diff --git a/cpan/Math-BigInt/t/bigintpm.inc b/cpan/Math-BigInt/t/bigintpm.inc index d98807f4bf..9dd331ab17 100644 --- a/cpan/Math-BigInt/t/bigintpm.inc +++ b/cpan/Math-BigInt/t/bigintpm.inc @@ -68,7 +68,7 @@ while (<DATA>) { $try = qq|\$x = $CLASS->new("$args[0]");|; if ($f eq "bnorm") { $try = qq|\$x = $CLASS->bnorm("$args[0]");|; - } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) { + } elsif ($f =~ /^is_(zero|one|odd|even|(non_)?(negative|positive)|nan|int)$/) { $try .= " \$x->$f() || 0;"; } elsif ($f eq "is_inf") { $try .= qq| \$x->is_inf("$args[1]");|; @@ -787,17 +787,26 @@ SKIP: { my @bl = $LIB->_base_len(); my $bl = $bl[5]; - $x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl; + # Compute the value. + $x = ('1' x $bl) . ('0' x $bl) . ('1' x $bl) . ('0' x $bl); $y = '1' x (2 * $bl); $x = $CLASS->new($x)->bmul($y); - # result is 123..$bl . $bl x (3*bl-1) . $bl...321 . '0' x $bl + + # Build the expected output. $y = ''; - my $d = ''; - for (my $i = 1; $i <= $bl; $i++) { - $y .= $i; - $d = $i . $d; + if ($bl >= 2) { + $y .= '123456790' x int(($bl - 2) / 9); + $y .= substr '123456790', 0, ($bl - 2) % 9; + $y .= ($bl - 1) % 9; + } + $y .= ((($bl - 1) % 9) + 1) x ($bl * 3); + if ($bl >= 2) { + $y .= substr '098765432', -(($bl - 1) % 9); + $y .= '098765432' x int(($bl - 2) / 9); } - $y .= $bl x (3 * $bl - 1) . $d . '0' x $bl; + $y .= '1'; + $y .= '0' x $bl; + is($x, $y, "testing number with a zero-hole of BASE_LEN_SMALL"); ######################################################################### @@ -1077,6 +1086,22 @@ invalid:0 -inf:0 invalid:0 +&is_non_negative +0:1 +-1:0 +1:1 ++inf:1 +-inf:0 +NaN:0 + +&is_non_positive +0:1 +-1:1 +1:0 ++inf:0 +-inf:1 +NaN:0 + &is_int -inf:0 +inf:0 @@ -2850,9 +2875,9 @@ abc:12:NaN -inf:NaN:NaN # -3:-inf:0 --3:-3:NaN --3:-2:NaN --3:-1:NaN +-3:-3:0 +-3:-2:0 +-3:-1:0 -3:0:1 -3:1:-3 -3:2:9 @@ -2861,9 +2886,9 @@ abc:12:NaN -3:NaN:NaN # -2:-inf:0 --2:-3:NaN --2:-2:NaN --2:-1:NaN +-2:-3:0 +-2:-2:0 +-2:-1:0 -2:0:1 -2:1:-2 -2:2:4 @@ -2905,9 +2930,9 @@ abc:12:NaN 1:NaN:NaN # 2:-inf:0 -2:-3:NaN -2:-2:NaN -2:-1:NaN +2:-3:0 +2:-2:0 +2:-1:0 2:0:1 2:1:2 2:2:4 @@ -2916,9 +2941,9 @@ abc:12:NaN 2:NaN:NaN # 3:-inf:0 -3:-3:NaN -3:-2:NaN -3:-1:NaN +3:-3:0 +3:-2:0 +3:-1:0 3:0:1 3:1:3 3:2:9 diff --git a/cpan/Math-BigInt/t/bigintpm.t b/cpan/Math-BigInt/t/bigintpm.t index 1616064745..7d05dc9e98 100644 --- a/cpan/Math-BigInt/t/bigintpm.t +++ b/cpan/Math-BigInt/t/bigintpm.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 4026 # tests in require'd file +use Test::More tests => 4038 # tests in require'd file + 20; # tests in this file use Math::BigInt only => 'Calc'; diff --git a/cpan/Math-BigInt/t/buparrow-mbi.t b/cpan/Math-BigInt/t/buparrow-mbi.t new file mode 100644 index 0000000000..c2eb2eec61 --- /dev/null +++ b/cpan/Math-BigInt/t/buparrow-mbi.t @@ -0,0 +1,581 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 1021; + +my $class; + +BEGIN { + $class = 'Math::BigInt'; + use_ok($class); +} + +while (<DATA>) { + s/#.*$//; # remove comments + s/\s+$//; # remove trailing whitespace + next unless length; # skip empty lines + + my ($a, $n, $b, $expected) = split /:/; + + # buparrow() modifies the invocand. + + { + my ($x, $y); + my $test = qq|\$x = $class->new("$a"); \$y = \$x->buparrow($n, $b);|; + + subtest $test, + sub { + plan tests => 4; + + eval $test; + is($@, "", "'$test' gives emtpy \$\@"); + + is(ref($y), $class, + "'$test' output arg is a $class"); + + is($y -> bstr(), $expected, + "'$test' output arg has the right value"); + + is($x -> bstr(), $expected, + "'$test' invocand has the right value"); + }; + } + + # uparrow() does not modify the invocand. + + { + my ($x, $y); + my $test = qq|\$x = $class->new("$a"); \$y = \$x->uparrow($n, $b);|; + + subtest $test, + sub { + plan tests => 4; + + eval $test; + is($@, "", "'$test' gives emtpy \$\@"); + + is(ref($y), $class, + "'$test' output arg is a $class"); + + is($y -> bstr(), $expected, + "'$test' output arg has the right value"); + + is($x -> bstr(), $a, + "'$test' invocand has the right value"); + }; + } +} + +__DATA__ +0:0:0:0 +0:0:1:0 +0:0:2:0 +0:0:3:0 +0:0:4:0 +0:0:5:0 +0:0:6:0 +0:0:7:0 +0:0:8:0 +0:0:9:0 +0:1:0:1 +0:1:1:0 +0:1:2:0 +0:1:3:0 +0:1:4:0 +0:1:5:0 +0:1:6:0 +0:1:7:0 +0:1:8:0 +0:1:9:0 +0:2:0:1 +0:2:1:0 +0:2:2:1 +0:2:3:0 +0:2:4:1 +0:2:5:0 +0:2:6:1 +0:2:7:0 +0:2:8:1 +0:2:9:0 +0:3:0:1 +0:3:1:0 +0:3:2:1 +0:3:3:0 +0:3:4:1 +0:3:5:0 +0:3:6:1 +0:3:7:0 +0:3:8:1 +0:3:9:0 +0:4:0:1 +0:4:1:0 +0:4:2:1 +0:4:3:0 +0:4:4:1 +0:4:5:0 +0:4:6:1 +0:4:7:0 +0:4:8:1 +0:4:9:0 +0:5:0:1 +0:5:1:0 +0:5:2:1 +0:5:3:0 +0:5:4:1 +0:5:5:0 +0:5:6:1 +0:5:7:0 +0:5:8:1 +0:5:9:0 +0:6:0:1 +0:6:1:0 +0:6:2:1 +0:6:3:0 +0:6:4:1 +0:6:5:0 +0:6:6:1 +0:6:7:0 +0:6:8:1 +0:6:9:0 +0:7:0:1 +0:7:1:0 +0:7:2:1 +0:7:3:0 +0:7:4:1 +0:7:5:0 +0:7:6:1 +0:7:7:0 +0:7:8:1 +0:7:9:0 +0:8:0:1 +0:8:1:0 +0:8:2:1 +0:8:3:0 +0:8:4:1 +0:8:5:0 +0:8:6:1 +0:8:7:0 +0:8:8:1 +0:8:9:0 +0:9:0:1 +0:9:1:0 +0:9:2:1 +0:9:3:0 +0:9:4:1 +0:9:5:0 +0:9:6:1 +0:9:7:0 +0:9:8:1 +0:9:9:0 +1:0:0:0 +1:0:1:1 +1:0:2:2 +1:0:3:3 +1:0:4:4 +1:0:5:5 +1:0:6:6 +1:0:7:7 +1:0:8:8 +1:0:9:9 +1:1:0:1 +1:1:1:1 +1:1:2:1 +1:1:3:1 +1:1:4:1 +1:1:5:1 +1:1:6:1 +1:1:7:1 +1:1:8:1 +1:1:9:1 +1:2:0:1 +1:2:1:1 +1:2:2:1 +1:2:3:1 +1:2:4:1 +1:2:5:1 +1:2:6:1 +1:2:7:1 +1:2:8:1 +1:2:9:1 +1:3:0:1 +1:3:1:1 +1:3:2:1 +1:3:3:1 +1:3:4:1 +1:3:5:1 +1:3:6:1 +1:3:7:1 +1:3:8:1 +1:3:9:1 +1:4:0:1 +1:4:1:1 +1:4:2:1 +1:4:3:1 +1:4:4:1 +1:4:5:1 +1:4:6:1 +1:4:7:1 +1:4:8:1 +1:4:9:1 +1:5:0:1 +1:5:1:1 +1:5:2:1 +1:5:3:1 +1:5:4:1 +1:5:5:1 +1:5:6:1 +1:5:7:1 +1:5:8:1 +1:5:9:1 +1:6:0:1 +1:6:1:1 +1:6:2:1 +1:6:3:1 +1:6:4:1 +1:6:5:1 +1:6:6:1 +1:6:7:1 +1:6:8:1 +1:6:9:1 +1:7:0:1 +1:7:1:1 +1:7:2:1 +1:7:3:1 +1:7:4:1 +1:7:5:1 +1:7:6:1 +1:7:7:1 +1:7:8:1 +1:7:9:1 +1:8:0:1 +1:8:1:1 +1:8:2:1 +1:8:3:1 +1:8:4:1 +1:8:5:1 +1:8:6:1 +1:8:7:1 +1:8:8:1 +1:8:9:1 +1:9:0:1 +1:9:1:1 +1:9:2:1 +1:9:3:1 +1:9:4:1 +1:9:5:1 +1:9:6:1 +1:9:7:1 +1:9:8:1 +1:9:9:1 +2:0:0:0 +2:0:1:2 +2:0:2:4 +2:0:3:6 +2:0:4:8 +2:0:5:10 +2:0:6:12 +2:0:7:14 +2:0:8:16 +2:0:9:18 +2:1:0:1 +2:1:1:2 +2:1:2:4 +2:1:3:8 +2:1:4:16 +2:1:5:32 +2:1:6:64 +2:1:7:128 +2:1:8:256 +2:1:9:512 +2:2:0:1 +2:2:1:2 +2:2:2:4 +2:2:3:16 +2:2:4:65536 +2:3:0:1 +2:3:1:2 +2:3:2:4 +2:3:3:65536 +2:4:0:1 +2:4:1:2 +2:4:2:4 +2:5:0:1 +2:5:1:2 +2:5:2:4 +2:6:0:1 +2:6:1:2 +2:6:2:4 +2:7:0:1 +2:7:1:2 +2:7:2:4 +2:8:0:1 +2:8:1:2 +2:8:2:4 +2:9:0:1 +2:9:1:2 +2:9:2:4 +3:0:0:0 +3:0:1:3 +3:0:2:6 +3:0:3:9 +3:0:4:12 +3:0:5:15 +3:0:6:18 +3:0:7:21 +3:0:8:24 +3:0:9:27 +3:1:0:1 +3:1:1:3 +3:1:2:9 +3:1:3:27 +3:1:4:81 +3:1:5:243 +3:1:6:729 +3:1:7:2187 +3:1:8:6561 +3:1:9:19683 +3:2:0:1 +3:2:1:3 +3:2:2:27 +3:2:3:7625597484987 +3:3:0:1 +3:3:1:3 +3:3:2:7625597484987 +3:4:0:1 +3:4:1:3 +3:5:0:1 +3:5:1:3 +3:6:0:1 +3:6:1:3 +3:7:0:1 +3:7:1:3 +3:8:0:1 +3:8:1:3 +3:9:0:1 +3:9:1:3 +4:0:0:0 +4:0:1:4 +4:0:2:8 +4:0:3:12 +4:0:4:16 +4:0:5:20 +4:0:6:24 +4:0:7:28 +4:0:8:32 +4:0:9:36 +4:1:0:1 +4:1:1:4 +4:1:2:16 +4:1:3:64 +4:1:4:256 +4:1:5:1024 +4:1:6:4096 +4:1:7:16384 +4:1:8:65536 +4:1:9:262144 +4:2:0:1 +4:2:1:4 +4:2:2:256 +4:2:3:13407807929942597099574024998205846127479365820592393377723561443721764030073546976801874298166903427690031858186486050853753882811946569946433649006084096 +4:3:0:1 +4:3:1:4 +4:4:0:1 +4:4:1:4 +4:5:0:1 +4:5:1:4 +4:6:0:1 +4:6:1:4 +4:7:0:1 +4:7:1:4 +4:8:0:1 +4:8:1:4 +4:9:0:1 +4:9:1:4 +5:0:0:0 +5:0:1:5 +5:0:2:10 +5:0:3:15 +5:0:4:20 +5:0:5:25 +5:0:6:30 +5:0:7:35 +5:0:8:40 +5:0:9:45 +5:1:0:1 +5:1:1:5 +5:1:2:25 +5:1:3:125 +5:1:4:625 +5:1:5:3125 +5:1:6:15625 +5:1:7:78125 +5:1:8:390625 +5:1:9:1953125 +5:2:0:1 +5:2:1:5 +5:2:2:3125 +5:2:3:1911012597945477520356404559703964599198081048990094337139512789246520530242615803012059386519739850265586440155794462235359212788673806972288410146915986602087961896757195701839281660338047611225975533626101001482651123413147768252411493094447176965282756285196737514395357542479093219206641883011787169122552421070050709064674382870851449950256586194461543183511379849133691779928127433840431549236855526783596374102105331546031353725325748636909159778690328266459182983815230286936572873691422648131291743762136325730321645282979486862576245362218017673224940567642819360078720713837072355305446356153946401185348493792719514594505508232749221605848912910945189959948686199543147666938013037176163592594479746164220050885079469804487133205133160739134230540198872570038329801246050197013467397175909027389493923817315786996845899794781068042822436093783946335265422815704302832442385515082316490967285712171708123232790481817268327510112746782317410985888683708522000711733492253913322300756147180429007527677793352306200618286012455254243061006894805446584704820650982664319360960388736258510747074340636286976576702699258649953557976318173902550891331223294743930343956161328334072831663498258145226862004307799084688103804187368324800903873596212919633602583120781673673742533322879296907205490595621406888825991244581842379597863476484315673760923625090371511798941424262270220066286486867868710182980872802560693101949280830825044198424796792058908817112327192301455582916746795197430548026404646854002733993860798594465961501752586965811447568510041568687730903712482535343839285397598749458497050038225012489284001826590056251286187629938044407340142347062055785305325034918189589707199305662188512963187501743535960282201038211616048545121039313312256332260766436236688296850208839496142830484739113991669622649948563685234712873294796680884509405893951104650944137909502276545653133018670633521323028460519434381399810561400652595300731790772711065783494174642684720956134647327748584238274899668755052504394218232191357223054066715373374248543645663782045701654593218154053548393614250664498585403307466468541890148134347714650315037954175778622811776585876941680908203125 +5:3:0:1 +5:3:1:5 +5:4:0:1 +5:4:1:5 +5:5:0:1 +5:5:1:5 +5:6:0:1 +5:6:1:5 +5:7:0:1 +5:7:1:5 +5:8:0:1 +5:8:1:5 +5:9:0:1 +5:9:1:5 +6:0:0:0 +6:0:1:6 +6:0:2:12 +6:0:3:18 +6:0:4:24 +6:0:5:30 +6:0:6:36 +6:0:7:42 +6:0:8:48 +6:0:9:54 +6:1:0:1 +6:1:1:6 +6:1:2:36 +6:1:3:216 +6:1:4:1296 +6:1:5:7776 +6:1:6:46656 +6:1:7:279936 +6:1:8:1679616 +6:1:9:10077696 +6:2:0:1 +6:2:1:6 +6:2:2:46656 +6:3:0:1 +6:3:1:6 +6:4:0:1 +6:4:1:6 +6:5:0:1 +6:5:1:6 +6:6:0:1 +6:6:1:6 +6:7:0:1 +6:7:1:6 +6:8:0:1 +6:8:1:6 +6:9:0:1 +6:9:1:6 +7:0:0:0 +7:0:1:7 +7:0:2:14 +7:0:3:21 +7:0:4:28 +7:0:5:35 +7:0:6:42 +7:0:7:49 +7:0:8:56 +7:0:9:63 +7:1:0:1 +7:1:1:7 +7:1:2:49 +7:1:3:343 +7:1:4:2401 +7:1:5:16807 +7:1:6:117649 +7:1:7:823543 +7:1:8:5764801 +7:1:9:40353607 +7:2:0:1 +7:2:1:7 +7:2:2:823543 +7:3:0:1 +7:3:1:7 +7:4:0:1 +7:4:1:7 +7:5:0:1 +7:5:1:7 +7:6:0:1 +7:6:1:7 +7:7:0:1 +7:7:1:7 +7:8:0:1 +7:8:1:7 +7:9:0:1 +7:9:1:7 +8:0:0:0 +8:0:1:8 +8:0:2:16 +8:0:3:24 +8:0:4:32 +8:0:5:40 +8:0:6:48 +8:0:7:56 +8:0:8:64 +8:0:9:72 +8:1:0:1 +8:1:1:8 +8:1:2:64 +8:1:3:512 +8:1:4:4096 +8:1:5:32768 +8:1:6:262144 +8:1:7:2097152 +8:1:8:16777216 +8:1:9:134217728 +8:2:0:1 +8:2:1:8 +8:2:2:16777216 +8:3:0:1 +8:3:1:8 +8:4:0:1 +8:4:1:8 +8:5:0:1 +8:5:1:8 +8:6:0:1 +8:6:1:8 +8:7:0:1 +8:7:1:8 +8:8:0:1 +8:8:1:8 +8:9:0:1 +8:9:1:8 +9:0:0:0 +9:0:1:9 +9:0:2:18 +9:0:3:27 +9:0:4:36 +9:0:5:45 +9:0:6:54 +9:0:7:63 +9:0:8:72 +9:0:9:81 +9:1:0:1 +9:1:1:9 +9:1:2:81 +9:1:3:729 +9:1:4:6561 +9:1:5:59049 +9:1:6:531441 +9:1:7:4782969 +9:1:8:43046721 +9:1:9:387420489 +9:2:0:1 +9:2:1:9 +9:2:2:387420489 +9:3:0:1 +9:3:1:9 +9:4:0:1 +9:4:1:9 +9:5:0:1 +9:5:1:9 +9:6:0:1 +9:6:1:9 +9:7:0:1 +9:7:1:9 +9:8:0:1 +9:8:1:9 +9:9:0:1 +9:9:1:9 diff --git a/cpan/Math-BigInt/t/calling-class-methods.t b/cpan/Math-BigInt/t/calling-class-methods.t index 1bc0f6a266..27ada2eb0c 100644 --- a/cpan/Math-BigInt/t/calling-class-methods.t +++ b/cpan/Math-BigInt/t/calling-class-methods.t @@ -5,7 +5,7 @@ use strict; use warnings; -use Test::More tests => 148; +use Test::More tests => 164; ############################################################################## @@ -76,6 +76,12 @@ __END__ &is_negative 1:0 -1:1 +&is_non_positive +1:0 +-1:1 +&is_non_negative +1:1 +-1:0 &is_nan abc:1 1:0 diff --git a/cpan/Math-BigInt/t/calling-instance-methods.t b/cpan/Math-BigInt/t/calling-instance-methods.t index 8b0945e72a..30421da67b 100644 --- a/cpan/Math-BigInt/t/calling-instance-methods.t +++ b/cpan/Math-BigInt/t/calling-instance-methods.t @@ -5,7 +5,7 @@ use strict; use warnings; -use Test::More tests => 140; +use Test::More tests => 156; ############################################################################## @@ -76,6 +76,12 @@ __END__ &is_negative 1:0 -1:1 +&is_non_positive +1:0 +-1:1 +&is_non_negative +1:1 +-1:0 &is_nan abc:1 1:0 diff --git a/cpan/Math-BigInt/t/calling.t b/cpan/Math-BigInt/t/calling.t index be72db4a8d..4b2690b107 100644 --- a/cpan/Math-BigInt/t/calling.t +++ b/cpan/Math-BigInt/t/calling.t @@ -6,7 +6,7 @@ use strict; use warnings; use lib 't'; -my $VERSION = '1.999816'; # adjust manually to match latest release +my $VERSION = '1.999817'; # adjust manually to match latest release use Test::More tests => 5; diff --git a/cpan/Math-BigInt/t/from_ieee754-mbf.t b/cpan/Math-BigInt/t/from_ieee754-mbf.t new file mode 100644 index 0000000000..99dd6e1e07 --- /dev/null +++ b/cpan/Math-BigInt/t/from_ieee754-mbf.t @@ -0,0 +1,257 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 230; + +use Math::BigFloat; + +my @k = (16, 32, 64, 128); + +sub stringify { + my $x = shift; + return "$x" unless $x -> is_finite(); + my $nstr = $x -> bnstr(); + my $sstr = $x -> bsstr(); + return length($nstr) < length($sstr) ? $nstr : $sstr; +} + +for my $k (@k) { + + # Parameters specific to this format: + + my $b = 2; + my $p = $k == 16 ? 11 + : $k == 32 ? 24 + : $k == 64 ? 53 + : $k - sprintf("%.0f", 4 * log($k)/log(2)) + 13; + + $b = Math::BigFloat -> new($b); + $k = Math::BigFloat -> new($k); + $p = Math::BigFloat -> new($p); + my $w = $k - $p; + + my $emax = 2 ** ($w - 1) - 1; + my $emin = 1 - $emax; + + my $format = sprintf 'binary%u', $k; + + my $binv = Math::BigFloat -> new("0.5"); + + my $data = + [ + + { + dsc => "smallest positive subnormal number", + bin => "0" + . ("0" x $w) + . ("0" x ($p - 2)) . "1", + asc => "$b ** ($emin) * $b ** (" . (1 - $p) . ") " + . "= $b ** (" . ($emin + 1 - $p) . ")", + mbf => $binv ** ($p - 1 - $emin), + }, + + { + dsc => "largest subnormal number", + bin => "0" + . ("0" x $w) + . ("1" x ($p - 1)), + asc => "$b ** ($emin) * (1 - $b ** (" . (1 - $p) . "))", + mbf => $binv ** (-$emin) * (1 - $binv ** ($p - 1)), + }, + + { + dsc => "smallest positive normal number", + bin => "0" + . ("0" x ($w - 1)) . "1" + . ("0" x ($p - 1)), + asc => "$b ** ($emin)", + mbf => $binv ** (-$emin), + }, + + { + dsc => "largest normal number", + bin => "0" + . ("1" x ($w - 1)) . "0" + . "1" x ($p - 1), + asc => "$b ** $emax * ($b - $b ** (" . (1 - $p) . "))", + mbf => $b ** $emax * ($b - $binv ** ($p - 1)), + }, + + { + dsc => "largest number less than one", + bin => "0" + . "0" . ("1" x ($w - 2)) . "0" + . "1" x ($p - 1), + asc => "1 - $b ** (-$p)", + mbf => 1 - $binv ** $p, + }, + + { + dsc => "smallest number larger than one", + bin => "0" + . "0" . ("1" x ($w - 1)) + . ("0" x ($p - 2)) . "1", + asc => "1 + $b ** (" . (1 - $p) . ")", + mbf => 1 + $binv ** ($p - 1), + }, + + { + dsc => "second smallest number larger than one", + bin => "0" + . "0" . ("1" x ($w - 1)) + . ("0" x ($p - 3)) . "10", + asc => "1 + $b ** (" . (2 - $p) . ")", + mbf => 1 + $binv ** ($p - 2), + }, + + { + dsc => "one", + bin => "0" + . "0" . ("1" x ($w - 1)) + . "0" x ($p - 1), + asc => "1", + mbf => Math::BigFloat -> new("1"), + }, + + { + dsc => "minus one", + bin => "1" + . "0" . ("1" x ($w - 1)) + . "0" x ($p - 1), + asc => "-1", + mbf => Math::BigFloat -> new("-1"), + }, + + { + dsc => "two", + bin => "0" + . "1" . ("0" x ($w - 1)) + . ("0" x ($p - 1)), + asc => "2", + mbf => Math::BigFloat -> new("2"), + }, + + { + dsc => "minus two", + bin => "1" + . "1" . ("0" x ($w - 1)) + . ("0" x ($p - 1)), + asc => "-2", + mbf => Math::BigFloat -> new("-2"), + }, + + { + dsc => "positive zero", + bin => "0" + . ("0" x $w) + . ("0" x ($p - 1)), + asc => "+0", + mbf => Math::BigFloat -> new("0"), + }, + + { + dsc => "negative zero", + bin => "1" + . ("0" x $w) + . ("0" x ($p - 1)), + asc => "-0", + mbf => Math::BigFloat -> new("0"), + }, + + { + dsc => "positive infinity", + bin => "0" + . ("1" x $w) + . ("0" x ($p - 1)), + asc => "+inf", + mbf => Math::BigFloat -> new("inf"), + }, + + { + dsc => "negative infinity", + bin => "1" + . ("1" x $w) + . ("0" x ($p - 1)), + asc => "-inf", + mbf => Math::BigFloat -> new("-inf"), + }, + + { + dsc => "NaN (sNaN on most processors, such as x86 and ARM)", + bin => "0" + . ("1" x $w) + . ("0" x ($p - 2)) . "1", + asc => "sNaN", + mbf => Math::BigFloat -> new("NaN"), + }, + + { + dsc => "NaN (qNaN on most processors, such as x86 and ARM)", + bin => "0" + . ("1" x $w) + . "1" . ("0" x ($p - 3)) . "1", + asc => "qNaN", + mbf => Math::BigFloat -> new("NaN"), + }, + + { + dsc => "NaN (an alternative encoding)", + bin => "0" + . ("1" x $w) + . ("1" x ($p - 1)), + asc => "NaN", + mbf => Math::BigFloat -> new("NaN"), + }, + + { + dsc => "NaN (encoding used by Perl on Cygwin)", + bin => "1" + . ("1" x $w) + . ("1" . ("0" x ($p - 2))), + asc => "NaN", + mbf => Math::BigFloat -> new("NaN"), + }, + + ]; + + for my $entry (@$data) { + my $bin = $entry -> {bin}; + my $bytes = pack "B*", $bin; + my $hex = unpack "H*", $bytes; + + note("\n", $entry -> {dsc }, " (k = $k)\n\n"); + + my $expected = stringify($entry -> {mbf}); + my ($got, $test); + + $got = Math::BigFloat -> from_ieee754($bin, $format); + $got = stringify($got); + $test = qq|Math::BigFloat->from_ieee754("$bin")|; + is($got, $expected, $test); + + $got = Math::BigFloat -> from_ieee754($hex, $format); + $got = stringify($got); + $test = qq|Math::BigFloat->from_ieee754("$hex")|; + is($got, $expected, $test); + + $got = Math::BigFloat -> from_ieee754($bytes, $format); + $got = stringify($got); + (my $str = $hex) =~ s/(..)/\\x$1/g; + $test = qq|Math::BigFloat->from_ieee754("$str")|; + is($got, $expected, $test); + } +} + +note("\nTest as class method vs. instance method.\n\n"); + +# As class method. + +my $x = Math::BigFloat -> from_ieee754("4000000000000000", "binary64"); +is($x, 2, "class method"); + +# As instance method, the invocand should be modified. + +$x -> from_ieee754("4008000000000000", "binary64"); +is($x, 3, "instance method modifies invocand"); diff --git a/cpan/Math-BigInt/t/new-mbf.t b/cpan/Math-BigInt/t/new-mbf.t index d1edfd45ff..547a69ca4b 100644 --- a/cpan/Math-BigInt/t/new-mbf.t +++ b/cpan/Math-BigInt/t/new-mbf.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 50; +use Test::More tests => 69; my $class; @@ -81,6 +81,43 @@ infinity:inf #-inf:NaN 0x.p+0:NaN +# This is more or less the same data as in from_oct-mbf.t, except that some of +# them are commented out, since new() only treats input as octal if it has a +# "0" prefix and a binary exponent, and possibly a leading "+" or "-" sign. +# Duplicates from above are also commented out. + +01p+0:1 +00.4p+1:1 +00.2p+2:1 +00.1p+3:1 +00.04p+4:1 +02p-1:1 +04p-2:1 +010p-3:1 + +-01p+0:-1 + +00p+0:0 +00p+7:0 +00p-7:0 +00.p+0:0 +00.0p+0:0 +#00.0p+0:0 + +#145376:51966 +#0145376:51966 +#00145376:51966 + +03.1p+2:12.5 +022.15p-1:9.1015625 +-00.361152746757p+32:-2023406814.9375 +044.3212636115p+30:39093746765 + +#NaN:NaN +#+inf:NaN +#-inf:NaN +0.p+0:NaN + # This is the same data as in from_bin-mbf.t, except that some of them are # commented out, since new() only treats input as binary if it has a "0b" or # "0B" prefix, possibly with a leading "+" or "-" sign. Duplicates from above diff --git a/cpan/Math-BigInt/t/sub_mbf.t b/cpan/Math-BigInt/t/sub_mbf.t index 584ea675e7..2f5d3fc1e7 100644 --- a/cpan/Math-BigInt/t/sub_mbf.t +++ b/cpan/Math-BigInt/t/sub_mbf.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 2818 # tests in require'd file +use Test::More tests => 2830 # tests in require'd file + 6; # tests in this file use lib 't'; diff --git a/cpan/Math-BigInt/t/sub_mbi.t b/cpan/Math-BigInt/t/sub_mbi.t index 3ee6953afa..97bcdee397 100644 --- a/cpan/Math-BigInt/t/sub_mbi.t +++ b/cpan/Math-BigInt/t/sub_mbi.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 4026 # tests in require'd file +use Test::More tests => 4038 # tests in require'd file + 5; # tests in this file use lib 't'; diff --git a/cpan/Math-BigInt/t/to_ieee754-mbf.t b/cpan/Math-BigInt/t/to_ieee754-mbf.t new file mode 100644 index 0000000000..047d8488fa --- /dev/null +++ b/cpan/Math-BigInt/t/to_ieee754-mbf.t @@ -0,0 +1,206 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 60; + +use Math::BigFloat; + +my @k = (16, 32, 64, 128); + +sub stringify { + my $x = shift; + return "$x" unless $x -> is_finite(); + my $nstr = $x -> bnstr(); + my $sstr = $x -> bsstr(); + return length($nstr) < length($sstr) ? $nstr : $sstr; +} + +for my $k (@k) { + + # Parameters specific to this format: + + my $b = 2; + my $p = $k == 16 ? 11 + : $k == 32 ? 24 + : $k == 64 ? 53 + : $k - sprintf("%.0f", 4 * log($k)/log(2)) + 13; + + $b = Math::BigFloat -> new($b); + $k = Math::BigFloat -> new($k); + $p = Math::BigFloat -> new($p); + my $w = $k - $p; + + my $emax = 2 ** ($w - 1) - 1; + my $emin = 1 - $emax; + + my $format = 'binary' . $k; + + note("\nComputing test data for k = $k ...\n\n"); + + my $binv = Math::BigFloat -> new("0.5"); + + my $data = + [ + + { + dsc => "smallest positive subnormal number", + bin => "0" + . ("0" x $w) + . ("0" x ($p - 2)) . "1", + asc => "$b ** ($emin) * $b ** (" . (1 - $p) . ") " + . "= $b ** (" . ($emin + 1 - $p) . ")", + mbf => $binv ** ($p - 1 - $emin), + }, + + { + dsc => "largest subnormal number", + bin => "0" + . ("0" x $w) + . ("1" x ($p - 1)), + asc => "$b ** ($emin) * (1 - $b ** (" . (1 - $p) . "))", + mbf => $binv ** (-$emin) * (1 - $binv ** ($p - 1)), + }, + + { + dsc => "smallest positive normal number", + bin => "0" + . ("0" x ($w - 1)) . "1" + . ("0" x ($p - 1)), + asc => "$b ** ($emin)", + mbf => $binv ** (-$emin), + }, + + { + dsc => "largest normal number", + bin => "0" + . ("1" x ($w - 1)) . "0" + . "1" x ($p - 1), + asc => "$b ** $emax * ($b - $b ** (" . (1 - $p) . "))", + mbf => $b ** $emax * ($b - $binv ** ($p - 1)), + }, + + { + dsc => "largest number less than one", + bin => "0" + . "0" . ("1" x ($w - 2)) . "0" + . "1" x ($p - 1), + asc => "1 - $b ** (-$p)", + mbf => 1 - $binv ** $p, + }, + + { + dsc => "smallest number larger than one", + bin => "0" + . "0" . ("1" x ($w - 1)) + . ("0" x ($p - 2)) . "1", + asc => "1 + $b ** (" . (1 - $p) . ")", + mbf => 1 + $binv ** ($p - 1), + }, + + { + dsc => "second smallest number larger than one", + bin => "0" + . "0" . ("1" x ($w - 1)) + . ("0" x ($p - 3)) . "10", + asc => "1 + $b ** (" . (2 - $p) . ")", + mbf => 1 + $binv ** ($p - 2), + }, + + { + dsc => "one", + bin => "0" + . "0" . ("1" x ($w - 1)) + . "0" x ($p - 1), + asc => "1", + mbf => Math::BigFloat -> new("1"), + }, + + { + dsc => "minus one", + bin => "1" + . "0" . ("1" x ($w - 1)) + . "0" x ($p - 1), + asc => "-1", + mbf => Math::BigFloat -> new("-1"), + }, + + { + dsc => "two", + bin => "0" + . "1" . ("0" x ($w - 1)) + . ("0" x ($p - 1)), + asc => "2", + mbf => Math::BigFloat -> new("2"), + }, + + { + dsc => "minus two", + bin => "1" + . "1" . ("0" x ($w - 1)) + . ("0" x ($p - 1)), + asc => "-2", + mbf => Math::BigFloat -> new("-2"), + }, + + { + dsc => "positive zero", + bin => "0" + . ("0" x $w) + . ("0" x ($p - 1)), + asc => "+0", + mbf => Math::BigFloat -> new("0"), + }, + + { + dsc => "positive infinity", + bin => "0" + . ("1" x $w) + . ("0" x ($p - 1)), + asc => "+inf", + mbf => Math::BigFloat -> new("inf"), + }, + + { + dsc => "negative infinity", + bin => "1" + . ("1" x $w) + . ("0" x ($p - 1)), + asc => "-inf", + mbf => Math::BigFloat -> new("-inf"), + }, + + { + dsc => "NaN (encoding used by Perl on Cygwin)", + bin => "1" + . ("1" x $w) + . ("1" . ("0" x ($p - 2))), + asc => "NaN", + mbf => Math::BigFloat -> new("NaN"), + }, + + ]; + + for my $entry (@$data) { + my $bin = $entry -> {bin}; + my $bytes = pack "B*", $bin; + my $hex = unpack "H*", $bytes; + + note("\n", $entry -> {dsc}, " (k = $k)\n\n"); + + my $x = Math::BigFloat -> new($entry -> {mbf}); + + my $test = qq|Math::BigFloat -> new("| . stringify($x) + . qq|") -> to_ieee754("$format")|; + + my $got_bytes = $x -> to_ieee754($format); + my $got_hex = unpack "H*", $got_bytes; + $got_hex =~ s/(..)/\\x$1/g; + + my $expected_hex = $hex; + $expected_hex =~ s/(..)/\\x$1/g; + + is($got_hex, $expected_hex); + } +} diff --git a/cpan/Math-BigInt/t/upgrade.inc b/cpan/Math-BigInt/t/upgrade.inc index 9cdba4edfb..d58376f244 100644 --- a/cpan/Math-BigInt/t/upgrade.inc +++ b/cpan/Math-BigInt/t/upgrade.inc @@ -80,7 +80,7 @@ while (<DATA>) { $try = qq|\$x = $CLASS->new("$args[0]");|; if ($f eq "bnorm") { $try = qq|\$x = $CLASS->bnorm("$args[0]");|; - } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) { + } elsif ($f =~ /^is_(zero|one|odd|even||(non_)?(negative|positive)|nan|int)$/) { $try .= " \$x->$f();"; } elsif ($f =~ /^(to|as)_(hex|oct|bin)$/) { $try .= " \$x->$f();"; @@ -304,6 +304,22 @@ NaNneg:0 -inf:0 NaNneg:0 +&is_non_negative +0:1 +-1:0 +1:1 ++inf:1 +-inf:0 +NaN:0 + +&is_non_positive +0:1 +-1:1 +1:0 ++inf:0 +-inf:1 +NaN:0 + &is_odd abc:0 0:0 diff --git a/cpan/Math-BigInt/t/upgrade.t b/cpan/Math-BigInt/t/upgrade.t index b373ceb56a..552c8ae511 100644 --- a/cpan/Math-BigInt/t/upgrade.t +++ b/cpan/Math-BigInt/t/upgrade.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 2196 # tests in require'd file +use Test::More tests => 2208 # tests in require'd file + 2; # tests in this file use Math::BigInt upgrade => 'Math::BigFloat'; diff --git a/cpan/Math-BigInt/t/with_sub.t b/cpan/Math-BigInt/t/with_sub.t index ca78927512..0ce15d10cb 100644 --- a/cpan/Math-BigInt/t/with_sub.t +++ b/cpan/Math-BigInt/t/with_sub.t @@ -5,7 +5,7 @@ use strict; use warnings; -use Test::More tests => 2818 # tests in require'd file +use Test::More tests => 2830 # tests in require'd file + 1; # tests in this file use Math::BigFloat with => 'Math::BigInt::Subclass', |