summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Math/BigInt.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Math/BigInt.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Math/BigInt.pm2682
1 files changed, 1492 insertions, 1190 deletions
diff --git a/Master/tlpkg/tlperl/lib/Math/BigInt.pm b/Master/tlpkg/tlperl/lib/Math/BigInt.pm
index 62f1be9cb06..a50b37e832a 100644
--- a/Master/tlpkg/tlperl/lib/Math/BigInt.pm
+++ b/Master/tlpkg/tlperl/lib/Math/BigInt.pm
@@ -15,19 +15,22 @@ package Math::BigInt;
# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
# underlying lib might change the reference!
-my $class = "Math::BigInt";
-use 5.006002;
+use 5.006001;
+use strict;
+use warnings;
-$VERSION = '1.9997';
+our $VERSION = '1.999715';
+$VERSION = eval $VERSION;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(objectify bgcd blcm);
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(objectify bgcd blcm);
# _trap_inf and _trap_nan are internal and should never be accessed from the
# outside
-use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode
- $upgrade $downgrade $_trap_nan $_trap_inf/;
-use strict;
+our ($round_mode, $accuracy, $precision, $div_scale, $rnd_mode,
+ $upgrade, $downgrade, $_trap_nan, $_trap_inf);
+
+my $class = "Math::BigInt";
# Inside overload, the first arg is always an object. If the original code had
# it reversed (like $x = 2 * $y), then the third parameter is true.
@@ -48,101 +51,101 @@ use overload
# some shortcuts for speed (assumes that reversed order of arguments is routed
# to normal '+' and we thus can always modify first arg. If this is changed,
# this breaks and must be adjusted.)
-'+=' => sub { $_[0]->badd($_[1]); },
-'-=' => sub { $_[0]->bsub($_[1]); },
-'*=' => sub { $_[0]->bmul($_[1]); },
-'/=' => sub { scalar $_[0]->bdiv($_[1]); },
-'%=' => sub { $_[0]->bmod($_[1]); },
-'^=' => sub { $_[0]->bxor($_[1]); },
-'&=' => sub { $_[0]->band($_[1]); },
-'|=' => sub { $_[0]->bior($_[1]); },
-
-'**=' => sub { $_[0]->bpow($_[1]); },
-'<<=' => sub { $_[0]->blsft($_[1]); },
-'>>=' => sub { $_[0]->brsft($_[1]); },
+'+=' => sub { $_[0]->badd($_[1]); },
+'-=' => sub { $_[0]->bsub($_[1]); },
+'*=' => sub { $_[0]->bmul($_[1]); },
+'/=' => sub { scalar $_[0]->bdiv($_[1]); },
+'%=' => sub { $_[0]->bmod($_[1]); },
+'^=' => sub { $_[0]->bxor($_[1]); },
+'&=' => sub { $_[0]->band($_[1]); },
+'|=' => sub { $_[0]->bior($_[1]); },
+
+'**=' => sub { $_[0]->bpow($_[1]); },
+'<<=' => sub { $_[0]->blsft($_[1]); },
+'>>=' => sub { $_[0]->brsft($_[1]); },
# not supported by Perl yet
-'..' => \&_pointpoint,
-
-'<=>' => sub { my $rc = $_[2] ?
- ref($_[0])->bcmp($_[1],$_[0]) :
- $_[0]->bcmp($_[1]);
- $rc = 1 unless defined $rc;
- $rc <=> 0;
- },
+'..' => \&_pointpoint,
+
+'<=>' => sub { my $rc = $_[2] ?
+ ref($_[0])->bcmp($_[1],$_[0]) :
+ $_[0]->bcmp($_[1]);
+ $rc = 1 unless defined $rc;
+ $rc <=> 0;
+ },
# we need '>=' to get things like "1 >= NaN" right:
-'>=' => sub { my $rc = $_[2] ?
- ref($_[0])->bcmp($_[1],$_[0]) :
+'>=' => sub { my $rc = $_[2] ?
+ ref($_[0])->bcmp($_[1],$_[0]) :
$_[0]->bcmp($_[1]);
- # if there was a NaN involved, return false
- return '' unless defined $rc;
- $rc >= 0;
- },
-'cmp' => sub {
- $_[2] ?
+ # if there was a NaN involved, return false
+ return '' unless defined $rc;
+ $rc >= 0;
+ },
+'cmp' => sub {
+ $_[2] ?
"$_[1]" cmp $_[0]->bstr() :
$_[0]->bstr() cmp "$_[1]" },
-'cos' => sub { $_[0]->copy->bcos(); },
-'sin' => sub { $_[0]->copy->bsin(); },
-'atan2' => sub { $_[2] ?
- ref($_[0])->new($_[1])->batan2($_[0]) :
- $_[0]->copy()->batan2($_[1]) },
+'cos' => sub { $_[0]->copy->bcos(); },
+'sin' => sub { $_[0]->copy->bsin(); },
+'atan2' => sub { $_[2] ?
+ ref($_[0])->new($_[1])->batan2($_[0]) :
+ $_[0]->copy()->batan2($_[1]) },
# are not yet overloadable
-#'hex' => sub { print "hex"; $_[0]; },
-#'oct' => sub { print "oct"; $_[0]; },
+#'hex' => sub { print "hex"; $_[0]; },
+#'oct' => sub { print "oct"; $_[0]; },
# log(N) is log(N, e), where e is Euler's number
-'log' => sub { $_[0]->copy()->blog($_[1], undef); },
-'exp' => sub { $_[0]->copy()->bexp($_[1]); },
-'int' => sub { $_[0]->copy(); },
-'neg' => sub { $_[0]->copy()->bneg(); },
-'abs' => sub { $_[0]->copy()->babs(); },
-'sqrt' => sub { $_[0]->copy()->bsqrt(); },
-'~' => sub { $_[0]->copy()->bnot(); },
+'log' => sub { $_[0]->copy()->blog(); },
+'exp' => sub { $_[0]->copy()->bexp($_[1]); },
+'int' => sub { $_[0]->copy(); },
+'neg' => sub { $_[0]->copy()->bneg(); },
+'abs' => sub { $_[0]->copy()->babs(); },
+'sqrt' => sub { $_[0]->copy()->bsqrt(); },
+'~' => sub { $_[0]->copy()->bnot(); },
# for subtract it's a bit tricky to not modify b: b-a => -a+b
-'-' => sub { my $c = $_[0]->copy; $_[2] ?
- $c->bneg()->badd( $_[1]) :
- $c->bsub( $_[1]) },
-'+' => sub { $_[0]->copy()->badd($_[1]); },
-'*' => sub { $_[0]->copy()->bmul($_[1]); },
+'-' => sub { my $c = $_[0]->copy; $_[2] ?
+ $c->bneg()->badd( $_[1]) :
+ $c->bsub( $_[1]) },
+'+' => sub { $_[0]->copy()->badd($_[1]); },
+'*' => sub { $_[0]->copy()->bmul($_[1]); },
-'/' => sub {
+'/' => sub {
$_[2] ? ref($_[0])->new($_[1])->bdiv($_[0]) : $_[0]->copy->bdiv($_[1]);
- },
-'%' => sub {
+ },
+'%' => sub {
$_[2] ? ref($_[0])->new($_[1])->bmod($_[0]) : $_[0]->copy->bmod($_[1]);
- },
-'**' => sub {
+ },
+'**' => sub {
$_[2] ? ref($_[0])->new($_[1])->bpow($_[0]) : $_[0]->copy->bpow($_[1]);
- },
-'<<' => sub {
+ },
+'<<' => sub {
$_[2] ? ref($_[0])->new($_[1])->blsft($_[0]) : $_[0]->copy->blsft($_[1]);
- },
-'>>' => sub {
+ },
+'>>' => sub {
$_[2] ? ref($_[0])->new($_[1])->brsft($_[0]) : $_[0]->copy->brsft($_[1]);
- },
-'&' => sub {
+ },
+'&' => sub {
$_[2] ? ref($_[0])->new($_[1])->band($_[0]) : $_[0]->copy->band($_[1]);
- },
-'|' => sub {
+ },
+'|' => sub {
$_[2] ? ref($_[0])->new($_[1])->bior($_[0]) : $_[0]->copy->bior($_[1]);
- },
-'^' => sub {
+ },
+'^' => sub {
$_[2] ? ref($_[0])->new($_[1])->bxor($_[0]) : $_[0]->copy->bxor($_[1]);
- },
+ },
# can modify arg of ++ and --, so avoid a copy() for speed, but don't
# use $_[0]->bone(), it would modify $_[0] to be 1!
-'++' => sub { $_[0]->binc() },
-'--' => sub { $_[0]->bdec() },
+'++' => sub { $_[0]->binc() },
+'--' => sub { $_[0]->bdec() },
# if overloaded, O(1) instead of O(N) and twice as fast for small numbers
-'bool' => sub {
+'bool' => sub {
# this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
- # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-(
+ # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-(
my $t = undef;
$t = 1 if !$_[0]->is_zero();
$t;
@@ -166,23 +169,23 @@ $accuracy = undef;
$precision = undef;
$div_scale = 40;
-$upgrade = undef; # default is no upgrade
-$downgrade = undef; # default is no downgrade
+$upgrade = undef; # default is no upgrade
+$downgrade = undef; # default is no downgrade
# These are internally, and not to be used from the outside at all
-$_trap_nan = 0; # are NaNs ok? set w/ config()
-$_trap_inf = 0; # are infs ok? set w/ config()
-my $nan = 'NaN'; # constants for easier life
+$_trap_nan = 0; # are NaNs ok? set w/ config()
+$_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
- # 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
+my $CALC = '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
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
@@ -193,9 +196,9 @@ sub FETCH { return $round_mode; }
sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); }
BEGIN
- {
+ {
# tie to enable $rnd_mode to work transparently
- tie $rnd_mode, 'Math::BigInt';
+ tie $rnd_mode, 'Math::BigInt';
# set up some handy alias names
*as_int = \&as_number;
@@ -203,7 +206,7 @@ BEGIN
*is_neg = \&is_negative;
}
-##############################################################################
+##############################################################################
sub round_mode
{
@@ -270,10 +273,10 @@ sub div_scale
sub accuracy
{
- # $x->accuracy($a); ref($x) $a
- # $x->accuracy(); ref($x)
- # Class->accuracy(); class
- # Class->accuracy($a); class $a
+ # $x->accuracy($a); ref($x) $a
+ # $x->accuracy(); ref($x)
+ # Class->accuracy(); class
+ # Class->accuracy($a); class $a
my $x = shift;
my $class = ref($x) || $x || __PACKAGE__;
@@ -294,28 +297,28 @@ sub accuracy
if (!$a || $a <= 0)
{
require Carp;
- Carp::croak ('Argument to accuracy must be greater than zero');
+ Carp::croak ('Argument to accuracy must be greater than zero');
}
if (int($a) != $a)
{
require Carp;
- Carp::croak ('Argument to accuracy must be an integer');
+ Carp::croak ('Argument to accuracy must be an integer');
}
}
if (ref($x))
{
# $object->accuracy() or fallback to global
- $x->bround($a) if $a; # not for undef, 0
- $x->{_a} = $a; # set/overwrite, even if not rounded
- delete $x->{_p}; # clear P
+ $x->bround($a) if $a; # not for undef, 0
+ $x->{_a} = $a; # set/overwrite, even if not rounded
+ delete $x->{_p}; # clear P
$a = ${"${class}::accuracy"} unless defined $a; # proper return value
}
else
{
- ${"${class}::accuracy"} = $a; # set global A
- ${"${class}::precision"} = undef; # clear global P
+ ${"${class}::accuracy"} = $a; # set global A
+ ${"${class}::precision"} = undef; # clear global P
}
- return $a; # shortcut
+ return $a; # shortcut
}
my $a;
@@ -328,10 +331,10 @@ sub accuracy
sub precision
{
- # $x->precision($p); ref($x) $p
- # $x->precision(); ref($x)
- # Class->precision(); class
- # Class->precision($p); class $p
+ # $x->precision($p); ref($x) $p
+ # $x->precision(); ref($x)
+ # Class->precision(); class
+ # Class->precision($p); class $p
my $x = shift;
my $class = ref($x) || $x || __PACKAGE__;
@@ -351,17 +354,17 @@ sub precision
if (ref($x))
{
# $object->precision() or fallback to global
- $x->bfround($p) if $p; # not for undef, 0
- $x->{_p} = $p; # set/overwrite, even if not rounded
- delete $x->{_a}; # clear A
+ $x->bfround($p) if $p; # not for undef, 0
+ $x->{_p} = $p; # set/overwrite, even if not rounded
+ delete $x->{_a}; # clear A
$p = ${"${class}::precision"} unless defined $p; # proper return value
}
else
{
- ${"${class}::precision"} = $p; # set global P
- ${"${class}::accuracy"} = undef; # clear global A
+ ${"${class}::precision"} = $p; # set global P
+ ${"${class}::accuracy"} = undef; # clear global A
}
- return $p; # shortcut
+ return $p; # shortcut
}
my $p;
@@ -440,7 +443,7 @@ sub config
}
sub _scale_a
- {
+ {
# select accuracy parameter based on precedence,
# used by bround() and bfround(), may return undef for scale (means no op)
my ($x,$scale,$mode) = @_;
@@ -464,7 +467,7 @@ sub _scale_a
}
sub _scale_p
- {
+ {
# select precision parameter based on precedence,
# used by bround() and bfround(), may return undef for scale (means no op)
my ($x,$scale,$mode) = @_;
@@ -490,164 +493,191 @@ sub _scale_p
##############################################################################
# constructors
-sub copy
- {
- # if two arguments, the first one is the class to "swallow" subclasses
- if (@_ > 1)
- {
- my $self = bless {
- sign => $_[1]->{sign},
- value => $CALC->_copy($_[1]->{value}),
- }, $_[0] if @_ > 1;
+sub copy {
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- $self->{_a} = $_[1]->{_a} if defined $_[1]->{_a};
- $self->{_p} = $_[1]->{_p} if defined $_[1]->{_p};
- return $self;
- }
+ # If called as a class method, the object to copy is the next argument.
- my $self = bless {
- sign => $_[0]->{sign},
- value => $CALC->_copy($_[0]->{value}),
- }, ref($_[0]);
+ $self = shift() unless $selfref;
- $self->{_a} = $_[0]->{_a} if defined $_[0]->{_a};
- $self->{_p} = $_[0]->{_p} if defined $_[0]->{_p};
- $self;
- }
+ my $copy = bless {}, $class;
-sub new
- {
- # create a new BigInt object from a string or another BigInt object.
- # see hash keys documented at top
+ $copy->{sign} = $self->{sign};
+ $copy->{value} = $CALC->_copy($self->{value});
+ $copy->{_a} = $self->{_a} if exists $self->{_a};
+ $copy->{_p} = $self->{_p} if exists $self->{_p};
- # the argument could be an object, so avoid ||, && etc on it, this would
- # cause costly overloaded code to be called. The only allowed ops are
- # ref() and defined.
+ return $copy;
+}
- my ($class,$wanted,$a,$p,$r) = @_;
+sub new {
+ # Create a new Math::BigInt object from a string or another Math::BigInt
+ # object. See hash keys documented at top.
- # avoid numify-calls by not using || on $wanted!
- return $class->bzero($a,$p) if !defined $wanted; # default to 0
- return $class->copy($wanted,$a,$p,$r)
- if ref($wanted) && $wanted->isa($class); # MBI or subclass
+ # The argument could be an object, so avoid ||, && etc. on it. This would
+ # cause costly overloaded code to be called. The only allowed ops are ref()
+ # and defined.
- $class->import() if $IMPORT == 0; # make require work
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- my $self = bless {}, $class;
+ my ($wanted, $a, $p, $r) = @_;
- # shortcut for "normal" numbers
- if ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*\z/))
- {
- $self->{sign} = $1 || '+';
+ # If called as a class method, initialize a new object.
- if ($wanted =~ /^[+-]/)
- {
- # remove sign without touching wanted to make it work with constants
- my $t = $wanted; $t =~ s/^[+-]//;
- $self->{value} = $CALC->_new($t);
- }
- else
- {
- $self->{value} = $CALC->_new($wanted);
- }
- no strict 'refs';
- if ( (defined $a) || (defined $p)
- || (defined ${"${class}::precision"})
- || (defined ${"${class}::accuracy"})
- )
- {
- $self->round($a,$p,$r) unless (@_ == 4 && !defined $a && !defined $p);
- }
- return $self;
- }
+ $self = bless {}, $class unless $selfref;
- # handle '+inf', '-inf' first
- if ($wanted =~ /^[+-]?inf\z/)
- {
- $self->{sign} = $wanted; # set a default sign for bstr()
- return $self->binf($wanted);
+ unless (defined $wanted) {
+ require Carp;
+ Carp::carp("Use of uninitialized value in new");
+ return $self->bzero($a, $p, $r);
}
- # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
- my ($mis,$miv,$mfv,$es,$ev) = _split($wanted);
- if (!ref $mis)
- {
- if ($_trap_nan)
- {
- require Carp; Carp::croak("$wanted is not a number in $class");
- }
- $self->{value} = $CALC->_zero();
- $self->{sign} = $nan;
- return $self;
+
+ if (ref($wanted) && $wanted->isa($class)) { # MBI or subclass
+ # Using "$copy = $wanted -> copy()" here fails some tests. Fixme!
+ my $copy = $class -> copy($wanted);
+ if ($selfref) {
+ %$self = %$copy;
+ } else {
+ $self = $copy;
+ }
+ return $self;
}
- if (!ref $miv)
- {
- # _from_hex or _from_bin
- $self->{value} = $mis->{value};
- $self->{sign} = $mis->{sign};
- return $self; # throw away $mis
- }
- # make integer from mantissa by adjusting exp, then convert to bigint
- $self->{sign} = $$mis; # store sign
- $self->{value} = $CALC->_zero(); # for all the NaN cases
- my $e = int("$$es$$ev"); # exponent (avoid recursion)
- if ($e > 0)
+
+ $class->import() if $IMPORT == 0; # make require work
+
+ # Shortcut for non-zero scalar integers with no non-zero exponent.
+
+ if (!ref($wanted) &&
+ $wanted =~ / ^
+ ([+-]?) # optional sign
+ ([1-9][0-9]*) # non-zero significand
+ (\.0*)? # ... with optional zero fraction
+ ([Ee][+-]?0+)? # optional zero exponent
+ \z
+ /x)
{
- my $diff = $e - CORE::length($$mfv);
- if ($diff < 0) # Not integer
- {
- if ($_trap_nan)
+ my $sgn = $1;
+ my $abs = $2;
+ $self->{sign} = $sgn || '+';
+ $self->{value} = $CALC->_new($abs);
+
+ no strict 'refs';
+ if (defined($a) || defined($p)
+ || defined(${"${class}::precision"})
+ || defined(${"${class}::accuracy"}))
{
- require Carp; Carp::croak("$wanted not an integer in $class");
+ $self->round($a, $p, $r)
+ unless @_ == 4 && !defined $a && !defined $p;
}
- #print "NOI 1\n";
- return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
- $self->{sign} = $nan;
- }
- else # diff >= 0
- {
- # adjust fraction and add it to value
- #print "diff > 0 $$miv\n";
- $$miv = $$miv . ($$mfv . '0' x $diff);
- }
+
+ return $self;
}
- else
- {
- if ($$mfv ne '') # e <= 0
- {
- # fraction and negative/zero E => NOI
- if ($_trap_nan)
- {
- require Carp; Carp::croak("$wanted not an integer in $class");
+
+ # Handle Infs.
+
+ if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) {
+ my $sgn = $1 || '+';
+ $self->{sign} = $sgn . 'inf'; # set a default sign for bstr()
+ return $self->binf($sgn);
+ }
+
+ # Handle explicit NaNs (not the ones returned due to invalid input).
+
+ if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) {
+ return $self->bnan();
+ }
+
+ if ($wanted =~ /^\s*[+-]?0[Xx]/) {
+ return $class -> from_hex($wanted);
+ }
+
+ if ($wanted =~ /^\s*[+-]?0[Bb]/) {
+ return $class -> from_bin($wanted);
+ }
+
+ # Split string into mantissa, exponent, integer, fraction, value, and sign.
+ my ($mis, $miv, $mfv, $es, $ev) = _split($wanted);
+ if (!ref $mis) {
+ if ($_trap_nan) {
+ require Carp; Carp::croak("$wanted is not a number in $class");
}
- #print "NOI 2 \$\$mfv '$$mfv'\n";
- return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
- $self->{sign} = $nan;
- }
- elsif ($e < 0)
- {
- # xE-y, and empty mfv
- #print "xE-y\n";
- $e = abs($e);
- if ($$miv !~ s/0{$e}$//) # can strip so many zero's?
- {
- if ($_trap_nan)
- {
- require Carp; Carp::croak("$wanted not an integer in $class");
- }
- #print "NOI 3\n";
- return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
+ $self->{value} = $CALC->_zero();
$self->{sign} = $nan;
+ return $self;
+ }
+
+ if (!ref $miv) {
+ # _from_hex or _from_bin
+ $self->{value} = $mis->{value};
+ $self->{sign} = $mis->{sign};
+ return $self; # throw away $mis
+ }
+
+ # 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
+ 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) {
+ require Carp; Carp::croak("$wanted not an integer in $class");
+ }
+ #print "NOI 1\n";
+ return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
+ $self->{sign} = $nan;
+ } else { # diff >= 0
+ # adjust fraction and add it to value
+ #print "diff > 0 $$miv\n";
+ $$miv = $$miv . ($$mfv . '0' x $diff);
}
- }
}
- $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
- $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/;
- # if any of the globals is set, use them to round and store them inside $self
- # do not round for new($x,undef,undef) since that is used by MBF to signal
- # no rounding
- $self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
- $self;
- }
+
+ else {
+ if ($$mfv ne '') { # e <= 0
+ # fraction and negative/zero E => NOI
+ if ($_trap_nan) {
+ require Carp; Carp::croak("$wanted not an integer in $class");
+ }
+ #print "NOI 2 \$\$mfv '$$mfv'\n";
+ return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
+ $self->{sign} = $nan;
+ } elsif ($e < 0) {
+ # xE-y, and empty mfv
+ # Split the mantissa at the decimal point. E.g., if
+ # $$miv = 12345 and $e = -2, then $frac = 45 and $$miv = 123.
+
+ my $frac = substr($$miv, $e); # $frac is fraction part
+ substr($$miv, $e) = ""; # $$miv is now integer part
+
+ if ($frac =~ /[^0]/) {
+ if ($_trap_nan) {
+ require Carp; Carp::croak("$wanted not an integer in $class");
+ }
+ #print "NOI 3\n";
+ return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade;
+ $self->{sign} = $nan;
+ }
+ }
+ }
+
+ unless ($self->{sign} eq $nan) {
+ $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
+ $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/;
+ }
+
+ # If any of the globals are set, use them to round, and store them inside
+ # $self. Do not round for new($x, undef, undef) since that is used by MBF
+ # to signal no rounding.
+
+ $self->round($a, $p, $r) unless @_ == 4 && !defined $a && !defined $p;
+ $self;
+}
sub bnan
{
@@ -664,7 +694,7 @@ sub bnan
require Carp;
Carp::croak ("Tried to set $self to NaN in $class\::bnan()");
}
- $self->import() if $IMPORT == 0; # make require work
+ $self->import() if $IMPORT == 0; # make require work
return if $self->modify('bnan');
if ($self->can('_bnan'))
{
@@ -677,7 +707,7 @@ sub bnan
$self->{value} = $CALC->_zero();
}
$self->{sign} = $nan;
- delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
+ delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly
$self;
}
@@ -698,7 +728,7 @@ sub binf
require Carp;
Carp::croak ("Tried to set $self to +-inf in $class\::binf()");
}
- $self->import() if $IMPORT == 0; # make require work
+ $self->import() if $IMPORT == 0; # make require work
return if $self->modify('binf');
if ($self->can('_binf'))
{
@@ -710,9 +740,9 @@ sub binf
# otherwise do our own thing
$self->{value} = $CALC->_zero();
}
- $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf
+ $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf
$self->{sign} = $sign;
- ($self->{_a},$self->{_p}) = @_; # take over requested rounding
+ ($self->{_a},$self->{_p}) = @_; # take over requested rounding
$self;
}
@@ -726,7 +756,7 @@ sub bzero
{
my $c = $self; $self = {}; bless $self, $c;
}
- $self->import() if $IMPORT == 0; # make require work
+ $self->import() if $IMPORT == 0; # make require work
return if $self->modify('bzero');
if ($self->can('_bzero'))
@@ -770,7 +800,7 @@ sub bone
{
my $c = $self; $self = {}; bless $self, $c;
}
- $self->import() if $IMPORT == 0; # make require work
+ $self->import() if $IMPORT == 0; # make require work
return if $self->modify('bone');
if ($self->can('_bone'))
@@ -811,42 +841,52 @@ sub bsstr
# (ref to BFLOAT or num_str ) return num_str
# Convert number from internal format to scientific string format.
# internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
- my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
if ($x->{sign} !~ /^[+-]$/)
{
- return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
- return 'inf'; # +inf
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
my ($m,$e) = $x->parts();
- #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt
+ #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt
# 'e+' because E can only be positive in BigInt
- $m->bstr() . 'e+' . $CALC->_str($e->{value});
+ $m->bstr() . 'e+' . $CALC->_str($e->{value});
}
-sub bstr
+sub bstr
{
# make a string from bigint object
- my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
if ($x->{sign} !~ /^[+-]$/)
{
- return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
- return 'inf'; # +inf
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
$es.$CALC->_str($x->{value});
}
-sub numify
+sub numify
{
- # Make a "normal" scalar from a BigInt object
+ # Make a Perl scalar number from a Math::BigInt object.
my $x = shift; $x = $class->new($x) unless ref $x;
- return $x->bstr() if $x->{sign} !~ /^[+-]$/;
- my $num = $CALC->_num($x->{value});
- return -$num if $x->{sign} eq '-';
- $num;
+ if ($x -> is_nan()) {
+ require Math::Complex;
+ my $inf = Math::Complex::Inf();
+ return $inf - $inf;
+ }
+
+ if ($x -> is_inf()) {
+ require Math::Complex;
+ my $inf = Math::Complex::Inf();
+ return $x -> is_negative() ? -$inf : $inf;
+ }
+
+ my $num = 0 + $CALC->_num($x->{value});
+ return $x->{sign} eq '-' ? -$num : $num;
}
##############################################################################
@@ -855,158 +895,146 @@ sub numify
sub sign
{
# return the sign of the number: +/-/-inf/+inf/NaN
- my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
$x->{sign};
}
-sub _find_round_parameters
- {
- # After any operation or when calling round(), the result is rounded by
- # regarding the A & P from arguments, local parameters, or globals.
+sub _find_round_parameters {
+ # After any operation or when calling round(), the result is rounded by
+ # regarding the A & P from arguments, local parameters, or globals.
- # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!!
+ # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!!
- # This procedure finds the round parameters, but it is for speed reasons
- # duplicated in round. Otherwise, it is tested by the testsuite and used
- # by fdiv().
+ # This procedure finds the round parameters, but it is for speed reasons
+ # duplicated in round. Otherwise, it is tested by the testsuite and used
+ # by bdiv().
- # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P
- # were requested/defined (locally or globally or both)
+ # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P
+ # were requested/defined (locally or globally or both)
- my ($self,$a,$p,$r,@args) = @_;
- # $a accuracy, if given by caller
- # $p precision, if given by caller
- # $r round_mode, if given by caller
- # @args all 'other' arguments (0 for unary, 1 for binary ops)
+ my ($self, $a, $p, $r, @args) = @_;
+ # $a accuracy, if given by caller
+ # $p precision, if given by caller
+ # $r round_mode, if given by caller
+ # @args all 'other' arguments (0 for unary, 1 for binary ops)
- my $c = ref($self); # find out class of argument(s)
- no strict 'refs';
+ my $class = ref($self); # find out class of argument(s)
+ no strict 'refs';
- # convert to normal scalar for speed and correctness in inner parts
- $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a);
- $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p);
+ # convert to normal scalar for speed and correctness in inner parts
+ $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a);
+ $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p);
- # now pick $a or $p, but only if we have got "arguments"
- if (!defined $a)
- {
- foreach ($self,@args)
- {
- # take the defined one, or if both defined, the one that is smaller
- $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
- }
+ # now pick $a or $p, but only if we have got "arguments"
+ if (!defined $a) {
+ foreach ($self, @args) {
+ # take the defined one, or if both defined, the one that is smaller
+ $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
+ }
}
- if (!defined $p)
- {
- # even if $a is defined, take $p, to signal error for both defined
- foreach ($self,@args)
- {
- # take the defined one, or if both defined, the one that is bigger
- # -2 > -3, and 3 > 2
- $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
- }
+ if (!defined $p) {
+ # even if $a is defined, take $p, to signal error for both defined
+ foreach ($self, @args) {
+ # take the defined one, or if both defined, the one that is bigger
+ # -2 > -3, and 3 > 2
+ $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
+ }
}
- # if still none defined, use globals (#2)
- $a = ${"$c\::accuracy"} unless defined $a;
- $p = ${"$c\::precision"} unless defined $p;
- # A == 0 is useless, so undef it to signal no rounding
- $a = undef if defined $a && $a == 0;
+ # if still none defined, use globals (#2)
+ $a = ${"$class\::accuracy"} unless defined $a;
+ $p = ${"$class\::precision"} unless defined $p;
- # no rounding today?
- return ($self) unless defined $a || defined $p; # early out
+ # A == 0 is useless, so undef it to signal no rounding
+ $a = undef if defined $a && $a == 0;
- # set A and set P is an fatal error
- return ($self->bnan()) if defined $a && defined $p; # error
+ # no rounding today?
+ return ($self) unless defined $a || defined $p; # early out
- $r = ${"$c\::round_mode"} unless defined $r;
- if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
- {
- require Carp; Carp::croak ("Unknown round mode '$r'");
+ # set A and set P is an fatal error
+ return ($self->bnan()) if defined $a && defined $p; # error
+
+ $r = ${"$class\::round_mode"} unless defined $r;
+ if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) {
+ require Carp; Carp::croak ("Unknown round mode '$r'");
}
- $a = int($a) if defined $a;
- $p = int($p) if defined $p;
+ $a = int($a) if defined $a;
+ $p = int($p) if defined $p;
- ($self,$a,$p,$r);
- }
+ ($self, $a, $p, $r);
+}
-sub round
- {
- # Round $self according to given parameters, or given second argument's
- # parameters or global defaults
+sub round {
+ # Round $self according to given parameters, or given second argument's
+ # parameters or global defaults
- # for speed reasons, _find_round_parameters is embedded here:
+ # for speed reasons, _find_round_parameters is embedded here:
- my ($self,$a,$p,$r,@args) = @_;
- # $a accuracy, if given by caller
- # $p precision, if given by caller
- # $r round_mode, if given by caller
- # @args all 'other' arguments (0 for unary, 1 for binary ops)
+ my ($self, $a, $p, $r, @args) = @_;
+ # $a accuracy, if given by caller
+ # $p precision, if given by caller
+ # $r round_mode, if given by caller
+ # @args all 'other' arguments (0 for unary, 1 for binary ops)
- my $c = ref($self); # find out class of argument(s)
- no strict 'refs';
+ my $class = ref($self); # find out class of argument(s)
+ no strict 'refs';
- # now pick $a or $p, but only if we have got "arguments"
- if (!defined $a)
- {
- foreach ($self,@args)
- {
- # take the defined one, or if both defined, the one that is smaller
- $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
- }
+ # now pick $a or $p, but only if we have got "arguments"
+ if (!defined $a) {
+ foreach ($self, @args) {
+ # take the defined one, or if both defined, the one that is smaller
+ $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a);
+ }
}
- if (!defined $p)
- {
- # even if $a is defined, take $p, to signal error for both defined
- foreach ($self,@args)
- {
- # take the defined one, or if both defined, the one that is bigger
- # -2 > -3, and 3 > 2
- $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
- }
+ if (!defined $p) {
+ # even if $a is defined, take $p, to signal error for both defined
+ foreach ($self, @args) {
+ # take the defined one, or if both defined, the one that is bigger
+ # -2 > -3, and 3 > 2
+ $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p);
+ }
}
- # if still none defined, use globals (#2)
- $a = ${"$c\::accuracy"} unless defined $a;
- $p = ${"$c\::precision"} unless defined $p;
- # A == 0 is useless, so undef it to signal no rounding
- $a = undef if defined $a && $a == 0;
+ # if still none defined, use globals (#2)
+ $a = ${"$class\::accuracy"} unless defined $a;
+ $p = ${"$class\::precision"} unless defined $p;
- # no rounding today?
- return $self unless defined $a || defined $p; # early out
+ # A == 0 is useless, so undef it to signal no rounding
+ $a = undef if defined $a && $a == 0;
- # set A and set P is an fatal error
- return $self->bnan() if defined $a && defined $p;
+ # no rounding today?
+ return $self unless defined $a || defined $p; # early out
- $r = ${"$c\::round_mode"} unless defined $r;
- if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/)
- {
- require Carp; Carp::croak ("Unknown round mode '$r'");
- }
+ # set A and set P is an fatal error
+ return $self->bnan() if defined $a && defined $p;
- # now round, by calling either fround or ffround:
- if (defined $a)
- {
- $self->bround(int($a),$r) if !defined $self->{_a} || $self->{_a} >= $a;
+ $r = ${"$class\::round_mode"} unless defined $r;
+ if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) {
+ require Carp; Carp::croak ("Unknown round mode '$r'");
}
- else # both can't be undefined due to early out
- {
- $self->bfround(int($p),$r) if !defined $self->{_p} || $self->{_p} <= $p;
+
+ # now round, by calling either bround or bfround:
+ if (defined $a) {
+ $self->bround(int($a), $r) if !defined $self->{_a} || $self->{_a} >= $a;
+ } else { # both can't be undefined due to early out
+ $self->bfround(int($p), $r) if !defined $self->{_p} || $self->{_p} <= $p;
}
- # bround() or bfround() already called bnorm() if nec.
- $self;
- }
+
+ # bround() or bfround() already called bnorm() if nec.
+ $self;
+}
sub bnorm
- {
+ {
# (numstr or BINT) return BINT
# Normalize number -- no-op here
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
$x;
}
-sub babs
+sub babs
{
# (BINT or num_str) return BINT
# make number absolute, or return absolute BINT from string
@@ -1030,8 +1058,8 @@ sub bsgn {
return $self; # zero or NaN
}
-sub bneg
- {
+sub bneg
+ {
# (BINT or num_str) return BINT
# negate number or make a negated number from string
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
@@ -1043,7 +1071,7 @@ sub bneg
$x;
}
-sub bcmp
+sub bcmp
{
# Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort)
# (BINT or num_str, BINT or num_str) return cond_code
@@ -1051,7 +1079,7 @@ sub bcmp
# set up parameters
my ($self,$x,$y) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
+ # objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
($self,$x,$y) = objectify(2,@_);
@@ -1071,33 +1099,33 @@ sub bcmp
return +1;
}
# check sign for speed first
- return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
- return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
+ return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
+ return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
# have same sign, so compare absolute values. Don't make tests for zero
# here because it's actually slower than testing in Calc (especially w/ Pari
# et al)
# post-normalized compare for internal use (honors signs)
- if ($x->{sign} eq '+')
+ if ($x->{sign} eq '+')
{
# $x and $y both > 0
return $CALC->_acmp($x->{value},$y->{value});
}
# $x && $y both < 0
- $CALC->_acmp($y->{value},$x->{value}); # swapped acmp (lib returns 0,1,-1)
+ $CALC->_acmp($y->{value},$x->{value}); # swapped acmp (lib returns 0,1,-1)
}
-sub bacmp
+sub bacmp
{
- # Compares 2 values, ignoring their signs.
+ # Compares 2 values, ignoring their signs.
# Returns one of undef, <0, =0, >0. (suitable for sort)
# (BINT, BINT) return cond_code
# set up parameters
my ($self,$x,$y) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
+ # objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
($self,$x,$y) = objectify(2,@_);
@@ -1114,17 +1142,17 @@ 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
+ $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
}
-sub badd
+sub badd
{
# add second arg (BINT or string) to first (BINT) (modifies first)
# return result as BINT
# set up parameters
my ($self,$x,$y,@r) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
+ # objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
($self,$x,$y,@r) = objectify(2,@_);
@@ -1134,7 +1162,7 @@ sub badd
return $upgrade->badd($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade &&
((!$x->isa($self)) || (!$y->isa($self)));
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
# inf and NaN handling
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
@@ -1153,20 +1181,20 @@ sub badd
return $x;
}
- my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
+ my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
- if ($sx eq $sy)
+ if ($sx eq $sy)
{
- $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
+ $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
}
- else
+ else
{
- my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
- if ($a > 0)
+ my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
+ if ($a > 0)
{
$x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
$x->{sign} = $sy;
- }
+ }
elsif ($a == 0)
{
# speedup, if equal, set result to 0
@@ -1181,7 +1209,7 @@ sub badd
$x->round(@r);
}
-sub bsub
+sub bsub
{
# (BINT or num_str, BINT or num_str) return BINT
# subtract second arg from first, modify first
@@ -1206,16 +1234,16 @@ sub bsub
# of $x, then flip the sign from $y, and if the sign of $x did change, too,
# then we caught the special case:
my $xsign = $x->{sign};
- $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
+ $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
if ($xsign ne $x->{sign})
{
# special case of $x->bsub($x) results in 0
return $x->bzero(@r) if $xsign =~ /^[+-]$/;
return $x->bnan(); # NaN, -inf, +inf
}
- $x->badd($y,@r); # badd does not leave internal zeros
- $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
- $x; # already rounded by badd() or no round nec.
+ $x->badd($y,@r); # badd does not leave internal zeros
+ $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
+ $x; # already rounded by badd() or no round nec.
}
sub binc
@@ -1236,7 +1264,7 @@ sub binc
return $x->round($a,$p,$r);
}
# inf, nan handling etc
- $x->badd($self->bone(),$a,$p,$r); # badd does round
+ $x->badd($self->bone(),$a,$p,$r); # badd does round
}
sub bdec
@@ -1249,7 +1277,7 @@ sub bdec
{
# x already < 0
$x->{value} = $CALC->_inc($x->{value});
- }
+ }
else
{
return $x->badd($self->bone('-'),@r)
@@ -1258,7 +1286,7 @@ sub bdec
if ($CALC->_is_zero($x->{value}))
{
# == 0
- $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1
+ $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1
}
else
{
@@ -1271,27 +1299,52 @@ sub bdec
sub blog
{
- # calculate $x = $a ** $base + $b and return $a (e.g. the log() to base
- # $base of $x)
+ # Return the logarithm of the operand. If a second operand is defined, that
+ # value is used as the base, otherwise the base is assumed to be Euler's
+ # constant.
+
+ # Don't objectify the base, since an undefined base, as in $x->blog() or
+ # $x->blog(undef) signals that the base is Euler's number.
# set up parameters
my ($self,$x,$base,@r) = (undef,@_);
# objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
- {
- ($self,$x,$base,@r) = objectify(2,@_);
- }
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
+ ($self,$x,$base,@r) = objectify(1,@_);
+ }
return $x if $x->modify('blog');
- $base = $self->new($base) if defined $base && !ref $base;
+ # Handle all exception cases and all trivial cases. I have used Wolfram Alpha
+ # (http://www.wolframalpha.com) as the reference for these cases.
+
+ return $x -> bnan() if $x -> is_nan();
+
+ if (defined $base) {
+ $base = $self -> new($base) unless ref $base;
+ if ($base -> is_nan() || $base -> is_one()) {
+ return $x -> bnan();
+ } elsif ($base -> is_inf() || $base -> is_zero()) {
+ return $x -> bnan() if $x -> is_inf() || $x -> is_zero();
+ return $x -> bzero();
+ } elsif ($base -> is_negative()) { # -inf < base < 0
+ return $x -> bzero() if $x -> is_one(); # x = 1
+ return $x -> bone() if $x == $base; # x = base
+ return $x -> bnan(); # otherwise
+ }
+ return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf
+ }
- # inf, -inf, NaN, <0 => NaN
- return $x->bnan()
- if $x->{sign} ne '+' || (defined $base && $base->{sign} ne '+');
+ # We now know that the base is either undefined or >= 2 and finite.
+
+ return $x -> binf('+') if $x -> is_inf(); # x = +/-inf
+ return $x -> bnan() if $x -> is_neg(); # -inf < x < 0
+ return $x -> bzero() if $x -> is_one(); # x = 1
+ return $x -> binf('-') if $x -> is_zero(); # x = 0
+
+ # At this point we are done handling all exception cases and trivial cases.
- return $upgrade->blog($upgrade->new($x),$base,@r) if
- defined $upgrade;
+ return $upgrade -> blog($upgrade -> new($x), $base, @r) if defined $upgrade;
# fix for bug #24969:
# the default base is e (Euler's number) which is not an integer
@@ -1306,7 +1359,7 @@ sub blog
}
my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value});
- return $x->bnan() unless defined $rc; # not possible to take log?
+ return $x->bnan() unless defined $rc; # not possible to take log?
$x->{value} = $rc;
$x->round(@r);
}
@@ -1349,7 +1402,7 @@ sub bnok
$z->binc();
my $r = $z->copy(); $z->binc();
my $d = $self->new(2);
- while ($z->bacmp($x) <= 0) # f <= x ?
+ while ($z->bacmp($x) <= 0) # f <= x ?
{
$r->bmul($z); $r->bdiv($d);
$z->binc(); $d->binc();
@@ -1409,16 +1462,16 @@ sub blcm
$x = $class->new($y);
}
my $self = ref($x);
- while (@_)
+ while (@_)
{
my $y = shift; $y = $self->new($y) if !ref ($y);
$x = __lcm($x,$y);
- }
+ }
$x;
}
-sub bgcd
- {
+sub bgcd
+ {
# (BINT or num_str, BINT or num_str) return BINT
# does not modify arguments, but returns new object
# GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff)
@@ -1426,20 +1479,20 @@ sub bgcd
my $y = shift;
$y = $class->new($y) if !ref($y);
my $self = ref($y);
- my $x = $y->copy()->babs(); # keep arguments
- return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN?
+ my $x = $y->copy()->babs(); # keep arguments
+ return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN?
while (@_)
{
$y = shift; $y = $self->new($y) if !ref($y);
- return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
+ return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
$x->{value} = $CALC->_gcd($x->{value},$y->{value});
last if $CALC->_is_one($x->{value});
}
$x;
}
-sub bnot
+sub bnot
{
# (num_str or BINT) return BINT
# represent ~x as twos-complement number
@@ -1447,7 +1500,7 @@ sub bnot
my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
return $x if $x->modify('bnot');
- $x->binc()->bneg(); # binc already does round
+ $x->binc()->bneg(); # binc already does round
}
##############################################################################
@@ -1459,7 +1512,7 @@ sub is_zero
# return true if arg (BINT or num_str) is zero (array '+', '0')
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
+ return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
$CALC->_is_zero($x->{value});
}
@@ -1478,11 +1531,11 @@ sub is_inf
if (defined $sign)
{
- $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf
- $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-'
+ $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf
+ $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-'
return $x->{sign} =~ /^$sign$/ ? 1 : 0;
}
- $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity
+ $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity
}
sub is_one
@@ -1492,7 +1545,7 @@ sub is_one
$sign = '+' if !defined $sign || $sign ne '-';
- return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
+ return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
$CALC->_is_one($x->{value});
}
@@ -1501,7 +1554,7 @@ sub is_odd
# return true when arg (BINT or num_str) is odd, false for even
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
+ return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
$CALC->_is_odd($x->{value});
}
@@ -1510,7 +1563,7 @@ sub is_even
# return true when arg (BINT or num_str) is even, false for odd
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
+ return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
$CALC->_is_even($x->{value});
}
@@ -1519,7 +1572,7 @@ sub is_positive
# return true when arg (BINT or num_str) is positive (> 0)
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- return 1 if $x->{sign} eq '+inf'; # +inf is positive
+ return 1 if $x->{sign} eq '+inf'; # +inf is positive
# 0+ is neither positive nor negative
($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0;
@@ -1530,7 +1583,7 @@ sub is_negative
# return true when arg (BINT or num_str) is negative (< 0)
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not
+ $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not
}
sub is_int
@@ -1539,13 +1592,13 @@ sub is_int
# always true for BigInt, but different for BigFloats
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
+ $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
}
###############################################################################
-sub bmul
- {
+sub bmul
+ {
# multiply the first number by the second number
# (BINT or num_str, BINT or num_str) return BINT
@@ -1568,26 +1621,26 @@ sub bmul
# result will always be +-inf:
# +inf * +/+inf => +inf, -inf * -/-inf => +inf
# +inf * -/-inf => -inf, -inf * +/+inf => -inf
- return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
- return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
return $x->binf('-');
}
return $upgrade->bmul($x,$upgrade->new($y),@r)
if defined $upgrade && !$y->isa($self);
- $r[3] = $y; # no push here
+ $r[3] = $y; # no push here
$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} = $CALC->_mul($x->{value},$y->{value}); # do actual math
+ $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
$x->round(@r);
}
sub bmuladd
- {
+ {
# multiply two numbers and then add the third to the result
# (BINT or num_str, BINT or num_str, BINT or num_str) return BINT
@@ -1597,8 +1650,8 @@ sub bmuladd
return $x if $x->modify('bmuladd');
return $x->bnan() if ($x->{sign} eq $nan) ||
- ($y->{sign} eq $nan) ||
- ($z->{sign} eq $nan);
+ ($y->{sign} eq $nan) ||
+ ($z->{sign} eq $nan);
# inf handling of x and y
if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
@@ -1607,8 +1660,8 @@ sub bmuladd
# result will always be +-inf:
# +inf * +/+inf => +inf, -inf * -/-inf => +inf
# +inf * -/-inf => -inf, -inf * +/+inf => -inf
- return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
- return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
return $x->binf('-');
}
# inf handling x*y and z
@@ -1622,27 +1675,27 @@ sub bmuladd
if defined $upgrade && (!$y->isa($self) || !$z->isa($self) || !$x->isa($self));
# TODO: what if $y and $z have A or P set?
- $r[3] = $z; # no push here
+ $r[3] = $z; # no push here
$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} = $CALC->_mul($x->{value},$y->{value}); # do actual math
+ $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
- my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs
+ my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs
- if ($sx eq $sz)
+ if ($sx eq $sz)
{
- $x->{value} = $CALC->_add($x->{value},$z->{value}); # same sign, abs add
+ $x->{value} = $CALC->_add($x->{value},$z->{value}); # same sign, abs add
}
- else
+ else
{
- my $a = $CALC->_acmp ($z->{value},$x->{value}); # absolute compare
- if ($a > 0)
+ my $a = $CALC->_acmp ($z->{value},$x->{value}); # absolute compare
+ if ($a > 0)
{
$x->{value} = $CALC->_sub($z->{value},$x->{value},1); # abs sub w/ swap
$x->{sign} = $sz;
- }
+ }
elsif ($a == 0)
{
# speedup, if equal, set result to 0
@@ -1657,115 +1710,190 @@ sub bmuladd
$x->round(@r);
}
-sub _div_inf
+sub bdiv
{
- # helper function that handles +-inf cases for bdiv()/bmod() to reuse code
- my ($self,$x,$y) = @_;
- # NaN if x == NaN or y == NaN or x==y==0
- return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
- if (($x->is_nan() || $y->is_nan()) ||
- ($x->is_zero() && $y->is_zero()));
+ # This does floored division, where the quotient is floored toward negative
+ # infinity and the remainder has the same sign as the divisor.
- # +-inf / +-inf == NaN, remainder also NaN
- if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
- {
- return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan();
+ # Set up parameters.
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+
+ # objectify() is costly, so avoid it if we can.
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
+ ($self,$x,$y,@r) = objectify(2,@_);
}
- # x / +-inf => 0, remainder x (works even if x == 0)
- if ($y->{sign} =~ /^[+-]inf$/)
- {
- my $t = $x->copy(); # bzero clobbers up $x
- return wantarray ? ($x->bzero(),$t) : $x->bzero()
+
+ return $x if $x->modify('bdiv');
+
+ my $wantarray = wantarray; # call only once
+
+ # At least one argument is NaN. Return NaN for both quotient and the
+ # modulo/remainder.
+
+ if ($x -> is_nan() || $y -> is_nan()) {
+ return $wantarray ? ($x -> bnan(), $self -> bnan()) : $x -> bnan();
}
- # 5 / 0 => +inf, -6 / 0 => -inf
- # +inf / 0 = inf, inf, and -inf / 0 => -inf, -inf
- # exception: -8 / 0 has remainder -8, not 8
- # exception: -inf / 0 has remainder -inf, not inf
- if ($y->is_zero())
- {
- # +-inf / 0 => special case for -inf
- return wantarray ? ($x,$x->copy()) : $x if $x->is_inf();
- if (!$x->is_zero() && !$x->is_inf())
- {
- my $t = $x->copy(); # binf clobbers up $x
- return wantarray ?
- ($x->binf($x->{sign}),$t) : $x->binf($x->{sign})
+ # Divide by zero and modulo zero.
+ #
+ # Division: Use the common convention that x / 0 is inf with the same sign
+ # as x, except when x = 0, where we return NaN. This is also what earlier
+ # versions did.
+ #
+ # Modulo: In modular arithmetic, the congruence relation z = x (mod y)
+ # means that there is some integer k such that z - x = k y. If y = 0, we
+ # get z - x = 0 or z = x. This is also what earlier versions did, except
+ # that 0 % 0 returned NaN.
+ #
+ # inf / 0 = inf inf % 0 = inf
+ # 5 / 0 = inf 5 % 0 = 5
+ # 0 / 0 = NaN 0 % 0 = 0 (before: NaN)
+ # -5 / 0 = -inf -5 % 0 = -5
+ # -inf / 0 = -inf -inf % 0 = -inf
+
+ if ($y -> is_zero()) {
+ my ($quo, $rem);
+ if ($wantarray) {
+ $rem = $x -> copy();
+ }
+ if ($x -> is_zero()) {
+ $quo = $x -> bnan();
+ } else {
+ $quo = $x -> binf($x -> {sign});
+ }
+ return $wantarray ? ($quo, $rem) : $quo;
+ }
+
+ # Numerator (dividend) is +/-inf, and denominator is finite and non-zero.
+ # The divide by zero cases are covered above. In all of the cases listed
+ # below we return the same as core Perl.
+ #
+ # inf / -inf = NaN inf % -inf = NaN
+ # inf / -5 = -inf inf % -5 = NaN (before: 0)
+ # inf / 5 = inf inf % 5 = NaN (before: 0)
+ # inf / inf = NaN inf % inf = NaN
+ #
+ # -inf / -inf = NaN -inf % -inf = NaN
+ # -inf / -5 = inf -inf % -5 = NaN (before: 0)
+ # -inf / 5 = -inf -inf % 5 = NaN (before: 0)
+ # -inf / inf = NaN -inf % inf = NaN
+
+ if ($x -> is_inf()) {
+ my ($quo, $rem);
+ $rem = $self -> bnan() if $wantarray;
+ if ($y -> is_inf()) {
+ $quo = $x -> bnan();
+ } else {
+ my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
+ $quo = $x -> binf($sign);
}
+ return $wantarray ? ($quo, $rem) : $quo;
}
- # last case: +-inf / ordinary number
- my $sign = '+inf';
- $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign};
- $x->{sign} = $sign;
- return wantarray ? ($x,$self->bzero()) : $x;
+ # Denominator (divisor) is +/-inf. The cases when the numerator is +/-inf
+ # are covered above. In the modulo cases (in the right column) we return
+ # the same as core Perl, which does floored division, so for consistency we
+ # also do floored division in the division cases (in the left column).
+ #
+ # -5 / inf = -1 (before: 0) -5 % inf = inf (before: -5)
+ # 0 / inf = 0 0 % inf = 0
+ # 5 / inf = 0 5 % inf = 5
+ #
+ # -5 / -inf = 0 -5 % -inf = -5
+ # 0 / -inf = 0 0 % -inf = 0
+ # 5 / -inf = -1 (before: 0) 5 % -inf = -inf (before: 5)
+
+ if ($y -> is_inf()) {
+ my ($quo, $rem);
+ if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
+ $rem = $x -> copy() if $wantarray;
+ $quo = $x -> bzero();
+ } else {
+ $rem = $self -> binf($y -> {sign}) if $wantarray;
+ $quo = $x -> bone('-');
+ }
+ return $wantarray ? ($quo, $rem) : $quo;
}
-sub bdiv
- {
- # (dividend: BINT or num_str, divisor: BINT or num_str) return
- # (BINT,BINT) (quo,rem) or BINT (only rem)
+ # At this point, both the numerator and denominator are finite numbers, and
+ # the denominator (divisor) is non-zero.
- # set up parameters
- my ($self,$x,$y,@r) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
- {
- ($self,$x,$y,@r) = objectify(2,@_);
- }
+ return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
+ if defined $upgrade;
- return $x if $x->modify('bdiv');
+ $r[3] = $y; # no push!
- return $self->_div_inf($x,$y)
- if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
+ # Inialize remainder.
- return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
- if defined $upgrade;
+ my $rem = $self->bzero();
- $r[3] = $y; # no push!
+ # Are both operands the same object, i.e., like $x -> bdiv($x)?
+ # If so, flipping the sign of $y also flips the sign of $x.
- # calc new sign and in case $y == +/- 1, return $x
- my $xsign = $x->{sign}; # keep
- $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
+ my $xsign = $x->{sign};
+ my $ysign = $y->{sign};
- if (wantarray)
- {
- my $rem = $self->bzero();
+ $y->{sign} =~ tr/+-/-+/; # Flip the sign of $y, and see ...
+ my $same = $xsign ne $x->{sign}; # ... if that changed the sign of $x.
+ $y->{sign} = $ysign; # Re-insert the original sign.
+
+ if ($same) {
+ $x -> bone();
+ } else {
($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value});
- $x->{sign} = '+' if $CALC->_is_zero($x->{value});
- $rem->{_a} = $x->{_a};
- $rem->{_p} = $x->{_p};
+
+ if ($CALC -> _is_zero($rem->{value})) {
+ if ($xsign eq $ysign || $CALC -> _is_zero($x->{value})) {
+ $x->{sign} = '+';
+ } else {
+ $x->{sign} = '-';
+ }
+ } else {
+ if ($xsign eq $ysign) {
+ $x->{sign} = '+';
+ } else {
+ if ($xsign eq '+') {
+ $x -> badd(1);
+ } else {
+ $x -> bsub(1);
+ }
+ $x->{sign} = '-';
+ }
+ }
+ }
+
$x->round(@r);
- if (! $CALC->_is_zero($rem->{value}))
- {
- $rem->{sign} = $y->{sign};
- $rem = $y->copy()->bsub($rem) if $xsign ne $y->{sign}; # one of them '-'
+
+ if ($wantarray) {
+ unless ($CALC -> _is_zero($rem->{value})) {
+ if ($xsign ne $ysign) {
+ $rem = $y -> copy() -> babs() -> bsub($rem);
}
- else
- {
- $rem->{sign} = '+'; # do not leave -0
+ $rem->{sign} = $ysign;
}
+ $rem->{_a} = $x->{_a};
+ $rem->{_p} = $x->{_p};
$rem->round(@r);
return ($x,$rem);
}
- $x->{value} = $CALC->_div($x->{value},$y->{value});
- $x->{sign} = '+' if $CALC->_is_zero($x->{value});
-
- $x->round(@r);
+ return $x;
}
###############################################################################
# modulus functions
-sub bmod
+sub bmod
{
- # modulus (or remainder)
- # (BINT or num_str, BINT or num_str) return BINT
- # set up parameters
+ # This is the remainder after floored division, where the quotient is
+ # floored toward negative infinity and the remainder has the same sign as
+ # the divisor.
+
+ # Set up parameters.
my ($self,$x,$y,@r) = (ref($_[0]),@_);
+
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
@@ -1773,36 +1901,63 @@ sub bmod
}
return $x if $x->modify('bmod');
- $r[3] = $y; # no push!
- if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero())
- {
- my ($d,$r) = $self->_div_inf($x,$y);
- $x->{sign} = $r->{sign};
- $x->{value} = $r->{value};
- return $x->round(@r);
+ $r[3] = $y; # no push!
+
+ # At least one argument is NaN.
+
+ if ($x -> is_nan() || $y -> is_nan()) {
+ return $x -> bnan();
+ }
+
+ # Modulo zero. See documentation for bdiv().
+
+ if ($y -> is_zero()) {
+ return $x;
+ }
+
+ # Numerator (dividend) is +/-inf.
+
+ if ($x -> is_inf()) {
+ return $x -> bnan();
}
- # calc new sign and in case $y == +/- 1, return $x
+ # Denominator (divisor) is +/-inf.
+
+ if ($y -> is_inf()) {
+ if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
+ return $x;
+ } else {
+ return $x -> binf($y -> sign());
+ }
+ }
+
+ # Calc new sign and in case $y == +/- 1, return $x.
+
$x->{value} = $CALC->_mod($x->{value},$y->{value});
- if (!$CALC->_is_zero($x->{value}))
+ if ($CALC -> _is_zero($x->{value}))
{
- $x->{value} = $CALC->_sub($y->{value},$x->{value},1) # $y-$x
- if ($x->{sign} ne $y->{sign});
- $x->{sign} = $y->{sign};
+ $x->{sign} = '+'; # do not leave -0
}
- else
+ else
{
- $x->{sign} = '+'; # do not leave -0
+ $x->{value} = $CALC->_sub($y->{value},$x->{value},1) # $y-$x
+ if ($x->{sign} ne $y->{sign});
+ $x->{sign} = $y->{sign};
}
+
$x->round(@r);
}
sub bmodinv
{
- # Return modular multiplicative inverse: z is the modular inverse of x (mod
- # y) if and only if x*z (mod y) = 1 (mod y). If the modulus y is larger than
- # one, x and z are relative primes (i.e., their greatest common divisor is
- # one).
+ # Return modular multiplicative inverse:
+ #
+ # z is the modular inverse of x (mod y) if and only if
+ #
+ # x*z ≡ 1 (mod y)
+ #
+ # If the modulus y is larger than one, x and z are relative primes (i.e.,
+ # their greatest common divisor is one).
#
# If no modular multiplicative inverse exists, NaN is returned.
@@ -1896,8 +2051,17 @@ sub bmodpow
return $num->bnan() if ($num->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf
$exp->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf
- $mod->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf
- $mod->is_zero());
+ $mod->{sign} =~ /NaN|inf/); # NaN, -inf, +inf
+
+ # Modulo zero. See documentation for Math::BigInt's bmod() method.
+
+ if ($mod -> is_zero()) {
+ if ($num -> is_zero()) {
+ return $self -> bnan();
+ } else {
+ return $num -> copy();
+ }
+ }
# Compute 'a (mod m)', ignoring the signs on 'a' and 'm'. If the resulting
# value is zero, the output is also zero, regardless of the signs on 'a' and
@@ -1973,14 +2137,14 @@ sub bfac
# compute factorial number from $x, modify $x in place
my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
- return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf
- return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
+ 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->round(@r);
}
-sub bpow
+sub bpow
{
# (BINT or num_str, BINT or num_str) return BINT
# compute power of two numbers -- stolen from Knuth Vol 2 pg 233
@@ -2050,15 +2214,15 @@ sub bpow
return $upgrade->bpow($upgrade->new($x),$y,@r)
if defined $upgrade && (!$y->isa($self) || $y->{sign} eq '-');
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
# cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
my $new_sign = '+';
- $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
+ $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
- # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
- return $x->binf()
+ # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
+ return $x->binf()
if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value});
# 1 ** -y => 1 / (1 ** |y|)
# so do test for negative $y after above's clause
@@ -2070,7 +2234,7 @@ sub bpow
$x->round(@r);
}
-sub blsft
+sub blsft
{
# (BINT or num_str, BINT or num_str) return BINT
# compute x << y, base n, y >= 0
@@ -2093,7 +2257,7 @@ sub blsft
$x->round(@r);
}
-sub brsft
+sub brsft
{
# (BINT or num_str, BINT or num_str) return BINT
# compute x >> y, base n, y >= 0
@@ -2109,52 +2273,52 @@ sub brsft
return $x if $x->modify('brsft');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
return $x->round(@r) if $y->is_zero();
- return $x->bzero(@r) if $x->is_zero(); # 0 => 0
+ return $x->bzero(@r) if $x->is_zero(); # 0 => 0
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
# this only works for negative numbers when shifting in base 2
if (($x->{sign} eq '-') && ($n == 2))
{
- return $x->round(@r) if $x->is_one('-'); # -1 => -1
+ return $x->round(@r) if $x->is_one('-'); # -1 => -1
if (!$y->is_one())
{
# although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
# but perhaps there is a better emulation for two's complement shift...
# if $y != 1, we must simulate it by doing:
# convert to bin, flip all bits, shift, and be done
- $x->binc(); # -3 => -2
+ $x->binc(); # -3 => -2
my $bin = $x->as_bin();
- $bin =~ s/^-0b//; # strip '-0b' prefix
- $bin =~ tr/10/01/; # flip bits
+ $bin =~ s/^-0b//; # strip '-0b' prefix
+ $bin =~ tr/10/01/; # flip bits
# now shift
if ($y >= CORE::length($bin))
{
- $bin = '0'; # shifting to far right creates -1
- # 0, because later increment makes
- # that 1, attached '-' makes it '-1'
- # because -1 >> x == -1 !
- }
+ $bin = '0'; # shifting to far right creates -1
+ # 0, because later increment makes
+ # that 1, attached '-' makes it '-1'
+ # because -1 >> x == -1 !
+ }
else
- {
- $bin =~ s/.{$y}$//; # cut off at the right side
- $bin = '1' . $bin; # extend left side by one dummy '1'
- $bin =~ tr/10/01/; # flip bits back
- }
- my $res = $self->new('0b'.$bin); # add prefix and convert back
- $res->binc(); # remember to increment
- $x->{value} = $res->{value}; # take over value
- return $x->round(@r); # we are done now, magic, isn't?
+ {
+ $bin =~ s/.{$y}$//; # cut off at the right side
+ $bin = '1' . $bin; # extend left side by one dummy '1'
+ $bin =~ tr/10/01/; # flip bits back
+ }
+ my $res = $self->new('0b'.$bin); # add prefix and convert back
+ $res->binc(); # remember to increment
+ $x->{value} = $res->{value}; # take over value
+ return $x->round(@r); # we are done now, magic, isn't?
}
# x < 0, n == 2, y == 1
- $x->bdec(); # n == 2, but $y == 1: this fixes it
+ $x->bdec(); # n == 2, but $y == 1: this fixes it
}
$x->{value} = $CALC->_rsft($x->{value},$y->{value},$n);
$x->round(@r);
}
-sub band
+sub band
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x & y
@@ -2169,7 +2333,7 @@ sub band
return $x if $x->modify('band');
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
@@ -2192,7 +2356,7 @@ sub band
__emu_band($self,$x,$y,$sx,$sy,@r);
}
-sub bior
+sub bior
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x | y
@@ -2206,7 +2370,7 @@ sub bior
}
return $x if $x->modify('bior');
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
@@ -2233,7 +2397,7 @@ sub bior
__emu_bior($self,$x,$y,$sx,$sy,@r);
}
-sub bxor
+sub bxor
{
#(BINT or num_str, BINT or num_str) return BINT
# compute x ^ y
@@ -2247,7 +2411,7 @@ sub bxor
}
return $x if $x->modify('bxor');
- $r[3] = $y; # no push!
+ $r[3] = $y; # no push!
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
@@ -2276,7 +2440,7 @@ sub length
{
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- my $e = $CALC->_len($x->{value});
+ my $e = $CALC->_len($x->{value});
wantarray ? ($e,0) : $e;
}
@@ -2295,9 +2459,9 @@ sub _trailing_zeros
my $x = shift;
$x = $class->new($x) unless ref $x;
- return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
+ return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
- $CALC->_zeros($x->{value}); # must handle odd values, 0 etc
+ $CALC->_zeros($x->{value}); # must handle odd values, 0 etc
}
sub bsqrt
@@ -2307,8 +2471,8 @@ sub bsqrt
return $x if $x->modify('bsqrt');
- return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN
- return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf
+ return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN
+ return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf
return $upgrade->bsqrt($x,@r) if defined $upgrade;
@@ -2356,7 +2520,7 @@ sub exponent
my $s = $x->{sign}; $s =~ s/^[+-]//; # NaN, -inf,+inf => NaN or inf
return $self->new($s);
}
- return $self->bone() if $x->is_zero();
+ return $self->bzero() if $x->is_zero();
# 12300 => 2 trailing zeros => exponent is 2
$self->new( $CALC->_zeros($x->{value}) );
@@ -2399,13 +2563,13 @@ sub bfround
my ($scale,$mode) = $x->_scale_p(@_);
- return $x if !defined $scale || $x->modify('bfround'); # no-op
+ return $x if !defined $scale || $x->modify('bfround'); # no-op
# no-op for BigInts if $n <= 0
$x->bround( $x->length()-$scale, $mode) if $scale > 0;
- delete $x->{_a}; # delete to save memory
- $x->{_p} = $scale; # store new _p
+ delete $x->{_a}; # delete to save memory
+ $x->{_p} = $scale; # store new _p
$x;
}
@@ -2414,7 +2578,7 @@ sub _scan_for_nonzero
# internal, used by bround() to scan for non-zeros after a '5'
my ($x,$pad,$xs,$len) = @_;
- return 0 if $len == 1; # "5" is trailed by invisible zeros
+ return 0 if $len == 1; # "5" is trailed by invisible zeros
my $follow = $pad - 1;
return 0 if $follow > $len || $follow < 1;
@@ -2440,14 +2604,14 @@ sub bround
my $x = shift; $x = $class->new($x) unless ref $x;
my ($scale,$mode) = $x->_scale_a(@_);
- return $x if !defined $scale || $x->modify('bround'); # no-op
+ return $x if !defined $scale || $x->modify('bround'); # no-op
if ($x->is_zero() || $scale == 0)
{
$x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
return $x;
}
- return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN
+ return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN
# we have fewer digits than we want to scale to
my $len = $x->length();
@@ -2460,7 +2624,7 @@ sub bround
if (($scale < 0 && $scale < -$len-1) || ($scale >= $len))
{
$x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2
- return $x;
+ return $x;
}
# count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6
@@ -2481,50 +2645,50 @@ sub bround
# in case of 01234 we round down, for 6789 up, and only in case 5 we look
# closer at the remaining digits of the original $x, remember decision
- my $round_up = 1; # default round up
+ my $round_up = 1; # default round up
$round_up -- if
- ($mode eq 'trunc') || # trunc by round down
- ($digit_after =~ /[01234]/) || # round down anyway,
- # 6789 => round up
- ($digit_after eq '5') && # not 5000...0000
- ($x->_scan_for_nonzero($pad,$xs,$len) == 0) &&
+ ($mode eq 'trunc') || # trunc by round down
+ ($digit_after =~ /[01234]/) || # round down anyway,
+ # 6789 => round up
+ ($digit_after eq '5') && # not 5000...0000
+ ($x->_scan_for_nonzero($pad,$xs,$len) == 0) &&
(
($mode eq 'even') && ($digit_round =~ /[24680]/) ||
($mode eq 'odd') && ($digit_round =~ /[13579]/) ||
($mode eq '+inf') && ($x->{sign} eq '-') ||
($mode eq '-inf') && ($x->{sign} eq '+') ||
- ($mode eq 'zero') # round down if zero, sign adjusted below
+ ($mode eq 'zero') # round down if zero, sign adjusted below
);
- my $put_back = 0; # not yet modified
-
+ my $put_back = 0; # not yet modified
+
if (($pad > 0) && ($pad <= $len))
{
- substr($xs,-$pad,$pad) = '0' x $pad; # replace with '00...'
- $put_back = 1; # need to put back
+ substr($xs,-$pad,$pad) = '0' x $pad; # replace with '00...'
+ $put_back = 1; # need to put back
}
elsif ($pad > $len)
{
- $x->bzero(); # round to '0'
+ $x->bzero(); # round to '0'
}
- if ($round_up) # what gave test above?
+ if ($round_up) # what gave test above?
{
- $put_back = 1; # need to put back
- $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0
+ $put_back = 1; # need to put back
+ $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0
# we modify directly the string variant instead of creating a number and
# adding it, since that is faster (we already have the string)
- my $c = 0; $pad ++; # for $pad == $len case
+ my $c = 0; $pad ++; # for $pad == $len case
while ($pad <= $len)
{
$c = substr($xs,-$pad,1) + 1; $c = '0' if $c eq '10';
substr($xs,-$pad,1) = $c; $pad++;
- last if $c != 0; # no overflow => early out
+ last if $c != 0; # no overflow => early out
}
$xs = '1'.$xs if $c == 0;
}
- $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed
+ $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed
$x->{_a} = $scale if $scale >= 0;
if ($scale < 0)
@@ -2571,7 +2735,7 @@ sub as_hex
# return as hex string, with prefixed 0x
my $x = shift; $x = $class->new($x) if !ref($x);
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
my $s = '';
$s = $x->{sign} if $x->{sign} eq '-';
@@ -2583,7 +2747,7 @@ sub as_bin
# return as binary string, with prefixed 0b
my $x = shift; $x = $class->new($x) if !ref($x);
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
return $s . $CALC->_as_bin($x->{value});
@@ -2594,10 +2758,10 @@ sub as_oct
# return as octal string, with prefixed 0
my $x = shift; $x = $class->new($x) if !ref($x);
- return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
+ return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
- return $s . $CALC->_as_oct($x->{value});
+ my $oct = $CALC->_as_oct($x->{value});
+ return $x->{sign} eq '-' ? "-$oct" : $oct;
}
##############################################################################
@@ -2684,9 +2848,7 @@ sub objectify {
# If it is an object of the right class, all is fine.
- if ($ref -> isa($a[0])) {
- next;
- }
+ next if $ref -> isa($a[0]);
# Upgrading is OK, so skip further tests if the argument is upgraded.
@@ -2694,27 +2856,44 @@ sub objectify {
next;
}
- # If we want a Math::BigInt, see if the object can become one.
- # Support the old misnomer as_number().
+ # See if we can call one of the as_xxx() methods. We don't know whether
+ # the as_xxx() method returns an object or a scalar, so re-check
+ # afterwards.
+
+ my $recheck = 0;
- if ($a[0] eq 'Math::BigInt') {
+ if ($a[0] -> isa('Math::BigInt')) {
if ($a[$i] -> can('as_int')) {
$a[$i] = $a[$i] -> as_int();
- next;
- }
- if ($a[$i] -> can('as_number')) {
+ $recheck = 1;
+ } elsif ($a[$i] -> can('as_number')) {
$a[$i] = $a[$i] -> as_number();
- next;
+ $recheck = 1;
}
}
- # If we want a Math::BigFloat, see if the object can become one.
-
- if ($a[0] eq 'Math::BigFloat') {
+ elsif ($a[0] -> isa('Math::BigFloat')) {
if ($a[$i] -> can('as_float')) {
$a[$i] = $a[$i] -> as_float();
+ $recheck = $1;
+ }
+ }
+
+ # If we called one of the as_xxx() methods, recheck.
+
+ if ($recheck) {
+ $ref = ref($a[$i]);
+
+ # Perl scalars are fed to the appropriate constructor.
+
+ unless ($ref) {
+ $a[$i] = $a[0] -> new($a[$i]);
next;
}
+
+ # If it is an object of the right class, all is fine.
+
+ next if $ref -> isa($a[0]);
}
# Last resort.
@@ -2734,33 +2913,33 @@ sub _register_callback
my ($class,$callback) = @_;
if (ref($callback) ne 'CODE')
- {
+ {
require Carp;
Carp::croak ("$callback is not a coderef");
}
$CALLBACKS{$class} = $callback;
}
-sub import
+sub import
{
my $self = shift;
- $IMPORT++; # remember we did import()
+ $IMPORT++; # remember we did import()
my @a; my $l = scalar @_;
- my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die
+ my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die
for ( my $i = 0; $i < $l ; $i++ )
{
if ($_[$i] eq ':constant')
{
# this causes overlord er load to step in
- overload::constant
- integer => sub { $self->new(shift) },
- binary => sub { $self->new(shift) };
+ overload::constant
+ integer => sub { $self->new(shift) },
+ binary => sub { $self->new(shift) };
}
elsif ($_[$i] eq 'upgrade')
{
# this causes upgrading
- $upgrade = $_[$i+1]; # or undef to disable
+ $upgrade = $_[$i+1]; # or undef to disable
$i++;
}
elsif ($_[$i] =~ /^(lib|try|only)\z/)
@@ -2782,19 +2961,19 @@ sub import
{
require Exporter;
- $self->SUPER::import(@a); # need it for subclasses
- $self->export_to_level(1,$self,@a); # need it for MBF
+ $self->SUPER::import(@a); # need it for subclasses
+ $self->export_to_level(1,$self,@a); # need it for MBF
}
# try to load core math lib
my @c = split /\s*,\s*/,$CALC;
foreach (@c)
{
- $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
+ $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
}
- push @c, \'Calc' # if all fail, try these
- if $warn_or_die < 2; # but not for "only"
- $CALC = ''; # signal error
+ push @c, \'Calc' # if all fail, try these
+ if $warn_or_die < 2; # but not for "only"
+ $CALC = ''; # signal error
foreach my $l (@c)
{
# fallback libraries are "marked" as \'string', extract string if nec.
@@ -2822,55 +3001,55 @@ sub import
my $ok = 1;
# loaded it ok, see if the api_version() is high enough
if ($lib->can('api_version') && $lib->api_version() >= 1.0)
- {
- $ok = 0;
- # api_version matches, check if it really provides anything we need
+ {
+ $ok = 0;
+ # api_version matches, check if it really provides anything we need
for my $method (qw/
- one two ten
- str num
- add mul div sub dec inc
- acmp len digit is_one is_zero is_even is_odd
- is_two is_ten
- zeros new copy check
- from_hex from_oct from_bin as_hex as_bin as_oct
- rsft lsft xor and or
- mod sqrt root fac pow modinv modpow log_int gcd
- /)
+ one two ten
+ str num
+ add mul div sub dec inc
+ acmp len digit is_one is_zero is_even is_odd
+ is_two is_ten
+ zeros new copy check
+ from_hex from_oct from_bin as_hex as_bin as_oct
+ rsft lsft xor and or
+ mod sqrt root fac pow modinv modpow log_int gcd
+ /)
{
- if (!$lib->can("_$method"))
- {
- if (($WARN{$lib}||0) < 2)
- {
- require Carp;
- Carp::carp ("$lib is missing method '_$method'");
- $WARN{$lib} = 1; # still warn about the lib
- }
- $ok++; last;
- }
+ if (!$lib->can("_$method"))
+ {
+ if (($WARN{$lib}||0) < 2)
+ {
+ require Carp;
+ Carp::carp ("$lib is missing method '_$method'");
+ $WARN{$lib} = 1; # still warn about the lib
+ }
+ $ok++; last;
+ }
}
- }
+ }
if ($ok == 0)
- {
- $CALC = $lib;
- if ($warn_or_die > 0 && ref($l))
- {
- require Carp;
- my $msg =
+ {
+ $CALC = $lib;
+ if ($warn_or_die > 0 && ref($l))
+ {
+ require Carp;
+ 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;
- }
- last; # found a usable one, break
- }
+ }
+ last; # found a usable one, break
+ }
else
- {
- if (($WARN{$lib}||0) < 2)
- {
- my $ver = eval "\$$lib\::VERSION" || 'unknown';
- require Carp;
- Carp::carp ("Cannot load outdated $lib v$ver, please upgrade");
- $WARN{$lib} = 2; # never warn again
- }
+ {
+ if (($WARN{$lib}||0) < 2)
+ {
+ my $ver = eval "\$$lib\::VERSION" || 'unknown';
+ require Carp;
+ Carp::carp ("Cannot load outdated $lib v$ver, please upgrade");
+ $WARN{$lib} = 2; # never warn again
+ }
}
}
}
@@ -2907,10 +3086,18 @@ sub import
# import done
}
+# Create a Math::BigInt from a hexadecimal string.
+
sub from_hex {
- # Create a bigint from a hexadecimal string.
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
+
+ my $str = shift;
+
+ # If called as a class method, initialize a new object.
- my ($self, $str) = @_;
+ $self = $class -> bzero() unless $selfref;
if ($str =~ s/
^
@@ -2931,21 +3118,17 @@ sub from_hex {
$chrs =~ tr/_//d;
$chrs = '0' unless CORE::length $chrs;
- # Initialize output.
-
- my $x = Math::BigInt->bzero();
-
# The library method requires a prefix.
- $x->{value} = $CALC->_from_hex('0x' . $chrs);
+ $self->{value} = $CALC->_from_hex('0x' . $chrs);
# Place the sign.
- if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
- $x->{sign} = '-';
+ if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) {
+ $self->{sign} = '-';
}
- return $x;
+ return $self;
}
# CORE::hex() parses as much as it can, and ignores any trailing garbage.
@@ -2954,10 +3137,18 @@ sub from_hex {
return $self->bnan();
}
+# Create a Math::BigInt from an octal string.
+
sub from_oct {
- # Create a bigint from an octal string.
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- my ($self, $str) = @_;
+ my $str = shift;
+
+ # If called as a class method, initialize a new object.
+
+ $self = $class -> bzero() unless $selfref;
if ($str =~ s/
^
@@ -2977,21 +3168,17 @@ sub from_oct {
$chrs =~ tr/_//d;
$chrs = '0' unless CORE::length $chrs;
- # Initialize output.
-
- my $x = Math::BigInt->bzero();
-
# The library method requires a prefix.
- $x->{value} = $CALC->_from_oct('0' . $chrs);
+ $self->{value} = $CALC->_from_oct('0' . $chrs);
# Place the sign.
- if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
- $x->{sign} = '-';
+ if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) {
+ $self->{sign} = '-';
}
- return $x;
+ return $self;
}
# CORE::oct() parses as much as it can, and ignores any trailing garbage.
@@ -3000,10 +3187,18 @@ sub from_oct {
return $self->bnan();
}
+# Create a Math::BigInt from a binary string.
+
sub from_bin {
- # Create a bigint from a binary string.
+ my $self = shift;
+ my $selfref = ref $self;
+ my $class = $selfref || $self;
- my ($self, $str) = @_;
+ my $str = shift;
+
+ # If called as a class method, initialize a new object.
+
+ $self = $class -> bzero() unless $selfref;
if ($str =~ s/
^
@@ -3024,21 +3219,17 @@ sub from_bin {
$chrs =~ tr/_//d;
$chrs = '0' unless CORE::length $chrs;
- # Initialize output.
-
- my $x = Math::BigInt->bzero();
-
# The library method requires a prefix.
- $x->{value} = $CALC->_from_bin('0b' . $chrs);
+ $self->{value} = $CALC->_from_bin('0b' . $chrs);
# Place the sign.
- if ($sign eq '-' && ! $CALC->_is_zero($x->{value})) {
- $x->{sign} = '-';
+ if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) {
+ $self->{sign} = '-';
}
- return $x;
+ return $self;
}
# For consistency with from_hex() and from_oct(), we return NaN when the
@@ -3047,6 +3238,80 @@ sub from_bin {
return $self->bnan();
}
+sub _split_dec_string {
+ my $str = shift;
+
+ if ($str =~ s/
+ ^
+
+ # leading whitespace
+ ( \s* )
+
+ # optional sign
+ ( [+-]? )
+
+ # significand
+ (
+ \d+ (?: _ \d+ )*
+ (?:
+ \.
+ (?: \d+ (?: _ \d+ )* )?
+ )?
+ |
+ \.
+ \d+ (?: _ \d+ )*
+ )
+
+ # optional exponent
+ (?:
+ [Ee]
+ ( [+-]? )
+ ( \d+ (?: _ \d+ )* )
+ )?
+
+ # trailing stuff
+ ( \D .*? )?
+
+ \z
+ //x)
+ {
+ my $leading = $1;
+ my $significand_sgn = $2 || '+';
+ my $significand_abs = $3;
+ my $exponent_sgn = $4 || '+';
+ my $exponent_abs = $5 || '0';
+ my $trailing = $6;
+
+ # Remove underscores and leading zeros.
+
+ $significand_abs =~ tr/_//d;
+ $exponent_abs =~ tr/_//d;
+
+ $significand_abs =~ s/^0+(.)/$1/;
+ $exponent_abs =~ s/^0+(.)/$1/;
+
+ # If the significand contains a dot, remove it and adjust the exponent
+ # accordingly. E.g., "1234.56789e+3" -> "123456789e-2"
+
+ my $idx = index $significand_abs, '.';
+ if ($idx > -1) {
+ $significand_abs =~ s/0+\z//;
+ substr($significand_abs, $idx, 1) = '';
+ my $exponent = $exponent_sgn . $exponent_abs;
+ $exponent .= $idx - CORE::length($significand_abs);
+ $exponent_abs = abs $exponent;
+ $exponent_sgn = $exponent < 0 ? '-' : '+';
+ }
+
+ return($leading,
+ $significand_sgn, $significand_abs,
+ $exponent_sgn, $exponent_abs,
+ $trailing);
+ }
+
+ return undef;
+}
+
sub _split
{
# input: num_str; output: undef for invalid or
@@ -3077,33 +3342,33 @@ sub _split
# strip underscores between digits
$x =~ s/([0-9])_([0-9])/$1$2/g;
- $x =~ s/([0-9])_([0-9])/$1$2/g; # do twice for 1_2_3
+ $x =~ s/([0-9])_([0-9])/$1$2/g; # do twice for 1_2_3
- # some possible inputs:
- # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
- # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2 # 0e999
+ # some possible inputs:
+ # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2
+ # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2 # 0e999
my ($m,$e,$last) = split /[Ee]/,$x;
- return if defined $last; # last defined => 1e2E3 or others
+ return if defined $last; # last defined => 1e2E3 or others
$e = '0' if !defined $e || $e eq "";
# sign,value for exponent,mantint,mantfrac
my ($es,$ev,$mis,$miv,$mfv);
# valid exponent?
- if ($e =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
+ if ($e =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
{
$es = $1; $ev = $2;
# valid mantissa?
return if $m eq '.' || $m eq '';
my ($mi,$mf,$lastf) = split /\./,$m;
- return if defined $lastf; # lastf defined => 1.2.3 or others
+ return if defined $lastf; # lastf defined => 1.2.3 or others
$mi = '0' if !defined $mi;
$mi .= '0' if $mi =~ /^[\-\+]?$/;
$mf = '0' if !defined $mf || $mf eq '';
- if ($mi =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
+ if ($mi =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros
{
$mis = $1||'+'; $miv = $2;
- return unless ($mf =~ /^([0-9]*?)0*$/); # strip trailing zeros
+ return unless ($mf =~ /^([0-9]*?)0*$/); # strip trailing zeros
$mfv = $1;
# handle the 0e999 case here
$ev = 0 if $miv eq '0' && $mfv eq '';
@@ -3116,8 +3381,8 @@ sub _split
##############################################################################
# internal calculation routines (others are in Math::BigInt::Calc etc)
-sub __lcm
- {
+sub __lcm
+ {
# (BINT or num_str, BINT or num_str) return BINT
# does modify first argument
# LCM
@@ -3158,7 +3423,7 @@ sub bcos
return $x if $x->modify('bcos');
- return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
return $upgrade->new($x)->bcos(@r) if defined $upgrade;
@@ -3179,7 +3444,7 @@ sub bsin
return $x if $x->modify('bsin');
- return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
return $upgrade->new($x)->bsin(@r) if defined $upgrade;
@@ -3193,7 +3458,7 @@ sub bsin
}
sub batan2
- {
+ {
# calculate arcus tangens of ($y/$x)
# set up parameters
@@ -3271,7 +3536,7 @@ sub batan
return $x if $x->modify('batan');
- return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
+ return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN
return $upgrade->new($x)->batan(@r) if defined $upgrade;
@@ -3320,106 +3585,108 @@ Math::BigInt - Arbitrary size integer/float math package
my @values = (64,74,18);
my $n = 1; my $sign = '-';
- # Number creation
- my $x = Math::BigInt->new($str); # defaults to 0
- my $y = $x->copy(); # make a true copy
- my $nan = Math::BigInt->bnan(); # create a NotANumber
- my $zero = Math::BigInt->bzero(); # create a +0
- my $inf = Math::BigInt->binf(); # create a +inf
- my $inf = Math::BigInt->binf('-'); # create a -inf
- my $one = Math::BigInt->bone(); # create a +1
- my $mone = Math::BigInt->bone('-'); # create a -1
-
- my $pi = Math::BigInt->bpi(); # returns '3'
- # see Math::BigFloat::bpi()
-
- $h = Math::BigInt->new('0x123'); # from hexadecimal
- $b = Math::BigInt->new('0b101'); # from binary
- $o = Math::BigInt->from_oct('0101'); # from octal
+ # Number creation
+ my $x = Math::BigInt->new($str); # defaults to 0
+ my $y = $x->copy(); # make a true copy
+ my $nan = Math::BigInt->bnan(); # create a NotANumber
+ my $zero = Math::BigInt->bzero(); # create a +0
+ my $inf = Math::BigInt->binf(); # create a +inf
+ my $inf = Math::BigInt->binf('-'); # create a -inf
+ my $one = Math::BigInt->bone(); # create a +1
+ my $mone = Math::BigInt->bone('-'); # create a -1
+
+ my $pi = Math::BigInt->bpi(); # returns '3'
+ # see Math::BigFloat::bpi()
+
+ $h = Math::BigInt->new('0x123'); # from hexadecimal
+ $b = Math::BigInt->new('0b101'); # from binary
+ $o = Math::BigInt->from_oct('0101'); # from octal
+ $h = Math::BigInt->from_hex('cafe'); # from hexadecimal
+ $b = Math::BigInt->from_bin('0101'); # from binary
# Testing (don't modify their arguments)
# (return true if the condition is met, otherwise false)
- $x->is_zero(); # if $x is +0
- $x->is_nan(); # if $x is NaN
- $x->is_one(); # if $x is +1
- $x->is_one('-'); # if $x is -1
- $x->is_odd(); # if $x is odd
- $x->is_even(); # if $x is even
- $x->is_pos(); # if $x > 0
- $x->is_neg(); # if $x < 0
- $x->is_inf($sign); # if $x is +inf, or -inf (sign is default '+')
- $x->is_int(); # if $x is an integer (not a float)
+ $x->is_zero(); # if $x is +0
+ $x->is_nan(); # if $x is NaN
+ $x->is_one(); # if $x is +1
+ $x->is_one('-'); # if $x is -1
+ $x->is_odd(); # if $x is odd
+ $x->is_even(); # if $x is even
+ $x->is_pos(); # if $x > 0
+ $x->is_neg(); # if $x < 0
+ $x->is_inf($sign); # if $x is +inf, or -inf (sign is default '+')
+ $x->is_int(); # if $x is an integer (not a float)
# comparing and digit/sign extraction
- $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
- $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
- $x->sign(); # return the sign, either +,- or NaN
- $x->digit($n); # return the nth digit, counting from right
- $x->digit(-$n); # return the nth digit, counting from left
+ $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
+ $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
+ $x->sign(); # return the sign, either +,- or NaN
+ $x->digit($n); # return the nth digit, counting from right
+ $x->digit(-$n); # return the nth digit, counting from left
# The following all modify their first argument. If you want to pre-
# serve $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for
# why this is necessary when mixing $a = $b assignments with non-over-
# loaded math.
- $x->bzero(); # set $x to 0
- $x->bnan(); # set $x to NaN
- $x->bone(); # set $x to +1
- $x->bone('-'); # set $x to -1
- $x->binf(); # set $x to inf
- $x->binf('-'); # set $x to -inf
-
- $x->bneg(); # negation
- $x->babs(); # absolute value
- $x->bsgn(); # sign function (-1, 0, 1, or NaN)
- $x->bnorm(); # normalize (no-op in BigInt)
- $x->bnot(); # two's complement (bit wise not)
- $x->binc(); # increment $x by 1
- $x->bdec(); # decrement $x by 1
-
- $x->badd($y); # addition (add $y to $x)
- $x->bsub($y); # subtraction (subtract $y from $x)
- $x->bmul($y); # multiplication (multiply $x by $y)
- $x->bdiv($y); # divide, set $x to quotient
- # return (quo,rem) or quo if scalar
-
- $x->bmuladd($y,$z); # $x = $x * $y + $z
-
- $x->bmod($y); # modulus (x % y)
+ $x->bzero(); # set $x to 0
+ $x->bnan(); # set $x to NaN
+ $x->bone(); # set $x to +1
+ $x->bone('-'); # set $x to -1
+ $x->binf(); # set $x to inf
+ $x->binf('-'); # set $x to -inf
+
+ $x->bneg(); # negation
+ $x->babs(); # absolute value
+ $x->bsgn(); # sign function (-1, 0, 1, or NaN)
+ $x->bnorm(); # normalize (no-op in BigInt)
+ $x->bnot(); # two's complement (bit wise not)
+ $x->binc(); # increment $x by 1
+ $x->bdec(); # decrement $x by 1
+
+ $x->badd($y); # addition (add $y to $x)
+ $x->bsub($y); # subtraction (subtract $y from $x)
+ $x->bmul($y); # multiplication (multiply $x by $y)
+ $x->bdiv($y); # divide, set $x to quotient
+ # return (quo,rem) or quo if scalar
+
+ $x->bmuladd($y,$z); # $x = $x * $y + $z
+
+ $x->bmod($y); # modulus (x % y)
$x->bmodpow($y,$mod); # modular exponentiation (($x ** $y) % $mod)
$x->bmodinv($mod); # modular multiplicative inverse
- $x->bpow($y); # power of arguments (x ** y)
- $x->blsft($y); # left shift in base 2
- $x->brsft($y); # right shift in base 2
- # returns (quo,rem) or quo if in sca-
- # lar context
- $x->blsft($y,$n); # left shift by $y places in base $n
- $x->brsft($y,$n); # right shift by $y places in base $n
- # returns (quo,rem) or quo if in sca-
- # lar context
-
- $x->band($y); # bitwise and
- $x->bior($y); # bitwise inclusive or
- $x->bxor($y); # bitwise exclusive or
- $x->bnot(); # bitwise not (two's complement)
-
- $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)
-
- $x->bnok($y); # x over y (binomial coefficient n over k)
-
- $x->blog(); # logarithm of $x to base e (Euler's number)
- $x->blog($base); # logarithm of $x to base $base (f.i. 2)
- $x->bexp(); # calculate e ** $x where e is Euler's number
+ $x->bpow($y); # power of arguments (x ** y)
+ $x->blsft($y); # left shift in base 2
+ $x->brsft($y); # right shift in base 2
+ # returns (quo,rem) or quo if in sca-
+ # lar context
+ $x->blsft($y,$n); # left shift by $y places in base $n
+ $x->brsft($y,$n); # right shift by $y places in base $n
+ # returns (quo,rem) or quo if in sca-
+ # lar context
+
+ $x->band($y); # bitwise and
+ $x->bior($y); # bitwise inclusive or
+ $x->bxor($y); # bitwise exclusive or
+ $x->bnot(); # bitwise not (two's complement)
+
+ $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)
+
+ $x->bnok($y); # x over y (binomial coefficient n over k)
+
+ $x->blog(); # logarithm of $x to base e (Euler's number)
+ $x->blog($base); # logarithm of $x to base $base (f.i. 2)
+ $x->bexp(); # calculate e ** $x where e is Euler's number
$x->round($A,$P,$mode); # round to accuracy or precision using
- # mode $mode
- $x->bround($n); # accuracy: preserve $n digits
- $x->bfround($n); # $n > 0: round $nth digits,
- # $n < 0: round to the $nth digit after the
- # dot, no-op for BigInts
+ # mode $mode
+ $x->bround($n); # accuracy: preserve $n digits
+ $x->bfround($n); # $n > 0: round $nth digits,
+ # $n < 0: round to the $nth digit after the
+ # dot, no-op for BigInts
# The following do not modify their arguments in BigInt (are no-ops),
# but do so in BigFloat:
@@ -3435,38 +3702,38 @@ Math::BigInt - Arbitrary size integer/float math package
# lowest common multiple (no OO style)
my $lcm = Math::BigInt::blcm(@values);
- $x->length(); # return number of digits in number
+ $x->length(); # return number of digits in number
($xl,$f) = $x->length(); # length of number and length of fraction
- # part, latter is always 0 digits long
- # for BigInts
+ # part, latter is always 0 digits long
+ # for BigInts
- $x->exponent(); # return exponent as BigInt
- $x->mantissa(); # return (signed) mantissa as BigInt
- $x->parts(); # return (mantissa,exponent) as BigInt
- $x->copy(); # make a true copy of $x (unlike $y = $x;)
- $x->as_int(); # return as BigInt (in BigInt: same as copy())
- $x->numify(); # return as scalar (might overflow!)
+ $x->exponent(); # return exponent as BigInt
+ $x->mantissa(); # return (signed) mantissa as BigInt
+ $x->parts(); # return (mantissa,exponent) as BigInt
+ $x->copy(); # make a true copy of $x (unlike $y = $x;)
+ $x->as_int(); # return as BigInt (in BigInt: same as copy())
+ $x->numify(); # return as scalar (might overflow!)
# conversion to string (do not modify their argument)
- $x->bstr(); # normalized string (e.g. '3')
- $x->bsstr(); # norm. string in scientific notation (e.g. '3E0')
- $x->as_hex(); # as signed hexadecimal string with prefixed 0x
- $x->as_bin(); # as signed binary string with prefixed 0b
- $x->as_oct(); # as signed octal string with prefixed 0
+ $x->bstr(); # normalized string (e.g. '3')
+ $x->bsstr(); # norm. string in scientific notation (e.g. '3E0')
+ $x->as_hex(); # as signed hexadecimal string with prefixed 0x
+ $x->as_bin(); # as signed binary string with prefixed 0b
+ $x->as_oct(); # as signed octal string with prefixed 0
# precision and accuracy (see section about rounding for more)
- $x->precision(); # return P of $x (or global, if P of $x undef)
- $x->precision($n); # set P of $x to $n
- $x->accuracy(); # return A of $x (or global, if A of $x undef)
- $x->accuracy($n); # set A $x to $n
+ $x->precision(); # return P of $x (or global, if P of $x undef)
+ $x->precision($n); # set P of $x to $n
+ $x->accuracy(); # return A of $x (or global, if A of $x undef)
+ $x->accuracy($n); # set A $x to $n
# Global methods
Math::BigInt->precision(); # get/set global P for all BigInt objects
Math::BigInt->accuracy(); # get/set global A for all BigInt objects
Math::BigInt->round_mode(); # get/set global round mode, one of
- # 'even', 'odd', '+inf', '-inf', 'zero',
- # 'trunc' or 'common'
+ # 'even', 'odd', '+inf', '-inf', 'zero',
+ # 'trunc' or 'common'
Math::BigInt->config(); # return hash containing configuration
=head1 DESCRIPTION
@@ -3474,7 +3741,7 @@ Math::BigInt - Arbitrary size integer/float math package
All operators (including basic math operations) are overloaded if you
declare your big integers as
- $i = new Math::BigInt '123_456_789_123_456_789';
+ $i = Math::BigInt -> new('123_456_789_123_456_789');
Operations with overloaded operators preserve the arguments which is
exactly what you expect.
@@ -3488,8 +3755,8 @@ Scalars holding numbers may also be passed, but note that non-integer numbers
may already have lost precision due to the conversion to float. Quote
your input if you want BigInt to see all the digits:
- $x = Math::BigInt->new(12345678890123456789); # bad
- $x = Math::BigInt->new('12345678901234567890'); # good
+ $x = Math::BigInt->new(12345678890123456789); # bad
+ $x = Math::BigInt->new('12345678901234567890'); # good
You can include one underscore between any two digits.
@@ -3500,21 +3767,21 @@ Hexadecimal (prefixed with "0x") and binary numbers (prefixed with "0b")
are accepted, too. Please note that octal numbers are not recognized
by new(), so the following will print "123":
- perl -MMath::BigInt -le 'print Math::BigInt->new("0123")'
+ perl -MMath::BigInt -le 'print Math::BigInt->new("0123")'
To convert an octal number, use from_oct();
- perl -MMath::BigInt -le 'print Math::BigInt->from_oct("0123")'
+ perl -MMath::BigInt -le 'print Math::BigInt->from_oct("0123")'
Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('')
results in 'NaN'. This might change in the future, so use always the following
explicit forms to get a zero or NaN:
- $zero = Math::BigInt->bzero();
- $nan = Math::BigInt->bnan();
+ $zero = Math::BigInt->bzero();
+ $nan = Math::BigInt->bnan();
-C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers
-are always stored in normalized form. If passed a string, creates a BigInt
+C<bnorm()> on a BigInt object is now effectively a no-op, since the numbers
+are always stored in normalized form. If passed a string, creates a BigInt
object from the input.
=head2 Output
@@ -3546,50 +3813,50 @@ 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.
- key Description
- Example
+ key Description
+ Example
============================================================
- lib Name of the low-level math library
- Math::BigInt::Calc
+ 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
+ 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
+ downgraded undef
precision Global precision
- undef
+ undef
accuracy Global accuracy
- undef
+ undef
round_mode Global round mode
- even
- version version number of the class you used
- 1.61
+ even
+ version version number of the class you used
+ 1.61
div_scale Fallback accuracy for div
- 40
+ 40
trap_nan If true, traps creation of NaN via croak()
- 1
+ 1
trap_inf If true, traps creation of +inf/-inf via croak()
- 1
+ 1
The following values can be set by passing C<config()> a reference to a hash:
- trap_inf trap_nan
+ trap_inf trap_nan
upgrade downgrade precision accuracy round_mode div_scale
Example:
- $new_cfg = Math::BigInt->config(
- { trap_inf => 1, precision => 5 }
- );
+ $new_cfg = Math::BigInt->config(
+ { trap_inf => 1, precision => 5 }
+ );
=item accuracy()
- $x->accuracy(5); # local for $x
- CLASS->accuracy(5); # global for all members of CLASS
- # Note: This also applies to new()!
+ $x->accuracy(5); # local for $x
+ CLASS->accuracy(5); # global for all members of CLASS
+ # Note: This also applies to new()!
$A = $x->accuracy(); # read out accuracy that affects $x
$A = CLASS->accuracy(); # read out global accuracy
@@ -3607,8 +3874,8 @@ to the math operation as additional parameter:
my $x = Math::BigInt->new(30000);
my $y = Math::BigInt->new(7);
- print scalar $x->copy()->bdiv($y, 2); # print 4300
- print scalar $x->copy()->bdiv($y)->bround(2); # print 4300
+ print scalar $x->copy()->bdiv($y, 2); # print 4300
+ print scalar $x->copy()->bdiv($y)->bround(2); # print 4300
Please see the section about L</ACCURACY and PRECISION> for further details.
@@ -3621,17 +3888,17 @@ Returns the current accuracy. For C<< $x->accuracy() >> it will return either
the local accuracy, or if not defined, the global. This means the return value
represents the accuracy that will be in effect for $x:
- $y = Math::BigInt->new(1234567); # unrounded
+ $y = Math::BigInt->new(1234567); # unrounded
print Math::BigInt->accuracy(4),"\n"; # set 4, print 4
- $x = Math::BigInt->new(123456); # $x will be automatic-
- # ally rounded!
- print "$x $y\n"; # '123500 1234567'
- print $x->accuracy(),"\n"; # will be 4
- print $y->accuracy(),"\n"; # also 4, since
- # global is 4
+ $x = Math::BigInt->new(123456); # $x will be automatic-
+ # ally rounded!
+ print "$x $y\n"; # '123500 1234567'
+ print $x->accuracy(),"\n"; # will be 4
+ print $y->accuracy(),"\n"; # also 4, since
+ # global is 4
print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5
- print $x->accuracy(),"\n"; # still 4
- print $y->accuracy(),"\n"; # 5, since global is 5
+ print $x->accuracy(),"\n"; # still 4
+ print $y->accuracy(),"\n"; # 5, since global is 5
Note: Works also for subclasses like Math::BigFloat. Each class has it's own
globals separated from Math::BigInt, but it is possible to subclass
@@ -3675,10 +3942,10 @@ Returns the current precision. For C<< $x->precision() >> it will return either
the local precision of $x, or if not defined, the global. This means the return
value represents the prevision that will be in effect for $x:
- $y = Math::BigInt->new(1234567); # unrounded
+ $y = Math::BigInt->new(1234567); # unrounded
print Math::BigInt->precision(4),"\n"; # set 4, print 4
$x = Math::BigInt->new(123456); # will be automatically rounded
- print $x; # print "120000"!
+ print $x; # print "120000"!
Note: Works also for subclasses like L<Math::BigFloat>. Each class has its
own globals separated from Math::BigInt, but it is possible to subclass
@@ -3697,9 +3964,9 @@ result:
$x = Math::BigInt->new(10);
- $x->brsft(1); # same as $x >> 1: 5
+ $x->brsft(1); # same as $x >> 1: 5
$x = Math::BigInt->new(1234);
- $x->brsft(2,10); # result 12
+ $x->brsft(2,10); # result 12
There is one exception, and that is base 2 with negative $x:
@@ -3782,17 +4049,17 @@ Creates a new BigInt object representing one. The optional argument is
either '-' or '+', indicating whether you want one or minus one.
If used on an object, it will set it to one:
- $x->bone(); # +1
- $x->bone('-'); # -1
+ $x->bone(); # +1
+ $x->bone('-'); # -1
=item is_one()/is_zero()/is_nan()/is_inf()
- $x->is_zero(); # true if arg is +0
- $x->is_nan(); # true if arg is NaN
- $x->is_one(); # true if arg is +1
- $x->is_one('-'); # true if arg is -1
- $x->is_inf(); # true if +inf
- $x->is_inf('-'); # true if -inf (sign is default '+')
+ $x->is_zero(); # true if arg is +0
+ $x->is_nan(); # true if arg is NaN
+ $x->is_one(); # true if arg is +1
+ $x->is_one('-'); # true if arg is -1
+ $x->is_inf(); # true if +inf
+ $x->is_inf('-'); # true if -inf (sign is default '+')
These methods all test the BigInt for being one specific value and return
true or false depending on the input. These are faster than doing something
@@ -3802,8 +4069,8 @@ like:
=item is_pos()/is_neg()/is_positive()/is_negative()
- $x->is_pos(); # true if > 0
- $x->is_neg(); # true if < 0
+ $x->is_pos(); # true if > 0
+ $x->is_neg(); # true if < 0
The methods return true if the argument is positive or negative, respectively.
C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
@@ -3818,9 +4085,9 @@ in v1.68.
=item is_odd()/is_even()/is_int()
- $x->is_odd(); # true if odd, false for even
- $x->is_even(); # true if even, false for odd
- $x->is_int(); # true if $x is an integer
+ $x->is_odd(); # true if odd, false for even
+ $x->is_even(); # true if even, false for odd
+ $x->is_int(); # true if $x is an integer
The return true when the argument satisfies the condition. C<NaN>, C<+inf>,
C<-inf> are not integers and are neither odd nor even.
@@ -3848,15 +4115,15 @@ Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN.
If you want $x to have a certain sign, use one of the following methods:
- $x->babs(); # '+'
- $x->babs()->bneg(); # '-'
- $x->bnan(); # 'NaN'
- $x->binf(); # '+inf'
- $x->binf('-'); # '-inf'
+ $x->babs(); # '+'
+ $x->babs()->bneg(); # '-'
+ $x->bnan(); # 'NaN'
+ $x->binf(); # '+inf'
+ $x->binf('-'); # '-inf'
=item digit()
- $x->digit($n); # return the nth digit, counting from right
+ $x->digit($n); # return the nth digit, counting from right
If C<$n> is negative, returns the digit counting from left.
@@ -3884,7 +4151,7 @@ number is negative, zero, or positive, respectively. Does not modify NaNs.
=item bnorm()
- $x->bnorm(); # normalize (no-op)
+ $x->bnorm(); # normalize (no-op)
=item bnot()
@@ -3898,23 +4165,23 @@ but faster.
=item binc()
- $x->binc(); # increment x by 1
+ $x->binc(); # increment x by 1
=item bdec()
- $x->bdec(); # decrement x by 1
+ $x->bdec(); # decrement x by 1
=item badd()
- $x->badd($y); # addition (add $y to $x)
+ $x->badd($y); # addition (add $y to $x)
=item bsub()
- $x->bsub($y); # subtraction (subtract $y from $x)
+ $x->bsub($y); # subtraction (subtract $y from $x)
=item bmul()
- $x->bmul($y); # multiplication (multiply $x by $y)
+ $x->bmul($y); # multiplication (multiply $x by $y)
=item bmuladd()
@@ -3926,16 +4193,24 @@ This method was added in v1.87 of Math::BigInt (June 2007).
=item bdiv()
- $x->bdiv($y); # divide, set $x to quotient
- # return (quo,rem) or quo if scalar
+ $x->bdiv($y); # divide, set $x to quotient
+
+Returns $x divided by $y. In list context, does floored division (F-division),
+where the quotient is the greatest integer less than or equal to the quotient
+of the two operands. Consequently, the remainder is either zero or has the same
+sign as the second operand. In scalar context, only the quotient is returned.
=item bmod()
- $x->bmod($y); # modulus (x % y)
+ $x->bmod($y); # modulus (x % y)
+
+Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the
+result is identical to the remainder after floored division (F-division), i.e.,
+identical to the result from Perl's % operator.
=item bmodinv()
- $x->bmodinv($mod); # modular multiplicative inverse
+ $x->bmodinv($mod); # modular multiplicative inverse
Returns the multiplicative inverse of C<$x> modulo C<$mod>. If
@@ -3952,8 +4227,8 @@ inverse exists.
=item bmodpow()
- $num->bmodpow($exp,$mod); # modular exponentiation
- # ($num**$exp % $mod)
+ $num->bmodpow($exp,$mod); # modular exponentiation
+ # ($num**$exp % $mod)
Returns the value of C<$num> taken to the power C<$exp> in the modulus
C<$mod> using binary exponentiation. C<bmodpow> is far superior to
@@ -3974,7 +4249,7 @@ is exactly equivalent to
=item bpow()
- $x->bpow($y); # power of arguments (x ** y)
+ $x->bpow($y); # power of arguments (x ** y)
=item blog()
@@ -3986,7 +4261,7 @@ If C<$base> is not defined, Euler's number (e) is used:
=item bexp()
- $x->bexp($accuracy); # calculate e ** X
+ $x->bexp($accuracy); # calculate e ** X
Calculates the expression C<e ** $x> where C<e> is Euler's number.
@@ -3996,20 +4271,20 @@ See also L</blog()>.
=item bnok()
- $x->bnok($y); # x over y (binomial coefficient n over k)
+ $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:
- ( n ) n!
- | - | = -------
- ( k ) k!(n-k)!
+ ( n ) n!
+ | - | = -------
+ ( k ) k!(n-k)!
This method was added in v1.84 of Math::BigInt (April 2007).
=item bpi()
- print Math::BigInt->bpi(100), "\n"; # 3
+ print Math::BigInt->bpi(100), "\n"; # 3
Returns PI truncated to an integer, with the argument being ignored. This means
under BigInt this always returns C<3>.
@@ -4019,8 +4294,8 @@ current rounding mode:
use Math::BigFloat;
use Math::BigInt upgrade => Math::BigFloat;
- print Math::BigInt->bpi(3), "\n"; # 3.14
- print Math::BigInt->bpi(100), "\n"; # 3.1415....
+ print Math::BigInt->bpi(3), "\n"; # 3.14
+ print Math::BigInt->bpi(100), "\n"; # 3.1415....
This method was added in v1.87 of Math::BigInt (June 2007).
@@ -4075,33 +4350,33 @@ This method was added in v1.87 of Math::BigInt (June 2007).
=item blsft()
- $x->blsft($y); # left shift in base 2
- $x->blsft($y,$n); # left shift, in base $n (like 10)
+ $x->blsft($y); # left shift in base 2
+ $x->blsft($y,$n); # left shift, in base $n (like 10)
=item brsft()
- $x->brsft($y); # right shift in base 2
- $x->brsft($y,$n); # right shift, in base $n (like 10)
+ $x->brsft($y); # right shift in base 2
+ $x->brsft($y,$n); # right shift, in base $n (like 10)
=item band()
- $x->band($y); # bitwise and
+ $x->band($y); # bitwise and
=item bior()
- $x->bior($y); # bitwise inclusive or
+ $x->bior($y); # bitwise inclusive or
=item bxor()
- $x->bxor($y); # bitwise exclusive or
+ $x->bxor($y); # bitwise exclusive or
=item bnot()
- $x->bnot(); # bitwise not (two's complement)
+ $x->bnot(); # bitwise not (two's complement)
=item bsqrt()
- $x->bsqrt(); # calculate square-root
+ $x->bsqrt(); # calculate square-root
=item broot()
@@ -4111,7 +4386,7 @@ Calculates the N'th root of C<$x>.
=item bfac()
- $x->bfac(); # factorial of $x (1*2*3*4*..$x)
+ $x->bfac(); # factorial of $x (1*2*3*4*..$x)
=item round()
@@ -4134,12 +4409,12 @@ is a no-op for them.
Examples:
- Input N Result
- ===================================================
- 123456.123456 3 123500
- 123456.123456 2 123450
- 123456.123456 -2 123456.12
- 123456.123456 -3 123456.123
+ Input N Result
+ ===================================================
+ 123456.123456 3 123500
+ 123456.123456 2 123450
+ 123456.123456 -2 123456.12
+ 123456.123456 -3 123456.123
=item bfloor()
@@ -4166,11 +4441,11 @@ if $x is not an integer.
=item bgcd()
- bgcd(@values); # greatest common divisor (no OO style)
+ bgcd(@values); # greatest common divisor (no OO style)
=item blcm()
- blcm(@values); # lowest common multiple (no OO style)
+ blcm(@values); # lowest common multiple (no OO style)
=item length()
@@ -4195,21 +4470,35 @@ Return the signed mantissa of $x as BigInt.
=item parts()
- $x->parts(); # return (mantissa,exponent) as BigInt
+ $x->parts(); # return (mantissa,exponent) as BigInt
=item copy()
- $x->copy(); # make a true copy of $x (unlike $y = $x;)
+ $x->copy(); # make a true copy of $x (unlike $y = $x;)
+
+=item as_int()
+
+=item as_number()
-=item as_int()/as_number()
+These methods are called when Math::BigInt encounters an object it doesn't know
+how to handle. For instance, assume $x is a Math::BigInt, or subclass thereof,
+and $y is defined, but not a Math::BigInt, or subclass thereof. If you do
- $x->as_int();
+ $x -> badd($y);
-Returns $x as a BigInt (truncated towards zero). In BigInt this is the same as
-C<copy()>.
+$y needs to be converted into an object that $x can deal with. This is done by
+first checking if $y is something that $x might be upgraded to. If that is the
+case, no further attempts are made. The next is to see if $y supports the
+method C<as_int()>. If it does, C<as_int()> is called, but if it doesn't, the
+next thing is to see if $y supports the method C<as_number()>. If it does,
+C<as_number()> is called. The method C<as_int()> (and C<as_number()>) is
+expected to return either an object that has the same class as $x, a subclass
+thereof, or a string that C<ref($x)-E<gt>new()> can parse to create an object.
-C<as_number()> is an alias to this method. C<as_number> was introduced in
-v1.22, while C<as_int()> was only introduced in v1.68.
+C<as_number()> is an alias to C<as_int()>. C<as_number> was introduced in
+v1.22, while C<as_int()> was introduced in v1.68.
+
+In Math::BigInt, C<as_int()> has the same effect as C<copy()>.
=item bstr()
@@ -4235,12 +4524,12 @@ Returns a normalized string representation of C<$x>.
=item numify()
- print $x->numify();
+ print $x->numify();
This returns a normal Perl scalar from $x. It is used automatically
whenever a scalar is needed, for instance in array index operations.
-This loses precision, to avoid this use L<as_int()|/"as_int()/as_number()"> instead.
+This loses precision, to avoid this use L</as_int()> instead.
=item modify()
@@ -4257,10 +4546,10 @@ Set/get the class for downgrade/upgrade operations. Thuis is used
for instance by L<bignum>. The defaults are '', thus the following
operation will create a BigInt, not a BigFloat:
- my $i = Math::BigInt->new(123);
- my $f = Math::BigFloat->new('123.1');
+ my $i = Math::BigInt->new(123);
+ my $f = Math::BigFloat->new('123.1');
- print $i + $f,"\n"; # print 246
+ print $i + $f,"\n"; # print 246
=item div_scale()
@@ -4305,15 +4594,15 @@ are zero.
The string output (of floating point numbers) will be padded with zeros:
- Initial value P A Result String
- ------------------------------------------------------------
- 1234.01 -3 1000 1000
- 1234 -2 1200 1200
- 1234.5 -1 1230 1230
- 1234.001 1 1234 1234.0
- 1234.01 0 1234 1234
- 1234.01 2 1234.01 1234.01
- 1234.01 5 1234.01 1234.01000
+ Initial value P A Result String
+ ------------------------------------------------------------
+ 1234.01 -3 1000 1000
+ 1234 -2 1200 1200
+ 1234.5 -1 1230 1230
+ 1234.001 1 1234 1234.0
+ 1234.01 0 1234 1234
+ 1234.01 2 1234.01 1234.01
+ 1234.01 5 1234.01 1234.01000
For BigInts, no padding occurs.
@@ -4326,11 +4615,11 @@ A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
The string output (of floating point numbers) will be padded with zeros:
- Initial value P A Result String
- ------------------------------------------------------------
- 1234.01 3 1230 1230
- 1234.01 6 1234.01 1234.01
- 1234.1 8 1234.1 1234.1000
+ Initial value P A Result String
+ ------------------------------------------------------------
+ 1234.01 3 1230 1230
+ 1234.01 6 1234.01 1234.01
+ 1234.1 8 1234.1 1234.1000
For BigInts, no padding occurs.
@@ -4414,21 +4703,21 @@ versions <= 5.7.2) is like this:
=item Precision
- * ffround($p) is able to round to $p number of digits after the decimal
+ * bfround($p) is able to round to $p number of digits after the decimal
point
* otherwise P is unused
=item Accuracy (significant digits)
- * fround($a) rounds to $a significant digits
- * only fdiv() and fsqrt() take A as (optional) parameter
- + other operations simply create the same number (fneg etc), or
- more (fmul) of digits
+ * bround($a) rounds to $a significant digits
+ * only bdiv() and bsqrt() take A as (optional) parameter
+ + other operations simply create the same number (bneg etc), or
+ more (bmul) of digits
+ rounding/truncating is only done when explicitly calling one
- of fround or ffround, and never for BigInt (not implemented)
- * fsqrt() simply hands its accuracy argument over to fdiv.
+ of bround or bfround, and never for BigInt (not implemented)
+ * bsqrt() simply hands its accuracy argument over to bdiv.
* the documentation and the comment in the code indicate two
- different ways on how fdiv() determines the maximum number
+ different ways on how bdiv() determines the maximum number
of digits it should calculate, and the actual code does yet
another thing
POD:
@@ -4497,12 +4786,12 @@ This is how it works now:
globals enforced upon creation of a number by using
$x = Math::BigInt->new($number,undef,undef):
- use Math::BigInt::SomeSubclass;
- use Math::BigInt;
+ use Math::BigInt::SomeSubclass;
+ use Math::BigInt;
- Math::BigInt->accuracy(2);
- Math::BigInt::SomeSubClass->accuracy(3);
- $x = Math::BigInt::SomeSubClass->new(1234);
+ Math::BigInt->accuracy(2);
+ Math::BigInt::SomeSubClass->accuracy(3);
+ $x = Math::BigInt::SomeSubClass->new(1234);
$x is now 1230, and not 1200. A subclass might choose to implement
this otherwise, e.g. falling back to the parent's A and P.
@@ -4526,22 +4815,22 @@ This is how it works now:
effect, and the other P, this results in an error (NaN).
* A takes precedence over P (Hint: A comes before P).
If neither of them is defined, nothing is used, i.e. the result will have
- as many digits as it can (with an exception for fdiv/fsqrt) and will not
+ as many digits as it can (with an exception for bdiv/bsqrt) and will not
be rounded.
- * There is another setting for fdiv() (and thus for fsqrt()). If neither of
- A or P is defined, fdiv() will use a fallback (F) of $div_scale digits.
+ * There is another setting for bdiv() (and thus for bsqrt()). If neither of
+ A or P is defined, bdiv() will use a fallback (F) of $div_scale digits.
If either the dividend's or the divisor's mantissa has more digits than
the value of F, the higher value will be used instead of F.
This is to limit the digits (A) of the result (just consider what would
happen with unlimited A and P in the case of 1/3 :-)
- * fdiv will calculate (at least) 4 more digits than required (determined by
+ * bdiv will calculate (at least) 4 more digits than required (determined by
A, P or F), and, if F is not used, round the result
(this will still fail in the case of a result like 0.12345000000001 with A
or P of 5, but this can not be helped - or can it?)
* Thus you can have the math done by on Math::Big* class in two modi:
+ never round (this is the default):
This is done by setting A and P to undef. No math operation
- will round the result, with fdiv() and fsqrt() as exceptions to guard
+ will round the result, with bdiv() and bsqrt() as exceptions to guard
against overflows. You must explicitly call bround(), bfround() or
round() (the latter with parameters).
Note: Once you have rounded a number, the settings will 'stick' on it
@@ -4552,7 +4841,7 @@ This is how it works now:
$x = Math::BigFloat->new(12.34);
$y = Math::BigFloat->new(98.76);
$z = $x * $y; # 1218.6984
- print $x->copy()->fround(3); # 12.3 (but A is now 3!)
+ print $x->copy()->bround(3); # 12.3 (but A is now 3!)
$z = $x * $y; # still 1218.6984, without
# copy would have been 1210!
@@ -4582,7 +4871,7 @@ This is how it works now:
+ global A
+ global P
+ global F
- * fsqrt() will hand its arguments to fdiv(), as it used to, only now for two
+ * bsqrt() will hand its arguments to bdiv(), as it used to, only now for two
arguments (A and P) instead of one
=item Local settings
@@ -4596,8 +4885,7 @@ This is how it works now:
=item Rounding
* the rounding routines will use the respective global or local settings.
- fround()/bround() is for accuracy rounding, while ffround()/bfround()
- is for precision
+ bround() is for accuracy rounding, while bfround() is for precision
* the two rounding functions take as the second parameter one of the
following rounding modes (R):
'even', 'odd', '+inf', '-inf', 'zero', 'trunc', 'common'
@@ -4628,7 +4916,7 @@ This is how it works now:
=item Remarks
* The defaults are set up so that the new code gives the same results as
- the old code (except in a few cases on fdiv):
+ the old code (except in a few cases on bdiv):
+ Both A and P are undefined and thus will not be used for rounding
after each operation.
+ round() is thus a no-op, unless given extra parameters A and P
@@ -4646,15 +4934,15 @@ While BigInt has extensive handling of inf and NaN, certain quirks remain.
These perl routines currently (as of Perl v.5.8.6) cannot handle passed
inf.
- te@linux:~> perl -wle 'print 2 ** 3333'
- inf
- te@linux:~> perl -wle 'print 2 ** 3333 == 2 ** 3333'
- 1
- te@linux:~> perl -wle 'print oct(2 ** 3333)'
- 0
- te@linux:~> perl -wle 'print hex(2 ** 3333)'
- Illegal hexadecimal digit 'i' ignored at -e line 1.
- 0
+ te@linux:~> perl -wle 'print 2 ** 3333'
+ Inf
+ te@linux:~> perl -wle 'print 2 ** 3333 == 2 ** 3333'
+ 1
+ te@linux:~> perl -wle 'print oct(2 ** 3333)'
+ 0
+ te@linux:~> perl -wle 'print hex(2 ** 3333)'
+ Illegal hexadecimal digit 'I' ignored at -e line 1.
+ 0
The same problems occur if you pass them Math::BigInt->binf() objects. Since
overloading these routines is not possible, this cannot be fixed from BigInt.
@@ -4693,11 +4981,11 @@ instead relying on the internal representation.
Math with the numbers is done (by default) by a module called
C<Math::BigInt::Calc>. This is equivalent to saying:
- use Math::BigInt try => 'Calc';
+ use Math::BigInt try => 'Calc';
You can change this backend library by using:
- use Math::BigInt try => 'GMP';
+ use Math::BigInt try => 'GMP';
B<Note>: General purpose packages should not be explicit about the library
to use; let the script author decide which is best.
@@ -4706,12 +4994,12 @@ If your script works with huge numbers and Calc is too slow for them,
you can also for the loading of one of these libraries and if none
of them can be used, the code will die:
- use Math::BigInt only => 'GMP,Pari';
+ use Math::BigInt only => 'GMP,Pari';
The following would first try to find Math::BigInt::Foo, then
Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
- use Math::BigInt try => 'Foo,Math::BigInt::Bar';
+ use Math::BigInt try => 'Foo,Math::BigInt::Bar';
The library that is loaded last will be used. Note that this can be
overwritten at any time by loading a different library, and numbers
@@ -4774,21 +5062,21 @@ change.
sub bigint { Math::BigInt->new(shift); }
- $x = Math::BigInt->bstr("1234") # string "1234"
- $x = "$x"; # same as bstr()
- $x = Math::BigInt->bneg("1234"); # BigInt "-1234"
- $x = Math::BigInt->babs("-12345"); # BigInt "12345"
- $x = Math::BigInt->bnorm("-0.00"); # BigInt "0"
+ $x = Math::BigInt->bstr("1234") # string "1234"
+ $x = "$x"; # same as bstr()
+ $x = Math::BigInt->bneg("1234"); # BigInt "-1234"
+ $x = Math::BigInt->babs("-12345"); # BigInt "12345"
+ $x = Math::BigInt->bnorm("-0.00"); # BigInt "0"
$x = bigint(1) + bigint(2); # BigInt "3"
$x = bigint(1) + "2"; # ditto (auto-BigIntify of "2")
$x = bigint(1); # BigInt "1"
- $x = $x + 5 / 2; # BigInt "3"
- $x = $x ** 3; # BigInt "27"
- $x *= 2; # BigInt "54"
- $x = Math::BigInt->new(0); # BigInt "0"
- $x--; # BigInt "-1"
- $x = Math::BigInt->badd(4,5) # BigInt "9"
- print $x->bsstr(); # 9e+0
+ $x = $x + 5 / 2; # BigInt "3"
+ $x = $x ** 3; # BigInt "27"
+ $x *= 2; # BigInt "54"
+ $x = Math::BigInt->new(0); # BigInt "0"
+ $x--; # BigInt "-1"
+ $x = Math::BigInt->badd(4,5) # BigInt "9"
+ print $x->bsstr(); # 9e+0
Examples for rounding:
@@ -4797,22 +5085,22 @@ Examples for rounding:
$x = Math::BigFloat->new(123.4567);
$y = Math::BigFloat->new(123.456789);
- Math::BigFloat->accuracy(4); # no more A than 4
-
- is ($x->copy()->fround(),123.4); # even rounding
- print $x->copy()->fround(),"\n"; # 123.4
- Math::BigFloat->round_mode('odd'); # round to odd
- print $x->copy()->fround(),"\n"; # 123.5
- Math::BigFloat->accuracy(5); # no more A than 5
- Math::BigFloat->round_mode('odd'); # round to odd
- print $x->copy()->fround(),"\n"; # 123.46
- $y = $x->copy()->fround(4),"\n"; # A = 4: 123.4
- print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
-
- Math::BigFloat->accuracy(undef); # A not important now
- Math::BigFloat->precision(2); # P important
- print $x->copy()->bnorm(),"\n"; # 123.46
- print $x->copy()->fround(),"\n"; # 123.46
+ Math::BigFloat->accuracy(4); # no more A than 4
+
+ is ($x->copy()->bround(),123.4); # even rounding
+ print $x->copy()->bround(),"\n"; # 123.4
+ Math::BigFloat->round_mode('odd'); # round to odd
+ print $x->copy()->bround(),"\n"; # 123.5
+ Math::BigFloat->accuracy(5); # no more A than 5
+ Math::BigFloat->round_mode('odd'); # round to odd
+ print $x->copy()->bround(),"\n"; # 123.46
+ $y = $x->copy()->bround(4),"\n"; # A = 4: 123.4
+ print "$y, ",$y->accuracy(),"\n"; # 123.4, 4
+
+ Math::BigFloat->accuracy(undef); # A not important now
+ Math::BigFloat->precision(2); # P important
+ print $x->copy()->bnorm(),"\n"; # 123.46
+ print $x->copy()->bround(),"\n"; # 123.46
Examples for converting:
@@ -4823,31 +5111,31 @@ Examples for converting:
After C<use Math::BigInt ':constant'> all the B<integer> decimal, hexadecimal
and binary constants in the given scope are converted to C<Math::BigInt>.
-This conversion happens at compile time.
+This conversion happens at compile time.
In particular,
perl -MMath::BigInt=:constant -e 'print 2**100,"\n"'
-prints the integer value of C<2**100>. Note that without conversion of
+prints the integer value of C<2**100>. Note that without conversion of
constants the expression 2**100 will be calculated as perl scalar.
Please note that strings and floating point constants are not affected,
so that
- use Math::BigInt qw/:constant/;
+ use Math::BigInt qw/:constant/;
- $x = 1234567890123456789012345678901234567890
- + 123456789123456789;
- $y = '1234567890123456789012345678901234567890'
- + '123456789123456789';
+ $x = 1234567890123456789012345678901234567890
+ + 123456789123456789;
+ $y = '1234567890123456789012345678901234567890'
+ + '123456789123456789';
do not work. You need an explicit Math::BigInt->new() around one of the
operands. You should also quote large constants to protect loss of precision:
- use Math::BigInt;
+ use Math::BigInt;
- $x = Math::BigInt->new('1234567889123456789123456789123456789');
+ $x = Math::BigInt->new('1234567889123456789123456789123456789');
Without the quotes Perl would convert the large number to a floating point
constant at compile time and then hand the result to BigInt, which results in
@@ -4855,10 +5143,10 @@ an truncated result or a NaN.
This also applies to integers that look like floating point constants:
- use Math::BigInt ':constant';
+ use Math::BigInt ':constant';
- print ref(123e2),"\n";
- print ref(123.2e2),"\n";
+ print ref(123e2),"\n";
+ print ref(123.2e2),"\n";
will print nothing but newlines. Use either L<bignum> or L<Math::BigFloat>
to get this to work.
@@ -4890,7 +5178,7 @@ C<babs()> etc), instead of O(N) and thus nearly always take much less time.
These optimizations were done on purpose.
If you find the Calc module to slow, try to install any of the replacement
-modules and see if they help you.
+modules and see if they help you.
=head2 Alternative math libraries
@@ -4931,7 +5219,7 @@ to support different storage methods.
More complex sub-classes may have to replicate more of the logic internal of
Math::BigInt if they need to change more basic behaviors. A subclass that
-needs to merely change the output only needs to overload C<bstr()>.
+needs to merely change the output only needs to overload C<bstr()>.
All other object methods and overloaded functions can be directly inherited
from the parent class.
@@ -4952,13 +5240,13 @@ auto-upgrading and auto-downgrading to work correctly:
$upgrade = undef;
$downgrade = undef;
-This allows Math::BigInt to correctly retrieve package globals from the
+This allows Math::BigInt to correctly retrieve package globals from the
subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or
t/Math/BigFloat/SubClass.pm completely functional subclass examples.
-Don't forget to
+Don't forget to
- use overload;
+ use overload;
in your subclass to automatically inherit the overloading from the parent. If
you like, you can change part of the overloading, look at Math::String for an
@@ -4968,20 +5256,20 @@ example.
When used like this:
- use Math::BigInt upgrade => 'Foo::Bar';
+ use Math::BigInt upgrade => 'Foo::Bar';
certain operations will 'upgrade' their calculation and thus the result to
the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat:
- use Math::BigInt upgrade => 'Math::BigFloat';
+ use Math::BigInt upgrade => 'Math::BigFloat';
As a shortcut, you can use the module L<bignum>:
- use bignum;
+ use bignum;
Also good for one-liners:
- perl -Mbignum -le 'print 2 ** 255'
+ perl -Mbignum -le 'print 2 ** 255'
This makes it possible to mix arguments of different classes (as in 2.5 + 2)
as well es preserve accuracy (as in sqrt(3)).
@@ -5003,20 +5291,27 @@ is in effect, they will always hand up their work:
=item bexp()
-=back
+=item bpi()
+
+=item bcos()
+
+=item bsin()
+
+=item batan2()
+
+=item batan()
-Beware: This list is not complete.
+=back
All other methods upgrade themselves only when one (or all) of their
-arguments are of the class mentioned in $upgrade (This might change in later
-versions to a more sophisticated scheme):
+arguments are of the class mentioned in $upgrade.
=head1 EXPORTS
C<Math::BigInt> exports nothing by default, but can export the following methods:
- bgcd
- blcm
+ bgcd
+ blcm
=head1 CAVEATS
@@ -5036,44 +5331,44 @@ and L<Test::More>, which stringify arguments before comparing them.
Mark Biggar said, when asked about to drop the '+' altogether, or make only
C<cmp> work:
- I agree (with the first alternative), don't add the '+' on positive
- numbers. It's not as important anymore with the new internal
- form for numbers. It made doing things like abs and neg easier,
- but those have to be done differently now anyway.
+ I agree (with the first alternative), don't add the '+' on positive
+ numbers. It's not as important anymore with the new internal
+ form for numbers. It made doing things like abs and neg easier,
+ but those have to be done differently now anyway.
So, the following examples will now work all as expected:
- use Test::More tests => 1;
- use Math::BigInt;
+ use Test::More tests => 1;
+ use Math::BigInt;
- my $x = new Math::BigInt 3*3;
- my $y = new Math::BigInt 3*3;
+ my $x = Math::BigInt -> new(3*3);
+ my $y = Math::BigInt -> new(3*3);
- is ($x,3*3, 'multiplication');
- print "$x eq 9" if $x eq $y;
- print "$x eq 9" if $x eq '9';
- print "$x eq 9" if $x eq 3*3;
+ is ($x,3*3, 'multiplication');
+ print "$x eq 9" if $x eq $y;
+ print "$x eq 9" if $x eq '9';
+ print "$x eq 9" if $x eq 3*3;
Additionally, the following still works:
- print "$x == 9" if $x == $y;
- print "$x == 9" if $x == 9;
- print "$x == 9" if $x == 3*3;
+ print "$x == 9" if $x == $y;
+ print "$x == 9" if $x == 9;
+ print "$x == 9" if $x == 3*3;
There is now a C<bsstr()> method to get the string in scientific notation aka
C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr()
for comparison, but Perl will represent some numbers as 100 and others
-as 1e+308. If in doubt, convert both arguments to Math::BigInt before
+as 1e+308. If in doubt, convert both arguments to Math::BigInt before
comparing them as strings:
- use Test::More tests => 3;
- use Math::BigInt;
+ use Test::More tests => 3;
+ use Math::BigInt;
- $x = Math::BigInt->new('1e56'); $y = 1e56;
- is ($x,$y); # will fail
- is ($x->bsstr(),$y); # okay
- $y = Math::BigInt->new($y);
- is ($x,$y); # okay
+ $x = Math::BigInt->new('1e56'); $y = 1e56;
+ is ($x,$y); # will fail
+ is ($x->bsstr(),$y); # okay
+ $y = Math::BigInt->new($y);
+ is ($x,$y); # okay
Alternatively, simply use C<< <=> >> for comparisons, this will get it
always right. There is not yet a way to get a number automatically represented
@@ -5084,77 +5379,77 @@ comparing NaNs.
=item int()
-C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
+C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
Perl scalar:
- $x = Math::BigInt->new(123);
- $y = int($x); # BigInt 123
- $x = Math::BigFloat->new(123.45);
- $y = int($x); # BigInt 123
+ $x = Math::BigInt->new(123);
+ $y = int($x); # BigInt 123
+ $x = Math::BigFloat->new(123.45);
+ $y = int($x); # BigInt 123
In all Perl versions you can use C<as_number()> or C<as_int> for the same
effect:
- $x = Math::BigFloat->new(123.45);
- $y = $x->as_number(); # BigInt 123
- $y = $x->as_int(); # ditto
+ $x = Math::BigFloat->new(123.45);
+ $y = $x->as_number(); # BigInt 123
+ $y = $x->as_int(); # ditto
This also works for other subclasses, like Math::String.
If you want a real Perl scalar, use C<numify()>:
- $y = $x->numify(); # 123 as scalar
+ $y = $x->numify(); # 123 as scalar
This is seldom necessary, though, because this is done automatically, like
when you access an array:
- $z = $array[$x]; # does work automatically
+ $z = $array[$x]; # does work automatically
=item length()
The following will probably not do what you expect:
- $c = Math::BigInt->new(123);
- print $c->length(),"\n"; # prints 30
+ $c = Math::BigInt->new(123);
+ print $c->length(),"\n"; # prints 30
It prints both the number of digits in the number and in the fraction part
-since print calls C<length()> in list context. Use something like:
+since print calls C<length()> in list context. Use something like:
- print scalar $c->length(),"\n"; # prints 3
+ print scalar $c->length(),"\n"; # prints 3
=item bdiv()
The following will probably not do what you expect:
- print $c->bdiv(10000),"\n";
+ print $c->bdiv(10000),"\n";
It prints both quotient and remainder since print calls C<bdiv()> in list
context. Also, C<bdiv()> will modify $c, so be careful. You probably want
to use
- print $c / 10000,"\n";
+ print $c / 10000,"\n";
or, if you want to modify $c instead,
- print scalar $c->bdiv(10000),"\n";
+ print scalar $c->bdiv(10000),"\n";
The quotient is always the greatest integer less than or equal to the
real-valued quotient of the two operands, and the remainder (when it is
non-zero) always has the same sign as the second operand; so, for
example,
- 1 / 4 => ( 0, 1)
- 1 / -4 => (-1,-3)
- -3 / 4 => (-1, 1)
- -3 / -4 => ( 0,-3)
- -11 / 2 => (-5,1)
- 11 /-2 => (-5,-1)
+ 1 / 4 => ( 0, 1)
+ 1 / -4 => (-1,-3)
+ -3 / 4 => (-1, 1)
+ -3 / -4 => ( 0,-3)
+ -11 / 2 => (-5,1)
+ 11 /-2 => (-5,-1)
As a consequence, the behavior of the operator % agrees with the
behavior of Perl's built-in % operator (as documented in the perlop
manpage), and the equation
- $x == ($x / $y) * $y + ($x % $y)
+ $x == ($x / $y) * $y + ($x % $y)
holds true for any $x and $y, which justifies calling the two return
values of bdiv() the quotient and remainder. The only exception to this rule
@@ -5176,37 +5471,37 @@ The following table shows the result of the division and the remainder, so that
the equation above holds true. Some "ordinary" cases are strewn in to show more
clearly the reasoning:
- A / B = C, R so that C * B + R = A
+ A / B = C, R so that C * B + R = A
=========================================================
- 5 / 8 = 0, 5 0 * 8 + 5 = 5
- 0 / 8 = 0, 0 0 * 8 + 0 = 0
- 0 / inf = 0, 0 0 * inf + 0 = 0
- 0 /-inf = 0, 0 0 * -inf + 0 = 0
- 5 / inf = 0, 5 0 * inf + 5 = 5
- 5 /-inf = 0, 5 0 * -inf + 5 = 5
- -5/ inf = 0, -5 0 * inf + -5 = -5
- -5/-inf = 0, -5 0 * -inf + -5 = -5
- inf/ 5 = inf, 0 inf * 5 + 0 = inf
+ 5 / 8 = 0, 5 0 * 8 + 5 = 5
+ 0 / 8 = 0, 0 0 * 8 + 0 = 0
+ 0 / inf = 0, 0 0 * inf + 0 = 0
+ 0 /-inf = 0, 0 0 * -inf + 0 = 0
+ 5 / inf = 0, 5 0 * inf + 5 = 5
+ 5 /-inf = 0, 5 0 * -inf + 5 = 5
+ -5/ inf = 0, -5 0 * inf + -5 = -5
+ -5/-inf = 0, -5 0 * -inf + -5 = -5
+ inf/ 5 = inf, 0 inf * 5 + 0 = inf
-inf/ 5 = -inf, 0 -inf * 5 + 0 = -inf
- inf/ -5 = -inf, 0 -inf * -5 + 0 = inf
+ inf/ -5 = -inf, 0 -inf * -5 + 0 = inf
-inf/ -5 = inf, 0 inf * -5 + 0 = -inf
- 5/ 5 = 1, 0 1 * 5 + 0 = 5
- -5/ -5 = 1, 0 1 * -5 + 0 = -5
+ 5/ 5 = 1, 0 1 * 5 + 0 = 5
+ -5/ -5 = 1, 0 1 * -5 + 0 = -5
inf/ inf = 1, 0 1 * inf + 0 = inf
-inf/-inf = 1, 0 1 * -inf + 0 = -inf
inf/-inf = -1, 0 -1 * -inf + 0 = inf
-inf/ inf = -1, 0 1 * -inf + 0 = -inf
- 8/ 0 = inf, 8 inf * 0 + 8 = 8
+ 8/ 0 = inf, 8 inf * 0 + 8 = 8
inf/ 0 = inf, inf inf * 0 + inf = inf
0/ 0 = NaN
These cases below violate the "remainder has the sign of the second of the two
arguments", since they wouldn't match up otherwise.
- A / B = C, R so that C * B + R = A
+ A / B = C, R so that C * B + R = A
========================================================
-inf/ 0 = -inf, -inf -inf * 0 + inf = -inf
- -8/ 0 = -inf, -8 -inf * 0 + 8 = -8
+ -8/ 0 = -inf, -8 -inf * 0 + 8 = -8
=item Modifying and =
@@ -5242,10 +5537,10 @@ returns it, unlike the old code which left it alone and only returned the
result. This is to be consistent with C<badd()> etc. The first three will
modify $x, the last one won't:
- print bpow($x,$i),"\n"; # modify $x
- print $x->bpow($i),"\n"; # ditto
- print $x **= $i,"\n"; # the same
- print $x ** $i,"\n"; # leave $x alone
+ print bpow($x,$i),"\n"; # modify $x
+ print $x->bpow($i),"\n"; # ditto
+ print $x **= $i,"\n"; # the same
+ print $x ** $i,"\n"; # leave $x alone
The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
@@ -5253,11 +5548,11 @@ The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though.
The following:
- $x = -$x;
+ $x = -$x;
is slower than
- $x->bneg();
+ $x->bneg();
since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
needs to preserve $x since it does not know that it later will get overwritten.
@@ -5265,56 +5560,47 @@ This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
=item Mixing different object types
-In Perl you will get a floating point value if you do one of the following:
-
- $float = 5.0 + 2;
- $float = 2 + 5.0;
- $float = 5 / 2;
-
-With overloaded math, only the first two variants will result in a BigFloat:
-
- use Math::BigInt;
- use Math::BigFloat;
-
- $mbf = Math::BigFloat->new(5);
- $mbi2 = Math::BigInteger->new(5);
- $mbi = Math::BigInteger->new(2);
+With overloaded operators, it is the first (dominating) operand that determines
+which method is called. Here are some examples showing what actually gets
+called in various cases.
- # what actually gets called:
- $float = $mbf + $mbi; # $mbf->badd()
- $float = $mbf / $mbi; # $mbf->bdiv()
- $integer = $mbi + $mbf; # $mbi->badd()
- $integer = $mbi2 / $mbi; # $mbi2->bdiv()
- $integer = $mbi2 / $mbf; # $mbi2->bdiv()
+ use Math::BigInt;
+ use Math::BigFloat;
-This is because math with overloaded operators follows the first (dominating)
-operand, and the operation of that is called and returns thus the result. So,
-Math::BigInt::bdiv() will always return a Math::BigInt, regardless whether
-the result should be a Math::BigFloat or the second operant is one.
+ $mbf = Math::BigFloat->new(5);
+ $mbi2 = Math::BigInt->new(5);
+ $mbi = Math::BigInt->new(2);
+ # what actually gets called:
+ $float = $mbf + $mbi; # $mbf->badd($mbi)
+ $float = $mbf / $mbi; # $mbf->bdiv($mbi)
+ $integer = $mbi + $mbf; # $mbi->badd($mbf)
+ $integer = $mbi2 / $mbi; # $mbi2->bdiv($mbi)
+ $integer = $mbi2 / $mbf; # $mbi2->bdiv($mbf)
-To get a Math::BigFloat you either need to call the operation manually,
-make sure the operands are already of the proper type or casted to that type
-via Math::BigFloat->new():
+For instance, Math::BigInt->bdiv() will always return a Math::BigInt, regardless of
+whether the second operant is a Math::BigFloat. To get a Math::BigFloat you
+either need to call the operation manually, make sure each operand already is a
+Math::BigFloat, or cast to that type via Math::BigFloat->new():
- $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5
+ $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5
-Beware of simple "casting" the entire expression, this would only convert
-the already computed result:
+Beware of casting the entire expression, as this would cast the
+result, at which point it is too late:
- $float = Math::BigFloat->new($mbi2 / $mbi); # = 2.0 thus wrong!
+ $float = Math::BigFloat->new($mbi2 / $mbi); # = 2
Beware also of the order of more complicated expressions like:
- $integer = ($mbi2 + $mbi) / $mbf; # int / float => int
- $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto
+ $integer = ($mbi2 + $mbi) / $mbf; # int / float => int
+ $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto
If in doubt, break the expression into simpler terms, or cast all operands
to the desired resulting type.
Scalar values are a bit different, since:
- $float = 2 + $mbf;
- $float = $mbf + 2;
+ $float = 2 + $mbf;
+ $float = $mbf + 2;
will both result in the proper type due to the way the overloaded math works.
@@ -5331,14 +5617,14 @@ mode. The reason is that the result is always truncated to an integer.
If you want a better approximation of the square root, then use:
- $x = Math::BigFloat->new(12);
- Math::BigFloat->precision(0);
- Math::BigFloat->round_mode('even');
- print $x->copy->bsqrt(),"\n"; # 4
+ $x = Math::BigFloat->new(12);
+ Math::BigFloat->precision(0);
+ Math::BigFloat->round_mode('even');
+ print $x->copy->bsqrt(),"\n"; # 4
- Math::BigFloat->precision(2);
- print $x->bsqrt(),"\n"; # 3.46
- print $x->bsqrt(3),"\n"; # 3.464
+ Math::BigFloat->precision(2);
+ print $x->bsqrt(),"\n"; # 3.46
+ print $x->bsqrt(3),"\n"; # 3.464
=item brsft()
@@ -5420,9 +5706,25 @@ because they solve the autoupgrading/downgrading issue, at least partly.
=head1 AUTHORS
-Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
-Completely rewritten by Tels http://bloodgate.com in late 2000, 2001 - 2006
-and still at it in 2007.
+=over 4
+
+=item *
+
+Mark Biggar, overloaded interface by Ilya Zakharevich, 1996-2001.
+
+=item *
+
+Completely rewritten by Tels L<http://bloodgate.com>, 2001-2008.
+
+=item *
+
+Florian Ragwitz E<lt>flora@cpan.orgE<gt>, 2010.
+
+=item *
+
+Peter John Acklam E<lt>pjacklam@online.noE<gt>, 2011-.
+
+=back
Many people contributed in one or more ways to the final beast, see the file
CREDITS for an (incomplete) list. If you miss your name, please drop me a