# _a : accuracy
# _p : precision
-$VERSION = '1.44';
+$VERSION = '1.47';
require 5.005;
require Exporter;
@ISA = qw(Exporter Math::BigInt);
use strict;
-# $_trap_inf and $_trap_nan are internal and should never be accessed from the outside
+# $_trap_inf/$_trap_nan are internal and should never be accessed from outside
use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode
$upgrade $downgrade $_trap_nan $_trap_inf/;
my $class = "Math::BigFloat";
my $LOG_2 =
'0.6931471805599453094172321214581765680755001343602552541206800094933936220';
my $LOG_2_A = length($LOG_2)-1;
+my $HALF = '0.5'; # made into an object if necc.
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
$self->{sign} = $wanted->sign();
return $self->bnorm();
}
- # got string
+ # else: got a string
+
# handle '+inf', '-inf' first
if ($wanted =~ /^[+-]?inf$/)
{
return $self->bnorm();
}
+ # shortcut for simple forms like '12' that neither have trailing nor leading
+ # zeros
+ if ($wanted =~ /^([+-]?)([1-9][0-9]*[1-9])$/)
+ {
+ $self->{_e} = $MBI->_zero();
+ $self->{_es} = '+';
+ $self->{sign} = $1 || '+';
+ $self->{_m} = $MBI->_new($2);
+ return $self->round(@r) if !$downgrade;
+ }
+
my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($wanted);
if (!ref $mis)
{
($self->{_e}, $self->{_es}) =
_e_sub ($self->{_e}, $len, $self->{_es}, '+');
}
- $self->{sign} = $$mis;
-
- # we can only have trailing zeros on the mantissa of $$mfv eq ''
- if (CORE::length($$mfv) == 0)
+ # we can only have trailing zeros on the mantissa if $$mfv eq ''
+ else
{
- my $zeros = $MBI->_zeros($self->{_m}); # correct for trailing zeros
+ # Use a regexp to count the trailing zeros in $$miv instead of _zeros()
+ # because that is faster, especially when _m is not stored in base 10.
+ my $zeros = 0; $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/;
if ($zeros != 0)
{
my $z = $MBI->_new($zeros);
+ # turn '120e2' into '12e3'
$MBI->_rsft ( $self->{_m}, $z, 10);
_e_add ( $self->{_e}, $z, $self->{_es}, '+');
}
}
+ $self->{sign} = $$mis;
+
# for something like 0Ey, set y to 1, and -0 => +0
+ # Check $$miv for beeing '0' and $$mfv eq '', because otherwise _m could not
+ # have become 0. That's faster than to call $MBI->_is_zero().
$self->{sign} = '+', $self->{_e} = $MBI->_one()
- if $MBI->_is_zero($self->{_m});
+ if $$miv eq '0' and $$mfv eq '';
+
return $self->round(@r) if !$downgrade;
}
# if downgrade, inf, NaN or integers go down
$x->bnorm()->round($a,$p,$r,$y);
}
-sub bsub
- {
- # (BigFloat or num_str, BigFloat or num_str) return BigFloat
- # subtract second arg from first, modify first
-
- # set up parameters
- my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
- # objectify is costly, so avoid it
- if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
- {
- ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
- }
-
- if ($y->is_zero()) # still round for not adding zero
- {
- return $x->round($a,$p,$r);
- }
-
- # $x - $y = -$x + $y
- $y->{sign} =~ tr/+-/-+/; # does nothing for NaN
- $x->badd($y,$a,$p,$r); # badd does not leave internal zeros
- $y->{sign} =~ tr/+-/-+/; # refix $y (does nothing for NaN)
- $x; # already rounded by badd()
- }
+# sub bsub is inherited from Math::BigInt!
sub binc
{
return $x->bnan() if $base->is_zero() || $base->is_one() ||
$base->{sign} ne '+';
# if $x == $base, we know the result must be 1.0
- return $x->bone('+',@params) if $x->bcmp($base) == 0;
+ if ($x->bcmp($base) == 0)
+ {
+ $x->bone('+',@params);
+ if ($fallback)
+ {
+ # clear a/p after round, since user did not request it
+ delete $x->{_a}; delete $x->{_p};
+ }
+ return $x;
+ }
}
# when user set globals, they would interfere with our calculation, so
### Since $x in the range 0.5 .. 1.5 is MUCH faster, we do a repeated div
### or mul by 2 (maximum times 3, since x < 10 and x > 0.1)
- my $half = $self->new('0.5');
+ $HALF = $self->new($HALF) unless ref($HALF);
+
my $twos = 0; # default: none (0 times)
my $two = $self->new(2);
- while ($x->bacmp($half) <= 0)
+ while ($x->bacmp($HALF) <= 0)
{
$twos--; $x->bmul($two);
}
# enough...
$scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
}
+
+ my $rem; $rem = $self->bzero() if wantarray;
+
+ $y = $self->new($y) unless $y->isa('Math::BigFloat');
+
my $lx = $MBI->_len($x->{_m}); my $ly = $MBI->_len($y->{_m});
$scale = $lx if $lx > $scale;
$scale = $ly if $ly > $scale;
my $diff = $ly - $lx;
$scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx!
-
- # make copy of $x in case of list context for later reminder calculation
- my $rem;
- if (wantarray && !$y->is_one())
+
+ # cases like $x /= $x (but not $x /= $y!) were wrong due to modifying $x
+ # twice below)
+ require Scalar::Util;
+ if (Scalar::Util::refaddr($x) == Scalar::Util::refaddr($y))
{
- $rem = $x->copy();
+ $x->bone(); # x/x => 1, rem 0
}
-
- $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+';
-
- # check for / +-1 ( +/- 1E0)
- if (!$y->is_one())
+ else
{
- # promote BigInts and it's subclasses (except when already a BigFloat)
- $y = $self->new($y) unless $y->isa('Math::BigFloat');
+
+ # make copy of $x in case of list context for later reminder calculation
+ if (wantarray && !$y->is_one())
+ {
+ $rem = $x->copy();
+ }
- # calculate the result to $scale digits and then round it
- # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
- $MBI->_lsft($x->{_m},$MBI->_new($scale),10);
- $MBI->_div ($x->{_m},$y->{_m} ); # a/c
+ $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+';
- ($x->{_e},$x->{_es}) =
- _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
- # correct for 10**scale
- ($x->{_e},$x->{_es}) =
- _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+');
- $x->bnorm(); # remove trailing 0's
- }
+ # check for / +-1 ( +/- 1E0)
+ if (!$y->is_one())
+ {
+ # promote BigInts and it's subclasses (except when already a BigFloat)
+ $y = $self->new($y) unless $y->isa('Math::BigFloat');
+
+ # calculate the result to $scale digits and then round it
+ # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
+ $MBI->_lsft($x->{_m},$MBI->_new($scale),10);
+ $MBI->_div ($x->{_m},$y->{_m}); # a/c
+
+ # correct exponent of $x
+ ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
+ # correct for 10**scale
+ ($x->{_e},$x->{_es}) = _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+');
+ $x->bnorm(); # remove trailing 0's
+ }
+ } # ende else $x != $y
# shortcut to not run through _find_round_parameters again
if (defined $params[0])
# clear a/p after round, since user did not request it
delete $x->{_a}; delete $x->{_p};
}
-
+
if (wantarray)
{
if (!$y->is_one())
{
$rem->bmod($y,@params); # copy already done
}
- else
- {
- $rem = $self->bzero();
- }
if ($fallback)
{
# clear a/p after round, since user did not request it
local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI
# remember sign and make $x positive, since -4 ** (1/2) => -2
- my $sign = 0; $sign = 1 if $x->{sign} eq '-'; $x->babs();
+ my $sign = 0; $sign = 1 if $x->{sign} eq '-'; $x->{sign} = '+';
+
+ my $is_two = 0;
+ if ($y->isa('Math::BigFloat'))
+ {
+ $is_two = ($y->{sign} eq '+' && $MBI->_is_two($y->{_m}) && $MBI->_is_zero($y->{_e}));
+ }
+ else
+ {
+ $is_two = ($y == 2);
+ }
- if ($y->bcmp(2) == 0) # normal square root
+ # normal square root if $y == 2:
+ if ($is_two)
{
$x->bsqrt($scale+4);
}
my $self = ref($x);
# if $y == 0.5, it is sqrt($x)
- return $x->bsqrt($a,$p,$r,$y) if $y->bcmp('0.5') == 0;
+ $HALF = $self->new($HALF) unless ref($HALF);
+ return $x->bsqrt($a,$p,$r,$y) if $y->bcmp($HALF) == 0;
# Using:
# a ** x == e ** (x * ln a)
$below = $v->copy();
$over = $u->copy();
-
+
$limit = $self->new("1E-". ($scale-1));
#my $steps = 0;
while (3 < 5)
($self,$x,$y,$a,$p,$r) = objectify(2,@_);
}
- return $x if $x->{sign} =~ /^[+-]inf$/;
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
- return $x->bone() if $y->is_zero();
+ return $x if $x->{sign} =~ /^[+-]inf$/;
+
+ # -2 ** -2 => NaN
+ return $x->bnan() if $x->{sign} eq '-' && $y->{sign} eq '-';
+
+ # cache the result of is_zero
+ my $y_is_zero = $y->is_zero();
+ return $x->bone() if $y_is_zero;
return $x if $x->is_one() || $y->is_one();
- return $x->_pow($y,$a,$p,$r) if !$y->is_int(); # non-integer power
+ my $x_is_zero = $x->is_zero();
+ return $x->_pow($y,$a,$p,$r) if !$x_is_zero && !$y->is_int(); # non-integer power
- my $y1 = $y->as_number()->{value}; # make CALC
+ my $y1 = $y->as_number()->{value}; # make MBI part
# if ($x == -1)
if ($x->{sign} eq '-' && $MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e}))
# if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1
return $MBI->_is_odd($y1) ? $x : $x->babs(1);
}
- if ($x->is_zero())
+ if ($x_is_zero)
{
- return $x->bone() if $y->is_zero();
+ return $x->bone() if $y_is_zero;
return $x if $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0)
# 0 ** -y => 1 / (0 ** y) => 1 / 0! (1 / 0 => +inf)
return $x->binf();
}
my $new_sign = '+';
- $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
+ $new_sign = $MBI->_is_odd($y1) ? '-' : '+' if $x->{sign} ne '+';
# calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
$x->{_m} = $MBI->_pow( $x->{_m}, $y1);
- $MBI->_mul ($x->{_e}, $y1);
+ $x->{_e} = $MBI->_mul ($x->{_e}, $y1);
$x->{sign} = $new_sign;
$x->bnorm();
if ($y->{sign} eq '-')
{
# modify $x in place!
- my $z = $x->copy(); $x->bzero()->binc();
+ my $z = $x->copy(); $x->bone();
return $x->bdiv($z,$a,$p,$r); # round in one go (might ignore y's A!)
}
$x->round($a,$p,$r,$y);
}
}
# pass sign to bround for rounding modes '+inf' and '-inf'
- my $m = Math::BigInt->new( $x->{sign} . $MBI->_str($x->{_m}));
+ my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
$m->bround($scale,$mode);
$x->{_m} = $m->{value}; # get our mantissa back
$x->bnorm();
}
# pass sign to bround for '+inf' and '-inf' rounding modes
- my $m = Math::BigInt->new( $x->{sign} . $MBI->_str($x->{_m}));
+ my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
$m->bround($scale,$mode); # round mantissa
$x->{_m} = $m->{value}; # get our mantissa back
# MBI not loaded, or with ne "Math::BigInt::Calc"
$lib .= ",$mbilib" if defined $mbilib;
$lib =~ s/^,//; # don't leave empty
+
# replacement library can handle lib statement, but also could ignore it
- if ($] < 5.006)
- {
- # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
- # used in the same script, or eval inside import().
- require Math::BigInt;
- Math::BigInt->import( lib => $lib, 'objectify' );
- }
- else
- {
- my $rc = "use Math::BigInt lib => '$lib', 'objectify';";
- eval $rc;
- }
+
+ # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
+ # used in the same script, or eval inside import(). So we require MBI:
+ require Math::BigInt;
+ Math::BigInt->import( lib => $lib, 'objectify' );
}
if ($@)
{
if ($MBI->_acmp($x->{_e},$z) >= 0)
{
$x->{_e} = $MBI->_sub ($x->{_e}, $z);
+ $x->{_es} = '+' if $MBI->_is_zero($x->{_e});
}
else
{
projects / p5sagit/p5-mst-13.2.git / blobdiff