# _p: precision
# _f: flags, used to signal MBI not to touch our private parts
-$VERSION = '1.29';
+$VERSION = '1.30';
require 5.005;
use Exporter;
use Math::BigInt qw/objectify/;
my %hand_ups = map { $_ => 1 }
qw / is_nan is_inf is_negative is_positive
accuracy precision div_scale round_mode fneg fabs babs fnot
- objectify
+ objectify upgrade downgrade
bone binf bnan bzero
/;
# handle '+inf', '-inf' first
if ($wanted =~ /^[+-]?inf$/)
{
+ return $downgrade->new($wanted) if $downgrade;
+
$self->{_e} = Math::BigInt->bzero();
$self->{_m} = Math::BigInt->bzero();
$self->{sign} = $wanted;
if (!ref $mis)
{
die "$wanted is not a number initialized to $class" if !$NaNOK;
+
+ return $downgrade->bnan() if $downgrade;
+
$self->{_e} = Math::BigInt->bzero();
$self->{_m} = Math::BigInt->bzero();
$self->{sign} = $nan;
$self->{_e} -= CORE::length($$mfv) if CORE::length($$mfv) != 0;
$self->{sign} = $$mis;
}
+ # if downgrade, inf, NaN or integers go down
+
+ if ($downgrade && $self->{_e}->{sign} eq '+')
+ {
+# print "downgrading $$miv$$mfv"."E$$es$$ev";
+ if ($self->{_e}->is_zero())
+ {
+ $self->{_m}->{sign} = $$mis; # negative if wanted
+ return $downgrade->new($self->{_m});
+ }
+ return $downgrade->new("$$mis$$miv$$mfv"."E$$es$$ev");
+ }
+
# print "mbf new $self->{sign} $self->{_m} e $self->{_e}\n";
$self->bnorm()->round(@r); # first normalize, then round
}
my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.';
- my $not_zero = !$x->is_zero();
+ my $not_zero = ! $x->is_zero();
if ($not_zero)
{
$es = $x->{_m}->bstr();
# adjust so that exponents are equal
my $lxm = $x->{_m}->length();
my $lym = $y->{_m}->length();
- my $lx = $lxm + $x->{_e};
- my $ly = $lym + $y->{_e};
- my $l = $lx - $ly; $l->bneg() if $x->{sign} eq '-';
+ # the numify somewhat limits our length, but makes it much faster
+ my $lx = $lxm + $x->{_e}->numify();
+ my $ly = $lym + $y->{_e}->numify();
+ my $l = $lx - $ly; $l = -$l if $x->{sign} eq '-';
return $l <=> 0 if $l != 0;
# lengths (corrected by exponent) are equal
- # so make mantissa euqal length by padding with zero (shift left)
+ # so make mantissa equal length by padding with zero (shift left)
my $diff = $lxm - $lym;
my $xm = $x->{_m}; # not yet copy it
my $ym = $y->{_m};
{
$xm = $x->{_m}->copy()->blsft(-$diff,10);
}
- my $rc = $xm->bcmp($ym);
+ my $rc = $xm->bacmp($ym);
$rc = -$rc if $x->{sign} eq '-'; # -124 < -123
$rc <=> 0;
}
# adjust so that exponents are equal
my $lxm = $x->{_m}->length();
my $lym = $y->{_m}->length();
- my $lx = $lxm + $x->{_e};
- my $ly = $lym + $y->{_e};
+ # the numify somewhat limits our length, but makes it much faster
+ my $lx = $lxm + $x->{_e}->numify();
+ my $ly = $lym + $y->{_e}->numify();
my $l = $lx - $ly;
return $l <=> 0 if $l != 0;
{
$xm = $x->{_m}->copy()->blsft(-$diff,10);
}
- $xm->bcmp($ym) <=> 0;
+ $xm->bacmp($ym) <=> 0;
}
sub badd
}
# speed: no add for 0+y or x+0
- return $x if $y->is_zero(); # x+0
+ return $x->bround($a,$p,$r) if $y->is_zero(); # x+0
if ($x->is_zero()) # 0+y
{
# make copy, clobbering up x (modify in place!)
}
# take lower of the two e's and adapt m1 to it to match m2
- my $e = $y->{_e}; $e = Math::BigInt::bzero() if !defined $e; # if no BFLOAT
- $e = $e - $x->{_e};
+ my $e = $y->{_e};
+ $e = Math::BigInt::bzero() if !defined $e; # if no BFLOAT ?
+ $e = $e->copy(); # make copy (didn't do it yet)
+ $e->bsub($x->{_e});
my $add = $y->{_m}->copy();
- if ($e < 0)
+# if ($e < 0) # < 0
+ if ($e->{sign} eq '-') # < 0
{
my $e1 = $e->copy()->babs();
- $x->{_m} *= (10 ** $e1);
+ #$x->{_m} *= (10 ** $e1);
+ $x->{_m}->blsft($e1,10);
$x->{_e} += $e; # need the sign of e
}
- elsif ($e > 0)
+# if ($e > 0) # > 0
+ elsif (!$e->is_zero()) # > 0
{
- $add *= (10 ** $e);
+ #$add *= (10 ** $e);
+ $add->blsft($e,10);
}
# else: both e are the same, so just leave them
$x->{_m}->{sign} = $x->{sign}; # fiddle with signs
# subtract second arg from first, modify first
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
- if (!$y->is_zero()) # don't need to do anything if $y is 0
+ if ($y->is_zero()) # still round for not adding zero
{
- $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)
+ return $x->round($a,$p,$r);
}
+
+ $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 bfac
{
- # (BINT or num_str, BINT or num_str) return BINT
+ # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
# compute factorial numbers
# modifies first argument
my ($self,$x,@r) = objectify(1,@_);
- return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
- return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
+ return $x->bnan()
+ if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
+ ($x->{_e}->{sign} ne '+')); # digits after dot?
- return $x->bnan() if $x->{_e}->{sign} ne '+'; # digits after dot?
+ return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
# use BigInt's bfac() for faster calc
$x->{_m}->blsft($x->{_e},10); # un-norm m
$x->{_e}->bzero(); # norm $x again
$x->{_m}->bfac(); # factorial
- $x->bnorm();
-
- #my $n = $x->copy();
- #$x->bone();
- #my $f = $self->new(2);
- #while ($f->bacmp($n) < 0)
- # {
- # $x->bmul($f); $f->binc();
- # }
- #$x->bmul($f); # last step
- $x->round(@r); # round
+ $x->bnorm()->round(@r);
}
sub bpow
# if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1
return $y1->is_odd() ? $x : $x->babs(1);
}
- return $x if $x->is_zero() && $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0)
- # 0 ** -y => 1 / (0 ** y) => / 0! (1 / 0 => +inf)
- return $x->binf() if $x->is_zero() && $y->{sign} eq '-';
+ if ($x->is_zero())
+ {
+ return $x if $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0)
+ # 0 ** -y => 1 / (0 ** y) => / 0! (1 / 0 => +inf)
+ $x->binf();
+ }
# calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
$y1->babs();
my $z = $x->copy(); $x->bzero()->binc();
return $x->bdiv($z,$a,$p,$r); # round in one go (might ignore y's A!)
}
- return $x->round($a,$p,$r,$y);
+ $x->round($a,$p,$r,$y);
}
###############################################################################
# if $x has digits after dot
if ($x->{_e}->{sign} eq '-')
{
- $x->{_m}->brsft(-$x->{_e},10);
- $x->{_e}->bzero();
- $x-- if $x->{sign} eq '-';
+ #$x->{_m}->brsft(-$x->{_e},10);
+ #$x->{_e}->bzero();
+ #$x-- if $x->{sign} eq '-';
+
+ $x->{_e}->{sign} = '+'; # negate e
+ $x->{_m}->brsft($x->{_e},10); # cut off digits after dot
+ $x->{_e}->bzero(); # trunc/norm
+ $x->{_m}->binc() if $x->{sign} eq '-'; # decrement if negative
}
$x->round($a,$p,$r);
}
# if $x has digits after dot
if ($x->{_e}->{sign} eq '-')
{
- $x->{_m}->brsft(-$x->{_e},10);
- $x->{_e}->bzero();
- $x++ if $x->{sign} eq '+';
+ #$x->{_m}->brsft(-$x->{_e},10);
+ #$x->{_e}->bzero();
+ #$x++ if $x->{sign} eq '+';
+
+ $x->{_e}->{sign} = '+'; # negate e
+ $x->{_m}->brsft($x->{_e},10); # cut off digits after dot
+ $x->{_e}->bzero(); # trunc/norm
+ $x->{_m}->binc() if $x->{sign} eq '+'; # decrement if negative
}
$x->round($a,$p,$r);
}
elsif ($_[$i] eq 'upgrade')
{
# this causes upgrading
- $upgrade = $_[$i+1]; # or undef to disable
+ $upgrade = $_[$i+1]; # or undef to disable
+ my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
+ splice @a, $j, $s; $j -= $s;
+ }
+ elsif ($_[$i] eq 'downgrade')
+ {
+ # this causes downgrading
+ $downgrade = $_[$i+1]; # or undef to disable
my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
splice @a, $j, $s; $j -= $s;
}
return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $zeros = $x->{_m}->_trailing_zeros(); # correct for trailing zeros
- if ($zeros != 0)
- {
- $x->{_m}->brsft($zeros,10); $x->{_e} += $zeros;
- }
- # for something like 0Ey, set y to 1, and -0 => +0
- $x->{sign} = '+', $x->{_e}->bone() if $x->{_m}->is_zero();
+# if (!$x->{_m}->is_odd())
+# {
+ my $zeros = $x->{_m}->_trailing_zeros(); # correct for trailing zeros
+ if ($zeros != 0)
+ {
+ $x->{_m}->brsft($zeros,10); $x->{_e}->badd($zeros);
+ }
+ # for something like 0Ey, set y to 1, and -0 => +0
+ $x->{sign} = '+', $x->{_e}->bone() if $x->{_m}->is_zero();
+# }
# this is to prevent automatically rounding when MBI's globals are set
$x->{_m}->{_f} = MB_NEVER_ROUND;
$x->{_e}->{_f} = MB_NEVER_ROUND;
# return copy as a bigint representation of this BigFloat number
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- my $z;
- if ($x->{_e}->is_zero())
- {
- $z = $x->{_m}->copy();
- $z->{sign} = $x->{sign};
- return $z;
- }
- $z = $x->{_m}->copy();
- if ($x->{_e} < 0)
+ my $z = $x->{_m}->copy();
+ if ($x->{_e}->{sign} eq '-') # < 0
{
- $z->brsft(-$x->{_e},10);
+ $x->{_e}->{sign} = '+'; # flip
+ $z->brsft($x->{_e},10);
+ $x->{_e}->{sign} = '-'; # flip back
}
- else
+ elsif (!$x->{_e}->is_zero()) # > 0
{
$z->blsft($x->{_e},10);
}
projects / p5sagit/p5-mst-13.2.git / commitdiff