diff options
| author | Karl Berry <karl@freefriends.org> | 2020-03-07 22:52:33 +0000 |
|---|---|---|
| committer | Karl Berry <karl@freefriends.org> | 2020-03-07 22:52:33 +0000 |
| commit | 11c6e5fc65f26ba5219997d19707b998a9abf26d (patch) | |
| tree | a1dc8073a679611d3f09c01eda006cc3f6f846b1 /Master/tlpkg/tlperl/lib/Math | |
| parent | a6593bd4f2eb12ae25540de026f7f9ebcf230a2f (diff) | |
tl20 perl 5.30.1 for Windows, from Siep
git-svn-id: svn://tug.org/texlive/trunk@54166 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Math')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Math/BigFloat.pm | 823 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm | 2 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Math/BigInt.pm | 1123 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Math/BigInt/Calc.pm | 15 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm | 394 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm | 2 | ||||
| -rwxr-xr-x | Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm | 428 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Math/BigInt/Trace.pm | 2 | ||||
| -rw-r--r-- | Master/tlpkg/tlperl/lib/Math/BigRat.pm | 254 |
9 files changed, 1610 insertions, 1433 deletions
diff --git a/Master/tlpkg/tlperl/lib/Math/BigFloat.pm b/Master/tlpkg/tlperl/lib/Math/BigFloat.pm index b716b88a348..8a92b5818da 100644 --- a/Master/tlpkg/tlperl/lib/Math/BigFloat.pm +++ b/Master/tlpkg/tlperl/lib/Math/BigFloat.pm @@ -6,9 +6,9 @@ package Math::BigFloat; # The following hash values are used internally: # sign : "+", "-", "+inf", "-inf", or "NaN" if not a number -# _m : mantissa ($CALC object) +# _m : mantissa ($LIB thingy) # _es : sign of _e -# _e : exponent ($CALC object) +# _e : exponent ($LIB thingy) # _a : accuracy # _p : precision @@ -16,12 +16,11 @@ use 5.006001; use strict; use warnings; -use Carp (); +use Carp qw< carp croak >; use Math::BigInt (); -our $VERSION = '1.999811'; +our $VERSION = '1.999816'; -require Exporter; our @ISA = qw/Math::BigInt/; our @EXPORT_OK = qw/bpi/; @@ -72,7 +71,6 @@ use overload '**=' => sub { $_[0]->bpow($_[1]); }, - '<<=' => sub { $_[0]->blsft($_[1]); }, '>>=' => sub { $_[0]->brsft($_[1]); }, @@ -218,7 +216,7 @@ $upgrade = undef; $downgrade = undef; # the package we are using for our private parts, defaults to: # Math::BigInt->config('lib') -my $MBI = 'Math::BigInt::Calc'; +my $LIB = 'Math::BigInt::Calc'; # are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config() $_trap_nan = 0; @@ -281,11 +279,11 @@ sub AUTOLOAD { if (!_method_alias($name)) { if (!defined $name) { # delayed load of Carp and avoid recursion - Carp::croak("$c: Can't call a method without name"); + croak("$c: Can't call a method without name"); } if (!_method_hand_up($name)) { # delayed load of Carp and avoid recursion - Carp::croak("Can't call $c\-\>$name, not a valid method"); + croak("Can't call $c\-\>$name, not a valid method"); } # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx() $name =~ s/^f/b/; @@ -320,8 +318,6 @@ sub AUTOLOAD { sub _method_hand_up { exists $hand_ups{$_[0]||''}; } } -sub DEBUG () { 0; } - sub isa { my ($self, $class) = @_; return if $class =~ /^Math::BigInt/; # we aren't one of these @@ -332,16 +328,22 @@ sub config { # return (later set?) configuration data as hash ref my $class = shift || 'Math::BigFloat'; + # Getter/accessor. + if (@_ == 1 && ref($_[0]) ne 'HASH') { - my $cfg = $class->SUPER::config(); - return $cfg->{$_[0]}; + my $param = shift; + return $class if $param eq 'class'; + return $LIB if $param eq 'with'; + return $class->SUPER::config($param); } + # Setter. + my $cfg = $class->SUPER::config(@_); # now we need only to override the ones that are different from our parent $cfg->{class} = $class; - $cfg->{with} = $MBI; + $cfg->{with} = $LIB; $cfg; } @@ -364,7 +366,7 @@ sub new { # avoid numify-calls by not using || on $wanted! unless (defined $wanted) { - #Carp::carp("Use of uninitialized value in new"); + #carp("Use of uninitialized value in new"); return $self->bzero(@r); } @@ -390,7 +392,7 @@ sub new { # shortcut for bigints and its subclasses if ((ref($wanted)) && $wanted -> can("as_number")) { $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy - $self->{_e} = $MBI->_zero(); + $self->{_e} = $LIB->_zero(); $self->{_es} = '+'; $self->{sign} = $wanted->sign(); return $self->bnorm(); @@ -434,10 +436,10 @@ sub new { # Shortcut for simple forms like '12' that have no trailing zeros. if ($wanted =~ /^([+-]?)0*([1-9][0-9]*[1-9])$/) { - $self->{_e} = $MBI -> _zero(); + $self->{_e} = $LIB -> _zero(); $self->{_es} = '+'; $self->{sign} = $1 || '+'; - $self->{_m} = $MBI -> _new($2); + $self->{_m} = $LIB -> _new($2); if (!$downgrade) { $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1]; return $self; @@ -447,26 +449,26 @@ sub new { my ($mis, $miv, $mfv, $es, $ev) = Math::BigInt::_split($wanted); if (!ref $mis) { if ($_trap_nan) { - Carp::croak("$wanted is not a number initialized to $class"); + croak("$wanted is not a number initialized to $class"); } return $downgrade->bnan() if $downgrade; - $self->{_e} = $MBI->_zero(); + $self->{_e} = $LIB->_zero(); $self->{_es} = '+'; - $self->{_m} = $MBI->_zero(); + $self->{_m} = $LIB->_zero(); $self->{sign} = $nan; } else { # make integer from mantissa by adjusting exp, then convert to int - $self->{_e} = $MBI->_new($$ev); # exponent + $self->{_e} = $LIB->_new($$ev); # exponent $self->{_es} = $$es || '+'; my $mantissa = "$$miv$$mfv"; # create mant. $mantissa =~ s/^0+(\d)/$1/; # strip leading zeros - $self->{_m} = $MBI->_new($mantissa); # create mant. + $self->{_m} = $LIB->_new($mantissa); # create mant. # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5 if (CORE::length($$mfv) != 0) { - my $len = $MBI->_new(CORE::length($$mfv)); + my $len = $LIB->_new(CORE::length($$mfv)); ($self->{_e}, $self->{_es}) = _e_sub($self->{_e}, $len, $self->{_es}, '+'); } @@ -478,9 +480,9 @@ sub new { my $zeros = 0; $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/; if ($zeros != 0) { - my $z = $MBI->_new($zeros); + my $z = $LIB->_new($zeros); # turn '120e2' into '12e3' - $self->{_m} = $MBI->_rsft($self->{_m}, $z, 10); + $self->{_m} = $LIB->_rsft($self->{_m}, $z, 10); ($self->{_e}, $self->{_es}) = _e_add($self->{_e}, $z, $self->{_es}, '+'); } @@ -489,8 +491,8 @@ sub new { # for something like 0Ey, set y to 0, and -0 => +0 # Check $$miv for being '0' and $$mfv eq '', because otherwise _m could not - # have become 0. That's faster than to call $MBI->_is_zero(). - $self->{sign} = '+', $self->{_e} = $MBI->_zero() + # have become 0. That's faster than to call $LIB->_is_zero(). + $self->{sign} = '+', $self->{_e} = $LIB->_zero() if $$miv eq '0' and $$mfv eq ''; if (!$downgrade) { @@ -502,8 +504,8 @@ sub new { # if downgrade, inf, NaN or integers go down if ($downgrade && $self->{_es} eq '+') { - if ($MBI->_is_zero($self->{_e})) { - return $downgrade->new($$mis . $MBI->_str($self->{_m})); + if ($LIB->_is_zero($self->{_e})) { + return $downgrade->new($$mis . $LIB->_str($self->{_m})); } return $downgrade->new($self->bsstr()); } @@ -587,7 +589,7 @@ sub from_hex { } $self -> {sign} = $s_sign; - $self -> {_m} = $MBI -> _from_hex('0x' . $s_value); + $self -> {_m} = $LIB -> _from_hex('0x' . $s_value); if ($two_expon > 0) { my $factor = $class -> new("2") -> bpow($two_expon); @@ -675,7 +677,7 @@ sub from_oct { } $self -> {sign} = $s_sign; - $self -> {_m} = $MBI -> _from_oct($s_value); + $self -> {_m} = $LIB -> _from_oct($s_value); if ($two_expon > 0) { my $factor = $class -> new("2") -> bpow($two_expon); @@ -763,7 +765,7 @@ sub from_bin { } $self -> {sign} = $s_sign; - $self -> {_m} = $MBI -> _from_bin('0b' . $s_value); + $self -> {_m} = $LIB -> _from_bin('0b' . $s_value); if ($two_expon > 0) { my $factor = $class -> new("2") -> bpow($two_expon); @@ -783,7 +785,7 @@ sub bzero { # create/assign '+0' if (@_ == 0) { - #Carp::carp("Using bone() as a function is deprecated;", + #carp("Using bone() as a function is deprecated;", # " use bone() as a method instead"); unshift @_, __PACKAGE__; } @@ -798,20 +800,23 @@ sub bzero { $self = bless {}, $class unless $selfref; $self -> {sign} = '+'; - $self -> {_m} = $MBI -> _zero(); + $self -> {_m} = $LIB -> _zero(); $self -> {_es} = '+'; - $self -> {_e} = $MBI -> _zero(); + $self -> {_e} = $LIB -> _zero(); - if (@_ > 0) { - if (@_ > 3) { - # call like: $x->bzero($a, $p, $r, $y); - ($self, $self->{_a}, $self->{_p}) = $self->_find_round_parameters(@_); - } else { - # call like: $x->bzero($a, $p, $r); - $self->{_a} = $_[0] - if !defined $self->{_a} || (defined $_[0] && $_[0] > $self->{_a}); - $self->{_p} = $_[1] - if !defined $self->{_p} || (defined $_[1] && $_[1] > $self->{_p}); + # If rounding parameters are given as arguments, use them. If no rounding + # parameters are given, and if called as a class method initialize the new + # instance with the class variables. + + if (@_) { + croak "can't specify both accuracy and precision" + if @_ >= 2 && defined $_[0] && defined $_[1]; + $self->{_a} = $_[0]; + $self->{_p} = $_[1]; + } else { + unless($selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); } } @@ -822,7 +827,7 @@ sub bone { # Create or assign '+1' (or -1 if given sign '-'). if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) { - #Carp::carp("Using bone() as a function is deprecated;", + #carp("Using bone() as a function is deprecated;", # " use bone() as a method instead"); unshift @_, __PACKAGE__; } @@ -840,20 +845,23 @@ sub bone { $self = bless {}, $class unless $selfref; $self -> {sign} = $sign; - $self -> {_m} = $MBI -> _one(); + $self -> {_m} = $LIB -> _one(); $self -> {_es} = '+'; - $self -> {_e} = $MBI -> _zero(); + $self -> {_e} = $LIB -> _zero(); - if (@_ > 0) { - if (@_ > 3) { - # call like: $x->bone($sign, $a, $p, $r, $y, ...); - ($self, $self->{_a}, $self->{_p}) = $self->_find_round_parameters(@_); - } else { - # call like: $x->bone($sign, $a, $p, $r); - $self->{_a} = $_[0] - if ((!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a})); - $self->{_p} = $_[1] - if ((!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p})); + # If rounding parameters are given as arguments, use them. If no rounding + # parameters are given, and if called as a class method initialize the new + # instance with the class variables. + + if (@_) { + croak "can't specify both accuracy and precision" + if @_ >= 2 && defined $_[0] && defined $_[1]; + $self->{_a} = $_[0]; + $self->{_p} = $_[1]; + } else { + unless($selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); } } @@ -866,7 +874,7 @@ sub binf { if (@_ == 0 || (defined($_[0]) && !ref($_[0]) && $_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/)) { - #Carp::carp("Using binf() as a function is deprecated;", + #carp("Using binf() as a function is deprecated;", # " use binf() as a method instead"); unshift @_, __PACKAGE__; } @@ -878,7 +886,7 @@ sub binf { { no strict 'refs'; if (${"${class}::_trap_inf"}) { - Carp::croak("Tried to create +-inf in $class->binf()"); + croak("Tried to create +-inf in $class->binf()"); } } @@ -891,9 +899,25 @@ sub binf { $self = bless {}, $class unless $selfref; $self -> {sign} = $sign . 'inf'; - $self -> {_m} = $MBI -> _zero(); + $self -> {_m} = $LIB -> _zero(); $self -> {_es} = '+'; - $self -> {_e} = $MBI -> _zero(); + $self -> {_e} = $LIB -> _zero(); + + # If rounding parameters are given as arguments, use them. If no rounding + # parameters are given, and if called as a class method initialize the new + # instance with the class variables. + + if (@_) { + croak "can't specify both accuracy and precision" + if @_ >= 2 && defined $_[0] && defined $_[1]; + $self->{_a} = $_[0]; + $self->{_p} = $_[1]; + } else { + unless($selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); + } + } return $self; } @@ -902,7 +926,7 @@ sub bnan { # create/assign a 'NaN' if (@_ == 0) { - #Carp::carp("Using bnan() as a function is deprecated;", + #carp("Using bnan() as a function is deprecated;", # " use bnan() as a method instead"); unshift @_, __PACKAGE__; } @@ -914,7 +938,7 @@ sub bnan { { no strict 'refs'; if (${"${class}::_trap_nan"}) { - Carp::croak("Tried to create NaN in $class->bnan()"); + croak("Tried to create NaN in $class->bnan()"); } } @@ -924,9 +948,25 @@ sub bnan { $self = bless {}, $class unless $selfref; $self -> {sign} = $nan; - $self -> {_m} = $MBI -> _zero(); + $self -> {_m} = $LIB -> _zero(); $self -> {_es} = '+'; - $self -> {_e} = $MBI -> _zero(); + $self -> {_e} = $LIB -> _zero(); + + # If rounding parameters are given as arguments, use them. If no rounding + # parameters are given, and if called as a class method initialize the new + # instance with the class variables. + + if (@_) { + croak "can't specify both accuracy and precision" + if @_ >= 2 && defined $_[0] && defined $_[1]; + $self->{_a} = $_[0]; + $self->{_p} = $_[1]; + } else { + unless($selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); + } + } return $self; } @@ -1032,13 +1072,12 @@ EOF my $digits = substr($all_digits, 0, $nchrs); - # Find out whether we should round up or down. Since pi is a - # transcendental number, we only have to look at one digit after the - # last digit we want. + # Find out whether we should round up or down. Rounding is easy, since + # pi is trancendental. With directed rounding, it doesn't matter what + # the following digits are. With rounding to nearest, we only have to + # look at one extra digit. - if ($rmode eq '+inf') { - $round_up = 1; - } elsif ($rmode eq 'trunc' || $rmode eq 'zero' || $rmode eq '-inf') { + if ($rmode eq 'trunc') { $round_up = 0; } else { my $next_digit = substr($all_digits, $nchrs, 1); @@ -1072,7 +1111,7 @@ EOF # Math::BigFloat, so use Brent-Salamin (aka AGM or Gauss-Legendre). # Use a few more digits in the intermediate computations. - my $nextra = 8; + $n += 8; $HALF = $class -> new($HALF) unless ref($HALF); my ($an, $bn, $tn, $pn) = ($class -> bone, $HALF -> copy() -> bsqrt($n), @@ -1118,8 +1157,8 @@ sub copy { $copy->{sign} = $self->{sign}; $copy->{_es} = $self->{_es}; - $copy->{_m} = $MBI->_copy($self->{_m}); - $copy->{_e} = $MBI->_copy($self->{_e}); + $copy->{_m} = $LIB->_copy($self->{_m}); + $copy->{_e} = $LIB->_copy($self->{_e}); $copy->{_a} = $self->{_a} if exists $self->{_a}; $copy->{_p} = $self->{_p} if exists $self->{_p}; @@ -1142,13 +1181,13 @@ sub as_number { return Math::BigInt->binf($x->sign()) if $x->is_inf(); return Math::BigInt->bnan() if $x->is_nan(); - my $z = $MBI->_copy($x->{_m}); + my $z = $LIB->_copy($x->{_m}); if ($x->{_es} eq '-') { # < 0 - $z = $MBI->_rsft($z, $x->{_e}, 10); - } elsif (! $MBI->_is_zero($x->{_e})) { # > 0 - $z = $MBI->_lsft($z, $x->{_e}, 10); + $z = $LIB->_rsft($z, $x->{_e}, 10); + } elsif (! $LIB->_is_zero($x->{_e})) { # > 0 + $z = $LIB->_lsft($z, $x->{_e}, 10); } - $z = Math::BigInt->new($x->{sign} . $MBI->_str($z)); + $z = Math::BigInt->new($x->{sign} . $LIB->_str($z)); $z; } @@ -1160,7 +1199,7 @@ sub is_zero { # return true if arg (BFLOAT or num_str) is zero my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - ($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})) ? 1 : 0; + ($x->{sign} eq '+' && $LIB->_is_zero($x->{_m})) ? 1 : 0; } sub is_one { @@ -1170,8 +1209,8 @@ sub is_one { $sign = '+' if !defined $sign || $sign ne '-'; ($x->{sign} eq $sign && - $MBI->_is_zero($x->{_e}) && - $MBI->_is_one($x->{_m})) ? 1 : 0; + $LIB->_is_zero($x->{_e}) && + $LIB->_is_one($x->{_m})) ? 1 : 0; } sub is_odd { @@ -1179,8 +1218,8 @@ sub is_odd { my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); (($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't - ($MBI->_is_zero($x->{_e})) && - ($MBI->_is_odd($x->{_m}))) ? 1 : 0; + ($LIB->_is_zero($x->{_e})) && + ($LIB->_is_odd($x->{_m}))) ? 1 : 0; } sub is_even { @@ -1189,7 +1228,7 @@ sub is_even { (($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't ($x->{_es} eq '+') && # 123.45 isn't - ($MBI->_is_even($x->{_m}))) ? 1 : 0; # but 1200 is + ($LIB->_is_even($x->{_m}))) ? 1 : 0; # but 1200 is } sub is_int { @@ -1252,8 +1291,8 @@ sub bcmp { # integer of arbitrary value, the exponents must be normalized by the length # of the mantissas before we can compare them. - my $mxl = $MBI->_len($x->{_m}); - my $myl = $MBI->_len($y->{_m}); + my $mxl = $LIB->_len($x->{_m}); + my $myl = $LIB->_len($y->{_m}); # If the mantissas have the same length, there is no point in normalizing the # exponents by the length of the mantissas, so treat that as a special case. @@ -1271,7 +1310,7 @@ sub bcmp { # Then handle the case where the exponents have the same sign. else { - $cmp = $MBI->_acmp($x->{_e}, $y->{_e}); + $cmp = $LIB->_acmp($x->{_e}, $y->{_e}); $cmp = -$cmp if $x->{_es} eq '-'; } @@ -1298,17 +1337,17 @@ sub bcmp { # need to do anything special. if ($y->{_es} eq '+') { - $ex = $MBI->_copy($x->{_e}); - $ey = $MBI->_copy($y->{_e}); + $ex = $LIB->_copy($x->{_e}); + $ey = $LIB->_copy($y->{_e}); } # If the exponent of x is >= 0 and the exponent of y is < 0, add the # absolute value of the exponent of y to both. else { - $ex = $MBI->_copy($x->{_e}); - $ex = $MBI->_add($ex, $y->{_e}); # ex + |ey| - $ey = $MBI->_zero(); # -ex + |ey| = 0 + $ex = $LIB->_copy($x->{_e}); + $ex = $LIB->_add($ex, $y->{_e}); # ex + |ey| + $ey = $LIB->_zero(); # -ex + |ey| = 0 } } else { @@ -1317,29 +1356,29 @@ sub bcmp { # absolute value of the exponent of x to both. if ($y->{_es} eq '+') { - $ex = $MBI->_zero(); # -ex + |ex| = 0 - $ey = $MBI->_copy($y->{_e}); - $ey = $MBI->_add($ey, $x->{_e}); # ey + |ex| + $ex = $LIB->_zero(); # -ex + |ex| = 0 + $ey = $LIB->_copy($y->{_e}); + $ey = $LIB->_add($ey, $x->{_e}); # ey + |ex| } # If the exponent of x is < 0 and the exponent of y is < 0, add the # absolute values of both exponents to both exponents. else { - $ex = $MBI->_copy($y->{_e}); # -ex + |ey| + |ex| = |ey| - $ey = $MBI->_copy($x->{_e}); # -ey + |ex| + |ey| = |ex| + $ex = $LIB->_copy($y->{_e}); # -ex + |ey| + |ex| = |ey| + $ey = $LIB->_copy($x->{_e}); # -ey + |ex| + |ey| = |ex| } } # Now we can normalize the exponents by adding lengths of the mantissas. - $ex = $MBI->_add($ex, $MBI->_new($mxl)); - $ey = $MBI->_add($ey, $MBI->_new($myl)); + $ex = $LIB->_add($ex, $LIB->_new($mxl)); + $ey = $LIB->_add($ey, $LIB->_new($myl)); # We're done if the exponents are different. - $cmp = $MBI->_acmp($ex, $ey); + $cmp = $LIB->_acmp($ex, $ey); $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123 return $cmp if $cmp; @@ -1351,12 +1390,12 @@ sub bcmp { my $my = $y->{_m}; if ($mxl > $myl) { - $my = $MBI->_lsft($MBI->_copy($my), $MBI->_new($mxl - $myl), 10); + $my = $LIB->_lsft($LIB->_copy($my), $LIB->_new($mxl - $myl), 10); } elsif ($mxl < $myl) { - $mx = $MBI->_lsft($MBI->_copy($mx), $MBI->_new($myl - $mxl), 10); + $mx = $LIB->_lsft($LIB->_copy($mx), $LIB->_new($myl - $mxl), 10); } - $cmp = $MBI->_acmp($mx, $my); + $cmp = $LIB->_acmp($mx, $my); $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123 return $cmp; @@ -1392,14 +1431,14 @@ sub bacmp { return 1 if $yz && !$xz; # +x <=> 0 # adjust so that exponents are equal - my $lxm = $MBI->_len($x->{_m}); - my $lym = $MBI->_len($y->{_m}); + my $lxm = $LIB->_len($x->{_m}); + my $lym = $LIB->_len($y->{_m}); my ($xes, $yes) = (1, 1); $xes = -1 if $x->{_es} ne '+'; $yes = -1 if $y->{_es} ne '+'; # the numify somewhat limits our length, but makes it much faster - my $lx = $lxm + $xes * $MBI->_num($x->{_e}); - my $ly = $lym + $yes * $MBI->_num($y->{_e}); + my $lx = $lxm + $xes * $LIB->_num($x->{_e}); + my $ly = $lym + $yes * $LIB->_num($y->{_e}); my $l = $lx - $ly; return $l <=> 0 if $l != 0; @@ -1409,13 +1448,13 @@ sub bacmp { my $xm = $x->{_m}; # not yet copy it my $ym = $y->{_m}; if ($diff > 0) { - $ym = $MBI->_copy($y->{_m}); - $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10); + $ym = $LIB->_copy($y->{_m}); + $ym = $LIB->_lsft($ym, $LIB->_new($diff), 10); } elsif ($diff < 0) { - $xm = $MBI->_copy($x->{_m}); - $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10); + $xm = $LIB->_copy($x->{_m}); + $xm = $LIB->_lsft($xm, $LIB->_new(-$diff), 10); } - $MBI->_acmp($xm, $ym); + $LIB->_acmp($xm, $ym); } ############################################################################### @@ -1430,7 +1469,7 @@ sub bneg { return $x if $x->modify('bneg'); # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN' - $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})); + $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{_m})); $x; } @@ -1440,26 +1479,26 @@ sub bnorm { return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc - my $zeros = $MBI->_zeros($x->{_m}); # correct for trailing zeros + my $zeros = $LIB->_zeros($x->{_m}); # correct for trailing zeros if ($zeros != 0) { - my $z = $MBI->_new($zeros); - $x->{_m} = $MBI->_rsft($x->{_m}, $z, 10); + my $z = $LIB->_new($zeros); + $x->{_m} = $LIB->_rsft($x->{_m}, $z, 10); if ($x->{_es} eq '-') { - if ($MBI->_acmp($x->{_e}, $z) >= 0) { - $x->{_e} = $MBI->_sub($x->{_e}, $z); - $x->{_es} = '+' if $MBI->_is_zero($x->{_e}); + if ($LIB->_acmp($x->{_e}, $z) >= 0) { + $x->{_e} = $LIB->_sub($x->{_e}, $z); + $x->{_es} = '+' if $LIB->_is_zero($x->{_e}); } else { - $x->{_e} = $MBI->_sub($MBI->_copy($z), $x->{_e}); + $x->{_e} = $LIB->_sub($LIB->_copy($z), $x->{_e}); $x->{_es} = '+'; } } else { - $x->{_e} = $MBI->_add($x->{_e}, $z); + $x->{_e} = $LIB->_add($x->{_e}, $z); } } else { # $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing # zeros). So, for something like 0Ey, set y to 1, and -0 => +0 - $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $MBI->_one() - if $MBI->_is_zero($x->{_m}); + $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $LIB->_one() + if $LIB->_is_zero($x->{_m}); } $x; @@ -1475,22 +1514,22 @@ sub binc { return $x->badd($class->bone(), @r); # digits after dot } - if (!$MBI->_is_zero($x->{_e})) # _e == 0 for NaN, inf, -inf + if (!$LIB->_is_zero($x->{_e})) # _e == 0 for NaN, inf, -inf { # 1e2 => 100, so after the shift below _m has a '0' as last digit - $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100 - $x->{_e} = $MBI->_zero(); # normalize + $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100 + $x->{_e} = $LIB->_zero(); # normalize $x->{_es} = '+'; # we know that the last digit of $x will be '1' or '9', depending on the # sign } # now $x->{_e} == 0 if ($x->{sign} eq '+') { - $x->{_m} = $MBI->_inc($x->{_m}); + $x->{_m} = $LIB->_inc($x->{_m}); return $x->bnorm()->bround(@r); } elsif ($x->{sign} eq '-') { - $x->{_m} = $MBI->_dec($x->{_m}); - $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0 + $x->{_m} = $LIB->_dec($x->{_m}); + $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0 return $x->bnorm()->bround(@r); } # inf, nan handling etc @@ -1507,23 +1546,23 @@ sub bdec { return $x->badd($class->bone('-'), @r); # digits after dot } - if (!$MBI->_is_zero($x->{_e})) { - $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100 - $x->{_e} = $MBI->_zero(); # normalize + if (!$LIB->_is_zero($x->{_e})) { + $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100 + $x->{_e} = $LIB->_zero(); # normalize $x->{_es} = '+'; } # now $x->{_e} == 0 my $zero = $x->is_zero(); # <= 0 if (($x->{sign} eq '-') || $zero) { - $x->{_m} = $MBI->_inc($x->{_m}); + $x->{_m} = $LIB->_inc($x->{_m}); $x->{sign} = '-' if $zero; # 0 => 1 => -1 - $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0 + $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0 return $x->bnorm()->round(@r); } # > 0 elsif ($x->{sign} eq '+') { - $x->{_m} = $MBI->_dec($x->{_m}); + $x->{_m} = $LIB->_dec($x->{_m}); return $x->bnorm()->round(@r); } # inf, nan handling etc @@ -1568,37 +1607,37 @@ sub badd { if ($x->is_zero()) # 0+y { # make copy, clobbering up x (modify in place!) - $x->{_e} = $MBI->_copy($y->{_e}); + $x->{_e} = $LIB->_copy($y->{_e}); $x->{_es} = $y->{_es}; - $x->{_m} = $MBI->_copy($y->{_m}); + $x->{_m} = $LIB->_copy($y->{_m}); $x->{sign} = $y->{sign} || $nan; return $x->round(@r); } # take lower of the two e's and adapt m1 to it to match m2 my $e = $y->{_e}; - $e = $MBI->_zero() if !defined $e; # if no BFLOAT? - $e = $MBI->_copy($e); # make copy (didn't do it yet) + $e = $LIB->_zero() if !defined $e; # if no BFLOAT? + $e = $LIB->_copy($e); # make copy (didn't do it yet) my $es; ($e, $es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es}); - my $add = $MBI->_copy($y->{_m}); + my $add = $LIB->_copy($y->{_m}); if ($es eq '-') # < 0 { - $x->{_m} = $MBI->_lsft($x->{_m}, $e, 10); + $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); - } elsif (!$MBI->_is_zero($e)) # > 0 + } elsif (!$LIB->_is_zero($e)) # > 0 { - $add = $MBI->_lsft($add, $e, 10); + $add = $LIB->_lsft($add, $e, 10); } # else: both e are the same, so just leave them if ($x->{sign} eq $y->{sign}) { # add - $x->{_m} = $MBI->_add($x->{_m}, $add); + $x->{_m} = $LIB->_add($x->{_m}, $add); } else { ($x->{_m}, $x->{sign}) = _e_add($x->{_m}, $add, $x->{sign}, $y->{sign}); @@ -1672,7 +1711,7 @@ sub bmul { ((!$x->isa($class)) || (!$y->isa($class))); # aEb * cEd = (a*c)E(b+d) - $x->{_m} = $MBI->_mul($x->{_m}, $y->{_m}); + $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); $r[3] = $y; # no push! @@ -1709,7 +1748,7 @@ sub bmuladd { ((!$x->isa($class)) || (!$y->isa($class))); # aEb * cEd = (a*c)E(b+d) - $x->{_m} = $MBI->_mul($x->{_m}, $y->{_m}); + $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); $r[3] = $y; # no push! @@ -1722,28 +1761,28 @@ sub bmuladd { # take lower of the two e's and adapt m1 to it to match m2 my $e = $z->{_e}; - $e = $MBI->_zero() if !defined $e; # if no BFLOAT? - $e = $MBI->_copy($e); # make copy (didn't do it yet) + $e = $LIB->_zero() if !defined $e; # if no BFLOAT? + $e = $LIB->_copy($e); # make copy (didn't do it yet) my $es; ($e, $es) = _e_sub($e, $x->{_e}, $z->{_es} || '+', $x->{_es}); - my $add = $MBI->_copy($z->{_m}); + my $add = $LIB->_copy($z->{_m}); if ($es eq '-') # < 0 { - $x->{_m} = $MBI->_lsft($x->{_m}, $e, 10); + $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); - } elsif (!$MBI->_is_zero($e)) # > 0 + } elsif (!$LIB->_is_zero($e)) # > 0 { - $add = $MBI->_lsft($add, $e, 10); + $add = $LIB->_lsft($add, $e, 10); } # else: both e are the same, so just leave them if ($x->{sign} eq $z->{sign}) { # add - $x->{_m} = $MBI->_add($x->{_m}, $add); + $x->{_m} = $LIB->_add($x->{_m}, $add); } else { ($x->{_m}, $x->{sign}) = _e_add($x->{_m}, $add, $x->{sign}, $z->{sign}); @@ -1870,14 +1909,14 @@ sub bdiv { $y = $class->new($y) unless $y->isa('Math::BigFloat'); - my $lx = $MBI -> _len($x->{_m}); my $ly = $MBI -> _len($y->{_m}); + my $lx = $LIB -> _len($x->{_m}); my $ly = $LIB -> _len($y->{_m}); $scale = $lx if $lx > $scale; $scale = $ly if $ly > $scale; my $diff = $ly - $lx; $scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx! # check that $y is not 1 nor -1 and cache the result: - my $y_not_one = !($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m})); + my $y_not_one = !($LIB->_is_zero($y->{_e}) && $LIB->_is_one($y->{_m})); # flipping the sign of $y will also flip the sign of $x for the special # case of $x->bsub($x); so we can catch it below: @@ -1906,13 +1945,13 @@ sub bdiv { # calculate the result to $scale digits and then round it # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d) - $x->{_m} = $MBI->_lsft($x->{_m}, $MBI->_new($scale), 10); - $x->{_m} = $MBI->_div($x->{_m}, $y->{_m}); # a/c + $x->{_m} = $LIB->_lsft($x->{_m}, $LIB->_new($scale), 10); + $x->{_m} = $LIB->_div($x->{_m}, $y->{_m}); # a/c # correct exponent of $x ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); # correct for 10**scale - ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+'); + ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $LIB->_new($scale), $x->{_es}, '+'); $x->bnorm(); # remove trailing 0's } } # end else $x != $y @@ -1990,7 +2029,7 @@ sub bmod { return $x->bzero() if $x->is_zero() || ($x->is_int() && # check that $y == +1 or $y == -1: - ($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m}))); + ($LIB->_is_zero($y->{_e}) && $LIB->_is_one($y->{_m}))); my $cmp = $x->bacmp($y); # equal or $x < $y? if ($cmp == 0) { # $x == $y => result 0 @@ -2005,19 +2044,19 @@ sub bmod { return $x -> round($a, $p, $r); } - my $ym = $MBI->_copy($y->{_m}); + my $ym = $LIB->_copy($y->{_m}); # 2e1 => 20 - $ym = $MBI->_lsft($ym, $y->{_e}, 10) - if $y->{_es} eq '+' && !$MBI->_is_zero($y->{_e}); + $ym = $LIB->_lsft($ym, $y->{_e}, 10) + if $y->{_es} eq '+' && !$LIB->_is_zero($y->{_e}); # if $y has digits after dot my $shifty = 0; # correct _e of $x by this if ($y->{_es} eq '-') # has digits after dot { # 123 % 2.5 => 1230 % 25 => 5 => 0.5 - $shifty = $MBI->_num($y->{_e}); # no more digits after dot - $x->{_m} = $MBI->_lsft($x->{_m}, $y->{_e}, 10); # 123 => 1230, $y->{_m} is already 25 + $shifty = $LIB->_num($y->{_e}); # no more digits after dot + $x->{_m} = $LIB->_lsft($x->{_m}, $y->{_e}, 10); # 123 => 1230, $y->{_m} is already 25 } # $ym is now mantissa of $y based on exponent 0 @@ -2025,24 +2064,24 @@ sub bmod { if ($x->{_es} eq '-') # has digits after dot { # 123.4 % 20 => 1234 % 200 - $shiftx = $MBI->_num($x->{_e}); # no more digits after dot - $ym = $MBI->_lsft($ym, $x->{_e}, 10); # 123 => 1230 + $shiftx = $LIB->_num($x->{_e}); # no more digits after dot + $ym = $LIB->_lsft($ym, $x->{_e}, 10); # 123 => 1230 } # 123e1 % 20 => 1230 % 20 - if ($x->{_es} eq '+' && !$MBI->_is_zero($x->{_e})) { - $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # es => '+' here + if ($x->{_es} eq '+' && !$LIB->_is_zero($x->{_e})) { + $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # es => '+' here } - $x->{_e} = $MBI->_new($shiftx); + $x->{_e} = $LIB->_new($shiftx); $x->{_es} = '+'; $x->{_es} = '-' if $shiftx != 0 || $shifty != 0; - $x->{_e} = $MBI->_add($x->{_e}, $MBI->_new($shifty)) if $shifty != 0; + $x->{_e} = $LIB->_add($x->{_e}, $LIB->_new($shifty)) if $shifty != 0; # now mantissas are equalized, exponent of $x is adjusted, so calc result - $x->{_m} = $MBI->_mod($x->{_m}, $ym); + $x->{_m} = $LIB->_mod($x->{_m}, $ym); - $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0 + $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0 $x->bnorm(); if ($neg != 0 && ! $x -> is_zero()) # one of them negative => correct in place @@ -2051,7 +2090,7 @@ sub bmod { $x->{_m} = $r->{_m}; $x->{_e} = $r->{_e}; $x->{_es} = $r->{_es}; - $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0 + $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0 $x->bnorm(); } @@ -2062,7 +2101,7 @@ sub bmodpow { # takes a very large number to a very large exponent in a given very # large modulus, quickly, thanks to binary exponentiation. Supports # negative exponents. - my ($class, $num, $exp, $mod, @r) = objectify(3, @_); + my ($class, $num, $exp, $mod) = objectify(3, @_); return $num if $num->modify('bmodpow'); @@ -2101,8 +2140,33 @@ sub bpow { return $x if $x->modify('bpow'); - return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; - return $x if $x->{sign} =~ /^[+-]inf$/; + # $x and/or $y is a NaN + return $x->bnan() if $x->is_nan() || $y->is_nan(); + + # $x and/or $y is a +/-Inf + if ($x->is_inf("-")) { + return $x->bzero() if $y->is_negative(); + return $x->bnan() if $y->is_zero(); + return $x if $y->is_odd(); + return $x->bneg(); + } elsif ($x->is_inf("+")) { + return $x->bzero() if $y->is_negative(); + return $x->bnan() if $y->is_zero(); + return $x; + } elsif ($y->is_inf("-")) { + return $x->bnan() if $x -> is_one("-"); + return $x->binf("+") if $x > -1 && $x < 1; + return $x->bone() if $x -> is_one("+"); + return $x->bzero(); + } elsif ($y->is_inf("+")) { + return $x->bnan() if $x -> is_one("-"); + return $x->bzero() if $x > -1 && $x < 1; + return $x->bone() if $x -> is_one("+"); + return $x->binf("+"); + } + + # we don't support complex numbers, so return NaN + return $x->bnan() if $x->is_negative() && !$y->is_int(); # cache the result of is_zero my $y_is_zero = $y->is_zero(); @@ -2110,14 +2174,13 @@ sub bpow { return $x if $x->is_one() || $y->is_one(); my $x_is_zero = $x->is_zero(); - return $x->_pow($y, $a, $p, $r) if !$x_is_zero && !$y->is_int(); # non-integer power + return $x->_pow($y, $a, $p, $r) if !$x_is_zero && !$y->is_int(); my $y1 = $y->as_number()->{value}; # make MBI part - # if ($x == -1) - if ($x->{sign} eq '-' && $MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e})) { + if ($x->is_one("-")) { # if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1 - return $MBI->_is_odd($y1) ? $x : $x->babs(1); + return $LIB->_is_odd($y1) ? $x : $x->babs(1); } if ($x_is_zero) { return $x if $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0) @@ -2126,11 +2189,11 @@ sub bpow { } my $new_sign = '+'; - $new_sign = $MBI->_is_odd($y1) ? '-' : '+' if $x->{sign} ne '+'; + $new_sign = $LIB->_is_odd($y1) ? '-' : '+' if $x->{sign} ne '+'; # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster) - $x->{_m} = $MBI->_pow($x->{_m}, $y1); - $x->{_e} = $MBI->_mul ($x->{_e}, $y1); + $x->{_m} = $LIB->_pow($x->{_m}, $y1); + $x->{_e} = $LIB->_mul ($x->{_e}, $y1); $x->{sign} = $new_sign; $x->bnorm(); @@ -2267,32 +2330,33 @@ sub blog { # first. This is very fast, and in case the real result was found, we can # stop right here. if (defined $base && $base->is_int() && $x->is_int()) { - my $i = $MBI->_copy($x->{_m}); - $i = $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e}); - my $int = Math::BigInt->bzero(); - $int->{value} = $i; - $int->blog($base->as_number()); - # if ($exact) - if ($base->as_number()->bpow($int) == $x) { - # found result, return it - $x->{_m} = $int->{value}; - $x->{_e} = $MBI->_zero(); - $x->{_es} = '+'; - $x->bnorm(); + my $xint = Math::BigInt -> new($x -> bdstr()); + my $bint = Math::BigInt -> new($base -> bdstr()); + $xint->blog($bint); + + # if we found the exact result, we're done + if ($bint -> bpow($xint) == $x) { + my $xflt = Math::BigFloat -> new($xint -> bdstr()); + $x->{sign} = $xflt->{sign}; + $x->{_m} = $xflt->{_m}; + $x->{_es} = $xflt->{_es}; + $x->{_e} = $xflt->{_e}; $done = 1; } } if ($done == 0) { - # base is undef, so base should be e (Euler's number), so first calculate the - # log to base e (using reduction by 10 (and probably 2)): - $class->_log_10($x, $scale); + # First calculate the log to base e (using reduction by 10 and possibly + # also by 2): + $x->_log_10($scale); # and if a different base was requested, convert it if (defined $base) { - $base = Math::BigFloat->new($base) unless $base->isa('Math::BigFloat'); - # not ln, but some other base (don't modify $base) - $x->bdiv($base->copy()->blog(undef, $scale), $scale); + $base = Math::BigFloat->new($base) + unless $base->isa('Math::BigFloat'); + # log_b(x) = ln(x) / ln(b), so compute ln(b) + my $base_log_e = $base->copy()->_log_10($scale); + $x->bdiv($base_log_e, $scale); } } @@ -2340,7 +2404,8 @@ sub bexp { $params[2] = $r; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { - # the 4 below is empirical, and there might be cases where it's not enough... + # the 4 below is empirical, and there might be cases where it's not + # enough ... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } @@ -2410,21 +2475,23 @@ sub bexp { # -- + -- + -- + -- + -- + --- + --- + ---- = ----- # 1 1 2 6 24 120 720 5040 5040 - # Note that we cannot simple reduce 13700/5040 to 685/252, but must keep A and B! + # Note that we cannot simply reduce 13700/5040 to 685/252, but must keep + # the numerator and the denominator! if ($scale <= 75) { # set $x directly from a cached string form - $x->{_m} = $MBI->_new( - "27182818284590452353602874713526624977572470936999595749669676277240766303535476"); + $x->{_m} = $LIB->_new("2718281828459045235360287471352662497757" . + "2470936999595749669676277240766303535476"); $x->{sign} = '+'; $x->{_es} = '-'; - $x->{_e} = $MBI->_new(79); + $x->{_e} = $LIB->_new(79); } else { # compute A and B so that e = A / B. # After some terms we end up with this, so we use it as a starting point: - my $A = $MBI->_new("90933395208605785401971970164779391644753259799242"); - my $F = $MBI->_new(42); + my $A = $LIB->_new("9093339520860578540197197" . + "0164779391644753259799242"); + my $F = $LIB->_new(42); my $step = 42; # Compute how many steps we need to take to get $A and $B sufficiently big @@ -2432,24 +2499,24 @@ sub bexp { # print STDERR "# Doing $steps steps for ", $scale-4, " digits\n"; while ($step++ <= $steps) { # calculate $a * $f + 1 - $A = $MBI->_mul($A, $F); - $A = $MBI->_inc($A); + $A = $LIB->_mul($A, $F); + $A = $LIB->_inc($A); # increment f - $F = $MBI->_inc($F); + $F = $LIB->_inc($F); } # compute $B as factorial of $steps (this is faster than doing it manually) - my $B = $MBI->_fac($MBI->_new($steps)); + my $B = $LIB->_fac($LIB->_new($steps)); - # print "A ", $MBI->_str($A), "\nB ", $MBI->_str($B), "\n"; + # print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n"; # compute A/B with $scale digits in the result (truncate, not round) - $A = $MBI->_lsft($A, $MBI->_new($scale), 10); - $A = $MBI->_div($A, $B); + $A = $LIB->_lsft($A, $LIB->_new($scale), 10); + $A = $LIB->_div($A, $B); $x->{_m} = $A; $x->{sign} = '+'; $x->{_es} = '-'; - $x->{_e} = $MBI->_new($scale); + $x->{_e} = $LIB->_new($scale); } # $x contains now an estimate of e, with some surplus digits, so we can round @@ -2502,16 +2569,20 @@ sub bnok { return $x if $x->modify('bnok'); return $x->bnan() if $x->is_nan() || $y->is_nan(); - return $x->binf() if $x->is_inf(); + return $x->bnan() if (($x->is_finite() && !$x->is_int()) || + ($y->is_finite() && !$y->is_int())); - my $u = $x->as_int(); - $u->bnok($y->as_int()); + my $xint = Math::BigInt -> new($x -> bsstr()); + my $yint = Math::BigInt -> new($y -> bsstr()); + $xint -> bnok($yint); + my $xflt = Math::BigFloat -> new($xint); - $x->{_m} = $u->{value}; - $x->{_e} = $MBI->_zero(); - $x->{_es} = '+'; - $x->{sign} = '+'; - $x->bnorm(@r); + $x->{_m} = $xflt->{_m}; + $x->{_e} = $xflt->{_e}; + $x->{_es} = $xflt->{_es}; + $x->{sign} = $xflt->{sign}; + + return $x; } sub bsin { @@ -2558,7 +2629,6 @@ sub bsin { # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; - my $last = 0; my $over = $x * $x; # X ^ 2 my $x2 = $over->copy(); # X ^ 2; difference between terms $over->bmul($x); # X ^ 3 as starting value @@ -2648,7 +2718,6 @@ sub bcos { # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; - my $last = 0; my $over = $x * $x; # X ^ 2 my $x2 = $over->copy(); # X ^ 2; difference between terms my $sign = 1; # start with -= @@ -2730,7 +2799,7 @@ sub batan { $self->{_es} = $pi->{_es}; # -y => -PI/2, +y => PI/2 $self->{sign} = substr($self->{sign}, 0, 1); # "+inf" => "+" - $self -> {_m} = $MBI->_div($self->{_m}, $MBI->_new(2)); + $self -> {_m} = $LIB->_div($self->{_m}, $LIB->_new(2)); return $self; } @@ -2752,25 +2821,24 @@ sub batan { # 1 or -1 => PI/4 # inlined is_one() && is_one('-') - if ($MBI->_is_one($self->{_m}) && $MBI->_is_zero($self->{_e})) { + if ($LIB->_is_one($self->{_m}) && $LIB->_is_zero($self->{_e})) { my $pi = $class->bpi($scale - 3); # modify $self in place $self->{_m} = $pi->{_m}; $self->{_e} = $pi->{_e}; $self->{_es} = $pi->{_es}; # leave the sign of $self alone (+1 => +PI/4, -1 => -PI/4) - $self->{_m} = $MBI->_div($self->{_m}, $MBI->_new(4)); + $self->{_m} = $LIB->_div($self->{_m}, $LIB->_new(4)); return $self; } # This series is only valid if -1 < x < 1, so for other x we need to # calculate PI/2 - atan(1/x): - my $one = $MBI->_new(1); my $pi = undef; if ($self->bacmp($self->copy()->bone) >= 0) { # calculate PI/2 $pi = $class->bpi($scale - 3); - $pi->{_m} = $MBI->_div($pi->{_m}, $MBI->_new(2)); + $pi->{_m} = $LIB->_div($pi->{_m}, $LIB->_new(2)); # calculate 1/$self: my $self_copy = $self->copy(); # modify $self in place @@ -2779,7 +2847,7 @@ sub batan { } my $fmul = 1; - foreach my $k (0 .. int($scale / 20)) { + foreach (0 .. int($scale / 20)) { $fmul *= 2; $self->bdiv($self->copy()->bmul($self)->binc->bsqrt($scale + 4)->binc, $scale + 4); } @@ -2796,7 +2864,6 @@ sub batan { # Need to disable $upgrade in BigInt, to avoid deep recursion. local $Math::BigInt::upgrade = undef; - my $last = 0; my $over = $self * $self; # X ^ 2 my $self2 = $over->copy(); # X ^ 2; difference between terms $over->bmul($self); # X ^ 3 as starting value @@ -2992,8 +3059,8 @@ sub bsqrt { # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI - my $i = $MBI->_copy($x->{_m}); - $i = $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e}); + my $i = $LIB->_copy($x->{_m}); + $i = $LIB->_lsft($i, $x->{_e}, 10) unless $LIB->_is_zero($x->{_e}); my $xas = Math::BigInt->bzero(); $xas->{value} = $i; @@ -3005,7 +3072,7 @@ sub bsqrt { { # exact result, copy result over to keep $x $x->{_m} = $gs->{value}; - $x->{_e} = $MBI->_zero(); + $x->{_e} = $LIB->_zero(); $x->{_es} = '+'; $x->bnorm(); # shortcut to not run through _find_round_parameters again @@ -3030,9 +3097,9 @@ sub bsqrt { # result of sqrt(input) by 10. Rounding afterwards returns the real result. # The following steps will transform 123.456 (in $x) into 123456 (in $y1) - my $y1 = $MBI->_copy($x->{_m}); + my $y1 = $LIB->_copy($x->{_m}); - my $length = $MBI->_len($y1); + my $length = $LIB->_len($y1); # Now calculate how many digits the result of sqrt(y1) would have my $digits = int($length / 2); @@ -3053,19 +3120,19 @@ sub bsqrt { # steps of 10. The length of $x does not count, since an even or odd number # of digits before the dot is not changed by adding an even number of digits # after the dot (the result is still odd or even digits long). - $s2++ if $MBI->_is_odd($x->{_e}); + $s2++ if $LIB->_is_odd($x->{_e}); - $y1 = $MBI->_lsft($y1, $MBI->_new($s2), 10); + $y1 = $LIB->_lsft($y1, $LIB->_new($s2), 10); # now take the square root and truncate to integer - $y1 = $MBI->_sqrt($y1); + $y1 = $LIB->_sqrt($y1); # By "shifting" $y1 right (by creating a negative _e) we calculate the final # result, which is than later rounded to the desired scale. # calculate how many zeros $x had after the '.' (or before it, depending # on sign of $dat, the result should have half as many: - my $dat = $MBI->_num($x->{_e}); + my $dat = $LIB->_num($x->{_e}); $dat = -$dat if $x->{_es} eq '-'; $dat += $length; @@ -3077,13 +3144,13 @@ sub bsqrt { } else { $dat = int(($dat)/2); } - $dat -= $MBI->_len($y1); + $dat -= $LIB->_len($y1); if ($dat < 0) { $dat = abs($dat); - $x->{_e} = $MBI->_new($dat); + $x->{_e} = $LIB->_new($dat); $x->{_es} = '-'; } else { - $x->{_e} = $MBI->_new($dat); + $x->{_e} = $LIB->_new($dat); $x->{_es} = '+'; } $x->{_m} = $y1; @@ -3163,7 +3230,7 @@ sub broot { my $is_two = 0; if ($y->isa('Math::BigFloat')) { - $is_two = ($y->{sign} eq '+' && $MBI->_is_two($y->{_m}) && $MBI->_is_zero($y->{_e})); + $is_two = ($y->{sign} eq '+' && $LIB->_is_two($y->{_m}) && $LIB->_is_zero($y->{_e})); } else { $is_two = ($y == 2); } @@ -3184,8 +3251,8 @@ sub broot { my $done = 0; # not yet if ($y->is_int() && $x->is_int()) { - my $i = $MBI->_copy($x->{_m}); - $i = $MBI->_lsft($i, $x->{_e}, 10) unless $MBI->_is_zero($x->{_e}); + my $i = $LIB->_copy($x->{_m}); + $i = $LIB->_lsft($i, $x->{_e}, 10) unless $LIB->_is_zero($x->{_e}); my $int = Math::BigInt->bzero(); $int->{value} = $i; $int->broot($y->as_number()); @@ -3193,7 +3260,7 @@ sub broot { if ($int->copy()->bpow($y) == $x) { # found result, return it $x->{_m} = $int->{value}; - $x->{_e} = $MBI->_zero(); + $x->{_e} = $LIB->_zero(); $x->{_es} = '+'; $x->bnorm(); $done = 1; @@ -3240,12 +3307,12 @@ sub bfac { if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN ($x->{_es} ne '+')); # digits after dot? - if (! $MBI->_is_zero($x->{_e})) { - $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0 - $x->{_e} = $MBI->_zero(); # normalize + if (! $LIB->_is_zero($x->{_e})) { + $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0 + $x->{_e} = $LIB->_zero(); # normalize $x->{_es} = '+'; } - $x->{_m} = $MBI->_fac($x->{_m}); # calculate factorial + $x->{_m} = $LIB->_fac($x->{_m}); # calculate factorial $x->bnorm()->round(@r); # norm again and round result } @@ -3264,15 +3331,15 @@ sub bdfac { if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN ($x->{_es} ne '+')); # digits after dot? - Carp::croak("bdfac() requires a newer version of the $MBI library.") - unless $MBI->can('_dfac'); + croak("bdfac() requires a newer version of the $LIB library.") + unless $LIB->can('_dfac'); - if (! $MBI->_is_zero($x->{_e})) { - $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0 - $x->{_e} = $MBI->_zero(); # normalize + if (! $LIB->_is_zero($x->{_e})) { + $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0 + $x->{_e} = $LIB->_zero(); # normalize $x->{_es} = '+'; } - $x->{_m} = $MBI->_dfac($x->{_m}); # calculate factorial + $x->{_m} = $LIB->_dfac($x->{_m}); # calculate factorial $x->bnorm()->round(@r); # norm again and round result } @@ -3337,8 +3404,8 @@ sub band { my $xref = ref($x); my $class = $xref || $x; - Carp::croak 'band() is an instance method, not a class method' unless $xref; - Carp::croak 'Not enough arguments for band()' if @_ < 1; + croak 'band() is an instance method, not a class method' unless $xref; + croak 'Not enough arguments for band()' if @_ < 1; return if $x -> modify('band'); @@ -3364,8 +3431,8 @@ sub bior { my $xref = ref($x); my $class = $xref || $x; - Carp::croak 'bior() is an instance method, not a class method' unless $xref; - Carp::croak 'Not enough arguments for bior()' if @_ < 1; + croak 'bior() is an instance method, not a class method' unless $xref; + croak 'Not enough arguments for bior()' if @_ < 1; return if $x -> modify('bior'); @@ -3391,8 +3458,8 @@ sub bxor { my $xref = ref($x); my $class = $xref || $x; - Carp::croak 'bxor() is an instance method, not a class method' unless $xref; - Carp::croak 'Not enough arguments for bxor()' if @_ < 1; + croak 'bxor() is an instance method, not a class method' unless $xref; + croak 'Not enough arguments for bxor()' if @_ < 1; return if $x -> modify('bxor'); @@ -3418,7 +3485,7 @@ sub bnot { my $xref = ref($x); my $class = $xref || $x; - Carp::croak 'bnot() is an instance method, not a class method' unless $xref; + croak 'bnot() is an instance method, not a class method' unless $xref; return if $x -> modify('bnot'); @@ -3447,7 +3514,7 @@ sub bround { $x = $class->new(shift) if !ref($x); if (($_[0] || 0) < 0) { - Carp::croak('bround() needs positive accuracy'); + croak('bround() needs positive accuracy'); } my ($scale, $mode) = $x->_scale_a(@_); @@ -3466,7 +3533,7 @@ sub bround { # 1: never round a 0 # 2: if we should keep more digits than the mantissa has, do nothing - if ($x->is_zero() || $MBI->_len($x->{_m}) <= $scale) { + if ($x->is_zero() || $LIB->_len($x->{_m}) <= $scale) { $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; return $x; } @@ -3510,11 +3577,11 @@ sub bfround { return $x if $x->{_es} eq '+'; # e >= 0 => nothing to round $scale = -$scale; # positive for simplicity - my $len = $MBI->_len($x->{_m}); # length of mantissa + my $len = $LIB->_len($x->{_m}); # length of mantissa # the following poses a restriction on _e, but if _e is bigger than a # scalar, you got other problems (memory etc) anyway - my $dad = -(0+ ($x->{_es}.$MBI->_num($x->{_e}))); # digits after dot + my $dad = -(0+ ($x->{_es}.$LIB->_num($x->{_e}))); # digits after dot my $zad = 0; # zeros after dot $zad = $dad - $len if (-$dad < -$len); # for 0.00..00xxx style @@ -3550,9 +3617,9 @@ sub bfround { # 123 => 100 means length(123) = 3 - $scale (2) => 1 - my $dbt = $MBI->_len($x->{_m}); + my $dbt = $LIB->_len($x->{_m}); # digits before dot - my $dbd = $dbt + ($x->{_es} . $MBI->_num($x->{_e})); + my $dbd = $dbt + ($x->{_es} . $LIB->_num($x->{_e})); # should be the same, so treat it as this $scale = 1 if $scale == 0; # shortcut if already integer @@ -3586,10 +3653,10 @@ sub bfloor { # if $x has digits after dot if ($x->{_es} eq '-') { - $x->{_m} = $MBI->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot - $x->{_e} = $MBI->_zero(); # trunc/norm + $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot + $x->{_e} = $LIB->_zero(); # trunc/norm $x->{_es} = '+'; # abs e - $x->{_m} = $MBI->_inc($x->{_m}) if $x->{sign} eq '-'; # increment if negative + $x->{_m} = $LIB->_inc($x->{_m}) if $x->{sign} eq '-'; # increment if negative } $x->round($a, $p, $r); } @@ -3603,13 +3670,13 @@ sub bceil { # if $x has digits after dot if ($x->{_es} eq '-') { - $x->{_m} = $MBI->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot - $x->{_e} = $MBI->_zero(); # trunc/norm + $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot + $x->{_e} = $LIB->_zero(); # trunc/norm $x->{_es} = '+'; # abs e if ($x->{sign} eq '+') { - $x->{_m} = $MBI->_inc($x->{_m}); # increment if positive + $x->{_m} = $LIB->_inc($x->{_m}); # increment if positive } else { - $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # avoid -0 + $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # avoid -0 } } $x->round($a, $p, $r); @@ -3624,10 +3691,10 @@ sub bint { # if $x has digits after the decimal point if ($x->{_es} eq '-') { - $x->{_m} = $MBI->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot - $x->{_e} = $MBI->_zero(); # truncate/normalize + $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # cut off digits after dot + $x->{_e} = $LIB->_zero(); # truncate/normalize $x->{_es} = '+'; # abs e - $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # avoid -0 + $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # avoid -0 } $x->round($a, $p, $r); } @@ -3698,13 +3765,13 @@ sub length { my $class = ref($x) || $x; $x = $class->new(shift) unless ref($x); - return 1 if $MBI->_is_zero($x->{_m}); + return 1 if $LIB->_is_zero($x->{_m}); - my $len = $MBI->_len($x->{_m}); - $len += $MBI->_num($x->{_e}) if $x->{_es} eq '+'; + my $len = $LIB->_len($x->{_m}); + $len += $LIB->_num($x->{_e}) if $x->{_es} eq '+'; if (wantarray()) { my $t = 0; - $t = $MBI->_num($x->{_e}) if $x->{_es} eq '-'; + $t = $LIB->_num($x->{_e}) if $x->{_es} eq '-'; return ($len, $t); } $len; @@ -3719,7 +3786,7 @@ sub mantissa { $s =~ s/^[+]//; return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf } - my $m = Math::BigInt->new($MBI->_str($x->{_m}), undef, undef); + my $m = Math::BigInt->new($LIB->_str($x->{_m}), undef, undef); $m->bneg() if $x->{sign} eq '-'; $m; @@ -3734,7 +3801,7 @@ sub exponent { $s =~ s/^[+-]//; return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf } - Math::BigInt->new($x->{_es} . $MBI->_str($x->{_e}), undef, undef); + Math::BigInt->new($x->{_es} . $LIB->_str($x->{_e}), undef, undef); } sub parts { @@ -3749,16 +3816,16 @@ $se =~ s/^[-]//; return ($class->new($s), $class->new($se)); # +inf => inf and -inf, +inf => inf } my $m = Math::BigInt->bzero(); - $m->{value} = $MBI->_copy($x->{_m}); + $m->{value} = $LIB->_copy($x->{_m}); $m->bneg() if $x->{sign} eq '-'; - ($m, Math::BigInt->new($x->{_es} . $MBI->_num($x->{_e}))); + ($m, Math::BigInt->new($x->{_es} . $LIB->_num($x->{_e}))); } sub sparts { my $self = shift; my $class = ref $self; - Carp::croak("sparts() is an instance method, not a class method") + croak("sparts() is an instance method, not a class method") unless $class; # Not-a-number. @@ -3783,12 +3850,12 @@ sub sparts { my $mant = $class -> bzero(); $mant -> {sign} = $self -> {sign}; - $mant -> {_m} = $MBI->_copy($self -> {_m}); + $mant -> {_m} = $LIB->_copy($self -> {_m}); return $mant unless wantarray; my $expo = $class -> bzero(); $expo -> {sign} = $self -> {_es}; - $expo -> {_m} = $MBI->_copy($self -> {_e}); + $expo -> {_m} = $LIB->_copy($self -> {_e}); return ($mant, $expo); } @@ -3797,7 +3864,7 @@ sub nparts { my $self = shift; my $class = ref $self; - Carp::croak("nparts() is an instance method, not a class method") + croak("nparts() is an instance method, not a class method") unless $class; # Not-a-number. @@ -3843,7 +3910,7 @@ sub eparts { my $self = shift; my $class = ref $self; - Carp::croak("eparts() is an instance method, not a class method") + croak("eparts() is an instance method, not a class method") unless $class; # Not-a-number and Infinity. @@ -3866,7 +3933,7 @@ sub dparts { my $self = shift; my $class = ref $self; - Carp::croak("dparts() is an instance method, not a class method") + croak("dparts() is an instance method, not a class method") unless $class; # Not-a-number and Infinity. @@ -3884,10 +3951,10 @@ sub dparts { # If the input has a fraction part. if ($int->{_es} eq '-') { - $int->{_m} = $MBI -> _rsft($int->{_m}, $int->{_e}, 10); - $int->{_e} = $MBI -> _zero(); + $int->{_m} = $LIB -> _rsft($int->{_m}, $int->{_e}, 10); + $int->{_e} = $LIB -> _zero(); $int->{_es} = '+'; - $int->{sign} = '+' if $MBI->_is_zero($int->{_m}); # avoid -0 + $int->{sign} = '+' if $LIB->_is_zero($int->{_m}); # avoid -0 return $int unless wantarray; $frc = $self -> copy() -> bsub($int); @@ -3919,11 +3986,11 @@ my $cad = 0; my $dot = '.'; # $x is zero? - my $not_zero = !($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})); + my $not_zero = !($x->{sign} eq '+' && $LIB->_is_zero($x->{_m})); if ($not_zero) { - $es = $MBI->_str($x->{_m}); + $es = $LIB->_str($x->{_m}); $len = CORE::length($es); - my $e = $MBI->_num($x->{_e}); + my $e = $LIB->_num($x->{_e}); $e = -$e if $x->{_es} eq '-'; if ($e < 0) { $dot = ''; @@ -3934,7 +4001,7 @@ my $dot = '.'; $cad = -($len+$r); } else { substr($es, $e, 0) = '.'; - $cad = $MBI->_num($x->{_e}); + $cad = $LIB->_num($x->{_e}); $cad = -$cad if $x->{_es} eq '-'; } } elsif ($e > 0) { @@ -3970,7 +4037,7 @@ sub bdstr { return 'inf'; # +inf } - my $mant = $MBI->_str($x->{_m}); + my $mant = $LIB->_str($x->{_m}); my $expo = $x -> exponent(); my $str = $mant; @@ -3997,7 +4064,7 @@ sub bsstr { return 'inf'; # +inf } - my $str = $MBI->_str($x->{_m}) . 'e' . $x->{_es}. $MBI->_str($x->{_e}); + my $str = $LIB->_str($x->{_m}) . 'e' . $x->{_es}. $LIB->_str($x->{_e}); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -4049,11 +4116,11 @@ sub to_hex { return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex? - my $z = $MBI->_copy($x->{_m}); - if (! $MBI->_is_zero($x->{_e})) { # > 0 - $z = $MBI->_lsft($z, $x->{_e}, 10); + my $z = $LIB->_copy($x->{_m}); + if (! $LIB->_is_zero($x->{_e})) { # > 0 + $z = $LIB->_lsft($z, $x->{_e}, 10); } - my $str = $MBI->_to_hex($z); + my $str = $LIB->_to_hex($z); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -4067,11 +4134,11 @@ sub to_oct { return $nan if $x->{_es} ne '+'; # how to do 1e-1 in octal? - my $z = $MBI->_copy($x->{_m}); - if (! $MBI->_is_zero($x->{_e})) { # > 0 - $z = $MBI->_lsft($z, $x->{_e}, 10); + my $z = $LIB->_copy($x->{_m}); + if (! $LIB->_is_zero($x->{_e})) { # > 0 + $z = $LIB->_lsft($z, $x->{_e}, 10); } - my $str = $MBI->_to_oct($z); + my $str = $LIB->_to_oct($z); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -4085,11 +4152,11 @@ sub to_bin { return $nan if $x->{_es} ne '+'; # how to do 1e-1 in binary? - my $z = $MBI->_copy($x->{_m}); - if (! $MBI->_is_zero($x->{_e})) { # > 0 - $z = $MBI->_lsft($z, $x->{_e}, 10); + my $z = $LIB->_copy($x->{_m}); + if (! $LIB->_is_zero($x->{_e})) { # > 0 + $z = $LIB->_lsft($z, $x->{_e}, 10); } - my $str = $MBI->_to_bin($z); + my $str = $LIB->_to_bin($z); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -4103,11 +4170,11 @@ sub as_hex { return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex? - my $z = $MBI->_copy($x->{_m}); - if (! $MBI->_is_zero($x->{_e})) { # > 0 - $z = $MBI->_lsft($z, $x->{_e}, 10); + my $z = $LIB->_copy($x->{_m}); + if (! $LIB->_is_zero($x->{_e})) { # > 0 + $z = $LIB->_lsft($z, $x->{_e}, 10); } - my $str = $MBI->_as_hex($z); + my $str = $LIB->_as_hex($z); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -4121,11 +4188,11 @@ sub as_oct { return $nan if $x->{_es} ne '+'; # how to do 1e-1 in octal? - my $z = $MBI->_copy($x->{_m}); - if (! $MBI->_is_zero($x->{_e})) { # > 0 - $z = $MBI->_lsft($z, $x->{_e}, 10); + my $z = $LIB->_copy($x->{_m}); + if (! $LIB->_is_zero($x->{_e})) { # > 0 + $z = $LIB->_lsft($z, $x->{_e}, 10); } - my $str = $MBI->_as_oct($z); + my $str = $LIB->_as_oct($z); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -4139,11 +4206,11 @@ sub as_bin { return $nan if $x->{_es} ne '+'; # how to do 1e-1 in binary? - my $z = $MBI->_copy($x->{_m}); - if (! $MBI->_is_zero($x->{_e})) { # > 0 - $z = $MBI->_lsft($z, $x->{_e}, 10); + my $z = $LIB->_copy($x->{_m}); + if (! $LIB->_is_zero($x->{_e})) { # > 0 + $z = $LIB->_lsft($z, $x->{_e}, 10); } - my $str = $MBI->_as_bin($z); + my $str = $LIB->_as_bin($z); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -4199,7 +4266,7 @@ my @a; } elsif ($_[$i] eq 'with') { # alternative class for our private parts() # XXX: no longer supported - # $MBI = $_[$i+1] || 'Math::BigInt'; + # $LIB = $_[$i+1] || 'Math::BigInt'; $i++; } else { push @a, $_[$i]; @@ -4209,11 +4276,11 @@ my @a; $lib =~ tr/a-zA-Z0-9,://cd; # restrict to sane characters # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work my $mbilib = eval { Math::BigInt->config('lib') }; - if ((defined $mbilib) && ($MBI eq 'Math::BigInt::Calc')) { - # MBI already loaded + if ((defined $mbilib) && ($LIB eq 'Math::BigInt::Calc')) { + # $LIB already loaded Math::BigInt->import($lib_kind, "$lib, $mbilib", 'objectify'); } else { - # MBI not loaded, or with ne "Math::BigInt::Calc" + # $LIB not loaded, or with ne "Math::BigInt::Calc" $lib .= ",$mbilib" if defined $mbilib; $lib =~ s/^,//; # don't leave empty @@ -4225,13 +4292,13 @@ my @a; Math::BigInt->import($lib_kind => $lib, 'objectify'); } if ($@) { - Carp::croak("Couldn't load $lib: $! $@"); + croak("Couldn't load $lib: $! $@"); } # find out which one was actually loaded - $MBI = Math::BigInt->config('lib'); + $LIB = Math::BigInt->config('lib'); # register us with MBI to get notified of future lib changes - Math::BigInt::_register_callback($class, sub { $MBI = $_[0]; }); + Math::BigInt::_register_callback($class, sub { $LIB = $_[0]; }); $class->export_to_level(1, $class, @a); # export wanted functions } @@ -4268,7 +4335,8 @@ my $r = $d; sub _log { # internal log function to calculate ln() based on Taylor series. # Modifies $x in place. - my ($class, $x, $scale) = @_; + my ($x, $scale) = @_; + my $class = ref $x; # in case of $x == 1, result is 0 return $x->bzero() if $x->is_one(); @@ -4290,7 +4358,7 @@ sub _log { # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 1/2 # |_ x 2 x^2 3 x^3 _| - my ($limit, $v, $u, $below, $factor, $two, $next, $over, $f); + my ($limit, $v, $u, $below, $factor, $next, $over, $f); $v = $x->copy(); $v->binc(); # v = x+1 $x->bdec(); $u = $x->copy(); # u = x-1; x = x-1 @@ -4304,6 +4372,7 @@ sub _log { my $steps = 0; $limit = $class->new("1E-". ($scale-1)); + 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 @@ -4337,19 +4406,15 @@ sub _log { $over *= $u; $below *= $v; $factor->badd($f); - if (DEBUG) { - $steps++; - print "step $steps = $x\n" if $steps % 10 == 0; - } } - print "took $steps steps\n" if DEBUG; $x->bmul($f); # $x *= 2 } sub _log_10 { # Internal log function based on reducing input to the range of 0.1 .. 9.99 # and then "correcting" the result to the proper one. Modifies $x in place. - my ($class, $x, $scale) = @_; + my ($x, $scale) = @_; + my $class = ref $x; # Taking blog() from numbers greater than 10 takes a *very long* time, so we # break the computation down into parts based on the observation that: @@ -4365,16 +4430,18 @@ sub _log_10 { # To get $x even closer to 1, we also divide by 2 and then use log(2) to # correct for this. For instance if $x is 2.4, we use the formula: - # blog(2.4 * 2) == blog (1.2) + blog(2) + # blog(2.4 * 2) == blog(1.2) + blog(2) # and thus calculate only blog(1.2) and blog(2), which is faster in total # than calculating blog(2.4). # In addition, the values for blog(2) and blog(10) are cached. - # Calculate nr of digits before dot: - my $dbd = $MBI->_num($x->{_e}); + # Calculate nr of digits before dot. x = 123, dbd = 3; x = 1.23, dbd = 1; + # x = 0.0123, dbd = -1; x = 0.000123, dbd = -3, etc. + + my $dbd = $LIB->_num($x->{_e}); $dbd = -$dbd if $x->{_es} eq '-'; - $dbd += $MBI->_len($x->{_m}); + $dbd += $LIB->_len($x->{_m}); # more than one digit (e.g. at least 10), but *not* exactly 10 to avoid # infinite recursion @@ -4383,7 +4450,10 @@ sub _log_10 { # disable the shortcut for 10, since we need log(10) and this would recurse # infinitely deep - if ($x->{_es} eq '+' && $MBI->_is_one($x->{_e}) && $MBI->_is_one($x->{_m})) { + if ($x->{_es} eq '+' && # $x == 10 + ($LIB->_is_one($x->{_e}) && + $LIB->_is_one($x->{_m}))) + { $dbd = 0; # disable shortcut # we can use the cached value in these cases if ($scale <= $LOG_10_A) { @@ -4394,7 +4464,9 @@ sub _log_10 { # if we can't use the shortcut, we continue normally } else { # disable the shortcut for 2, since we maybe have it cached - if (($MBI->_is_zero($x->{_e}) && $MBI->_is_two($x->{_m}))) { + if (($LIB->_is_zero($x->{_e}) && # $x == 2 + $LIB->_is_two($x->{_m}))) + { $dbd = 0; # disable shortcut # we can use the cached value in these cases if ($scale <= $LOG_2_A) { @@ -4407,8 +4479,11 @@ sub _log_10 { } # if $x = 0.1, we know the result must be 0-log(10) - if ($calc != 0 && $x->{_es} eq '-' && $MBI->_is_one($x->{_e}) && - $MBI->_is_one($x->{_m})) { + if ($calc != 0 && + ($x->{_es} eq '-' && # $x == 0.1 + ($LIB->_is_one($x->{_e}) && + $LIB->_is_one($x->{_m})))) + { $dbd = 0; # disable shortcut # we can use the cached value in these cases if ($scale <= $LOG_10_A) { @@ -4418,7 +4493,7 @@ sub _log_10 { } } - return if $calc == 0; # already have the result + return $x if $calc == 0; # already have the result # default: these correction factors are undef and thus not used my $l_10; # value of ln(10) to A of $scale @@ -4459,7 +4534,7 @@ sub _log_10 { } else { # else: slower, compute and cache result $l_2 = $two->copy(); - $class->_log($l_2, $scale); # scale+4, actually + $l_2->_log($scale); # scale+4, actually $LOG_2 = $l_2->copy(); # cache the result for later # the copy() is for mul below $LOG_2_A = $scale; @@ -4467,7 +4542,7 @@ sub _log_10 { # now calculate log(1.25): $l_10 = $class->new('1.25'); - $class->_log($l_10, $scale); # scale+4, actually + $l_10->_log($scale); # scale+4, actually # log(1.25) + log(2) + log(2) + log(2): $l_10->badd($l_2); @@ -4485,7 +4560,7 @@ sub _log_10 { $dbd_sign = '-'; } ($x->{_e}, $x->{_es}) = - _e_sub($x->{_e}, $MBI->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23 + _e_sub($x->{_e}, $LIB->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23 } @@ -4518,7 +4593,7 @@ sub _log_10 { # also disable downgrade for this code path local $Math::BigFloat::downgrade = undef; $l_2 = $two->copy(); - $class->_log($l_2, $scale); # scale+4, actually + $l_2->_log($scale); # scale+4, actually $LOG_2 = $l_2->copy(); # cache the result for later # the copy() is for mul below $LOG_2_A = $scale; @@ -4528,7 +4603,7 @@ sub _log_10 { undef $l_2; } - $class->_log($x, $scale); # need to do the "normal" way + $x->_log($scale); # need to do the "normal" way $x->badd($l_10) if defined $l_10; # correct it by ln(10) $x->badd($l_2) if defined $l_2; # and maybe by ln(2) @@ -4538,39 +4613,39 @@ sub _log_10 { sub _e_add { # Internal helper sub to take two positive integers and their signs and - # then add them. Input ($CALC, $CALC, ('+'|'-'), ('+'|'-')), output - # ($CALC, ('+'|'-')). + # then add them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')), output + # ($LIB, ('+'|'-')). my ($x, $y, $xs, $ys) = @_; # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8) if ($xs eq $ys) { - $x = $MBI->_add($x, $y); # +a + +b or -a + -b + $x = $LIB->_add($x, $y); # +a + +b or -a + -b } else { - my $a = $MBI->_acmp($x, $y); + my $a = $LIB->_acmp($x, $y); if ($a == 0) { # This does NOT modify $x in-place. TODO: Fix this? - $x = $MBI->_zero(); # result is 0 + $x = $LIB->_zero(); # result is 0 $xs = '+'; return ($x, $xs); } if ($a > 0) { - $x = $MBI->_sub($x, $y); # abs sub + $x = $LIB->_sub($x, $y); # abs sub } else { # a < 0 - $x = $MBI->_sub ($y, $x, 1); # abs sub + $x = $LIB->_sub ($y, $x, 1); # abs sub $xs = $ys; } } - $xs = '+' if $xs eq '-' && $MBI->_is_zero($x); # no "-0" + $xs = '+' if $xs eq '-' && $LIB->_is_zero($x); # no "-0" return ($x, $xs); } sub _e_sub { # Internal helper sub to take two positive integers and their signs and - # then subtract them. Input ($CALC, $CALC, ('+'|'-'), ('+'|'-')), - # output ($CALC, ('+'|'-')) + # then subtract them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')), + # output ($LIB, ('+'|'-')) my ($x, $y, $xs, $ys) = @_; # flip sign @@ -4706,7 +4781,7 @@ Math::BigFloat - Arbitrary size floating point math package Math::BigFloat->round_mode($m); # set global round mode, must be one of # 'even', 'odd', '+inf', '-inf', 'zero', # 'trunc', or 'common' - Math::BigFloat->config(); # return hash with configuration + Math::BigFloat->config("lib"); # name of backend math library # Constructor methods (when the class methods below are used as instance # methods, the value is assigned the invocand) @@ -4791,7 +4866,7 @@ Math::BigFloat - Arbitrary size floating point math package $x->bcos(); # cosine $x->batan(); # inverse tangent $x->batan2($y); # two-argument inverse tangent - $x->bsqrt(); # calculate square-root + $x->bsqrt(); # calculate square root $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root) $x->bfac(); # factorial of $x (1*2*3*4*..$x) @@ -5062,7 +5137,7 @@ This method was added in v1.87 of Math::BigInt (June 2007). In scalar context, divides $x by $y and returns the result to the given or default accuracy/precision. In list context, does floored division (F-division), returning an integer $q and a remainder $r so that $x = $q * $y + -$r. The remainer (modulo) is equal to what is returned by C<$x->bmod($y)>. +$r. The remainer (modulo) is equal to what is returned by C<< $x->bmod($y) >>. =item bmod() diff --git a/Master/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm b/Master/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm index 04dec98bc5e..2fc069370ad 100644 --- a/Master/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm +++ b/Master/tlpkg/tlperl/lib/Math/BigFloat/Trace.pm @@ -13,7 +13,7 @@ our ($accuracy, $precision, $round_mode, $div_scale); our @ISA = qw(Exporter Math::BigFloat); -our $VERSION = '0.49'; +our $VERSION = '0.51'; use overload; # inherit overload from Math::BigFloat diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt.pm b/Master/tlpkg/tlperl/lib/Math/BigInt.pm index 9fd9bd02ba3..a443cd4a5d4 100644 --- a/Master/tlpkg/tlperl/lib/Math/BigInt.pm +++ b/Master/tlpkg/tlperl/lib/Math/BigInt.pm @@ -11,17 +11,18 @@ package Math::BigInt; # _a : accuracy # _p : precision -# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since +# Remember not to take shortcuts ala $xs = $x->{value}; $LIB->foo($xs); since # underlying lib might change the reference! use 5.006001; use strict; use warnings; -use Carp (); +use Carp qw< carp croak >; -our $VERSION = '1.999811'; +our $VERSION = '1.999816'; +require Exporter; our @ISA = qw(Exporter); our @EXPORT_OK = qw(objectify bgcd blcm); @@ -79,7 +80,6 @@ use overload '**=' => sub { $_[0]->bpow($_[1]); }, - '<<=' => sub { $_[0]->blsft($_[1]); }, '>>=' => sub { $_[0]->brsft($_[1]); }, @@ -228,12 +228,11 @@ our $_trap_inf = 0; # are infs ok? set w/ config() my $nan = 'NaN'; # constants for easier life -my $CALC = 'Math::BigInt::Calc'; # module to do the low level math +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 %CAN; # cache for $CALC->can(...) my %CALLBACKS; # callbacks to notify on lib loads my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math @@ -277,7 +276,7 @@ sub round_mode { if (defined $_[0]) { my $m = shift; if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/) { - Carp::croak("Unknown round mode '$m'"); + croak("Unknown round mode '$m'"); } return ${"${class}::round_mode"} = $m; } @@ -315,7 +314,7 @@ sub div_scale { my $class = ref($self) || $self || __PACKAGE__; if (defined $_[0]) { if ($_[0] < 0) { - Carp::croak('div_scale must be greater than zero'); + croak('div_scale must be greater than zero'); } ${"${class}::div_scale"} = $_[0]; } @@ -332,42 +331,40 @@ sub accuracy { my $class = ref($x) || $x || __PACKAGE__; no strict 'refs'; - # need to set new value? if (@_ > 0) { my $a = shift; - # convert objects to scalars to avoid deep recursion. If object doesn't - # have numify(), then hopefully it will have overloading for int() and - # boolean test without wandering into a deep recursion path... - $a = $a->numify() if ref($a) && $a->can('numify'); - if (defined $a) { + $a = $a->numify() if ref($a) && $a->can('numify'); # also croak on non-numerical if (!$a || $a <= 0) { - Carp::croak('Argument to accuracy must be greater than zero'); + croak('Argument to accuracy must be greater than zero'); } if (int($a) != $a) { - Carp::croak('Argument to accuracy must be an integer'); + croak('Argument to accuracy must be an integer'); } } + if (ref($x)) { - # $object->accuracy() or fallback to global + # Set instance variable. $x->bround($a) if $a; # not for undef, 0 $x->{_a} = $a; # set/overwrite, even if not rounded delete $x->{_p}; # clear P + # Why return class variable here? Fixme! $a = ${"${class}::accuracy"} unless defined $a; # proper return value } else { + # Set class variable. ${"${class}::accuracy"} = $a; # set global A ${"${class}::precision"} = undef; # clear global P } + return $a; # shortcut } - my $a; - # $object->accuracy() or fallback to global - $a = $x->{_a} if ref($x); - # but don't return global undef, when $x's accuracy is 0! - $a = ${"${class}::accuracy"} if !defined $a; - $a; + # Return instance variable. + return $x->{_a} if ref($x) && (defined $x->{_a} || defined $x->{_p}); + + # Return class variable. + return ${"${class}::accuracy"}; } sub precision { @@ -382,36 +379,38 @@ sub precision { no strict 'refs'; if (@_ > 0) { my $p = shift; - # convert objects to scalars to avoid deep recursion. If object doesn't - # have numify(), then hopefully it will have overloading for int() and - # boolean test without wandering into a deep recursion path... - $p = $p->numify() if ref($p) && $p->can('numify'); - if ((defined $p) && (int($p) != $p)) { - Carp::croak('Argument to precision must be an integer'); + if (defined $p) { + $p = $p->numify() if ref($p) && $p->can('numify'); + if ($p != int $p) { + croak('Argument to precision must be an integer'); + } } + if (ref($x)) { - # $object->precision() or fallback to global + # Set instance variable. $x->bfround($p) if $p; # not for undef, 0 $x->{_p} = $p; # set/overwrite, even if not rounded delete $x->{_a}; # clear A + # Why return class variable here? Fixme! $p = ${"${class}::precision"} unless defined $p; # proper return value } else { + # Set class variable. ${"${class}::precision"} = $p; # set global P ${"${class}::accuracy"} = undef; # clear global A } + return $p; # shortcut } - my $p; - # $object->precision() or fallback to global - $p = $x->{_p} if ref($x); - # but don't return global undef, when $x's precision is 0! - $p = ${"${class}::precision"} if !defined $p; - $p; + # Return instance variable. + return $x->{_p} if ref($x) && (defined $x->{_a} || defined $x->{_p}); + + # Return class variable. + return ${"${class}::precision"}; } sub config { - # return (or set) configuration data as hash ref + # return (or set) configuration data. my $class = shift || __PACKAGE__; no strict 'refs'; @@ -435,7 +434,7 @@ sub config { delete $args->{$key}; } if (keys %$args > 0) { - Carp::croak("Illegal key(s) '", join("', '", keys %$args), + croak("Illegal key(s) '", join("', '", keys %$args), "' passed to $class\->config()"); } foreach my $key (keys %$set_args) { @@ -451,8 +450,8 @@ sub config { # now return actual configuration my $cfg = { - lib => $CALC, - lib_version => ${"${CALC}::VERSION"}, + lib => $LIB, + lib_version => ${"${LIB}::VERSION"}, class => $class, trap_nan => ${"${class}::_trap_nan"}, trap_inf => ${"${class}::_trap_inf"}, @@ -548,14 +547,14 @@ sub new { my ($wanted, $a, $p, $r) = @_; - # Always return a new object, so it called as an instance method, copy the + # Always return a new object, so if called as an instance method, copy the # invocand, and if called as a class method, initialize a new object. $self = $selfref ? $self -> copy() : bless {}, $class; unless (defined $wanted) { - #Carp::carp("Use of uninitialized value in new()"); + #carp("Use of uninitialized value in new()"); return $self->bzero($a, $p, $r); } @@ -586,7 +585,7 @@ sub new { my $sgn = $1; my $abs = $2; $self->{sign} = $sgn || '+'; - $self->{value} = $CALC->_new($abs); + $self->{value} = $LIB->_new($abs); no strict 'refs'; if (defined($a) || defined($p) @@ -636,9 +635,9 @@ sub new { my ($mis, $miv, $mfv, $es, $ev) = _split($wanted); if (!ref $mis) { if ($_trap_nan) { - Carp::croak("$wanted is not a number in $class"); + croak("$wanted is not a number in $class"); } - $self->{value} = $CALC->_zero(); + $self->{value} = $LIB->_zero(); $self->{sign} = $nan; return $self; } @@ -653,13 +652,13 @@ sub new { # Make integer from mantissa by adjusting exponent, then convert to a # Math::BigInt. $self->{sign} = $$mis; # store sign - $self->{value} = $CALC->_zero(); # for all the NaN cases + $self->{value} = $LIB->_zero(); # for all the NaN cases my $e = int("$$es$$ev"); # exponent (avoid recursion) if ($e > 0) { my $diff = $e - CORE::length($$mfv); if ($diff < 0) { # Not integer if ($_trap_nan) { - Carp::croak("$wanted not an integer in $class"); + croak("$wanted not an integer in $class"); } #print "NOI 1\n"; return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; @@ -675,7 +674,7 @@ sub new { if ($$mfv ne '') { # e <= 0 # fraction and negative/zero E => NOI if ($_trap_nan) { - Carp::croak("$wanted not an integer in $class"); + croak("$wanted not an integer in $class"); } #print "NOI 2 \$\$mfv '$$mfv'\n"; return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; @@ -690,7 +689,7 @@ sub new { if ($frac =~ /[^0]/) { if ($_trap_nan) { - Carp::croak("$wanted not an integer in $class"); + croak("$wanted not an integer in $class"); } #print "NOI 3\n"; return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; @@ -701,7 +700,7 @@ sub new { unless ($self->{sign} eq $nan) { $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0 - $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/; + $self->{value} = $LIB->_new($$miv) if $self->{sign} =~ /^[+-]$/; } # If any of the globals are set, use them to round, and store them inside @@ -752,11 +751,11 @@ sub from_hex { # The library method requires a prefix. - $self->{value} = $CALC->_from_hex('0x' . $chrs); + $self->{value} = $LIB->_from_hex('0x' . $chrs); # Place the sign. - $self->{sign} = $sign eq '-' && ! $CALC->_is_zero($self->{value}) + $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) ? '-' : '+'; return $self; @@ -807,11 +806,11 @@ sub from_oct { # The library method requires a prefix. - $self->{value} = $CALC->_from_oct('0' . $chrs); + $self->{value} = $LIB->_from_oct('0' . $chrs); # Place the sign. - $self->{sign} = $sign eq '-' && ! $CALC->_is_zero($self->{value}) + $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) ? '-' : '+'; return $self; @@ -863,11 +862,11 @@ sub from_bin { # The library method requires a prefix. - $self->{value} = $CALC->_from_bin('0b' . $chrs); + $self->{value} = $LIB->_from_bin('0b' . $chrs); # Place the sign. - $self->{sign} = $sign eq '-' && ! $CALC->_is_zero($self->{value}) + $self->{sign} = $sign eq '-' && ! $LIB->_is_zero($self->{value}) ? '-' : '+'; return $self; @@ -877,6 +876,7 @@ sub from_bin { # input is invalid. return $self->bnan(); + } # Create a Math::BigInt from a byte string. @@ -890,8 +890,8 @@ sub from_bytes { return if $selfref && $self->modify('from_bytes'); - Carp::croak("from_bytes() requires a newer version of the $CALC library.") - unless $CALC->can('_from_bytes'); + croak("from_bytes() requires a newer version of the $LIB library.") + unless $LIB->can('_from_bytes'); my $str = shift; @@ -899,15 +899,59 @@ sub from_bytes { $self = $class -> bzero() unless $selfref; $self -> {sign} = '+'; - $self -> {value} = $CALC -> _from_bytes($str); + $self -> {value} = $LIB -> _from_bytes($str); return $self; } +sub from_base { + my $self = shift; + my $selfref = ref $self; + my $class = $selfref || $self; + + # Don't modify constant (read-only) objects. + + return if $selfref && $self->modify('from_base'); + + my $str = shift; + + my $base = shift; + $base = $class->new($base) unless ref($base); + + croak("the base must be a finite integer >= 2") + if $base < 2 || ! $base -> is_int(); + + # If called as a class method, initialize a new object. + + $self = $class -> bzero() unless $selfref; + + # If no collating sequence is given, pass some of the conversions to + # methods optimized for those cases. + + if (! @_) { + return $self -> from_bin($str) if $base == 2; + return $self -> from_oct($str) if $base == 8; + return $self -> from_hex($str) if $base == 16; + if ($base == 10) { + my $tmp = $class -> new($str); + $self -> {value} = $tmp -> {value}; + $self -> {sign} = '+'; + } + } + + croak("from_base() requires a newer version of the $LIB library.") + unless $LIB->can('_from_base'); + + $self -> {sign} = '+'; + $self -> {value} + = $LIB->_from_base($str, $base -> {value}, @_ ? shift() : ()); + return $self +} + sub bzero { # create/assign '+0' if (@_ == 0) { - #Carp::carp("Using bzero() as a function is deprecated;", + #carp("Using bzero() as a function is deprecated;", # " use bzero() as a method instead"); unshift @_, __PACKAGE__; } @@ -925,18 +969,21 @@ sub bzero { $self = bless {}, $class unless $selfref; $self->{sign} = '+'; - $self->{value} = $CALC->_zero(); + $self->{value} = $LIB->_zero(); - if (@_ > 0) { - if (@_ > 3) { - # call like: $x->bzero($a, $p, $r, $y, ...); - ($self, $self->{_a}, $self->{_p}) = $self->_find_round_parameters(@_); - } else { - # call like: $x->bzero($a, $p, $r); - $self->{_a} = $_[0] - if !defined $self->{_a} || (defined $_[0] && $_[0] > $self->{_a}); - $self->{_p} = $_[1] - if !defined $self->{_p} || (defined $_[1] && $_[1] > $self->{_p}); + # If rounding parameters are given as arguments, use them. If no rounding + # parameters are given, and if called as a class method initialize the new + # instance with the class variables. + + if (@_) { + croak "can't specify both accuracy and precision" + if @_ >= 2 && defined $_[0] && defined $_[1]; + $self->{_a} = $_[0]; + $self->{_p} = $_[1]; + } else { + unless($selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); } } @@ -947,7 +994,7 @@ sub bone { # Create or assign '+1' (or -1 if given sign '-'). if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) { - #Carp::carp("Using bone() as a function is deprecated;", + #carp("Using bone() as a function is deprecated;", # " use bone() as a method instead"); unshift @_, __PACKAGE__; } @@ -962,24 +1009,30 @@ sub bone { return if $selfref && $self->modify('bone'); - my $sign = shift; - $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+"; + my $sign = '+'; # default + if (@_) { + $sign = shift; + $sign = $sign =~ /^\s*-/ ? "-" : "+"; + } $self = bless {}, $class unless $selfref; $self->{sign} = $sign; - $self->{value} = $CALC->_one(); + $self->{value} = $LIB->_one(); - if (@_ > 0) { - if (@_ > 3) { - # call like: $x->bone($sign, $a, $p, $r, $y, ...); - ($self, $self->{_a}, $self->{_p}) = $self->_find_round_parameters(@_); - } else { - # call like: $x->bone($sign, $a, $p, $r); - $self->{_a} = $_[0] - if !defined $self->{_a} || (defined $_[0] && $_[0] > $self->{_a}); - $self->{_p} = $_[1] - if !defined $self->{_p} || (defined $_[1] && $_[1] > $self->{_p}); + # If rounding parameters are given as arguments, use them. If no rounding + # parameters are given, and if called as a class method initialize the new + # instance with the class variables. + + if (@_) { + croak "can't specify both accuracy and precision" + if @_ >= 2 && defined $_[0] && defined $_[1]; + $self->{_a} = $_[0]; + $self->{_p} = $_[1]; + } else { + unless($selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); } } @@ -992,7 +1045,7 @@ sub binf { if (@_ == 0 || (defined($_[0]) && !ref($_[0]) && $_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/)) { - #Carp::carp("Using binf() as a function is deprecated;", + #carp("Using binf() as a function is deprecated;", # " use binf() as a method instead"); unshift @_, __PACKAGE__; } @@ -1004,7 +1057,7 @@ sub binf { { no strict 'refs'; if (${"${class}::_trap_inf"}) { - Carp::croak("Tried to create +-inf in $class->binf()"); + croak("Tried to create +-inf in $class->binf()"); } } @@ -1020,7 +1073,23 @@ sub binf { $self = bless {}, $class unless $selfref; $self -> {sign} = $sign . 'inf'; - $self -> {value} = $CALC -> _zero(); + $self -> {value} = $LIB -> _zero(); + + # If rounding parameters are given as arguments, use them. If no rounding + # parameters are given, and if called as a class method initialize the new + # instance with the class variables. + + if (@_) { + croak "can't specify both accuracy and precision" + if @_ >= 2 && defined $_[0] && defined $_[1]; + $self->{_a} = $_[0]; + $self->{_p} = $_[1]; + } else { + unless($selfref) { + $self->{_a} = $class -> accuracy(); + $self->{_p} = $class -> precision(); + } + } return $self; } @@ -1029,7 +1098,7 @@ sub bnan { # create/assign a 'NaN' if (@_ == 0) { - #Carp::carp("Using bnan() as a function is deprecated;", + #carp("Using bnan() as a function is deprecated;", # " use bnan() as a method instead"); unshift @_, __PACKAGE__; } @@ -1041,7 +1110,7 @@ sub bnan { { no strict 'refs'; if (${"${class}::_trap_nan"}) { - Carp::croak("Tried to create NaN in $class->bnan()"); + croak("Tried to create NaN in $class->bnan()"); } } @@ -1054,7 +1123,7 @@ sub bnan { $self = bless {}, $class unless $selfref; $self -> {sign} = $nan; - $self -> {value} = $CALC -> _zero(); + $self -> {value} = $LIB -> _zero(); return $self; } @@ -1088,7 +1157,7 @@ sub copy { my $copy = bless {}, $class; $copy->{sign} = $self->{sign}; - $copy->{value} = $CALC->_copy($self->{value}); + $copy->{value} = $LIB->_copy($self->{value}); $copy->{_a} = $self->{_a} if exists $self->{_a}; $copy->{_p} = $self->{_p} if exists $self->{_p}; @@ -1111,7 +1180,7 @@ sub is_zero { my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't - $CALC->_is_zero($x->{value}); + $LIB->_is_zero($x->{value}); } sub is_one { @@ -1121,7 +1190,7 @@ sub is_one { $sign = '+' if !defined $sign || $sign ne '-'; return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either - $CALC->_is_one($x->{value}); + $LIB->_is_one($x->{value}); } sub is_finite { @@ -1170,7 +1239,7 @@ sub is_odd { my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't - $CALC->_is_odd($x->{value}); + $LIB->_is_odd($x->{value}); } sub is_even { @@ -1178,7 +1247,7 @@ sub is_even { my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't - $CALC->_is_even($x->{value}); + $LIB->_is_even($x->{value}); } sub is_int { @@ -1225,11 +1294,11 @@ sub bcmp { # post-normalized compare for internal use (honors signs) if ($x->{sign} eq '+') { # $x and $y both > 0 - return $CALC->_acmp($x->{value}, $y->{value}); + return $LIB->_acmp($x->{value}, $y->{value}); } # $x && $y both < 0 - $CALC->_acmp($y->{value}, $x->{value}); # swapped acmp (lib returns 0, 1, -1) + $LIB->_acmp($y->{value}, $x->{value}); # swapped acmp (lib returns 0, 1, -1) } sub bacmp { @@ -1252,16 +1321,15 @@ sub bacmp { return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; return -1; } - $CALC->_acmp($x->{value}, $y->{value}); # lib does only 0, 1, -1 + $LIB->_acmp($x->{value}, $y->{value}); # lib does only 0, 1, -1 } sub beq { my $self = shift; my $selfref = ref $self; - my $class = $selfref || $self; - Carp::croak 'beq() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for beq()' unless @_ == 1; + croak 'beq() is an instance method, not a class method' unless $selfref; + croak 'Wrong number of arguments for beq()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && ! $cmp; @@ -1270,10 +1338,9 @@ sub beq { sub bne { my $self = shift; my $selfref = ref $self; - my $class = $selfref || $self; - Carp::croak 'bne() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for bne()' unless @_ == 1; + croak 'bne() is an instance method, not a class method' unless $selfref; + croak 'Wrong number of arguments for bne()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && ! $cmp ? '' : 1; @@ -1282,10 +1349,9 @@ sub bne { sub blt { my $self = shift; my $selfref = ref $self; - my $class = $selfref || $self; - Carp::croak 'blt() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for blt()' unless @_ == 1; + croak 'blt() is an instance method, not a class method' unless $selfref; + croak 'Wrong number of arguments for blt()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && $cmp < 0; @@ -1294,10 +1360,9 @@ sub blt { sub ble { my $self = shift; my $selfref = ref $self; - my $class = $selfref || $self; - Carp::croak 'ble() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for ble()' unless @_ == 1; + croak 'ble() is an instance method, not a class method' unless $selfref; + croak 'Wrong number of arguments for ble()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && $cmp <= 0; @@ -1306,10 +1371,9 @@ sub ble { sub bgt { my $self = shift; my $selfref = ref $self; - my $class = $selfref || $self; - Carp::croak 'bgt() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for bgt()' unless @_ == 1; + croak 'bgt() is an instance method, not a class method' unless $selfref; + croak 'Wrong number of arguments for bgt()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && $cmp > 0; @@ -1318,11 +1382,10 @@ sub bgt { sub bge { my $self = shift; my $selfref = ref $self; - my $class = $selfref || $self; - Carp::croak 'bge() is an instance method, not a class method' + croak 'bge() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for bge()' unless @_ == 1; + croak 'Wrong number of arguments for bge()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && $cmp >= 0; @@ -1340,7 +1403,7 @@ sub bneg { return $x if $x->modify('bneg'); # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN' - $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $CALC->_is_zero($x->{value})); + $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $LIB->_is_zero($x->{value})); $x; } @@ -1380,11 +1443,11 @@ sub binc { return $x if $x->modify('binc'); if ($x->{sign} eq '+') { - $x->{value} = $CALC->_inc($x->{value}); + $x->{value} = $LIB->_inc($x->{value}); return $x->round($a, $p, $r); } elsif ($x->{sign} eq '-') { - $x->{value} = $CALC->_dec($x->{value}); - $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0 + $x->{value} = $LIB->_dec($x->{value}); + $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # -1 +1 => -0 => +0 return $x->round($a, $p, $r); } # inf, nan handling etc @@ -1398,18 +1461,18 @@ sub bdec { if ($x->{sign} eq '-') { # x already < 0 - $x->{value} = $CALC->_inc($x->{value}); + $x->{value} = $LIB->_inc($x->{value}); } else { return $x->badd($class->bone('-'), @r) unless $x->{sign} eq '+'; # inf or NaN # >= 0 - if ($CALC->_is_zero($x->{value})) { + if ($LIB->_is_zero($x->{value})) { # == 0 - $x->{value} = $CALC->_one(); + $x->{value} = $LIB->_one(); $x->{sign} = '-'; # 0 => -1 } else { # > 0 - $x->{value} = $CALC->_dec($x->{value}); + $x->{value} = $LIB->_dec($x->{value}); } } $x->round(@r); @@ -1420,9 +1483,9 @@ sub bdec { # my $selfref = ref $self; # my $class = $selfref || $self; # -# Carp::croak 'bstrcmp() is an instance method, not a class method' +# croak 'bstrcmp() is an instance method, not a class method' # unless $selfref; -# Carp::croak 'Wrong number of arguments for bstrcmp()' unless @_ == 1; +# croak 'Wrong number of arguments for bstrcmp()' unless @_ == 1; # # return $self -> bstr() CORE::cmp shift; #} @@ -1432,9 +1495,9 @@ sub bdec { # my $selfref = ref $self; # my $class = $selfref || $self; # -# Carp::croak 'bstreq() is an instance method, not a class method' +# croak 'bstreq() is an instance method, not a class method' # unless $selfref; -# Carp::croak 'Wrong number of arguments for bstreq()' unless @_ == 1; +# croak 'Wrong number of arguments for bstreq()' unless @_ == 1; # # my $cmp = $self -> bstrcmp(shift); # return defined($cmp) && ! $cmp; @@ -1445,9 +1508,9 @@ sub bdec { # my $selfref = ref $self; # my $class = $selfref || $self; # -# Carp::croak 'bstrne() is an instance method, not a class method' +# croak 'bstrne() is an instance method, not a class method' # unless $selfref; -# Carp::croak 'Wrong number of arguments for bstrne()' unless @_ == 1; +# croak 'Wrong number of arguments for bstrne()' unless @_ == 1; # # my $cmp = $self -> bstrcmp(shift); # return defined($cmp) && ! $cmp ? '' : 1; @@ -1458,9 +1521,9 @@ sub bdec { # my $selfref = ref $self; # my $class = $selfref || $self; # -# Carp::croak 'bstrlt() is an instance method, not a class method' +# croak 'bstrlt() is an instance method, not a class method' # unless $selfref; -# Carp::croak 'Wrong number of arguments for bstrlt()' unless @_ == 1; +# croak 'Wrong number of arguments for bstrlt()' unless @_ == 1; # # my $cmp = $self -> bstrcmp(shift); # return defined($cmp) && $cmp < 0; @@ -1471,9 +1534,9 @@ sub bdec { # my $selfref = ref $self; # my $class = $selfref || $self; # -# Carp::croak 'bstrle() is an instance method, not a class method' +# croak 'bstrle() is an instance method, not a class method' # unless $selfref; -# Carp::croak 'Wrong number of arguments for bstrle()' unless @_ == 1; +# croak 'Wrong number of arguments for bstrle()' unless @_ == 1; # # my $cmp = $self -> bstrcmp(shift); # return defined($cmp) && $cmp <= 0; @@ -1484,9 +1547,9 @@ sub bdec { # my $selfref = ref $self; # my $class = $selfref || $self; # -# Carp::croak 'bstrgt() is an instance method, not a class method' +# croak 'bstrgt() is an instance method, not a class method' # unless $selfref; -# Carp::croak 'Wrong number of arguments for bstrgt()' unless @_ == 1; +# croak 'Wrong number of arguments for bstrgt()' unless @_ == 1; # # my $cmp = $self -> bstrcmp(shift); # return defined($cmp) && $cmp > 0; @@ -1497,9 +1560,9 @@ sub bdec { # my $selfref = ref $self; # my $class = $selfref || $self; # -# Carp::croak 'bstrge() is an instance method, not a class method' +# croak 'bstrge() is an instance method, not a class method' # unless $selfref; -# Carp::croak 'Wrong number of arguments for bstrge()' unless @_ == 1; +# croak 'Wrong number of arguments for bstrge()' unless @_ == 1; # # my $cmp = $self -> bstrcmp(shift); # return defined($cmp) && $cmp >= 0; @@ -1540,19 +1603,19 @@ sub badd { my ($sx, $sy) = ($x->{sign}, $y->{sign}); # get signs if ($sx eq $sy) { - $x->{value} = $CALC->_add($x->{value}, $y->{value}); # same sign, abs add + $x->{value} = $LIB->_add($x->{value}, $y->{value}); # same sign, abs add } else { - my $a = $CALC->_acmp ($y->{value}, $x->{value}); # absolute compare + my $a = $LIB->_acmp ($y->{value}, $x->{value}); # absolute compare if ($a > 0) { - $x->{value} = $CALC->_sub($y->{value}, $x->{value}, 1); # abs sub w/ swap + $x->{value} = $LIB->_sub($y->{value}, $x->{value}, 1); # abs sub w/ swap $x->{sign} = $sy; } elsif ($a == 0) { # speedup, if equal, set result to 0 - $x->{value} = $CALC->_zero(); + $x->{value} = $LIB->_zero(); $x->{sign} = '+'; } else # a < 0 { - $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub + $x->{value} = $LIB->_sub($x->{value}, $y->{value}); # abs sub } } $x->round(@r); @@ -1626,8 +1689,8 @@ sub bmul { $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + - $x->{value} = $CALC->_mul($x->{value}, $y->{value}); # do actual math - $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0 + $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math + $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # no -0 $x->round(@r); } @@ -1669,25 +1732,25 @@ sub bmuladd { $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + - $x->{value} = $CALC->_mul($x->{value}, $y->{value}); # do actual math - $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0 + $x->{value} = $LIB->_mul($x->{value}, $y->{value}); # do actual math + $x->{sign} = '+' if $LIB->_is_zero($x->{value}); # no -0 my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs if ($sx eq $sz) { - $x->{value} = $CALC->_add($x->{value}, $z->{value}); # same sign, abs add + $x->{value} = $LIB->_add($x->{value}, $z->{value}); # same sign, abs add } else { - my $a = $CALC->_acmp ($z->{value}, $x->{value}); # absolute compare + my $a = $LIB->_acmp ($z->{value}, $x->{value}); # absolute compare if ($a > 0) { - $x->{value} = $CALC->_sub($z->{value}, $x->{value}, 1); # abs sub w/ swap + $x->{value} = $LIB->_sub($z->{value}, $x->{value}, 1); # abs sub w/ swap $x->{sign} = $sz; } elsif ($a == 0) { # speedup, if equal, set result to 0 - $x->{value} = $CALC->_zero(); + $x->{value} = $LIB->_zero(); $x->{sign} = '+'; } else # a < 0 { - $x->{value} = $CALC->_sub($x->{value}, $z->{value}); # abs sub + $x->{value} = $LIB->_sub($x->{value}, $z->{value}); # abs sub } } $x->round(@r); @@ -1824,10 +1887,10 @@ sub bdiv { $x -> bone(); } else { ($x -> {value}, $rem -> {value}) = - $CALC -> _div($x -> {value}, $y -> {value}); + $LIB -> _div($x -> {value}, $y -> {value}); - if ($CALC -> _is_zero($rem -> {value})) { - if ($xsign eq $ysign || $CALC -> _is_zero($x -> {value})) { + if ($LIB -> _is_zero($rem -> {value})) { + if ($xsign eq $ysign || $LIB -> _is_zero($x -> {value})) { $x -> {sign} = '+'; } else { $x -> {sign} = '-'; @@ -1849,7 +1912,7 @@ sub bdiv { $x -> round(@r); if ($wantarray) { - unless ($CALC -> _is_zero($rem -> {value})) { + unless ($LIB -> _is_zero($rem -> {value})) { if ($xsign ne $ysign) { $rem = $y -> copy() -> babs() -> bsub($rem); } @@ -1989,16 +2052,16 @@ sub btdiv { $x -> bone(); } else { ($x -> {value}, $rem -> {value}) = - $CALC -> _div($x -> {value}, $y -> {value}); + $LIB -> _div($x -> {value}, $y -> {value}); $x -> {sign} = $xsign eq $ysign ? '+' : '-'; - $x -> {sign} = '+' if $CALC -> _is_zero($x -> {value}); + $x -> {sign} = '+' if $LIB -> _is_zero($x -> {value}); $x -> round(@r); } if (wantarray) { $rem -> {sign} = $xsign; - $rem -> {sign} = '+' if $CALC -> _is_zero($rem -> {value}); + $rem -> {sign} = '+' if $LIB -> _is_zero($rem -> {value}); $rem -> {_a} = $x -> {_a}; $rem -> {_p} = $x -> {_p}; $rem -> round(@r); @@ -2052,11 +2115,11 @@ sub bmod { # Calc new sign and in case $y == +/- 1, return $x. - $x -> {value} = $CALC -> _mod($x -> {value}, $y -> {value}); - if ($CALC -> _is_zero($x -> {value})) { + $x -> {value} = $LIB -> _mod($x -> {value}, $y -> {value}); + if ($LIB -> _is_zero($x -> {value})) { $x -> {sign} = '+'; # do not leave -0 } else { - $x -> {value} = $CALC -> _sub($y -> {value}, $x -> {value}, 1) # $y-$x + $x -> {value} = $LIB -> _sub($y -> {value}, $x -> {value}, 1) # $y-$x if ($x -> {sign} ne $y -> {sign}); $x -> {sign} = $y -> {sign}; } @@ -2107,12 +2170,11 @@ sub btmod { $r[3] = $y; # no push! my $xsign = $x -> {sign}; - my $ysign = $y -> {sign}; - $x -> {value} = $CALC -> _mod($x -> {value}, $y -> {value}); + $x -> {value} = $LIB -> _mod($x -> {value}, $y -> {value}); $x -> {sign} = $xsign; - $x -> {sign} = '+' if $CALC -> _is_zero($x -> {value}); + $x -> {sign} = '+' if $LIB -> _is_zero($x -> {value}); $x -> round(@r); return $x; } @@ -2157,7 +2219,7 @@ sub bmodinv { # $x = 0 is when $y = 1 or $y = -1, but that was covered above. # # Note that computing $x modulo $y here affects the value we'll feed to - # $CALC->_modinv() below when $x and $y have opposite signs. E.g., if $x = + # $LIB->_modinv() below when $x and $y have opposite signs. E.g., if $x = # 5 and $y = 7, those two values are fed to _modinv(), but if $x = -5 and # $y = 7, the values fed to _modinv() are $x = 2 (= -5 % 7) and $y = 7. # The value if $x is affected only when $x and $y have opposite signs. @@ -2168,7 +2230,7 @@ sub bmodinv { # Compute the modular multiplicative inverse of the absolute values. We'll # correct for the signs of $x and $y later. Return NaN if no GCD is found. - ($x->{value}, $x->{sign}) = $CALC->_modinv($x->{value}, $y->{value}); + ($x->{value}, $x->{sign}) = $LIB->_modinv($x->{value}, $y->{value}); return $x->bnan() if !defined $x->{value}; # Library inconsistency workaround: _modinv() in Math::BigInt::GMP versions @@ -2233,13 +2295,13 @@ sub bmodpow { # value is zero, the output is also zero, regardless of the signs on 'a' and # 'm'. - my $value = $CALC->_modpow($num->{value}, $exp->{value}, $mod->{value}); + my $value = $LIB->_modpow($num->{value}, $exp->{value}, $mod->{value}); my $sign = '+'; # If the resulting value is non-zero, we have four special cases, depending # on the signs on 'a' and 'm'. - unless ($CALC->_is_zero($value)) { + unless ($LIB->_is_zero($value)) { # There is a negative sign on 'a' (= $num**$exp) only if the number we # are exponentiating ($num) is negative and the exponent ($exp) is odd. @@ -2261,8 +2323,8 @@ sub bmodpow { else { # Use copy of $mod since _sub() modifies the first argument. - my $mod = $CALC->_copy($mod->{value}); - $value = $CALC->_sub($mod, $value); + my $mod = $LIB->_copy($mod->{value}); + $value = $LIB->_sub($mod, $value); $sign = '+'; } @@ -2275,8 +2337,8 @@ sub bmodpow { if ($mod->{sign} eq '-') { # Use copy of $mod since _sub() modifies the first argument. - my $mod = $CALC->_copy($mod->{value}); - $value = $CALC->_sub($mod, $value); + my $mod = $LIB->_copy($mod->{value}); + $value = $LIB->_sub($mod, $value); $sign = '-'; } @@ -2309,52 +2371,29 @@ sub bpow { return $x if $x->modify('bpow'); - return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; - - # inf handling - if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { - if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) { - # +-inf ** +-inf - return $x->bnan(); - } - # +-inf ** Y - if ($x->{sign} =~ /^[+-]inf/) { - # +inf ** 0 => NaN - return $x->bnan() if $y->is_zero(); - # -inf ** -1 => 1/inf => 0 - return $x->bzero() if $y->is_one('-') && $x->is_negative(); - - # +inf ** Y => inf - return $x if $x->{sign} eq '+inf'; - - # -inf ** Y => -inf if Y is odd - return $x if $y->is_odd(); - return $x->babs(); - } - # X ** +-inf - - # 1 ** +inf => 1 - return $x if $x->is_one(); - - # 0 ** inf => 0 - return $x if $x->is_zero() && $y->{sign} =~ /^[+]/; - - # 0 ** -inf => inf - return $x->binf() if $x->is_zero(); - - # -1 ** -inf => NaN - return $x->bnan() if $x->is_one('-') && $y->{sign} =~ /^[-]/; - - # -X ** -inf => 0 - return $x->bzero() if $x->{sign} eq '-' && $y->{sign} =~ /^[-]/; - - # -1 ** inf => NaN - return $x->bnan() if $x->{sign} eq '-'; - - # X ** inf => inf - return $x->binf() if $y->{sign} =~ /^[+]/; - # X ** -inf => 0 + # $x and/or $y is a NaN + return $x->bnan() if $x->is_nan() || $y->is_nan(); + + # $x and/or $y is a +/-Inf + if ($x->is_inf("-")) { + return $x->bzero() if $y->is_negative(); + return $x->bnan() if $y->is_zero(); + return $x if $y->is_odd(); + return $x->bneg(); + } elsif ($x->is_inf("+")) { + return $x->bzero() if $y->is_negative(); + return $x->bnan() if $y->is_zero(); + return $x; + } elsif ($y->is_inf("-")) { + return $x->bnan() if $x -> is_one("-"); + return $x->binf("+") if $x -> is_zero(); + return $x->bone() if $x -> is_one("+"); return $x->bzero(); + } elsif ($y->is_inf("+")) { + return $x->bnan() if $x -> is_one("-"); + return $x->bzero() if $x -> is_zero(); + return $x->bone() if $x -> is_one("+"); + return $x->binf("+"); } return $upgrade->bpow($upgrade->new($x), $y, @r) @@ -2369,14 +2408,14 @@ sub bpow { # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf return $x->binf() - if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value}); + 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 '-' && !$CALC->_is_one($x->{value}); + return $x->bnan() if $y->{sign} eq '-' && !$LIB->_is_one($x->{value}); - $x->{value} = $CALC->_pow($x->{value}, $y->{value}); + $x->{value} = $LIB->_pow($x->{value}, $y->{value}); $x->{sign} = $new_sign; - $x->{sign} = '+' if $CALC->_is_zero($y->{value}); + $x->{sign} = '+' if $LIB->_is_zero($y->{value}); $x->round(@r); } @@ -2444,7 +2483,7 @@ sub blog { return $x; } - my ($rc, $exact) = $CALC->_log_int($x->{value}, $base->{value}); + my ($rc, $exact) = $LIB->_log_int($x->{value}, $base->{value}); return $x->bnan() unless defined $rc; # not possible to take log? $x->{value} = $rc; $x->round(@r); @@ -2482,74 +2521,85 @@ sub bexp { } sub bnok { - # Calculate n over k (binomial coefficient or "choose" function) as integer. - # set up parameters - my ($class, $x, $y, @r) = (ref($_[0]), @_); + # Calculate n over k (binomial coefficient or "choose" function) as + # integer. - # objectify is costly, so avoid it + # Set up parameters. + my ($self, $n, $k, @r) = (ref($_[0]), @_); + + # Objectify is costly, so avoid it. if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($class, $x, $y, @r) = objectify(2, @_); + ($self, $n, $k, @r) = objectify(2, @_); } - return $x if $x->modify('bnok'); - return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'; - return $x->binf() if $x->{sign} eq '+inf'; + return $n if $n->modify('bnok'); - # k > n or k < 0 => 0 - my $cmp = $x->bacmp($y); - return $x->bzero() if $cmp < 0 || substr($y->{sign}, 0, 1) eq "-"; - - if ($CALC->can('_nok')) { - $x->{value} = $CALC->_nok($x->{value}, $y->{value}); - } else { - # ( 7 ) 7! 1*2*3*4 * 5*6*7 5 * 6 * 7 6 7 - # ( - ) = --------- = --------------- = --------- = 5 * - * - - # ( 3 ) (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3 + # All cases where at least one argument is NaN. - my $n = $x -> {value}; - my $k = $y -> {value}; + return $n->bnan() if $n->{sign} eq 'NaN' || $k->{sign} eq 'NaN'; - # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as - # nok(n, n-k) to minimize the number if iterations in the loop. + # All cases where at least one argument is +/-inf. - { - my $twok = $CALC->_mul($CALC->_two(), $CALC->_copy($k)); - if ($CALC->_acmp($twok, $n) > 0) { - $k = $CALC->_sub($CALC->_copy($n), $k); + if ($n -> is_inf()) { + if ($k -> is_inf()) { # bnok(+/-inf,+/-inf) + return $n -> bnan(); + } elsif ($k -> is_neg()) { # bnok(+/-inf,k), k < 0 + return $n -> bzero(); + } elsif ($k -> is_zero()) { # bnok(+/-inf,k), k = 0 + return $n -> bone(); + } else { + if ($n -> is_inf("+")) { # bnok(+inf,k), 0 < k < +inf + return $n -> binf("+"); + } else { # bnok(-inf,k), k > 0 + my $sign = $k -> is_even() ? "+" : "-"; + return $n -> binf($sign); } } + } - if ($CALC->_is_zero($k)) { - $n = $CALC->_one(); - } else { + elsif ($k -> is_inf()) { # bnok(n,+/-inf), -inf <= n <= inf + return $n -> bnan(); + } - # Make a copy of the original n, since we'll be modifying n - # in-place. + # At this point, both n and k are real numbers. - my $n_orig = $CALC->_copy($n); + my $sign = 1; - $CALC->_sub($n, $k); - $CALC->_inc($n); + if ($n >= 0) { + if ($k < 0 || $k > $n) { + return $n -> bzero(); + } + } else { - my $f = $CALC->_copy($n); - $CALC->_inc($f); + if ($k >= 0) { - my $d = $CALC->_two(); + # n < 0 and k >= 0: bnok(n,k) = (-1)^k * bnok(-n+k-1,k) - # while f <= n (the original n, that is) ... + $sign = (-1) ** $k; + $n -> bneg() -> badd($k) -> bdec(); - while ($CALC->_acmp($f, $n_orig) <= 0) { - $CALC->_mul($n, $f); - $CALC->_div($n, $d); - $CALC->_inc($f); - $CALC->_inc($d); - } - } + } elsif ($k <= $n) { + + # n < 0 and k <= n: bnok(n,k) = (-1)^(n-k) * bnok(-k-1,n-k) + + $sign = (-1) ** ($n - $k); + my $x0 = $n -> copy(); + $n -> bone() -> badd($k) -> bneg(); + $k = $k -> copy(); + $k -> bneg() -> badd($x0); - $x -> {value} = $n; + } else { + + # n < 0 and n < k < 0: + + return $n -> bzero(); + } } - $x->round(@r); + $n->{value} = $LIB->_nok($n->{value}, $k->{value}); + $n -> bneg() if $sign == -1; + + $n->round(@r); } sub bsin { @@ -2606,7 +2656,7 @@ sub batan { # calculate the result and truncate it to integer my $t = Math::BigFloat->new($x)->batan(@r); - $x->{value} = $CALC->_new($x->as_int()->bstr()); + $x->{value} = $LIB->_new($x->as_int()->bstr()); $x->round(@r); } @@ -2678,7 +2728,7 @@ sub bsqrt { return $upgrade->bsqrt($x, @r) if defined $upgrade; - $x->{value} = $CALC->_sqrt($x->{value}); + $x->{value} = $LIB->_sqrt($x->{value}); $x->round(@r); } @@ -2706,7 +2756,7 @@ sub broot { return $upgrade->new($x)->broot($upgrade->new($y), @r) if defined $upgrade; - $x->{value} = $CALC->_root($x->{value}, $y->{value}); + $x->{value} = $LIB->_root($x->{value}, $y->{value}); $x->round(@r); } @@ -2718,7 +2768,7 @@ sub bfac { return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN - $x->{value} = $CALC->_fac($x->{value}); + $x->{value} = $LIB->_fac($x->{value}); $x->round(@r); } @@ -2729,10 +2779,10 @@ sub bdfac { return $x if $x->modify('bdfac') || $x->{sign} eq '+inf'; # inf => inf return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN - Carp::croak("bdfac() requires a newer version of the $CALC library.") - unless $CALC->can('_dfac'); + croak("bdfac() requires a newer version of the $LIB library.") + unless $LIB->can('_dfac'); - $x->{value} = $CALC->_dfac($x->{value}); + $x->{value} = $LIB->_dfac($x->{value}); $x->round(@r); } @@ -2740,8 +2790,8 @@ sub bfib { # compute Fibonacci number(s) my ($class, $x, @r) = objectify(1, @_); - Carp::croak("bfib() requires a newer version of the $CALC library.") - unless $CALC->can('_fib'); + croak("bfib() requires a newer version of the $LIB library.") + unless $LIB->can('_fib'); return $x if $x->modify('bfib'); @@ -2749,12 +2799,12 @@ sub bfib { if (wantarray) { return () if $x -> is_nan(); - Carp::croak("bfib() can't return an infinitely long list of numbers") + croak("bfib() can't return an infinitely long list of numbers") if $x -> is_inf(); # Use the backend library to compute the first $x Fibonacci numbers. - my @values = $CALC->_fib($x->{value}); + my @values = $LIB->_fib($x->{value}); # Make objects out of them. The last element in the array is the # invocand. @@ -2787,7 +2837,7 @@ sub bfib { return $x->bnan() if $x -> is_nan() || $x -> is_inf('-'); $x->{sign} = $x -> is_neg() && $x -> is_even() ? '-' : '+'; - $x->{value} = $CALC->_fib($x->{value}); + $x->{value} = $LIB->_fib($x->{value}); return $x->round(@r); } } @@ -2796,8 +2846,8 @@ sub blucas { # compute Lucas number(s) my ($class, $x, @r) = objectify(1, @_); - Carp::croak("blucas() requires a newer version of the $CALC library.") - unless $CALC->can('_lucas'); + croak("blucas() requires a newer version of the $LIB library.") + unless $LIB->can('_lucas'); return $x if $x->modify('blucas'); @@ -2805,12 +2855,12 @@ sub blucas { if (wantarray) { return () if $x -> is_nan(); - Carp::croak("blucas() can't return an infinitely long list of numbers") + croak("blucas() can't return an infinitely long list of numbers") if $x -> is_inf(); # Use the backend library to compute the first $x Lucas numbers. - my @values = $CALC->_lucas($x->{value}); + my @values = $LIB->_lucas($x->{value}); # Make objects out of them. The last element in the array is the # invocand. @@ -2843,7 +2893,7 @@ sub blucas { return $x->bnan() if $x -> is_nan() || $x -> is_inf('-'); $x->{sign} = $x -> is_neg() && $x -> is_even() ? '-' : '+'; - $x->{value} = $CALC->_lucas($x->{value}); + $x->{value} = $LIB->_lucas($x->{value}); return $x->round(@r); } } @@ -2868,7 +2918,7 @@ sub blsft { $b = 2 if !defined $b; return $x -> bnan() if $b <= 0 || $y -> {sign} eq '-'; - $x -> {value} = $CALC -> _lsft($x -> {value}, $y -> {value}, $b); + $x -> {value} = $LIB -> _lsft($x -> {value}, $y -> {value}, $b); $x -> round(@r); } @@ -2926,7 +2976,7 @@ sub brsft { $x -> bdec(); # n == 2, but $y == 1: this fixes it } - $x -> {value} = $CALC -> _rsft($x -> {value}, $y -> {value}, $b); + $x -> {value} = $LIB -> _rsft($x -> {value}, $y -> {value}, $b); $x -> round(@r); } @@ -2951,21 +3001,13 @@ sub band { return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); - my $sx = $x->{sign} eq '+' ? 1 : -1; - my $sy = $y->{sign} eq '+' ? 1 : -1; - - if ($sx == 1 && $sy == 1) { - $x->{value} = $CALC->_and($x->{value}, $y->{value}); - return $x->round(@r); - } - - if ($CAN{signed_and}) { - $x->{value} = $CALC->_signed_and($x->{value}, $y->{value}, $sx, $sy); - return $x->round(@r); + if ($x->{sign} eq '+' && $y->{sign} eq '+') { + $x->{value} = $LIB->_and($x->{value}, $y->{value}); + } else { + ($x->{value}, $x->{sign}) = $LIB->_sand($x->{value}, $x->{sign}, + $y->{value}, $y->{sign}); } - - require $EMU_LIB; - __emu_band($class, $x, $y, $sx, $sy, @r); + return $x->round(@r); } sub bior { @@ -2980,29 +3022,18 @@ sub bior { } return $x if $x->modify('bior'); + $r[3] = $y; # no push! return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); - my $sx = $x->{sign} eq '+' ? 1 : -1; - my $sy = $y->{sign} eq '+' ? 1 : -1; - - # the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior() - - # don't use lib for negative values - if ($sx == 1 && $sy == 1) { - $x->{value} = $CALC->_or($x->{value}, $y->{value}); - return $x->round(@r); - } - - # if lib can do negative values, let it handle this - if ($CAN{signed_or}) { - $x->{value} = $CALC->_signed_or($x->{value}, $y->{value}, $sx, $sy); - return $x->round(@r); + if ($x->{sign} eq '+' && $y->{sign} eq '+') { + $x->{value} = $LIB->_or($x->{value}, $y->{value}); + } else { + ($x->{value}, $x->{sign}) = $LIB->_sor($x->{value}, $x->{sign}, + $y->{value}, $y->{sign}); } - - require $EMU_LIB; - __emu_bior($class, $x, $y, $sx, $sy, @r); + return $x->round(@r); } sub bxor { @@ -3017,34 +3048,25 @@ sub bxor { } return $x if $x->modify('bxor'); + $r[3] = $y; # no push! return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); - my $sx = $x->{sign} eq '+' ? 1 : -1; - my $sy = $y->{sign} eq '+' ? 1 : -1; - - # don't use lib for negative values - if ($sx == 1 && $sy == 1) { - $x->{value} = $CALC->_xor($x->{value}, $y->{value}); - return $x->round(@r); - } - - # if lib can do negative values, let it handle this - if ($CAN{signed_xor}) { - $x->{value} = $CALC->_signed_xor($x->{value}, $y->{value}, $sx, $sy); - return $x->round(@r); + if ($x->{sign} eq '+' && $y->{sign} eq '+') { + $x->{value} = $LIB->_xor($x->{value}, $y->{value}); + } else { + ($x->{value}, $x->{sign}) = $LIB->_sxor($x->{value}, $x->{sign}, + $y->{value}, $y->{sign}); } - - require $EMU_LIB; - __emu_bxor($class, $x, $y, $sx, $sy, @r); + return $x->round(@r); } sub bnot { # (num_str or BINT) return BINT # represent ~x as twos-complement number # we don't need $class, so undef instead of ref($_[0]) make it slightly faster - my ($class, $x, $a, $p, $r) = ref($_[0]) ? (undef, @_) : objectify(1, @_); + my ($class, $x) = ref($_[0]) ? (undef, @_) : objectify(1, @_); return $x if $x->modify('bnot'); $x->binc()->bneg(); # binc already does round @@ -3085,9 +3107,11 @@ sub round { } } - # if still none defined, use globals (#2) - $a = ${"$class\::accuracy"} unless defined $a; - $p = ${"$class\::precision"} unless defined $p; + # if still none defined, use globals + unless (defined $a || defined $p) { + $a = ${"$class\::accuracy"}; + $p = ${"$class\::precision"}; + } # A == 0 is useless, so undef it to signal no rounding $a = undef if defined $a && $a == 0; @@ -3100,7 +3124,7 @@ sub round { $r = ${"$class\::round_mode"} unless defined $r; if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) { - Carp::croak("Unknown round mode '$r'"); + croak("Unknown round mode '$r'"); } # now round, by calling either bround or bfround: @@ -3152,7 +3176,7 @@ sub bround { # do not use digit(), it is very costly for binary => decimal # getting the entire string is also costly, but we need to do it only once - my $xs = $CALC->_str($x->{value}); + my $xs = $LIB->_str($x->{value}); my $pl = -$pad-1; # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4 @@ -3207,7 +3231,7 @@ sub bround { $xs = '1'.$xs if $c == 0; } - $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed + $x->{value} = $LIB->_new($xs) if $put_back == 1; # put back, if needed $x->{_a} = $scale if $scale >= 0; if ($scale < 0) { @@ -3285,8 +3309,8 @@ sub bgcd { my $y = shift @args; $y = $class->new($y) unless ref($y) && $y -> isa($class); return $class->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN? - $x->{value} = $CALC->_gcd($x->{value}, $y->{value}); - last if $CALC->_is_one($x->{value}); + $x->{value} = $LIB->_gcd($x->{value}, $y->{value}); + last if $LIB->_is_one($x->{value}); } return $x -> babs(); @@ -3307,7 +3331,7 @@ sub blcm { my $y = shift @args; $y = $class -> new($y) unless ref($y) && $y -> isa($class); return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y not integer - $x -> {value} = $CALC->_lcm($x -> {value}, $y -> {value}); + $x -> {value} = $LIB->_lcm($x -> {value}, $y -> {value}); } return $x -> babs(); @@ -3329,13 +3353,13 @@ sub digit { my ($class, $x, $n) = ref($_[0]) ? (undef, @_) : objectify(1, @_); $n = $n->numify() if ref($n); - $CALC->_digit($x->{value}, $n || 0); + $LIB->_digit($x->{value}, $n || 0); } sub length { my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - my $e = $CALC->_len($x->{value}); + my $e = $LIB->_len($x->{value}); wantarray ? ($e, 0) : $e; } @@ -3351,7 +3375,7 @@ sub exponent { return $class->bzero() if $x->is_zero(); # 12300 => 2 trailing zeros => exponent is 2 - $class->new($CALC->_zeros($x->{value})); + $class->new($LIB->_zeros($x->{value})); } sub mantissa { @@ -3367,7 +3391,7 @@ sub mantissa { delete $m->{_a}; # that's a bit inefficient: - my $zeros = $CALC->_zeros($m->{value}); + my $zeros = $LIB->_zeros($m->{value}); $m->brsft($zeros, 10) if $zeros != 0; $m; } @@ -3383,7 +3407,7 @@ sub sparts { my $self = shift; my $class = ref $self; - Carp::croak("sparts() is an instance method, not a class method") + croak("sparts() is an instance method, not a class method") unless $class; # Not-a-number. @@ -3407,7 +3431,7 @@ sub sparts { # Finite number. my $mant = $self -> copy(); - my $nzeros = $CALC -> _zeros($mant -> {value}); + my $nzeros = $LIB -> _zeros($mant -> {value}); $mant -> brsft($nzeros, 10) if $nzeros != 0; return $mant unless wantarray; @@ -3420,7 +3444,7 @@ sub nparts { my $self = shift; my $class = ref $self; - Carp::croak("nparts() is an instance method, not a class method") + croak("nparts() is an instance method, not a class method") unless $class; # Not-a-number. @@ -3466,7 +3490,7 @@ sub eparts { my $self = shift; my $class = ref $self; - Carp::croak("eparts() is an instance method, not a class method") + croak("eparts() is an instance method, not a class method") unless $class; # Not-a-number and Infinity. @@ -3505,7 +3529,7 @@ sub dparts { my $self = shift; my $class = ref $self; - Carp::croak("dparts() is an instance method, not a class method") + croak("dparts() is an instance method, not a class method") unless $class; my $int = $self -> copy(); @@ -3526,7 +3550,7 @@ sub bstr { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } - my $str = $CALC->_str($x->{value}); + my $str = $LIB->_str($x->{value}); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -3541,7 +3565,7 @@ sub bsstr { return 'inf'; # +inf } my ($m, $e) = $x -> parts(); - my $str = $CALC->_str($m->{value}) . 'e+' . $CALC->_str($e->{value}); + my $str = $LIB->_str($m->{value}) . 'e+' . $LIB->_str($e->{value}); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -3564,15 +3588,15 @@ sub bnstr { my $fracpos = $mant -> length() - 1; if ($fracpos == 0) { - my $str = $CALC->_str($mant->{value}) . "e+" . $CALC->_str($expo->{value}); + my $str = $LIB->_str($mant->{value}) . "e+" . $LIB->_str($expo->{value}); return $x->{sign} eq '-' ? "-$str" : $str; } $expo += $fracpos; - my $mantstr = $CALC->_str($mant -> {value}); + my $mantstr = $LIB->_str($mant -> {value}); substr($mantstr, -$fracpos, 0) = '.'; - my $str = $mantstr . 'e+' . $CALC->_str($expo -> {value}); + my $str = $mantstr . 'e+' . $LIB->_str($expo -> {value}); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -3591,7 +3615,7 @@ sub bestr { my $sign = $mant -> sign(); $mant -> babs(); - my $mantstr = $CALC->_str($mant -> {value}); + my $mantstr = $LIB->_str($mant -> {value}); my $mantlen = CORE::length($mantstr); my $dotidx = 1; @@ -3607,7 +3631,7 @@ sub bestr { substr($mantstr, $dotidx, 0) = "."; } - my $str = $mantstr . 'e+' . $CALC->_str($expo -> {value}); + my $str = $mantstr . 'e+' . $LIB->_str($expo -> {value}); return $sign eq "-" ? "-$str" : $str; } @@ -3621,7 +3645,7 @@ sub bdstr { return 'inf'; # +inf } - my $str = $CALC->_str($x->{value}); + my $str = $LIB->_str($x->{value}); return $x->{sign} eq '-' ? "-$str" : $str; } @@ -3632,7 +3656,7 @@ sub to_hex { return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc - my $hex = $CALC->_to_hex($x->{value}); + my $hex = $LIB->_to_hex($x->{value}); return $x->{sign} eq '-' ? "-$hex" : $hex; } @@ -3643,7 +3667,7 @@ sub to_oct { return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc - my $oct = $CALC->_to_oct($x->{value}); + my $oct = $LIB->_to_oct($x->{value}); return $x->{sign} eq '-' ? "-$oct" : $oct; } @@ -3654,7 +3678,7 @@ sub to_bin { return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc - my $bin = $CALC->_to_bin($x->{value}); + my $bin = $LIB->_to_bin($x->{value}); return $x->{sign} eq '-' ? "-$bin" : $bin; } @@ -3663,13 +3687,43 @@ sub to_bytes { my $x = shift; $x = $class->new($x) if !ref($x); - Carp::croak("to_bytes() requires a finite, non-negative integer") + croak("to_bytes() requires a finite, non-negative integer") if $x -> is_neg() || ! $x -> is_int(); - Carp::croak("to_bytes() requires a newer version of the $CALC library.") - unless $CALC->can('_to_bytes'); + croak("to_bytes() requires a newer version of the $LIB library.") + unless $LIB->can('_to_bytes'); - return $CALC->_to_bytes($x->{value}); + return $LIB->_to_bytes($x->{value}); +} + +sub to_base { + # return a base anything string + my $x = shift; + $x = $class->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); + + croak("the base must be a finite integer >= 2") + if $base < 2 || ! $base -> is_int(); + + # If no collating sequence is given, pass some of the conversions to + # methods optimized for those cases. + + if (! @_) { + return $x -> to_bin() if $base == 2; + return $x -> to_oct() if $base == 8; + return uc $x -> to_hex() if $base == 16; + return $x -> bstr() if $base == 10; + } + + croak("to_base() requires a newer version of the $LIB library.") + unless $LIB->can('_to_base'); + + return $LIB->_to_base($x->{value}, $base -> {value}, @_ ? shift() : ()); } sub as_hex { @@ -3679,7 +3733,7 @@ sub as_hex { return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc - my $hex = $CALC->_as_hex($x->{value}); + my $hex = $LIB->_as_hex($x->{value}); return $x->{sign} eq '-' ? "-$hex" : $hex; } @@ -3690,7 +3744,7 @@ sub as_oct { return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc - my $oct = $CALC->_as_oct($x->{value}); + my $oct = $LIB->_as_oct($x->{value}); return $x->{sign} eq '-' ? "-$oct" : $oct; } @@ -3701,7 +3755,7 @@ sub as_bin { return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc - my $bin = $CALC->_as_bin($x->{value}); + my $bin = $LIB->_as_bin($x->{value}); return $x->{sign} eq '-' ? "-$bin" : $bin; } @@ -3728,7 +3782,7 @@ sub numify { return $x -> is_negative() ? -$inf : $inf; } - my $num = 0 + $CALC->_num($x->{value}); + my $num = 0 + $LIB->_num($x->{value}); return $x->{sign} eq '-' ? -$num : $num; } @@ -3763,7 +3817,7 @@ sub objectify { # Check the context. unless (wantarray) { - Carp::croak("${class}::objectify() needs list context"); + croak("${class}::objectify() needs list context"); } # Get the number of arguments to objectify. @@ -3880,7 +3934,6 @@ sub objectify { sub import { my $class = shift; - $IMPORT++; # remember we did import() my @a; my $l = scalar @_; @@ -3897,7 +3950,7 @@ sub import { $i++; } elsif ($_[$i] =~ /^(lib|try|only)\z/) { # this causes a different low lib to take care... - $CALC = $_[$i+1] || ''; + $LIB = $_[$i+1] || ''; # lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback) $warn_or_die = 1 if $_[$i] eq 'lib'; $warn_or_die = 2 if $_[$i] eq 'only'; @@ -3908,20 +3961,18 @@ sub import { } # any non :constant stuff is handled by our parent, Exporter if (@a > 0) { - require Exporter; - $class->SUPER::import(@a); # need it for subclasses $class->export_to_level(1, $class, @a); # need it for MBF } # try to load core math lib - my @c = split /\s*,\s*/, $CALC; + my @c = split /\s*,\s*/, $LIB; foreach (@c) { $_ =~ 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" - $CALC = ''; # signal error + $LIB = ''; # signal error foreach my $l (@c) { # fallback libraries are "marked" as \'string', extract string if nec. my $lib = $l; @@ -3964,7 +4015,7 @@ sub import { /) { if (!$lib->can("_$method")) { if (($WARN{$lib} || 0) < 2) { - Carp::carp("$lib is missing method '_$method'"); + carp("$lib is missing method '_$method'"); $WARN{$lib} = 1; # still warn about the lib } $ok++; @@ -3973,43 +4024,35 @@ sub import { } } if ($ok == 0) { - $CALC = $lib; + $LIB = $lib; if ($warn_or_die > 0 && ref($l)) { my $msg = "Math::BigInt: couldn't load specified" . " math lib(s), fallback to $lib"; - Carp::carp($msg) if $warn_or_die == 1; - Carp::croak($msg) if $warn_or_die == 2; + 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::carp("Cannot load outdated $lib v$ver, please upgrade"); + carp("Cannot load outdated $lib v$ver, please upgrade"); $WARN{$lib} = 2; # never warn again } } } } - if ($CALC eq '') { + if ($LIB eq '') { if ($warn_or_die == 2) { - Carp::croak("Couldn't load specified math lib(s)" . + croak("Couldn't load specified math lib(s)" . " and fallback disallowed"); } else { - Carp::croak("Couldn't load any math lib(s), not even fallback to Calc.pm"); + croak("Couldn't load any math lib(s), not even fallback to Calc.pm"); } } # notify callbacks foreach my $class (keys %CALLBACKS) { - &{$CALLBACKS{$class}}($CALC); - } - - # Fill $CAN with the results of $CALC->can(...) for emulating lower math lib - # functions - - %CAN = (); - for my $method (qw/ signed_and signed_or signed_xor /) { - $CAN{$method} = $CALC->can("_$method") ? 1 : 0; + &{$CALLBACKS{$class}}($LIB); } # import done @@ -4019,7 +4062,7 @@ sub _register_callback { my ($class, $callback) = @_; if (ref($callback) ne 'CODE') { - Carp::croak("$callback is not a coderef"); + croak("$callback is not a coderef"); } $CALLBACKS{$class} = $callback; } @@ -4171,7 +4214,7 @@ sub _trailing_zeros { return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc - $CALC->_zeros($x->{value}); # must handle odd values, 0 etc + $LIB->_zeros($x->{value}); # must handle odd values, 0 etc } sub _scan_for_nonzero { @@ -4243,7 +4286,7 @@ sub _find_round_parameters { $r = ${"$class\::round_mode"} unless defined $r; if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) { - Carp::croak("Unknown round mode '$r'"); + croak("Unknown round mode '$r'"); } $a = int($a) if defined $a; @@ -4306,19 +4349,20 @@ Math::BigInt - Arbitrary size integer/float math package # Constructor methods (when the class methods below are used as instance # methods, the value is assigned the invocand) - $x = Math::BigInt->new($str); # defaults to 0 - $x = Math::BigInt->new('0x123'); # from hexadecimal - $x = Math::BigInt->new('0b101'); # from binary - $x = Math::BigInt->from_hex('cafe'); # from hexadecimal - $x = Math::BigInt->from_oct('377'); # from octal - $x = Math::BigInt->from_bin('1101'); # from binary - $x = Math::BigInt->bzero(); # create a +0 - $x = Math::BigInt->bone(); # create a +1 - $x = Math::BigInt->bone('-'); # create a -1 - $x = Math::BigInt->binf(); # create a +inf - $x = Math::BigInt->binf('-'); # create a -inf - $x = Math::BigInt->bnan(); # create a Not-A-Number - $x = Math::BigInt->bpi(); # returns pi + $x = Math::BigInt->new($str); # defaults to 0 + $x = Math::BigInt->new('0x123'); # from hexadecimal + $x = Math::BigInt->new('0b101'); # from binary + $x = Math::BigInt->from_hex('cafe'); # from hexadecimal + $x = Math::BigInt->from_oct('377'); # from octal + $x = Math::BigInt->from_bin('1101'); # from binary + $x = Math::BigInt->from_base('why', 36); # from any base + $x = Math::BigInt->bzero(); # create a +0 + $x = Math::BigInt->bone(); # create a +1 + $x = Math::BigInt->bone('-'); # create a -1 + $x = Math::BigInt->binf(); # create a +inf + $x = Math::BigInt->binf('-'); # create a -inf + $x = Math::BigInt->bnan(); # create a Not-A-Number + $x = Math::BigInt->bpi(); # returns pi $y = $x->copy(); # make a copy (unlike $y = $x) $y = $x->as_int(); # return as a Math::BigInt @@ -4383,7 +4427,7 @@ Math::BigInt - Arbitrary size integer/float math package $x->bcos(); # cosine $x->batan(); # inverse tangent $x->batan2($y); # two-argument inverse tangent - $x->bsqrt(); # calculate square-root + $x->bsqrt(); # calculate square root $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root) $x->bfac(); # factorial of $x (1*2*3*4*..$x) @@ -4445,6 +4489,7 @@ Math::BigInt - Arbitrary size integer/float math package $x->to_bin(); # as signed binary string $x->to_oct(); # as signed octal string $x->to_bytes(); # as byte string + $x->to_base($b); # as string in any base $x->as_hex(); # as signed hexadecimal string with prefixed 0x $x->as_bin(); # as signed binary string with prefixed 0b @@ -4652,54 +4697,39 @@ This is used for instance by L<Math::BigInt::Constant>. =item config() - use Data::Dumper; - - print Dumper ( Math::BigInt->config() ); - print Math::BigInt->config()->{lib},"\n"; - print Math::BigInt->config('lib')},"\n"; + Math::BigInt->config("trap_nan" => 1); # set + $accu = Math::BigInt->config("accuracy"); # get -Returns a hash containing the configuration, e.g. the version number, lib -loaded etc. The following hash keys are currently filled in with the -appropriate information. +Set or get class variables. Read-only parameters are marked as RO. Read-write +parameters are marked as RW. The following parameters are supported. - key Description - Example + Parameter RO/RW Description + Example ============================================================ - lib Name of the low-level math library - Math::BigInt::Calc - lib_version Version of low-level math library (see 'lib') - 0.30 - class The class name of config() you just called - Math::BigInt - upgrade To which class math operations might be - upgraded Math::BigFloat - downgrade To which class math operations might be - downgraded undef - precision Global precision - undef - accuracy Global accuracy - undef - round_mode Global round mode - even - version version number of the class you used - 1.61 - div_scale Fallback accuracy for div - 40 - trap_nan If true, traps creation of NaN via croak() - 1 - trap_inf If true, traps creation of +inf/-inf via croak() - 1 - -The following values can be set by passing C<config()> a reference to a hash: - - accuracy precision round_mode div_scale - upgrade downgrade trap_inf trap_nan - -Example: - - $new_cfg = Math::BigInt->config( - { trap_inf => 1, precision => 5 } - ); + lib RO Name of the math backend library + Math::BigInt::Calc + lib_version RO Version of the math backend library + 0.30 + class RO The class of config you just called + Math::BigRat + version RO version number of the class you used + 0.10 + upgrade RW To which class numbers are upgraded + undef + downgrade RW To which class numbers are downgraded + undef + precision RW Global precision + undef + accuracy RW Global accuracy + undef + round_mode RW Global round mode + even + div_scale RW Fallback accuracy for division etc. + 40 + trap_nan RW Trap NaNs + undef + trap_inf RW Trap +inf/-inf + undef =back @@ -4767,6 +4797,49 @@ In some special cases, from_bytes() matches the conversion done by unpack(): $x = Math::BigInt->from_bytes($b); # = 3305723134637787565 $y = unpack "Q>", $b; # ditto, but scalar +=item from_base() + +Given a string, a base, and an optional collation sequence, interpret the +string as a number in the given base. The collation sequence describes the +value of each character in the string. + +If a collation sequence is not given, a default collation sequence is used. If +the base is less than or equal to 36, the collation sequence is the string +consisting of the 36 characters "0" to "9" and "A" to "Z". In this case, the +letter case in the input is ignored. If the base is greater than 36, and +smaller than or equal to 62, the collation sequence is the string consisting of +the 62 characters "0" to "9", "A" to "Z", and "a" to "z". A base larger than 62 +requires the collation sequence to be specified explicitly. + +These examples show standard binary, octal, and hexadecimal conversion. All +cases return 250. + + $x = Math::BigInt->from_base("11111010", 2); + $x = Math::BigInt->from_base("372", 8); + $x = Math::BigInt->from_base("fa", 16); + +When the base is less than or equal to 36, and no collation sequence is given, +the letter case is ignored, so both of these also return 250: + + $x = Math::BigInt->from_base("6Y", 16); + $x = Math::BigInt->from_base("6y", 16); + +When the base greater than 36, and no collation sequence is given, the default +collation sequence contains both uppercase and lowercase letters, so +the letter case in the input is not ignored: + + $x = Math::BigInt->from_base("6S", 37); # $x is 250 + $x = Math::BigInt->from_base("6s", 37); # $x is 276 + $x = Math::BigInt->from_base("121", 3); # $x is 16 + $x = Math::BigInt->from_base("XYZ", 36); # $x is 44027 + $x = Math::BigInt->from_base("Why", 42); # $x is 58314 + +The collation sequence can be any set of unique characters. These two cases +are equivalent + + $x = Math::BigInt->from_base("100", 2, "01"); # $x is 4 + $x = Math::BigInt->from_base("|--", 2, "-|"); # $x is 4 + =item bzero() $x = Math::BigInt->bzero(); @@ -5196,13 +5269,28 @@ See also L</blog()>. $x->bnok($y); # x over y (binomial coefficient n over k) Calculates the binomial coefficient n over k, also called the "choose" -function. The result is equivalent to: +function, which is - ( n ) n! - | - | = ------- + ( n ) n! + | | = -------- ( k ) k!(n-k)! -This method was added in v1.84 of Math::BigInt (April 2007). +when n and k are non-negative. This method implements the full Kronenburg +extension (Kronenburg, M.J. "The Binomial Coefficient for Negative Arguments." +18 May 2011. http://arxiv.org/abs/1105.3689/) illustrated by the following +pseudo-code: + + if n >= 0 and k >= 0: + return binomial(n, k) + if k >= 0: + return (-1)^k*binomial(-n+k-1, k) + if k <= n: + return (-1)^(n-k)*binomial(-k-1, n-k) + else + return 0 + +The behaviour is identical to the behaviour of the Maple and Mathematica +function for negative integers n, k. =item bsin() @@ -5255,7 +5343,7 @@ This method was added in v1.87 of Math::BigInt (June 2007). =item bsqrt() - $x->bsqrt(); # calculate square-root + $x->bsqrt(); # calculate square root C<bsqrt()> returns the square root truncated to an integer. @@ -5602,8 +5690,8 @@ corresponds to the output from C<sparts()>. Returns a string representing the number using normalized notation, the most common variant of scientific notation. For finite non-zero numbers, the -absolute value of the significand is less than or equal to 1 and less than 10. -The output corresponds to the output from C<nparts()>. +absolute value of the significand is greater than or equal to 1 and less than +10. The output corresponds to the output from C<nparts()>. 123 is returned as "1.23e+2" 1230 is returned as "1.23e+3" @@ -5614,8 +5702,8 @@ The output corresponds to the output from C<nparts()>. =item bestr() Returns a string representing the number using engineering notation. For finite -non-zero numbers, the absolute value of the significand is less than or equal -to 1 and less than 1000, and the exponent is a multiple of 3. The output +non-zero numbers, the absolute value of the significand is greater than or +equal to 1 and less than 1000, and the exponent is a multiple of 3. The output corresponds to the output from C<eparts()>. 123 is returned as "123e+0" @@ -5639,19 +5727,19 @@ corresponds to the output from C<dparts()>. $x->to_hex(); -Returns a hexadecimal string representation of the number. +Returns a hexadecimal string representation of the number. See also from_hex(). =item to_bin() $x->to_bin(); -Returns a binary string representation of the number. +Returns a binary string representation of the number. See also from_bin(). =item to_oct() $x->to_oct(); -Returns an octal string representation of the number. +Returns an octal string representation of the number. See also from_oct(). =item to_bytes() @@ -5659,7 +5747,27 @@ Returns an octal string representation of the number. $s = $x->to_bytes(); # $s = "cafe" Returns a byte string representation of the number using big endian byte -order. The invocand must be a non-negative, finite integer. +order. The invocand must be a non-negative, finite integer. See also from_bytes(). + +=item to_base() + + $x = Math::BigInt->new("250"); + $x->to_base(2); # returns "11111010" + $x->to_base(8); # returns "372" + $x->to_base(16); # returns "fa" + +Returns a string representation of the number in the given base. If a collation +sequence is given, the collation sequence determines which characters are used +in the output. + +Here are some more examples + + $x = Math::BigInt->new("16")->to_base(3); # returns "121" + $x = Math::BigInt->new("44027")->to_base(36); # returns "XYZ" + $x = Math::BigInt->new("58314")->to_base(42); # returns "Why" + $x = Math::BigInt->new("4")->to_base(2, "-|"); # returns "|--" + +See from_base() for information and examples. =item as_hex() @@ -5767,59 +5875,66 @@ dividing numbers. When rounding a number, different 'styles' or 'kinds' of rounding are possible. (Note that random rounding, as in Math::Round, is not implemented.) +=head3 Directed rounding + +These round modes always round in the same direction. + =over =item 'trunc' -truncation invariably removes all digits following the rounding place, -replacing them with zeros. Thus, 987.65 rounded to tens (P = 1) becomes 980, -and rounded to the fourth sigdig becomes 987.6 (A = 4). 123.456 rounded to the -second place after the decimal point (P = -2) becomes 123.46. +Round towards zero. Remove all digits following the rounding place, i.e., +replace them with zeros. Thus, 987.65 rounded to tens (P=1) becomes 980, and +rounded to the fourth significant digit becomes 987.6 (A=4). 123.456 rounded to +the second place after the decimal point (P=-2) becomes 123.46. This +corresponds to the IEEE 754 rounding mode 'roundTowardZero'. + +=back -All other implemented styles of rounding attempt to round to the "nearest -digit." If the digit D immediately to the right of the rounding place (skipping -the decimal point) is greater than 5, the number is incremented at the rounding -place (possibly causing a cascade of incrementation): e.g. when rounding to -units, 0.9 rounds to 1, and -19.9 rounds to -20. If D < 5, the number is -similarly truncated at the rounding place: e.g. when rounding to units, 0.4 -rounds to 0, and -19.4 rounds to -19. +=head3 Rounding to nearest -However the results of other styles of rounding differ if the digit immediately -to the right of the rounding place (skipping the decimal point) is 5 and if -there are no digits, or no digits other than 0, after that 5. In such cases: +These rounding modes round to the nearest digit. They differ in how they +determine which way to round in the ambiguous case when there is a tie. + +=over =item 'even' -rounds the digit at the rounding place to 0, 2, 4, 6, or 8 if it is not -already. E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55 -becomes -0.6, but 0.4501 becomes 0.5. +Round towards the nearest even digit, e.g., when rounding to nearest integer, +-5.5 becomes -6, 4.5 becomes 4, but 4.501 becomes 5. This corresponds to the +IEEE 754 rounding mode 'roundTiesToEven'. =item 'odd' -rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if it is not -already. E.g., when rounding to the first sigdig, 0.45 becomes 0.5, -0.55 -becomes -0.5, but 0.5501 becomes 0.6. +Round towards the nearest odd digit, e.g., when rounding to nearest integer, +4.5 becomes 5, -5.5 becomes -5, but 5.501 becomes 6. This corresponds to the +IEEE 754 rounding mode 'roundTiesToOdd'. =item '+inf' -round to plus infinity, i.e. always round up. E.g., when rounding to the first -sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5, and 0.4501 also becomes 0.5. +Round towards plus infinity, i.e., always round up. E.g., when rounding to the +nearest integer, 4.5 becomes 5, -5.5 becomes -5, and 4.501 also becomes 5. This +corresponds to the IEEE 754 rounding mode 'roundTiesToPositive'. =item '-inf' -round to minus infinity, i.e. always round down. E.g., when rounding to the -first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5. +Round towards minus infinity, i.e., always round down. E.g., when rounding to +the nearest integer, 4.5 becomes 4, -5.5 becomes -6, but 4.501 becomes 5. This +corresponds to the IEEE 754 rounding mode 'roundTiesToNegative'. =item 'zero' -round to zero, i.e. positive numbers down, negative ones up. E.g., when -rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.5, but 0.4501 -becomes 0.5. +Round towards zero, i.e., round positive numbers down and negative numbers up. +E.g., when rounding to the nearest integer, 4.5 becomes 4, -5.5 becomes -5, but +4.501 becomes 5. This corresponds to the IEEE 754 rounding mode +'roundTiesToZero'. =item 'common' -round up if the digit immediately to the right of the rounding place is 5 or -greater, otherwise round down. E.g., 0.15 becomes 0.2 and 0.149 becomes 0.1. +Round away from zero, i.e., round to the number with the largest absolute +value. E.g., when rounding to the nearest integer, -1.5 becomes -2, 1.5 becomes +2 and 1.49 becomes 1. This corresponds to the IEEE 754 rounding mode +'roundTiesToAway'. =back diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/Calc.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/Calc.pm index 571006963f0..2bb06a0976b 100644 --- a/Master/tlpkg/tlperl/lib/Math/BigInt/Calc.pm +++ b/Master/tlpkg/tlperl/lib/Math/BigInt/Calc.pm @@ -4,10 +4,10 @@ use 5.006001; use strict; use warnings; -use Carp; +use Carp qw< carp croak >; use Math::BigInt::Lib; -our $VERSION = '1.999811'; +our $VERSION = '1.999816'; our @ISA = ('Math::BigInt::Lib'); @@ -104,8 +104,7 @@ sub _new { my ($class, $str) = @_; #unless ($str =~ /^([1-9]\d*|0)\z/) { - # require Carp; - # Carp::croak("Invalid input string '$str'"); + # croak("Invalid input string '$str'"); #} my $input_len = length($str) - 1; @@ -264,8 +263,7 @@ sub _str { my $idx = $#$ary; # index of last element if ($idx < 0) { # should not happen - require Carp; - Carp::croak("$_[1] has no elements"); + croak("$_[1] has no elements"); } # Handle first one differently, since it should not have any leading zeros. @@ -693,7 +691,7 @@ sub _div_use_mul { 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 ($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) { @@ -858,7 +856,7 @@ sub _div_use_div_64 { 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 ($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) { @@ -2045,7 +2043,6 @@ sub _root { elsif ($acmp > 0) { $upper = $y; - my $zero = $c -> _zero(); while ($acmp > 0) { if ($c -> _acmp($upper, $delta) <= 0) { $lower = $c -> _zero(); diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm deleted file mode 100644 index 69c02caffef..00000000000 --- a/Master/tlpkg/tlperl/lib/Math/BigInt/CalcEmu.pm +++ /dev/null @@ -1,394 +0,0 @@ -package Math::BigInt::CalcEmu; - -use 5.006001; -use strict; -use warnings; - -our $VERSION = '1.999811'; - -package Math::BigInt; - -# See SYNOPSIS below. - -my $CALC_EMU; - -BEGIN - { - $CALC_EMU = Math::BigInt->config('lib'); - # register us with MBI to get notified of future lib changes - Math::BigInt::_register_callback( __PACKAGE__, sub { $CALC_EMU = $_[0]; } ); - } - -sub __emu_band - { - my ($self,$x,$y,$sx,$sy,@r) = @_; - - return $x->bzero(@r) if $y->is_zero() || $x->is_zero(); - - my $sign = 0; # sign of result - $sign = 1 if $sx == -1 && $sy == -1; - - my ($bx,$by); - - if ($sx == -1) # if x is negative - { - # two's complement: inc and flip all "bits" in $bx - $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc - $bx =~ s/-?0x//; - $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - else - { - $bx = $x->as_hex(); # get binary representation - $bx =~ s/-?0x//; - $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - if ($sy == -1) # if y is negative - { - # two's complement: inc and flip all "bits" in $by - $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc - $by =~ s/-?0x//; - $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - else - { - $by = $y->as_hex(); # get binary representation - $by =~ s/-?0x//; - $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - # now we have bit-strings from X and Y, reverse them for padding - $bx = reverse $bx; - $by = reverse $by; - - # padd the shorter string - my $xx = "\x00"; $xx = "\x0f" if $sx == -1; - my $yy = "\x00"; $yy = "\x0f" if $sy == -1; - my $diff = CORE::length($bx) - CORE::length($by); - if ($diff > 0) - { - # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by - $by .= $yy x $diff; - } - elsif ($diff < 0) - { - # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx - $bx .= $xx x abs($diff); - } - - # and the strings together - my $r = $bx & $by; - - # and reverse the result again - $bx = reverse $r; - - # One of $x or $y was negative, so need to flip bits in the result. - # In both cases (one or two of them negative, or both positive) we need - # to get the characters back. - if ($sign == 1) - { - $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; - } - else - { - $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; - } - - # leading zeros will be stripped by _from_hex() - $bx = '0x' . $bx; - $x->{value} = $CALC_EMU->_from_hex( $bx ); - - # calculate sign of result - $x->{sign} = '+'; - $x->{sign} = '-' if $sign == 1 && !$x->is_zero(); - - $x->bdec() if $sign == 1; - - $x->round(@r); - } - -sub __emu_bior - { - my ($self,$x,$y,$sx,$sy,@r) = @_; - - return $x->round(@r) if $y->is_zero(); - - my $sign = 0; # sign of result - $sign = 1 if ($sx == -1) || ($sy == -1); - - my ($bx,$by); - - if ($sx == -1) # if x is negative - { - # two's complement: inc and flip all "bits" in $bx - $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc - $bx =~ s/-?0x//; - $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - else - { - $bx = $x->as_hex(); # get binary representation - $bx =~ s/-?0x//; - $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - if ($sy == -1) # if y is negative - { - # two's complement: inc and flip all "bits" in $by - $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc - $by =~ s/-?0x//; - $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - else - { - $by = $y->as_hex(); # get binary representation - $by =~ s/-?0x//; - $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - # now we have bit-strings from X and Y, reverse them for padding - $bx = reverse $bx; - $by = reverse $by; - - # padd the shorter string - my $xx = "\x00"; $xx = "\x0f" if $sx == -1; - my $yy = "\x00"; $yy = "\x0f" if $sy == -1; - my $diff = CORE::length($bx) - CORE::length($by); - if ($diff > 0) - { - $by .= $yy x $diff; - } - elsif ($diff < 0) - { - $bx .= $xx x abs($diff); - } - - # or the strings together - my $r = $bx | $by; - - # and reverse the result again - $bx = reverse $r; - - # one of $x or $y was negative, so need to flip bits in the result - # in both cases (one or two of them negative, or both positive) we need - # to get the characters back. - if ($sign == 1) - { - $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; - } - else - { - $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; - } - - # leading zeros will be stripped by _from_hex() - $bx = '0x' . $bx; - $x->{value} = $CALC_EMU->_from_hex( $bx ); - - # calculate sign of result - $x->{sign} = '+'; - $x->{sign} = '-' if $sign == 1 && !$x->is_zero(); - - # if one of X or Y was negative, we need to decrement result - $x->bdec() if $sign == 1; - - $x->round(@r); - } - -sub __emu_bxor - { - my ($self,$x,$y,$sx,$sy,@r) = @_; - - return $x->round(@r) if $y->is_zero(); - - my $sign = 0; # sign of result - $sign = 1 if $x->{sign} ne $y->{sign}; - - my ($bx,$by); - - if ($sx == -1) # if x is negative - { - # two's complement: inc and flip all "bits" in $bx - $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc - $bx =~ s/-?0x//; - $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - else - { - $bx = $x->as_hex(); # get binary representation - $bx =~ s/-?0x//; - $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - if ($sy == -1) # if y is negative - { - # two's complement: inc and flip all "bits" in $by - $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc - $by =~ s/-?0x//; - $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - else - { - $by = $y->as_hex(); # get binary representation - $by =~ s/-?0x//; - $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; - } - # now we have bit-strings from X and Y, reverse them for padding - $bx = reverse $bx; - $by = reverse $by; - - # padd the shorter string - my $xx = "\x00"; $xx = "\x0f" if $sx == -1; - my $yy = "\x00"; $yy = "\x0f" if $sy == -1; - my $diff = CORE::length($bx) - CORE::length($by); - if ($diff > 0) - { - $by .= $yy x $diff; - } - elsif ($diff < 0) - { - $bx .= $xx x abs($diff); - } - - # xor the strings together - my $r = $bx ^ $by; - - # and reverse the result again - $bx = reverse $r; - - # one of $x or $y was negative, so need to flip bits in the result - # in both cases (one or two of them negative, or both positive) we need - # to get the characters back. - if ($sign == 1) - { - $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; - } - else - { - $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; - } - - # leading zeros will be stripped by _from_hex() - $bx = '0x' . $bx; - $x->{value} = $CALC_EMU->_from_hex( $bx ); - - # calculate sign of result - $x->{sign} = '+'; - $x->{sign} = '-' if $sx != $sy && !$x->is_zero(); - - $x->bdec() if $sign == 1; - - $x->round(@r); - } - -############################################################################## -############################################################################## - -1; - -__END__ - -=pod - -=head1 NAME - -Math::BigInt::CalcEmu - Emulate low-level math with BigInt code - -=head1 SYNOPSIS - - use Math::BigInt::CalcEmu; - -=head1 DESCRIPTION - -Contains routines that emulate low-level math functions in BigInt, e.g. -optional routines the low-level math package does not provide on its own. - -Will be loaded on demand and called automatically by BigInt. - -Stuff here is really low-priority to optimize, since it is far better to -implement the operation in the low-level math library directly, possible even -using a call to the native lib. - -=head1 METHODS - -=over - -=item __emu_bxor - -=item __emu_band - -=item __emu_bior - -=back - -=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::CalcEmu - -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 - -(c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by -Tels from 2001-2003. - -=head1 SEE ALSO - -L<Math::BigInt>, L<Math::BigFloat>, -L<Math::BigInt::GMP> and L<Math::BigInt::Pari>. - -=cut diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm index 8d0ba4097af..3e772e92a3e 100644 --- a/Master/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm +++ b/Master/tlpkg/tlperl/lib/Math/BigInt/FastCalc.pm @@ -8,7 +8,7 @@ use Math::BigInt::Calc 1.999801; our @ISA = qw< Math::BigInt::Calc >; -our $VERSION = '0.5006'; +our $VERSION = '0.5008'; ############################################################################## # global constants, flags and accessory diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm index 23a44aa9559..883f31f4c93 100755 --- a/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm +++ b/Master/tlpkg/tlperl/lib/Math/BigInt/Lib.pm @@ -4,7 +4,7 @@ use 5.006001; use strict; use warnings; -our $VERSION = '1.999811'; +our $VERSION = '1.999816'; use Carp; @@ -1076,6 +1076,261 @@ sub _or { return $z; } +sub _sand { + my ($class, $x, $sx, $y, $sy) = @_; + + return ($class -> _zero(), '+') + if $class -> _is_zero($x) || $class -> _is_zero($y); + + my $sign = $sx eq '-' && $sy eq '-' ? '-' : '+'; + + my ($bx, $by); + + if ($sx eq '-') { # if x is negative + # two's complement: inc (dec unsigned value) and flip all "bits" in $bx + $bx = $class -> _copy($x); + $bx = $class -> _dec($bx); + $bx = $class -> _as_hex($bx); + $bx =~ s/^-?0x//; + $bx =~ tr<0123456789abcdef> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } else { # if x is positive + $bx = $class -> _as_hex($x); # get binary representation + $bx =~ s/^-?0x//; + $bx =~ tr<fedcba9876543210> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } + + if ($sy eq '-') { # if y is negative + # two's complement: inc (dec unsigned value) and flip all "bits" in $by + $by = $class -> _copy($y); + $by = $class -> _dec($by); + $by = $class -> _as_hex($by); + $by =~ s/^-?0x//; + $by =~ tr<0123456789abcdef> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } else { + $by = $class -> _as_hex($y); # get binary representation + $by =~ s/^-?0x//; + $by =~ tr<fedcba9876543210> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } + + # now we have bit-strings from X and Y, reverse them for padding + $bx = reverse $bx; + $by = reverse $by; + + # padd the shorter string + my $xx = "\x00"; $xx = "\x0f" if $sx eq '-'; + my $yy = "\x00"; $yy = "\x0f" if $sy eq '-'; + my $diff = CORE::length($bx) - CORE::length($by); + if ($diff > 0) { + # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by + $by .= $yy x $diff; + } elsif ($diff < 0) { + # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx + $bx .= $xx x abs($diff); + } + + # and the strings together + my $r = $bx & $by; + + # and reverse the result again + $bx = reverse $r; + + # One of $bx or $by was negative, so need to flip bits in the result. In both + # cases (one or two of them negative, or both positive) we need to get the + # characters back. + if ($sign eq '-') { + $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> + <0123456789abcdef>; + } else { + $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> + <fedcba9876543210>; + } + + # leading zeros will be stripped by _from_hex() + $bx = '0x' . $bx; + $bx = $class -> _from_hex($bx); + + $bx = $class -> _inc($bx) if $sign eq '-'; + + # avoid negative zero + $sign = '+' if $class -> _is_zero($bx); + + return $bx, $sign; +} + +sub _sxor { + my ($class, $x, $sx, $y, $sy) = @_; + + return ($class -> _zero(), '+') + if $class -> _is_zero($x) && $class -> _is_zero($y); + + my $sign = $sx ne $sy ? '-' : '+'; + + my ($bx, $by); + + if ($sx eq '-') { # if x is negative + # two's complement: inc (dec unsigned value) and flip all "bits" in $bx + $bx = $class -> _copy($x); + $bx = $class -> _dec($bx); + $bx = $class -> _as_hex($bx); + $bx =~ s/^-?0x//; + $bx =~ tr<0123456789abcdef> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } else { # if x is positive + $bx = $class -> _as_hex($x); # get binary representation + $bx =~ s/^-?0x//; + $bx =~ tr<fedcba9876543210> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } + + if ($sy eq '-') { # if y is negative + # two's complement: inc (dec unsigned value) and flip all "bits" in $by + $by = $class -> _copy($y); + $by = $class -> _dec($by); + $by = $class -> _as_hex($by); + $by =~ s/^-?0x//; + $by =~ tr<0123456789abcdef> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } else { + $by = $class -> _as_hex($y); # get binary representation + $by =~ s/^-?0x//; + $by =~ tr<fedcba9876543210> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } + + # now we have bit-strings from X and Y, reverse them for padding + $bx = reverse $bx; + $by = reverse $by; + + # padd the shorter string + my $xx = "\x00"; $xx = "\x0f" if $sx eq '-'; + my $yy = "\x00"; $yy = "\x0f" if $sy eq '-'; + my $diff = CORE::length($bx) - CORE::length($by); + if ($diff > 0) { + # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by + $by .= $yy x $diff; + } elsif ($diff < 0) { + # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx + $bx .= $xx x abs($diff); + } + + # xor the strings together + my $r = $bx ^ $by; + + # and reverse the result again + $bx = reverse $r; + + # One of $bx or $by was negative, so need to flip bits in the result. In both + # cases (one or two of them negative, or both positive) we need to get the + # characters back. + if ($sign eq '-') { + $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> + <0123456789abcdef>; + } else { + $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> + <fedcba9876543210>; + } + + # leading zeros will be stripped by _from_hex() + $bx = '0x' . $bx; + $bx = $class -> _from_hex($bx); + + $bx = $class -> _inc($bx) if $sign eq '-'; + + # avoid negative zero + $sign = '+' if $class -> _is_zero($bx); + + return $bx, $sign; +} + +sub _sor { + my ($class, $x, $sx, $y, $sy) = @_; + + return ($class -> _zero(), '+') + if $class -> _is_zero($x) && $class -> _is_zero($y); + + my $sign = $sx eq '-' || $sy eq '-' ? '-' : '+'; + + my ($bx, $by); + + if ($sx eq '-') { # if x is negative + # two's complement: inc (dec unsigned value) and flip all "bits" in $bx + $bx = $class -> _copy($x); + $bx = $class -> _dec($bx); + $bx = $class -> _as_hex($bx); + $bx =~ s/^-?0x//; + $bx =~ tr<0123456789abcdef> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } else { # if x is positive + $bx = $class -> _as_hex($x); # get binary representation + $bx =~ s/^-?0x//; + $bx =~ tr<fedcba9876543210> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } + + if ($sy eq '-') { # if y is negative + # two's complement: inc (dec unsigned value) and flip all "bits" in $by + $by = $class -> _copy($y); + $by = $class -> _dec($by); + $by = $class -> _as_hex($by); + $by =~ s/^-?0x//; + $by =~ tr<0123456789abcdef> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } else { + $by = $class -> _as_hex($y); # get binary representation + $by =~ s/^-?0x//; + $by =~ tr<fedcba9876543210> + <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>; + } + + # now we have bit-strings from X and Y, reverse them for padding + $bx = reverse $bx; + $by = reverse $by; + + # padd the shorter string + my $xx = "\x00"; $xx = "\x0f" if $sx eq '-'; + my $yy = "\x00"; $yy = "\x0f" if $sy eq '-'; + my $diff = CORE::length($bx) - CORE::length($by); + if ($diff > 0) { + # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by + $by .= $yy x $diff; + } elsif ($diff < 0) { + # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx + $bx .= $xx x abs($diff); + } + + # or the strings together + my $r = $bx | $by; + + # and reverse the result again + $bx = reverse $r; + + # One of $bx or $by was negative, so need to flip bits in the result. In both + # cases (one or two of them negative, or both positive) we need to get the + # characters back. + if ($sign eq '-') { + $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> + <0123456789abcdef>; + } else { + $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00> + <fedcba9876543210>; + } + + # leading zeros will be stripped by _from_hex() + $bx = '0x' . $bx; + $bx = $class -> _from_hex($bx); + + $bx = $class -> _inc($bx) if $sign eq '-'; + + # avoid negative zero + $sign = '+' if $class -> _is_zero($bx); + + return $bx, $sign; +} + sub _to_bin { # convert the number to a string of binary digits without prefix my ($class, $x) = @_; @@ -1162,6 +1417,43 @@ sub _to_bytes { *_as_bytes = \&_to_bytes; +sub _to_base { + # convert the number to a string of digits in various bases + my $class = shift; + my $x = shift; + my $base = shift; + $base = $class -> _new($base) unless ref($base); + + my $collseq; + if (@_) { + $collseq = shift(); + } else { + if ($class -> _acmp($base, $class -> _new("62")) <= 0) { + $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + . 'abcdefghijklmnopqrstuvwxyz'; + } else { + croak "When base > 62, a collation sequence must be given"; + } + } + + my @collseq = split '', $collseq; + my %collseq = map { $_ => $collseq[$_] } 0 .. $#collseq; + + my $str = ''; + my $tmp = $class -> _copy($x); + my $rem; + until ($class -> _is_zero($tmp)) { + ($tmp, $rem) = $class -> _div($tmp, $base); + my $num = $class -> _num($rem); + croak "no character to represent '$num' in collation sequence", + " (collation sequence is too short)" if $num > $#collseq; + my $chr = $collseq[$num]; + $str = $chr . $str; + } + return "0" unless length $str; + return $str; +} + sub _from_hex { # Convert a string of hexadecimal digits to a number. @@ -1264,6 +1556,56 @@ sub _from_bytes { return $x; } +sub _from_base { + # convert a string to a decimal number + my $class = shift; + my $str = shift; + my $base = shift; + $base = $class -> _new($base) unless ref($base); + + my $n = length($str); + my $x = $class -> _zero(); + + my $collseq; + if (@_) { + $collseq = shift(); + } else { + 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'; + } else { + croak "When base > 62, a collation sequence must be given"; + } + $collseq = substr $collseq, 0, $class -> _num($base); + } + + # Create a mapping from each character in the collation sequence to the + # corresponding integer. Check for duplicates in the collation sequence. + + my @collseq = split '', $collseq; + my %collseq; + for my $num (0 .. $#collseq) { + my $chr = $collseq[$num]; + die "duplicate character '$chr' in collation sequence" + if exists $collseq{$chr}; + $collseq{$chr} = $num; + } + + for (my $i = 0 ; $i < $n ; ++$i) { + my $chr = substr($str, $i, 1); + die "input character '$chr' does not exist in collation sequence" + unless exists $collseq{$chr}; + $x = $class -> _mul($x, $base); + my $num = $class -> _new($collseq{$chr}); + $x = $class -> _add($x, $num); + } + + return $x; +} + ############################################################################## # special modulus functions @@ -1637,6 +1979,37 @@ Returns an object given a byte string representing the number. The byte string is in big endian byte order, so the two-byte input string "\x01\x00" should give an output value representing the number 256. +=item CLASS-E<gt>_from_base(STR, BASE, COLLSEQ) + +Returns an object given a string STR, a base BASE, and a collation sequence +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. + +For instance, with base 3 and collation sequence "-/|", the character "-" +represents 0, "/" represents 1, and "|" represents 2. So if STR is "/|-", the +output is 1 * 3**2 + 2 * 3**1 + 0 * 3**0 = 15. + +The following examples show standard binary, octal, decimal, and hexadecimal +conversion. All examples return 250. + + $x = $class -> _from_base("11111010", 2) + $x = $class -> _from_base("372", 8) + $x = $class -> _from_base("250", 10) + $x = $class -> _from_base("FA", 16) + +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("caaa", 5, "abcde") + =back =head3 Mathematical functions @@ -1775,11 +2148,23 @@ Returns bitwise and. =item CLASS-E<gt>_or(OBJ1, OBJ2) -Return bitwise or. +Returns bitwise or. =item CLASS-E<gt>_xor(OBJ1, OBJ2) -Return bitwise exclusive or. +Returns bitwise exclusive or. + +=item CLASS-E<gt>_sand(OBJ1, OBJ2, SIGN1, SIGN2) + +Returns bitwise signed and. + +=item CLASS-E<gt>_sor(OBJ1, OBJ2, SIGN1, SIGN2) + +Returns bitwise signed or. + +=item CLASS-E<gt>_sxor(OBJ1, OBJ2, SIGN1, SIGN2) + +Returns bitwise signed exclusive or. =back @@ -1845,6 +2230,19 @@ Returns a byte string representation of OBJ. The byte string is in big endian byte order, so if OBJ represents the number 256, the output should be the two-byte string "\x01\x00". +=item CLASS-E<gt>_to_base(OBJ, BASE, COLLSEQ) + +Returns a string representation of OBJ in base BASE with collation sequence +COLLSEQ. + + $val = $class -> _new("210"); + $str = $class -> _to_base($val, 10, "xyz") # $str is "zyx" + + $val = $class -> _new("32"); + $str = $class -> _to_base($val, 2, "-|") # $str is "|-----" + +See _from_base() for more information. + =item CLASS-E<gt>_as_bin(OBJ) Like C<_to_bin()> but with a '0b' prefix. @@ -1951,30 +2349,6 @@ 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. - -=over 4 - -=item CLASS-E<gt>_signed_or(OBJ1, OBJ2, SIGN1, SIGN2) - -Return the signed bitwise or. - -=item CLASS-E<gt>_signed_and(OBJ1, OBJ2, SIGN1, SIGN2) - -Return the signed bitwise and. - -=item CLASS-E<gt>_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 library for big numbers to the diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt/Trace.pm b/Master/tlpkg/tlperl/lib/Math/BigInt/Trace.pm index 5f83c79210f..5517bedad99 100644 --- a/Master/tlpkg/tlperl/lib/Math/BigInt/Trace.pm +++ b/Master/tlpkg/tlperl/lib/Math/BigInt/Trace.pm @@ -13,7 +13,7 @@ our ($accuracy, $precision, $round_mode, $div_scale); our @ISA = qw(Exporter Math::BigInt); -our $VERSION = '0.49'; +our $VERSION = '0.51'; use overload; # inherit overload from Math::BigInt diff --git a/Master/tlpkg/tlperl/lib/Math/BigRat.pm b/Master/tlpkg/tlperl/lib/Math/BigRat.pm index 520b443b015..e3d172836c0 100644 --- a/Master/tlpkg/tlperl/lib/Math/BigRat.pm +++ b/Master/tlpkg/tlperl/lib/Math/BigRat.pm @@ -16,11 +16,11 @@ use 5.006; use strict; use warnings; -use Carp (); +use Carp qw< carp croak >; use Math::BigFloat 1.999718; -our $VERSION = '0.2613'; +our $VERSION = '0.2614'; our @ISA = qw(Math::BigFloat); @@ -42,7 +42,6 @@ use overload '/' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0]) : $_[0] -> copy() -> bdiv($_[1]); }, - '%' => sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0]) : $_[0] -> copy() -> bmod($_[1]); }, @@ -69,7 +68,6 @@ use overload '**=' => sub { $_[0]->bpow($_[1]); }, - '<<=' => sub { $_[0]->blsft($_[1]); }, '>>=' => sub { $_[0]->brsft($_[1]); }, @@ -207,7 +205,7 @@ BEGIN { # only one library loaded) *_e_add = \&Math::BigFloat::_e_add; *_e_sub = \&Math::BigFloat::_e_sub; - *as_int = \&as_number; + *as_number = \&as_int; *is_pos = \&is_positive; *is_neg = \&is_negative; } @@ -226,8 +224,7 @@ $downgrade = undef; $_trap_nan = 0; # are NaNs ok? set w/ config() $_trap_inf = 0; # are infs ok? set w/ config() -# the package we are using for our private parts, defaults to: -# Math::BigInt->config()->{lib} +# the math backend library my $LIB = 'Math::BigInt::Calc'; @@ -249,17 +246,17 @@ sub new { # Check the way we are called. if ($protoref) { - Carp::croak("new() is a class method, not an instance method"); + croak("new() is a class method, not an instance method"); } if (@_ < 1) { - #Carp::carp("Using new() with no argument is deprecated;", + #carp("Using new() with no argument is deprecated;", # " use bzero() or new(0) instead"); return $class -> bzero(); } if (@_ > 2) { - Carp::carp("Superfluous arguments to new() ignored."); + carp("Superfluous arguments to new() ignored."); } # Get numerator and denominator. If any of the arguments is undefined, @@ -270,7 +267,7 @@ sub new { if (@_ == 1 && !defined $n || @_ == 2 && (!defined $n || !defined $d)) { - #Carp::carp("Use of uninitialized value in new()"); + #carp("Use of uninitialized value in new()"); return $class -> bzero(); } @@ -553,7 +550,7 @@ sub bnan { $self = bless {}, $class unless $selfref; if ($_trap_nan) { - Carp::croak ("Tried to set a variable to NaN in $class->bnan()"); + croak ("Tried to set a variable to NaN in $class->bnan()"); } $self -> {sign} = $nan; @@ -577,7 +574,7 @@ sub binf { $sign = defined($sign) && substr($sign, 0, 1) eq '-' ? '-inf' : '+inf'; if ($_trap_inf) { - Carp::croak ("Tried to set a variable to +-inf in $class->binf()"); + croak ("Tried to set a variable to +-inf in $class->binf()"); } $self -> {sign} = $sign; @@ -685,10 +682,10 @@ sub bnorm { # Both parts must be objects of whatever we are using today. if (my $c = $LIB->_check($x->{_n})) { - Carp::croak("n did not pass the self-check ($c) in bnorm()"); + croak("n did not pass the self-check ($c) in bnorm()"); } if (my $c = $LIB->_check($x->{_d})) { - Carp::croak("d did not pass the self-check ($c) in bnorm()"); + croak("d did not pass the self-check ($c) in bnorm()"); } # no normalize for NaN, inf etc. @@ -742,7 +739,7 @@ sub _bnan { # partial object (happens under trap_nan), so fix it beforehand $self->{_d} = $LIB->_zero() unless defined $self->{_d}; $self->{_n} = $LIB->_zero() unless defined $self->{_n}; - Carp::croak ("Tried to set $self to NaN in $class\::_bnan()"); + croak ("Tried to set $self to NaN in $class\::_bnan()"); } $self->{_n} = $LIB->_zero(); $self->{_d} = $LIB->_zero(); @@ -758,7 +755,7 @@ sub _binf { # partial object (happens under trap_nan), so fix it beforehand $self->{_d} = $LIB->_zero() unless defined $self->{_d}; $self->{_n} = $LIB->_zero() unless defined $self->{_n}; - Carp::croak ("Tried to set $self to inf in $class\::_binf()"); + croak ("Tried to set $self to inf in $class\::_binf()"); } $self->{_n} = $LIB->_zero(); $self->{_d} = $LIB->_zero(); @@ -1137,9 +1134,11 @@ sub is_one { # return true if arg (BRAT or num_str) is +1 or -1 if signis given my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); - my $sign = $_[2] || ''; $sign = '+' if $sign ne '-'; - return 1 - if ($x->{sign} eq $sign && $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d})); + croak "too many arguments for is_one()" if @_ > 2; + my $sign = $_[1] || ''; + $sign = '+' if $sign ne '-'; + return 1 if ($x->{sign} eq $sign && + $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d})); 0; } @@ -1280,69 +1279,62 @@ sub bpow { ($class, $x, $y, @r) = objectify(2, @_); } - return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x - return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; - return $x->bone(@r) if $y->is_zero(); - return $x->round(@r) if $x->is_one() || $y->is_one(); + # $x and/or $y is a NaN + return $x->bnan() if $x->is_nan() || $y->is_nan(); - if ($x->{sign} eq '-' && $LIB->_is_one($x->{_n}) && $LIB->_is_one($x->{_d})) { - # if $x == -1 and odd/even y => +1/-1 - return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r); - # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; + # $x and/or $y is a +/-Inf + if ($x->is_inf("-")) { + return $x->bzero() if $y->is_negative(); + return $x->bnan() if $y->is_zero(); + return $x if $y->is_odd(); + return $x->bneg(); + } elsif ($x->is_inf("+")) { + return $x->bzero() if $y->is_negative(); + return $x->bnan() if $y->is_zero(); + return $x; + } elsif ($y->is_inf("-")) { + return $x->bnan() if $x -> is_one("-"); + return $x->binf("+") if $x > -1 && $x < 1; + return $x->bone() if $x -> is_one("+"); + return $x->bzero(); + } elsif ($y->is_inf("+")) { + return $x->bnan() if $x -> is_one("-"); + return $x->bzero() if $x > -1 && $x < 1; + return $x->bone() if $x -> is_one("+"); + return $x->binf("+"); + } + + if ($x->is_zero()) { + return $x->binf() if $y->is_negative(); + return $x->bone("+") if $y->is_zero(); + return $x; + } elsif ($x->is_one()) { + return $x->round(@r) if $y->is_odd(); # x is -1, y is odd => -1 + return $x->babs()->round(@r); # x is -1, y is even => 1 + } elsif ($y->is_zero()) { + return $x->bone(@r); # x^0 and x != 0 => 1 + } elsif ($y->is_one()) { + return $x->round(@r); # x^1 => x } - # 1 ** -y => 1 / (1 ** |y|) - # so do test for negative $y after above's clause - return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0) - - # shortcut if y == 1/N (is then sqrt() respective broot()) - if ($LIB->_is_one($y->{_n})) { - return $x->bsqrt(@r) if $LIB->_is_two($y->{_d}); # 1/2 => sqrt - return $x->broot($LIB->_str($y->{_d}), @r); # 1/N => root(N) - } + # we don't support complex numbers, so return NaN + return $x->bnan() if $x->is_negative() && !$y->is_int(); - # shortcut y/1 (and/or x/1) - if ($LIB->_is_one($y->{_d})) { - # shortcut for x/1 and y/1 - if ($LIB->_is_one($x->{_d})) { - $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n}); # x/1 ** y/1 => (x ** y)/1 - if ($y->{sign} eq '-') { - # 0.2 ** -3 => 1/(0.2 ** 3) - ($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}); # swap - } - # correct sign; + ** + => + - if ($x->{sign} eq '-') { - # - * - => +, - * - * - => - - $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_even($y->{_n}); - } - return $x->round(@r); - } + # (a/b)^-(c/d) = (b/a)^(c/d) + ($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}) if $y->is_negative(); - # x/z ** y/1 - $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n}); # 5/2 ** y/1 => 5 ** y / 2 ** y + unless ($LIB->_is_one($y->{_n})) { + $x->{_n} = $LIB->_pow($x->{_n}, $y->{_n}); $x->{_d} = $LIB->_pow($x->{_d}, $y->{_n}); - if ($y->{sign} eq '-') { - # 0.2 ** -3 => 1/(0.2 ** 3) - ($x->{_n}, $x->{_d}) = ($x->{_d}, $x->{_n}); # swap - } - # correct sign; + ** + => + - $x->{sign} = '+' if $x->{sign} eq '-' && $LIB->_is_even($y->{_n}); - return $x->round(@r); } - # print STDERR "# $x $y\n"; - - # otherwise: - - # n/d n ______________ - # a/b = -\/ (a/b) ** d - - # (a/b) ** n == (a ** n) / (b ** n) - $LIB->_pow($x->{_n}, $y->{_n}); - $LIB->_pow($x->{_d}, $y->{_n}); + unless ($LIB->_is_one($y->{_d})) { + return $x->bsqrt(@r) if $LIB->_is_two($y->{_d}); # 1/2 => sqrt + return $x->broot($LIB->_str($y->{_d}), @r); # 1/N => root(N) + } - return $x->broot($LIB->_str($y->{_d}), @r); # n/d => root(n) + return $x->round(@r); } sub blog { @@ -1616,16 +1608,38 @@ sub bsqrt { return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf return $x->round(@r) if $x->is_zero() || $x->is_one(); - local $Math::BigFloat::upgrade = undef; + my $n = $x -> {_n}; + my $d = $x -> {_d}; + + # Look for an exact solution. For the numerator and the denominator, take + # the square root and square it and see if we got the original value. If we + # did, for both the numerator and the denominator, we have an exact + # solution. + + { + my $nsqrt = $LIB -> _sqrt($LIB -> _copy($n)); + my $n2 = $LIB -> _mul($LIB -> _copy($nsqrt), $nsqrt); + if ($LIB -> _acmp($n, $n2) == 0) { + my $dsqrt = $LIB -> _sqrt($LIB -> _copy($d)); + my $d2 = $LIB -> _mul($LIB -> _copy($dsqrt), $dsqrt); + if ($LIB -> _acmp($d, $d2) == 0) { + $x -> {_n} = $nsqrt; + $x -> {_d} = $dsqrt; + return $x->round(@r); + } + } + } + + local $Math::BigFloat::upgrade = undef; local $Math::BigFloat::downgrade = undef; local $Math::BigFloat::precision = undef; - local $Math::BigFloat::accuracy = undef; - local $Math::BigInt::upgrade = undef; - local $Math::BigInt::precision = undef; - local $Math::BigInt::accuracy = undef; + local $Math::BigFloat::accuracy = undef; + local $Math::BigInt::upgrade = undef; + local $Math::BigInt::precision = undef; + local $Math::BigInt::accuracy = undef; - my $xn = Math::BigFloat -> new($LIB -> _str($x->{_n})); - my $xd = Math::BigFloat -> new($LIB -> _str($x->{_d})); + my $xn = Math::BigFloat -> new($LIB -> _str($n)); + my $xd = Math::BigFloat -> new($LIB -> _str($d)); my $xtmp = Math::BigRat -> new($xn -> bdiv($xd) -> bsqrt() -> bsstr()); @@ -1671,8 +1685,8 @@ sub band { my $xref = ref($x); my $class = $xref || $x; - Carp::croak 'band() is an instance method, not a class method' unless $xref; - Carp::croak 'Not enough arguments for band()' if @_ < 1; + croak 'band() is an instance method, not a class method' unless $xref; + croak 'Not enough arguments for band()' if @_ < 1; my $y = shift; $y = $class -> new($y) unless ref($y); @@ -1695,8 +1709,8 @@ sub bior { my $xref = ref($x); my $class = $xref || $x; - Carp::croak 'bior() is an instance method, not a class method' unless $xref; - Carp::croak 'Not enough arguments for bior()' if @_ < 1; + croak 'bior() is an instance method, not a class method' unless $xref; + croak 'Not enough arguments for bior()' if @_ < 1; my $y = shift; $y = $class -> new($y) unless ref($y); @@ -1719,8 +1733,8 @@ sub bxor { my $xref = ref($x); my $class = $xref || $x; - Carp::croak 'bxor() is an instance method, not a class method' unless $xref; - Carp::croak 'Not enough arguments for bxor()' if @_ < 1; + croak 'bxor() is an instance method, not a class method' unless $xref; + croak 'Not enough arguments for bxor()' if @_ < 1; my $y = shift; $y = $class -> new($y) unless ref($y); @@ -1743,7 +1757,7 @@ sub bnot { my $xref = ref($x); my $class = $xref || $x; - Carp::croak 'bnot() is an instance method, not a class method' unless $xref; + croak 'bnot() is an instance method, not a class method' unless $xref; my @r = @_; @@ -1852,8 +1866,8 @@ sub beq { my $selfref = ref $self; my $class = $selfref || $self; - Carp::croak 'beq() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for beq()' unless @_ == 1; + croak 'beq() is an instance method, not a class method' unless $selfref; + croak 'Wrong number of arguments for beq()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && ! $cmp; @@ -1864,8 +1878,8 @@ sub bne { my $selfref = ref $self; my $class = $selfref || $self; - Carp::croak 'bne() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for bne()' unless @_ == 1; + croak 'bne() is an instance method, not a class method' unless $selfref; + croak 'Wrong number of arguments for bne()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && ! $cmp ? '' : 1; @@ -1876,8 +1890,8 @@ sub blt { my $selfref = ref $self; my $class = $selfref || $self; - Carp::croak 'blt() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for blt()' unless @_ == 1; + croak 'blt() is an instance method, not a class method' unless $selfref; + croak 'Wrong number of arguments for blt()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && $cmp < 0; @@ -1888,8 +1902,8 @@ sub ble { my $selfref = ref $self; my $class = $selfref || $self; - Carp::croak 'ble() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for ble()' unless @_ == 1; + croak 'ble() is an instance method, not a class method' unless $selfref; + croak 'Wrong number of arguments for ble()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && $cmp <= 0; @@ -1900,8 +1914,8 @@ sub bgt { my $selfref = ref $self; my $class = $selfref || $self; - Carp::croak 'bgt() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for bgt()' unless @_ == 1; + croak 'bgt() is an instance method, not a class method' unless $selfref; + croak 'Wrong number of arguments for bgt()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && $cmp > 0; @@ -1912,9 +1926,9 @@ sub bge { my $selfref = ref $self; my $class = $selfref || $self; - Carp::croak 'bge() is an instance method, not a class method' + croak 'bge() is an instance method, not a class method' unless $selfref; - Carp::croak 'Wrong number of arguments for bge()' unless @_ == 1; + croak 'Wrong number of arguments for bge()' unless @_ == 1; my $cmp = $self -> bcmp(shift); return defined($cmp) && $cmp >= 0; @@ -1941,7 +1955,7 @@ sub numify { return $x->{sign} eq '-' ? 0 - $abs : 0 + $abs; } -sub as_number { +sub as_int { my ($self, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_); # NaN, inf etc @@ -2076,13 +2090,13 @@ sub import { # LIB already loaded, so feed it our lib arguments Math::BigInt->import(@import); - $LIB = Math::BigFloat->config()->{lib}; + $LIB = Math::BigFloat->config("lib"); # register us with LIB to get notified of future lib changes Math::BigInt::_register_callback($class, sub { $LIB = $_[0]; }); - # any non :constant stuff is handled by our parent, Exporter (loaded - # by Math::BigFloat, even if @_ is empty, to give it a chance + # any non :constant stuff is handled by Exporter (loaded by parent class) + # even if @_ is empty, to give it a chance $class->SUPER::import(@a); # for subclasses $class->export_to_level(1, $class, @a); # need this, too } @@ -2193,7 +2207,7 @@ BigInts. Returns the object as a scalar. This will lose some data if the object cannot be represented by a normal Perl scalar (integer or float), so -use L<as_int()|/"as_int()/as_number()"> or L</as_float()> instead. +use L</as_int()> or L</as_float()> instead. This routine is automatically used whenever a scalar is required: @@ -2201,7 +2215,9 @@ This routine is automatically used whenever a scalar is required: @array = (0, 1, 2, 3); $y = $array[$x]; # set $y to 3 -=item as_int()/as_number() +=item as_int() + +=item as_number() $x = Math::BigRat->new('13/7'); print $x->as_int(), "\n"; # '1' @@ -2642,21 +2658,19 @@ This method was added in v0.20 of Math::BigRat (May 2007). =item config() - use Data::Dumper; - - print Dumper ( Math::BigRat->config() ); - print Math::BigRat->config()->{lib}, "\n"; + Math::BigRat->config("trap_nan" => 1); # set + $accu = Math::BigRat->config("accuracy"); # get -Returns a hash containing the configuration, e.g. the version number, lib -loaded etc. The following hash keys are currently filled in with the -appropriate information. +Set or get configuration parameter values. Read-only parameters are marked as +RO. Read-write parameters are marked as RW. The following parameters are +supported. - key RO/RW Description + Parameter RO/RW Description Example ============================================================ - lib RO Name of the Math library + lib RO Name of the math backend library Math::BigInt::Calc - lib_version RO Version of 'lib' + lib_version RO Version of the math backend library 0.30 class RO The class of config you just called Math::BigRat @@ -2672,17 +2686,13 @@ appropriate information. undef round_mode RW Global round mode even - div_scale RW Fallback accuracy for div + div_scale RW Fallback accuracy for div, sqrt etc. 40 - trap_nan RW Trap creation of NaN (undef = no) + trap_nan RW Trap NaNs undef - trap_inf RW Trap creation of +inf/-inf (undef = no) + trap_inf RW Trap +inf/-inf undef -By passing a reference to a hash you may set the configuration values. This -works only for values that a marked with a C<RW> above, anything else is -read-only. - =back =head1 BUGS |