Math::BigRat 0.12, by Tels.
p4raw-id: //depot/perl@22344
#
# The following hash values are internally used:
-# _e: exponent (BigInt)
-# _m: mantissa (absolute BigInt)
-# sign: +,-,+inf,-inf, or "NaN" if not a number
-# _a: accuracy
-# _p: precision
-# _f: flags, used to signal MBI not to touch our private parts
-
-$VERSION = '1.43';
+# _e : exponent (ref to $CALC object)
+# _m : mantissa (ref to $CALC object)
+# _es : sign of _e
+# sign : +,-,+inf,-inf, or "NaN" if not a number
+# _a : accuracy
+# _p : precision
+
+$VERSION = '1.44';
require 5.005;
require Exporter;
$upgrade = undef;
$downgrade = undef;
-my $MBI = 'Math::BigInt'; # the package we are using for our private parts
- # changable by use Math::BigFloat with => 'package'
-
-# the following are private and not to be used from the outside:
-
-sub MB_NEVER_ROUND () { 0x0001; }
+# the package we are using for our private parts, defaults to:
+# Math::BigInt->config()->{lib}
+my $MBI = 'Math::BigInt::Calc';
# are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config()
$_trap_nan = 0;
-# the same for infs
+# the same for infinity
$_trap_inf = 0;
# constant for easier life
my $nan = 'NaN';
-my $IMPORT = 0; # was import() called yet?
- # used to make require work
+my $IMPORT = 0; # was import() called yet? used to make require work
# some digits of accuracy for blog(undef,10); which we use in blog() for speed
my $LOG_10 =
# shortcut for bigints and its subclasses
if ((ref($wanted)) && (ref($wanted) ne $class))
{
- $self->{_m} = $wanted->as_number(); # get us a bigint copy
- $self->{_e} = $MBI->bzero();
- $self->{_m}->babs();
+ $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy
+ $self->{_e} = $MBI->_zero();
+ $self->{_es} = '+';
$self->{sign} = $wanted->sign();
return $self->bnorm();
}
{
return $downgrade->new($wanted) if $downgrade;
- $self->{_e} = $MBI->bzero();
- $self->{_m} = $MBI->bzero();
+ $self->{_e} = $MBI->_zero();
+ $self->{_es} = '+';
+ $self->{_m} = $MBI->_zero();
$self->{sign} = $wanted;
$self->{sign} = '+inf' if $self->{sign} eq 'inf';
return $self->bnorm();
}
- #print "new string '$wanted'\n";
- my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split(\$wanted);
+ my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($wanted);
if (!ref $mis)
{
if ($_trap_nan)
return $downgrade->bnan() if $downgrade;
- $self->{_e} = $MBI->bzero();
- $self->{_m} = $MBI->bzero();
+ $self->{_e} = $MBI->_zero();
+ $self->{_es} = '+';
+ $self->{_m} = $MBI->_zero();
$self->{sign} = $nan;
}
else
{
- # make integer from mantissa by adjusting exp, then convert to bigint
- # undef,undef to signal MBI that we don't need no bloody rounding
- $self->{_e} = $MBI->new("$$es$$ev",undef,undef); # exponent
- $self->{_m} = $MBI->new("$$miv$$mfv",undef,undef); # create mant.
-
- # this is to prevent automatically rounding when MBI's globals are set
- $self->{_m}->{_f} = MB_NEVER_ROUND;
- $self->{_e}->{_f} = MB_NEVER_ROUND;
+ # make integer from mantissa by adjusting exp, then convert to int
+ $self->{_e} = $MBI->_new($$ev); # exponent
+ $self->{_es} = $$es || '+';
+ my $mantissa = "$$miv$$mfv"; # create mant.
+ $mantissa =~ s/^0+(\d)/$1/; # strip leading zeros
+ $self->{_m} = $MBI->_new($mantissa); # create mant.
# 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5
- $self->{_e}->bsub( $MBI->new(CORE::length($$mfv),undef,undef))
- if CORE::length($$mfv) != 0;
+ if (CORE::length($$mfv) != 0)
+ {
+ my $len = $MBI->_new( CORE::length($$mfv));
+ ($self->{_e}, $self->{_es}) =
+ _e_sub ($self->{_e}, $len, $self->{_es}, '+');
+ }
$self->{sign} = $$mis;
- #print "$$miv$$mfv $$es$$ev\n";
-
# we can only have trailing zeros on the mantissa of $$mfv eq ''
if (CORE::length($$mfv) == 0)
{
- my $zeros = $self->{_m}->_trailing_zeros(); # correct for trailing zeros
+ my $zeros = $MBI->_zeros($self->{_m}); # correct for trailing zeros
if ($zeros != 0)
{
- $self->{_m}->brsft($zeros,10); $self->{_e}->badd($MBI->new($zeros));
+ my $z = $MBI->_new($zeros);
+ $MBI->_rsft ( $self->{_m}, $z, 10);
+ _e_add ( $self->{_e}, $z, $self->{_es}, '+');
}
}
-# else
-# {
- # for something like 0Ey, set y to 1, and -0 => +0
- $self->{sign} = '+', $self->{_e}->bone() if $self->{_m}->is_zero();
-# }
+ # for something like 0Ey, set y to 1, and -0 => +0
+ $self->{sign} = '+', $self->{_e} = $MBI->_one()
+ if $MBI->_is_zero($self->{_m});
return $self->round(@r) if !$downgrade;
}
# if downgrade, inf, NaN or integers go down
- if ($downgrade && $self->{_e}->{sign} eq '+')
+ if ($downgrade && $self->{_es} eq '+')
{
- #print "downgrading $$miv$$mfv"."E$$es$$ev";
- if ($self->{_e}->is_zero())
+ if ($MBI->_is_zero( $self->{_e} ))
{
- $self->{_m}->{sign} = $$mis; # negative if wanted
- return $downgrade->new($self->{_m});
+ return $downgrade->new($$mis . $MBI->_str( $self->{_m} ));
}
return $downgrade->new($self->bsstr());
}
- #print "mbf new $self->{sign} $self->{_m} e $self->{_e} ",ref($self),"\n";
$self->bnorm()->round(@r); # first normalize, then round
}
+sub copy
+ {
+ my ($c,$x);
+ if (@_ > 1)
+ {
+ # if two arguments, the first one is the class to "swallow" subclasses
+ ($c,$x) = @_;
+ }
+ else
+ {
+ $x = shift;
+ $c = ref($x);
+ }
+ return unless ref($x); # only for objects
+
+ my $self = {}; bless $self,$c;
+
+ $self->{sign} = $x->{sign};
+ $self->{_es} = $x->{_es};
+ $self->{_m} = $MBI->_copy($x->{_m});
+ $self->{_e} = $MBI->_copy($x->{_e});
+ $self->{_a} = $x->{_a} if defined $x->{_a};
+ $self->{_p} = $x->{_p} if defined $x->{_p};
+ $self;
+ }
+
sub _bnan
{
# used by parent class bone() to initialize number to NaN
}
$IMPORT=1; # call our import only once
- $self->{_m} = $MBI->bzero();
- $self->{_e} = $MBI->bzero();
+ $self->{_m} = $MBI->_zero();
+ $self->{_e} = $MBI->_zero();
+ $self->{_es} = '+';
}
sub _binf
}
$IMPORT=1; # call our import only once
- $self->{_m} = $MBI->bzero();
- $self->{_e} = $MBI->bzero();
+ $self->{_m} = $MBI->_zero();
+ $self->{_e} = $MBI->_zero();
+ $self->{_es} = '+';
}
sub _bone
# used by parent class bone() to initialize number to 1
my $self = shift;
$IMPORT=1; # call our import only once
- $self->{_m} = $MBI->bone();
- $self->{_e} = $MBI->bzero();
+ $self->{_m} = $MBI->_one();
+ $self->{_e} = $MBI->_zero();
+ $self->{_es} = '+';
}
sub _bzero
# used by parent class bone() to initialize number to 0
my $self = shift;
$IMPORT=1; # call our import only once
- $self->{_m} = $MBI->bzero();
- $self->{_e} = $MBI->bone();
+ $self->{_m} = $MBI->_zero();
+ $self->{_e} = $MBI->_one();
+ $self->{_es} = '+';
}
sub isa
my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.';
# $x is zero?
- my $not_zero = !($x->{sign} eq '+' && $x->{_m}->is_zero());
+ my $not_zero = !($x->{sign} eq '+' && $MBI->_is_zero($x->{_m}));
if ($not_zero)
{
- $es = $x->{_m}->bstr();
+ $es = $MBI->_str($x->{_m});
$len = CORE::length($es);
- my $e = $x->{_e}->numify();
+ my $e = $MBI->_num($x->{_e});
+ $e = -$e if $x->{_es} eq '-';
if ($e < 0)
{
$dot = '';
# if _e is bigger than a scalar, the following will blow your memory
if ($e <= -$len)
{
- #print "style: 0.xxxx\n";
my $r = abs($e) - $len;
$es = '0.'. ('0' x $r) . $es; $cad = -($len+$r);
}
else
{
- #print "insert '.' at $e in '$es'\n";
- substr($es,$e,0) = '.'; $cad = $x->{_e};
+ substr($es,$e,0) = '.'; $cad = $MBI->_num($x->{_e});
+ $cad = -$cad if $x->{_es} eq '-';
}
}
elsif ($e > 0)
$es .= '0' x $e; $len += $e; $cad = 0;
}
} # if not zero
+
$es = '-'.$es if $x->{sign} eq '-';
# if set accuracy or precision, pad with zeros on the right side
if ((defined $x->{_a}) && ($not_zero))
return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
return 'inf'; # +inf
}
- # do $esign, because we need '1e+1', since $x->{_e}->bstr() misses the +
- my $esign = $x->{_e}->{sign}; $esign = '' if $esign eq '-';
- my $sep = 'e'.$esign;
+ my $sep = 'e'.$x->{_es};
my $sign = $x->{sign}; $sign = '' if $sign eq '+';
- $sign . $x->{_m}->bstr() . $sep . $x->{_e}->bstr();
+ $sign . $MBI->_str($x->{_m}) . $sep . $MBI->_str($x->{_e});
}
sub numify
return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
# adjust so that exponents are equal
- my $lxm = $x->{_m}->length();
- my $lym = $y->{_m}->length();
+ my $lxm = $MBI->_len($x->{_m});
+ my $lym = $MBI->_len($y->{_m});
# the numify somewhat limits our length, but makes it much faster
- my $lx = $lxm + $x->{_e}->numify();
- my $ly = $lym + $y->{_e}->numify();
+ my ($xes,$yes) = (1,1);
+ $xes = -1 if $x->{_es} ne '+';
+ $yes = -1 if $y->{_es} ne '+';
+ my $lx = $lxm + $xes * $MBI->_num($x->{_e});
+ my $ly = $lym + $yes * $MBI->_num($y->{_e});
my $l = $lx - $ly; $l = -$l if $x->{sign} eq '-';
return $l <=> 0 if $l != 0;
my $ym = $y->{_m};
if ($diff > 0)
{
- $ym = $y->{_m}->copy()->blsft($diff,10);
+ $ym = $MBI->_copy($y->{_m});
+ $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10);
}
elsif ($diff < 0)
{
- $xm = $x->{_m}->copy()->blsft(-$diff,10);
+ $xm = $MBI->_copy($x->{_m});
+ $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10);
}
- my $rc = $xm->bacmp($ym);
+ my $rc = $MBI->_acmp($xm,$ym);
$rc = -$rc if $x->{sign} eq '-'; # -124 < -123
$rc <=> 0;
}
return 1 if $yz && !$xz; # +x <=> 0
# adjust so that exponents are equal
- my $lxm = $x->{_m}->length();
- my $lym = $y->{_m}->length();
+ my $lxm = $MBI->_len($x->{_m});
+ my $lym = $MBI->_len($y->{_m});
+ my ($xes,$yes) = (1,1);
+ $xes = -1 if $x->{_es} ne '+';
+ $yes = -1 if $y->{_es} ne '+';
# the numify somewhat limits our length, but makes it much faster
- my $lx = $lxm + $x->{_e}->numify();
- my $ly = $lym + $y->{_e}->numify();
+ my $lx = $lxm + $xes * $MBI->_num($x->{_e});
+ my $ly = $lym + $yes * $MBI->_num($y->{_e});
my $l = $lx - $ly;
return $l <=> 0 if $l != 0;
my $ym = $y->{_m};
if ($diff > 0)
{
- $ym = $y->{_m}->copy()->blsft($diff,10);
+ $ym = $MBI->_copy($y->{_m});
+ $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10);
}
elsif ($diff < 0)
{
- $xm = $x->{_m}->copy()->blsft(-$diff,10);
+ $xm = $MBI->_copy($x->{_m});
+ $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10);
}
- $xm->bacmp($ym) <=> 0;
+ $MBI->_acmp($xm,$ym);
}
sub badd
if ($x->is_zero()) # 0+y
{
# make copy, clobbering up x (modify in place!)
- $x->{_e} = $y->{_e}->copy();
- $x->{_m} = $y->{_m}->copy();
+ $x->{_e} = $MBI->_copy($y->{_e});
+ $x->{_es} = $y->{_es};
+ $x->{_m} = $MBI->_copy($y->{_m});
$x->{sign} = $y->{sign} || $nan;
return $x->round($a,$p,$r,$y);
}
# take lower of the two e's and adapt m1 to it to match m2
my $e = $y->{_e};
- $e = $MBI->bzero() if !defined $e; # if no BFLOAT ?
- $e = $e->copy(); # make copy (didn't do it yet)
- $e->bsub($x->{_e}); # Ye - Xe
- my $add = $y->{_m}->copy();
- if ($e->{sign} eq '-') # < 0
+ $e = $MBI->_zero() if !defined $e; # if no BFLOAT?
+ $e = $MBI->_copy($e); # make copy (didn't do it yet)
+
+ my $es;
+
+ ($e,$es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es});
+
+ my $add = $MBI->_copy($y->{_m});
+
+ if ($es eq '-') # < 0
{
- $x->{_e} += $e; # need the sign of e
- $x->{_m}->blsft($e->babs(),10); # destroys copy of _e
+ $MBI->_lsft( $x->{_m}, $e, 10);
+ ($x->{_e},$x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
}
- elsif (!$e->is_zero()) # > 0
+ elsif (!$MBI->_is_zero($e)) # > 0
{
- $add->blsft($e,10);
+ $MBI->_lsft($add, $e, 10);
}
# else: both e are the same, so just leave them
- $x->{_m}->{sign} = $x->{sign}; # fiddle with signs
- $add->{sign} = $y->{sign};
- $x->{_m} += $add; # finally do add/sub
- $x->{sign} = $x->{_m}->{sign}; # re-adjust signs
- $x->{_m}->{sign} = '+'; # mantissa always positiv
+
+ if ($x->{sign} eq $y->{sign})
+ {
+ # add
+ $x->{_m} = $MBI->_add($x->{_m}, $add);
+ }
+ else
+ {
+ ($x->{_m}, $x->{sign}) =
+ _e_add($x->{_m}, $add, $x->{sign}, $y->{sign});
+ }
+
# delete trailing zeros, then round
$x->bnorm()->round($a,$p,$r,$y);
}
# increment arg by one
my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- if ($x->{_e}->sign() eq '-')
+ if ($x->{_es} eq '-')
{
return $x->badd($self->bone(),@r); # digits after dot
}
- if (!$x->{_e}->is_zero()) # _e == 0 for NaN, inf, -inf
+ if (!$MBI->_is_zero($x->{_e})) # _e == 0 for NaN, inf, -inf
{
# 1e2 => 100, so after the shift below _m has a '0' as last digit
- $x->{_m}->blsft($x->{_e},10); # 1e2 => 100
- $x->{_e}->bzero(); # normalize
+ $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e},10); # 1e2 => 100
+ $x->{_e} = $MBI->_zero(); # normalize
+ $x->{_es} = '+';
# we know that the last digit of $x will be '1' or '9', depending on the
# sign
}
# now $x->{_e} == 0
if ($x->{sign} eq '+')
{
- $x->{_m}->binc();
+ $MBI->_inc($x->{_m});
return $x->bnorm()->bround(@r);
}
elsif ($x->{sign} eq '-')
{
- $x->{_m}->bdec();
- $x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0
+ $MBI->_dec($x->{_m});
+ $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0
return $x->bnorm()->bround(@r);
}
# inf, nan handling etc
# decrement arg by one
my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- if ($x->{_e}->sign() eq '-')
+ if ($x->{_es} eq '-')
{
return $x->badd($self->bone('-'),@r); # digits after dot
}
- if (!$x->{_e}->is_zero())
+ if (!$MBI->_is_zero($x->{_e}))
{
- $x->{_m}->blsft($x->{_e},10); # 1e2 => 100
- $x->{_e}->bzero();
+ $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e},10); # 1e2 => 100
+ $x->{_e} = $MBI->_zero(); # normalize
+ $x->{_es} = '+';
}
# now $x->{_e} == 0
my $zero = $x->is_zero();
# <= 0
if (($x->{sign} eq '-') || $zero)
{
- $x->{_m}->binc();
- $x->{sign} = '-' if $zero; # 0 => 1 => -1
- $x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0
+ $MBI->_inc($x->{_m});
+ $x->{sign} = '-' if $zero; # 0 => 1 => -1
+ $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0
return $x->bnorm()->round(@r);
}
# > 0
elsif ($x->{sign} eq '+')
{
- $x->{_m}->bdec();
+ $MBI->_dec($x->{_m});
return $x->bnorm()->round(@r);
}
# inf, nan handling etc
- $x->badd($self->bone('-'),@r); # does round
+ $x->badd($self->bone('-'),@r); # does round
}
sub DEBUG () { 0; }
# also takes care of the "error in _find_round_parameters?" case
return $x->bnan() if $x->{sign} ne '+' || $x->is_zero();
+
# no rounding at all, so must use fallback
if (scalar @params == 0)
{
# stop right here.
if (defined $base && $base->is_int() && $x->is_int())
{
- my $int = $x->{_m}->copy();
- $int->blsft($x->{_e},10) unless $x->{_e}->is_zero();
+ my $i = $MBI->_copy( $x->{_m} );
+ $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
+ my $int = Math::BigInt->bzero();
+ $int->{value} = $i;
$int->blog($base->as_number());
# if ($exact)
- if ($base->copy()->bpow($int) == $x)
+ if ($base->as_number()->bpow($int) == $x)
{
# found result, return it
- $x->{_m} = $int;
- $x->{_e} = $MBI->bzero();
+ $x->{_m} = $int->{value};
+ $x->{_e} = $MBI->_zero();
+ $x->{_es} = '+';
$x->bnorm();
$done = 1;
}
{
# first calculate the log to base e (using reduction by 10 (and probably 2))
$self->_log_10($x,$scale);
-
+
# and if a different base was requested, convert it
if (defined $base)
{
delete $next->{_a}; delete $next->{_p};
$x->badd($next);
- #print "step $x\n ($next - $limit = ",$next - $limit,")\n";
# calculate things for the next term
$over *= $u; $below *= $v; $factor->badd($f);
if (DEBUG)
# log(10) afterwards to get the correct result.
# calculate nr of digits before dot
- my $dbd = $x->{_m}->length() + $x->{_e}->numify();
+ my $dbd = $MBI->_num($x->{_e});
+ $dbd = -$dbd if $x->{_es} eq '-';
+ $dbd += $MBI->_len($x->{_m});
# more than one digit (e.g. at least 10), but *not* exactly 10 to avoid
# infinite recursion
# disable the shortcut for 10, since we need log(10) and this would recurse
# infinitely deep
- if ($x->{_e}->is_one() && $x->{_m}->is_one())
+ if ($x->{_es} eq '+' && $MBI->_is_one($x->{_e}) && $MBI->_is_one($x->{_m}))
{
$dbd = 0; # disable shortcut
# we can use the cached value in these cases
else
{
# disable the shortcut for 2, since we maybe have it cached
- if ($x->{_e}->is_zero() && $x->{_m}->bcmp(2) == 0)
+ if (($MBI->_is_zero($x->{_e}) && $MBI->_is_two($x->{_m})))
{
$dbd = 0; # disable shortcut
# we can use the cached value in these cases
}
# if $x = 0.1, we know the result must be 0-log(10)
- if ($calc != 0 && $x->{_e}->is_one('-') && $x->{_m}->is_one())
+ if ($calc != 0 && $x->{_es} eq '-' && $MBI->_is_one($x->{_e}) &&
+ $MBI->_is_one($x->{_m}))
{
$dbd = 0; # disable shortcut
# we can use the cached value in these cases
if ($scale <= $LOG_10_A)
{
# use cached value
- #print "using cached value for l_10\n";
$l_10 = $LOG_10->copy(); # copy for mul
}
else
# else: slower, compute it (but don't cache it, because it could be big)
# also disable downgrade for this code path
local $Math::BigFloat::downgrade = undef;
- #print "l_10 = $l_10 (self = $self',
- # ", ref(l_10) = ",ref($l_10)," scale $scale)\n";
- #print "calculating value for l_10, scale $scale\n";
$l_10 = $self->new(10)->blog(undef,$scale); # scale+4, actually
}
$dbd-- if ($dbd > 1); # 20 => dbd=2, so make it dbd=1
- # make object
- $dbd = $self->new($dbd);
- #print "dbd $dbd\n";
- $l_10->bmul($dbd); # log(10) * (digits_before_dot-1)
- #print "l_10 = $l_10\n";
- #print "x = $x";
- $x->{_e}->bsub($dbd); # 123 => 1.23
- #print " => $x\n";
- #print "calculating log($x) with scale=$scale\n";
+ $l_10->bmul( $self->new($dbd)); # log(10) * (digits_before_dot-1)
+ my $dbd_sign = '+';
+ if ($dbd < 0)
+ {
+ $dbd = -$dbd;
+ $dbd_sign = '-';
+ }
+ ($x->{_e}, $x->{_es}) =
+ _e_sub( $x->{_e}, $MBI->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23
}
{
$twos++; $x->bdiv($two,$scale+4); # keep all digits
}
- #print "$twos\n";
# $twos > 0 => did mul 2, < 0 => did div 2 (never both)
# calculate correction factor based on ln(2)
if ($twos != 0)
if ($scale <= $LOG_2_A)
{
# use cached value
- #print "using cached value for l_10\n";
$l_2 = $LOG_2->copy(); # copy for mul
}
else
# else: slower, compute it (but don't cache it, because it could be big)
# also disable downgrade for this code path
local $Math::BigFloat::downgrade = undef;
- #print "calculating value for l_2, scale $scale\n";
$l_2 = $two->blog(undef,$scale); # scale+4, actually
}
$l_2->bmul($twos); # * -2 => subtract, * 2 => add
$x;
}
-###############################################################################
-# is_foo methods (is_negative, is_positive are inherited from BigInt)
+##############################################################################
-sub _is_zero_or_one
+sub _e_add
{
- # internal, return true if BigInt arg is zero or one, saving the
- # two calls to is_zero() and is_one()
- my $x = $_[0];
+ # Internal helper sub to take two positive integers and their signs and
+ # then add them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')),
+ # output ($CALC,('+'|'-'))
+ my ($x,$y,$xs,$ys) = @_;
+
+ # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
+ if ($xs eq $ys)
+ {
+ $x = $MBI->_add ($x, $y ); # a+b
+ # the sign follows $xs
+ return ($x, $xs);
+ }
- $x->{sign} eq '+' && ($x->is_zero() || $x->is_one());
+ my $a = $MBI->_acmp($x,$y);
+ if ($a > 0)
+ {
+ $x = $MBI->_sub ($x , $y); # abs sub
+ }
+ elsif ($a == 0)
+ {
+ $x = $MBI->_zero(); # result is 0
+ $xs = '+';
+ }
+ else # a < 0
+ {
+ $x = $MBI->_sub ( $y, $x, 1 ); # abs sub
+ $xs = $ys;
+ }
+ ($x,$xs);
}
+sub _e_sub
+ {
+ # Internal helper sub to take two positive integers and their signs and
+ # then subtract them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')),
+ # output ($CALC,('+'|'-'))
+ my ($x,$y,$xs,$ys) = @_;
+
+ # flip sign
+ $ys =~ tr/+-/-+/;
+ _e_add($x,$y,$xs,$ys); # call add (does subtract now)
+ }
+
+###############################################################################
+# is_foo methods (is_negative, is_positive are inherited from BigInt)
+
sub is_int
{
# return true if arg (BFLOAT or num_str) is an integer
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
- $x->{_e}->{sign} eq '+'; # 1e-1 => no integer
+ $x->{_es} eq '+'; # 1e-1 => no integer
0;
}
# return true if arg (BFLOAT or num_str) is zero
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero();
+ return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_m});
0;
}
$sign = '+' if !defined $sign || $sign ne '-';
return 1
- if ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one());
+ if ($x->{sign} eq $sign &&
+ $MBI->_is_zero($x->{_e}) && $MBI->_is_one($x->{_m}));
0;
}
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
- ($x->{_e}->is_zero() && $x->{_m}->is_odd());
+ ($MBI->_is_zero($x->{_e}) && $MBI->_is_odd($x->{_m}));
0;
}
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
- return 1 if ($x->{_e}->{sign} eq '+' # 123.45 is never
- && $x->{_m}->is_even()); # but 1200 is
+ return 1 if ($x->{_es} eq '+' # 123.45 is never
+ && $MBI->_is_even($x->{_m})); # but 1200 is
0;
}
((!$x->isa($self)) || (!$y->isa($self)));
# aEb * cEd = (a*c)E(b+d)
- $x->{_m}->bmul($y->{_m});
- $x->{_e}->badd($y->{_e});
+ $MBI->_mul($x->{_m},$y->{_m});
+ ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
+
# adjust sign:
$x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
return $x->bnorm()->round($a,$p,$r,$y);
# enough...
$scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
}
- my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length();
+ 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;
# promote BigInts and it's subclasses (except when already a BigFloat)
$y = $self->new($y) unless $y->isa('Math::BigFloat');
- # need to disable $upgrade in BigInt, to avoid deep recursion
- local $Math::BigInt::upgrade = undef; # should be parent class vs MBI
-
# calculate the result to $scale digits and then round it
# a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
- $x->{_m}->blsft($scale,10);
- $x->{_m}->bdiv( $y->{_m} ); # a/c
- $x->{_e}->bsub( $y->{_e} ); # b-d
- $x->{_e}->bsub($scale); # correct for 10**scale
+ $MBI->_lsft($x->{_m},$MBI->_new($scale),10);
+ $MBI->_div ($x->{_m},$y->{_m} ); # a/c
+
+ ($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
}
($self,$x,$y,$a,$p,$r) = objectify(2,@_);
}
+ # handle NaN, inf, -inf
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
my ($d,$re) = $self->SUPER::_div_inf($x,$y);
$x->{_m} = $re->{_m};
return $x->round($a,$p,$r,$y);
}
- return $x->bnan() if $x->is_zero() && $y->is_zero();
- return $x if $y->is_zero();
- return $x->bnan() if $x->is_nan() || $y->is_nan();
+ if ($y->is_zero())
+ {
+ return $x->bnan() if $x->is_zero();
+ return $x;
+ }
return $x->bzero() if $y->is_one() || $x->is_zero();
- # inf handling is missing here
-
my $cmp = $x->bacmp($y); # equal or $x < $y?
return $x->bzero($a,$p) if $cmp == 0; # $x == $y => result 0
$x->{sign} = $y->{sign}; # calc sign first
return $x->round($a,$p,$r) if $cmp < 0 && $neg == 0; # $x < $y => result $x
- my $ym = $y->{_m}->copy();
+ my $ym = $MBI->_copy($y->{_m});
# 2e1 => 20
- $ym->blsft($y->{_e},10) if $y->{_e}->{sign} eq '+' && !$y->{_e}->is_zero();
+ $MBI->_lsft( $ym, $y->{_e}, 10)
+ if $y->{_es} eq '+' && !$MBI->_is_zero($y->{_e});
# if $y has digits after dot
my $shifty = 0; # correct _e of $x by this
- if ($y->{_e}->{sign} eq '-') # has digits after dot
+ if ($y->{_es} eq '-') # has digits after dot
{
# 123 % 2.5 => 1230 % 25 => 5 => 0.5
- $shifty = $y->{_e}->copy()->babs(); # no more digits after dot
- $x->blsft($shifty,10); # 123 => 1230, $y->{_m} is already 25
+ $shifty = $MBI->_num($y->{_e}); # no more digits after dot
+ $MBI->_lsft($x->{_m}, $y->{_e}, 10);# 123 => 1230, $y->{_m} is already 25
}
# $ym is now mantissa of $y based on exponent 0
my $shiftx = 0; # correct _e of $x by this
- if ($x->{_e}->{sign} eq '-') # has digits after dot
+ if ($x->{_es} eq '-') # has digits after dot
{
# 123.4 % 20 => 1234 % 200
- $shiftx = $x->{_e}->copy()->babs(); # no more digits after dot
- $ym->blsft($shiftx,10);
+ $shiftx = $MBI->_num($x->{_e}); # no more digits after dot
+ $MBI->_lsft($ym, $x->{_e}, 10); # 123 => 1230
}
# 123e1 % 20 => 1230 % 20
- if ($x->{_e}->{sign} eq '+' && !$x->{_e}->is_zero())
+ if ($x->{_es} eq '+' && !$MBI->_is_zero($x->{_e}))
{
- $x->{_m}->blsft($x->{_e},10);
+ $MBI->_lsft( $x->{_m}, $x->{_e},10); # es => '+' here
}
- $x->{_e} = $MBI->bzero() unless $x->{_e}->is_zero();
-
- $x->{_e}->bsub($shiftx) if $shiftx != 0;
- $x->{_e}->bsub($shifty) if $shifty != 0;
+
+ $x->{_e} = $MBI->_new($shiftx);
+ $x->{_es} = '+';
+ $x->{_es} = '-' if $shiftx != 0 || $shifty != 0;
+ $MBI->_add( $x->{_e}, $MBI->_new($shifty)) if $shifty != 0;
# now mantissas are equalized, exponent of $x is adjusted, so calc result
- $x->{_m}->bmod($ym);
+ $x->{_m} = $MBI->_mod( $x->{_m}, $ym);
- $x->{sign} = '+' if $x->{_m}->is_zero(); # fix sign for -0
+ $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0
$x->bnorm();
if ($neg != 0) # one of them negative => correct in place
my $r = $y - $x;
$x->{_m} = $r->{_m};
$x->{_e} = $r->{_e};
- $x->{sign} = '+' if $x->{_m}->is_zero(); # fix sign for -0
+ $x->{_es} = $r->{_es};
+ $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0
$x->bnorm();
}
# simulate old behaviour
$params[0] = $self->div_scale(); # and round to it as accuracy
$scale = $params[0]+4; # at least four more for proper round
- $params[2] = $r; # round mode by caller or undef
+ $params[2] = $r; # iound mode by caller or undef
$fallback = 1; # to clear a/p afterwards
}
else
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->is_negative(); $x->babs();
+ my $sign = 0; $sign = 1 if $x->{sign} eq '-'; $x->babs();
if ($y->bcmp(2) == 0) # normal square root
{
# copy private parts over
$x->{_m} = $u->{_m};
$x->{_e} = $u->{_e};
+ $x->{_es} = $u->{_es};
}
else
{
my $done = 0; # not yet
if ($y->is_int() && $x->is_int())
{
- my $int = $x->{_m}->copy();
- $int->blsft($x->{_e},10) unless $x->{_e}->is_zero();
+ my $i = $MBI->_copy( $x->{_m} );
+ $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
+ my $int = Math::BigInt->bzero();
+ $int->{value} = $i;
$int->broot($y->as_number());
# if ($exact)
if ($int->copy()->bpow($y) == $x)
{
# found result, return it
- $x->{_m} = $int;
- $x->{_e} = $MBI->bzero();
+ $x->{_m} = $int->{value};
+ $x->{_e} = $MBI->_zero();
+ $x->{_es} = '+';
$x->bnorm();
$done = 1;
}
# need to disable $upgrade in BigInt, to avoid deep recursion
local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI
- my $xas = $x->as_number();
+ my $i = $MBI->_copy( $x->{_m} );
+ $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e});
+ my $xas = Math::BigInt->bzero();
+ $xas->{value} = $i;
+
my $gs = $xas->copy()->bsqrt(); # some guess
- if (($x->{_e}->{sign} ne '-') # guess can't be accurate if there are
+ if (($x->{_es} ne '-') # guess can't be accurate if there are
# digits after the dot
&& ($xas->bacmp($gs * $gs) == 0)) # guess hit the nail on the head?
{
- # exact result
- $x->{_m} = $gs; $x->{_e} = $MBI->bzero(); $x->bnorm();
+ # exact result, copy result over to keep $x
+ $x->{_m} = $gs->{value}; $x->{_e} = $MBI->_zero(); $x->{_es} = '+';
+ $x->bnorm();
# shortcut to not run through _find_round_parameters again
if (defined $params[0])
{
# sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy
# of the result by multipyling the input by 100 and then divide the integer
# result of sqrt(input) by 10. Rounding afterwards returns the real result.
- # this will transform 123.456 (in $x) into 123456 (in $y1)
- my $y1 = $x->{_m}->copy();
+
+ # The following steps will transform 123.456 (in $x) into 123456 (in $y1)
+ my $y1 = $MBI->_copy($x->{_m});
+
+ my $length = $MBI->_len($y1);
+
+ # Now calculate how many digits the result of sqrt(y1) would have
+ my $digits = int($length / 2);
+
+ # But we need at least $scale digits, so calculate how many are missing
+ my $shift = $scale - $digits;
+
+ # That should never happen (we take care of integer guesses above)
+ # $shift = 0 if $shift < 0;
+
+ # Multiply in steps of 100, by shifting left two times the "missing" digits
+ my $s2 = $shift * 2;
+
# We now make sure that $y1 has the same odd or even number of digits than
# $x had. So when _e of $x is odd, we must shift $y1 by one digit left,
# because we always must multiply by steps of 100 (sqrt(100) is 10) and not
# steps of 10. The length of $x does not count, since an even or odd number
# of digits before the dot is not changed by adding an even number of digits
# after the dot (the result is still odd or even digits long).
- my $length = $y1->length();
- $y1->bmul(10) if $x->{_e}->is_odd();
- # now calculate how many digits the result of sqrt(y1) would have
- my $digits = int($length / 2);
- # but we need at least $scale digits, so calculate how many are missing
- my $shift = $scale - $digits;
- # that should never happen (we take care of integer guesses above)
- # $shift = 0 if $shift < 0;
- # multiply in steps of 100, by shifting left two times the "missing" digits
- $y1->blsft($shift*2,10);
+ $s2++ if $MBI->_is_odd($x->{_e});
+
+ $MBI->_lsft( $y1, $MBI->_new($s2), 10);
+
# now take the square root and truncate to integer
- $y1->bsqrt();
+ $y1 = $MBI->_sqrt($y1);
+
# By "shifting" $y1 right (by creating a negative _e) we calculate the final
# result, which is than later rounded to the desired scale.
# calculate how many zeros $x had after the '.' (or before it, depending
- # on sign of $dat, the result should have half as many:
- my $dat = $length + $x->{_e}->numify();
+ # on sign of $dat, the result should have half as many:
+ my $dat = $MBI->_num($x->{_e});
+ $dat = -$dat if $x->{_es} eq '-';
+ $dat += $length;
if ($dat > 0)
{
{
$dat = int(($dat)/2);
}
- $x->{_e}= $MBI->new( $dat - $y1->length() );
-
+ $dat -= $MBI->_len($y1);
+ if ($dat < 0)
+ {
+ $dat = abs($dat);
+ $x->{_e} = $MBI->_new( $dat );
+ $x->{_es} = '-';
+ }
+ else
+ {
+ $x->{_e} = $MBI->_new( $dat );
+ $x->{_es} = '+';
+ }
$x->{_m} = $y1;
+ $x->bnorm();
# shortcut to not run through _find_round_parameters again
if (defined $params[0])
return $x if $x->{sign} eq '+inf'; # inf => inf
return $x->bnan()
if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
- ($x->{_e}->{sign} ne '+')); # digits after dot?
+ ($x->{_es} ne '+')); # digits after dot?
# use BigInt's bfac() for faster calc
- if (! $x->{_e}->is_zero())
+ if (! $MBI->_is_zero($x->{_e}))
{
- $x->{_m}->blsft($x->{_e},10); # change 12e1 to 120e0
- $x->{_e}->bzero();
+ $MBI->_lsft($x->{_m}, $x->{_e},10); # change 12e1 to 120e0
+ $x->{_e} = $MBI->_zero(); # normalize
+ $x->{_es} = '+';
}
- $x->{_m}->bfac(); # calculate factorial
+ $MBI->_fac($x->{_m}); # calculate factorial
$x->bnorm()->round(@r); # norm again and round result
}
$x->badd($next);
# calculate things for the next term
$over *= $u; $below *= $factor; $factor->binc();
+
+ last if $x->{sign} !~ /^[-+]$/;
+
#$steps++;
}
return $x->_pow($y,$a,$p,$r) if !$y->is_int(); # non-integer power
- my $y1 = $y->as_number(); # make bigint
+ my $y1 = $y->as_number()->{value}; # make CALC
+
# if ($x == -1)
- if ($x->{sign} eq '-' && $x->{_m}->is_one() && $x->{_e}->is_zero())
+ 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 $y1->is_odd() ? $x : $x->babs(1);
+ return $MBI->_is_odd($y1) ? $x : $x->babs(1);
}
if ($x->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) => / 0! (1 / 0 => +inf)
- $x->binf();
+ # 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 '+');
+
# calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
- $y1->babs();
- $x->{_m}->bpow($y1);
- $x->{_e}->bmul($y1);
- $x->{sign} = $nan if $x->{_m}->{sign} eq $nan || $x->{_e}->{sign} eq $nan;
+ $x->{_m} = $MBI->_pow( $x->{_m}, $y1);
+ $MBI->_mul ($x->{_e}, $y1);
+
+ $x->{sign} = $new_sign;
$x->bnorm();
if ($y->{sign} eq '-')
{
my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
return $x if $x->modify('bfround');
-
+
my ($scale,$mode) = $x->_scale_p($self->precision(),$self->round_mode(),@_);
return $x if !defined $scale; # no-op
{
# round right from the '.'
- return $x if $x->{_e}->{sign} eq '+'; # e >= 0 => nothing to round
+ return $x if $x->{_es} eq '+'; # e >= 0 => nothing to round
$scale = -$scale; # positive for simplicity
- my $len = $x->{_m}->length(); # length of mantissa
+ my $len = $MBI->_len($x->{_m}); # length of mantissa
# the following poses a restriction on _e, but if _e is bigger than a
# scalar, you got other problems (memory etc) anyway
- my $dad = -($x->{_e}->numify()); # digits after dot
+ my $dad = -(0+ ($x->{_es}.$MBI->_num($x->{_e}))); # digits after dot
my $zad = 0; # zeros after dot
$zad = $dad - $len if (-$dad < -$len); # for 0.00..00xxx style
-
- #print "scale $scale dad $dad zad $zad len $len\n";
+
+ # p rint "scale $scale dad $dad zad $zad len $len\n";
# number bsstr len zad dad
# 0.123 123e-3 3 0 3
# 0.0123 123e-4 3 1 4
# 123 => 100 means length(123) = 3 - $scale (2) => 1
- my $dbt = $x->{_m}->length();
+ my $dbt = $MBI->_len($x->{_m});
# digits before dot
- my $dbd = $dbt + $x->{_e}->numify();
+ my $dbd = $dbt + ($x->{_es} . $MBI->_num($x->{_e}));
# should be the same, so treat it as this
$scale = 1 if $scale == 0;
# shortcut if already integer
}
}
# pass sign to bround for rounding modes '+inf' and '-inf'
- $x->{_m}->{sign} = $x->{sign};
- $x->{_m}->bround($scale,$mode);
- $x->{_m}->{sign} = '+'; # fix sign back
+ my $m = Math::BigInt->new( $x->{sign} . $MBI->_str($x->{_m}));
+ $m->bround($scale,$mode);
+ $x->{_m} = $m->{value}; # get our mantissa back
$x->bnorm();
}
{
# accuracy: preserve $N digits, and overwrite the rest with 0's
my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
-
+
if (($_[0] || 0) < 0)
{
require Carp; Carp::croak ('bround() needs positive accuracy');
# 1: $scale == 0 => keep all digits
# 2: never round a 0
# 3: if we should keep more digits than the mantissa has, do nothing
- if ($scale == 0 || $x->is_zero() || $x->{_m}->length() <= $scale)
+ if ($scale == 0 || $x->is_zero() || $MBI->_len($x->{_m}) <= $scale)
{
$x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale;
return $x;
}
# pass sign to bround for '+inf' and '-inf' rounding modes
- $x->{_m}->{sign} = $x->{sign};
- $x->{_m}->bround($scale,$mode); # round mantissa
- $x->{_m}->{sign} = '+'; # fix sign back
+ my $m = Math::BigInt->new( $x->{sign} . $MBI->_str($x->{_m}));
+
+ $m->bround($scale,$mode); # round mantissa
+ $x->{_m} = $m->{value}; # get our mantissa back
$x->{_a} = $scale; # remember rounding
delete $x->{_p}; # and clear P
$x->bnorm(); # del trailing zeros gen. by bround()
return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
# if $x has digits after dot
- if ($x->{_e}->{sign} eq '-')
+ if ($x->{_es} 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->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot
+ $x->{_e} = $MBI->_zero(); # trunc/norm
+ $x->{_es} = '+'; # abs e
+ $MBI->_inc($x->{_m}) if $x->{sign} eq '-'; # increment if negative
}
$x->round($a,$p,$r);
}
return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf
# if $x has digits after dot
- if ($x->{_e}->{sign} eq '-')
+ if ($x->{_es} 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->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot
+ $x->{_e} = $MBI->_zero(); # trunc/norm
+ $x->{_es} = '+'; # abs e
+ $MBI->_inc($x->{_m}) if $x->{sign} eq '+'; # increment if positive
}
$x->round($a,$p,$r);
}
}
# try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
$name =~ s/^f/b/;
- return &{"$MBI"."::$name"}(@_);
+ return &{"Math::BigInt"."::$name"}(@_);
}
my $bname = $name; $bname =~ s/^f/b/;
$c .= "::$name";
if ($x->{sign} !~ /^[+-]$/)
{
my $s = $x->{sign}; $s =~ s/^[+-]//;
- return $self->new($s); # -inf, +inf => +inf
+ return Math::BigInt->new($s); # -inf, +inf => +inf
}
- return $x->{_e}->copy();
+ Math::BigInt->new( $x->{_es} . $MBI->_str($x->{_e}));
}
sub mantissa
if ($x->{sign} !~ /^[+-]$/)
{
my $s = $x->{sign}; $s =~ s/^[+]//;
- return $self->new($s); # -inf, +inf => +inf
+ return Math::BigInt->new($s); # -inf, +inf => +inf
}
- my $m = $x->{_m}->copy(); # faster than going via bstr()
+ my $m = Math::BigInt->new( $MBI->_str($x->{_m}));
$m->bneg() if $x->{sign} eq '-';
$m;
my $s = $x->{sign}; $s =~ s/^[+]//; my $se = $s; $se =~ s/^[-]//;
return ($self->new($s),$self->new($se)); # +inf => inf and -inf,+inf => inf
}
- my $m = $x->{_m}->copy(); # faster than going via bstr()
+ my $m = Math::BigInt->bzero();
+ $m->{value} = $MBI->_copy($x->{_m});
$m->bneg() if $x->{sign} eq '-';
- return ($m,$x->{_e}->copy());
+ ($m, Math::BigInt->new( $x->{_es} . $MBI->_num($x->{_e}) ));
}
##############################################################################
elsif ($_[$i] eq 'with')
{
# alternative class for our private parts()
- $MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt
+ # XXX: no longer supported
+ # $MBI = $_[$i+1] || 'Math::BigInt';
$i++;
}
else
# let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
my $mbilib = eval { Math::BigInt->config()->{lib} };
- if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
+ if ((defined $mbilib) && ($MBI eq 'Math::BigInt::Calc'))
{
# MBI already loaded
- $MBI->import('lib',"$lib,$mbilib", 'objectify');
+ Math::BigInt->import('lib',"$lib,$mbilib", 'objectify');
}
else
{
- # MBI not loaded, or with ne "Math::BigInt"
+ # 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
{
# Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
# used in the same script, or eval inside import().
- my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
- my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
- require File::Spec;
- $file = File::Spec->catfile (@parts, $file);
- eval { require "$file"; };
- $MBI->import( lib => $lib, 'objectify' );
+ require Math::BigInt;
+ Math::BigInt->import( lib => $lib, 'objectify' );
}
else
{
- my $rc = "use $MBI lib => '$lib', 'objectify';";
+ my $rc = "use Math::BigInt lib => '$lib', 'objectify';";
eval $rc;
}
}
if ($@)
{
- require Carp; Carp::croak ("Couldn't load $MBI: $! $@");
+ require Carp; Carp::croak ("Couldn't load $lib: $! $@");
}
+ $MBI = Math::BigInt->config()->{lib};
# any non :constant stuff is handled by our parent, Exporter
# even if @_ is empty, to give it a chance
{
# adjust m and e so that m is smallest possible
# round number according to accuracy and precision settings
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- my $zeros = $x->{_m}->_trailing_zeros(); # correct for trailing zeros
+ my $zeros = $MBI->_zeros($x->{_m}); # correct for trailing zeros
if ($zeros != 0)
{
- my $z = $MBI->new($zeros,undef,undef);
- $x->{_m}->brsft($z,10); $x->{_e}->badd($z);
+ my $z = $MBI->_new($zeros);
+ $x->{_m} = $MBI->_rsft ($x->{_m}, $z, 10);
+ if ($x->{_es} eq '-')
+ {
+ if ($MBI->_acmp($x->{_e},$z) >= 0)
+ {
+ $x->{_e} = $MBI->_sub ($x->{_e}, $z);
+ }
+ else
+ {
+ $x->{_e} = $MBI->_sub ( $MBI->_copy($z), $x->{_e});
+ $x->{_es} = '+';
+ }
+ }
+ else
+ {
+ $x->{_e} = $MBI->_add ($x->{_e}, $z);
+ }
}
else
{
# $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing
# zeros). So, for something like 0Ey, set y to 1, and -0 => +0
- $x->{sign} = '+', $x->{_e}->bone() if $x->{_m}->is_zero();
+ $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $MBI->_one()
+ if $MBI->_is_zero($x->{_m});
}
- # this is to prevent automatically rounding when MBI's globals are set
- $x->{_m}->{_f} = MB_NEVER_ROUND;
- $x->{_e}->{_f} = MB_NEVER_ROUND;
- # 'forget' that mantissa was rounded via MBI::bround() in MBF's bfround()
- delete $x->{_m}->{_a}; delete $x->{_e}->{_a};
- delete $x->{_m}->{_p}; delete $x->{_e}->{_p};
$x; # MBI bnorm is no-op, so dont call it
}
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
return '0x0' if $x->is_zero();
- return $nan if $x->{_e}->{sign} ne '+'; # how to do 1e-1 in hex!?
+ return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex!?
- my $z = $x->{_m}->copy();
- if (!$x->{_e}->is_zero()) # > 0
+ my $z = $MBI->_copy($x->{_m});
+ if (! $MBI->_is_zero($x->{_e})) # > 0
{
- $z->blsft($x->{_e},10);
+ $MBI->_lsft( $z, $x->{_e},10);
}
- $z->{sign} = $x->{sign};
+ $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z));
$z->as_hex();
}
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
return '0b0' if $x->is_zero();
- return $nan if $x->{_e}->{sign} ne '+'; # how to do 1e-1 in hex!?
+ return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex!?
- my $z = $x->{_m}->copy();
- if (!$x->{_e}->is_zero()) # > 0
+ my $z = $MBI->_copy($x->{_m});
+ if (! $MBI->_is_zero($x->{_e})) # > 0
{
- $z->blsft($x->{_e},10);
+ $MBI->_lsft( $z, $x->{_e},10);
}
- $z->{sign} = $x->{sign};
+ $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z));
$z->as_bin();
}
# return copy as a bigint representation of this BigFloat number
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- my $z = $x->{_m}->copy();
- if ($x->{_e}->{sign} eq '-') # < 0
+ my $z = $MBI->_copy($x->{_m});
+ if ($x->{_es} eq '-') # < 0
{
- $x->{_e}->{sign} = '+'; # flip
- $z->brsft($x->{_e},10);
- $x->{_e}->{sign} = '-'; # flip back
+ $MBI->_rsft( $z, $x->{_e},10);
}
- elsif (!$x->{_e}->is_zero()) # > 0
+ elsif (! $MBI->_is_zero($x->{_e})) # > 0
{
- $z->blsft($x->{_e},10);
+ $MBI->_lsft( $z, $x->{_e},10);
}
- $z->{sign} = $x->{sign};
+ $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z));
$z;
}
my $class = ref($x) || $x;
$x = $class->new(shift) unless ref($x);
- return 1 if $x->{_m}->is_zero();
- my $len = $x->{_m}->length();
- $len += $x->{_e} if $x->{_e}->sign() eq '+';
+ return 1 if $MBI->_is_zero($x->{_m});
+
+ my $len = $MBI->_len($x->{_m});
+ $len += $MBI->_num($x->{_e}) if $x->{_es} eq '+';
if (wantarray())
{
- my $t = $MBI->bzero();
- $t = $x->{_e}->copy()->babs() if $x->{_e}->sign() eq '-';
- return ($len,$t);
+ my $t = 0;
+ $t = $MBI->_num($x->{_e}) if $x->{_es} eq '-';
+ return ($len, $t);
}
$len;
}
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.69';
+$VERSION = '1.70';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify bgcd blcm);
my $CALC = 'Math::BigInt::Calc'; # module to do the low level math
# default is Calc.pm
-my %CAN; # cache for $CALC->can(...)
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 $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
-my $EMU = 'Math::BigInt::CalcEmu'; # emulate low-level math
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
return unless ref($x); # only for objects
my $self = {}; bless $self,$c;
- my $r;
- foreach my $k (keys %$x)
- {
- if ($k eq 'value')
- {
- $self->{value} = $CALC->_copy($x->{value}); next;
- }
- if (!($r = ref($x->{$k})))
- {
- $self->{$k} = $x->{$k}; next;
- }
- if ($r eq 'SCALAR')
- {
- $self->{$k} = \${$x->{$k}};
- }
- elsif ($r eq 'ARRAY')
- {
- $self->{$k} = [ @{$x->{$k}} ];
- }
- elsif ($r eq 'HASH')
- {
- # only one level deep!
- foreach my $h (keys %{$x->{$k}})
- {
- $self->{$k}->{$h} = $x->{$k}->{$h};
- }
- }
- else # normal ref
- {
- my $xk = $x->{$k};
- if ($xk->can('copy'))
- {
- $self->{$k} = $xk->copy();
- }
- else
- {
- $self->{$k} = $xk->new($xk);
- }
- }
- }
+
+ $self->{sign} = $x->{sign};
+ $self->{value} = $CALC->_copy($x->{value});
+ $self->{_a} = $x->{_a} if defined $x->{_a};
+ $self->{_p} = $x->{_p} if defined $x->{_p};
$self;
}
if ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*\z/))
{
$self->{sign} = $1 || '+';
- my $ref = \$wanted;
+
if ($wanted =~ /^[+-]/)
{
# remove sign without touching wanted to make it work with constants
- my $t = $wanted; $t =~ s/^[+-]//; $ref = \$t;
+ my $t = $wanted; $t =~ s/^[+-]//;
+ $self->{value} = $CALC->_new($t);
+ }
+ else
+ {
+ $self->{value} = $CALC->_new($wanted);
}
- # force to string version (otherwise Pari is unhappy about overflowed
- # constants, for instance)
- # not good, BigInt shouldn't need to know about alternative libs:
- # $ref = \"$$ref" if $CALC eq 'Math::BigInt::Pari';
- $self->{value} = $CALC->_new($ref);
no strict 'refs';
if ( (defined $a) || (defined $p)
|| (defined ${"${class}::precision"})
return $self;
}
# split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
- my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
+ my ($mis,$miv,$mfv,$es,$ev) = _split($wanted);
if (!ref $mis)
{
if ($_trap_nan)
}
}
$self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0
- $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/;
+ $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
my ($m,$e) = $x->parts();
#$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
return 'inf'; # +inf
}
my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
- $es.${$CALC->_str($x->{value})};
+ $es.$CALC->_str($x->{value});
}
sub numify
return $x if $x->modify('bsub');
-# upgrade done by badd():
-# return $upgrade->badd($x,$y,@r) if defined $upgrade &&
-# ((!$x->isa($self)) || (!$y->isa($self)));
+ return $upgrade->new($x)->bsub($upgrade->new($y),@r) if defined $upgrade &&
+ ((!$x->isa($self)) || (!$y->isa($self)));
if ($y->is_zero())
{
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
- ($self,$x,$base,@r) = objectify(2,$class,@_);
+ ($self,$x,$base,@r) = objectify(1,$class,@_);
}
-
+
return $x if $x->modify('blog');
# inf, -inf, NaN, <0 => NaN
return $x->bnan()
- if $x->{sign} ne '+' || $base->{sign} ne '+';
-
- return $upgrade->blog($upgrade->new($x),$base,@r) if
- defined $upgrade && (ref($x) ne $upgrade || ref($base) ne $upgrade);
+ if $x->{sign} ne '+' || (defined $base && $base->{sign} ne '+');
- if ($CAN{log_int})
- {
- my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value});
- return $x->bnan() unless defined $rc;
- $x->{value} = $rc;
- return $x->round(@r);
- }
+ return $upgrade->blog($upgrade->new($x),$base,@r) if
+ defined $upgrade;
- require $EMU_LIB;
- __emu_blog($self,$x,$base,@r);
+ my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value});
+ return $x->bnan() unless defined $rc; # not possible to take log?
+ $x->{value} = $rc;
+ $x->round(@r);
}
sub blcm
}
else
{
- $x = $class->new($y);
+ $x = __PACKAGE__->new($y);
}
- while (@_) { $x = __lcm($x,shift); }
+ my $self = ref($x);
+ while (@_)
+ {
+ my $y = shift; $y = $self->new($y) if !ref ($y);
+ $x = __lcm($x,$y);
+ }
$x;
}
my $y = shift;
$y = __PACKAGE__->new($y) if !ref($y);
my $self = ref($y);
- my $x = $y->copy(); # keep arguments
- if ($CAN{gcd})
- {
- while (@_)
- {
- $y = shift; $y = $self->new($y) if !ref($y);
- next if $y->is_zero();
- return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
- $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
- }
- }
- else
+ my $x = $y->copy()->babs(); # keep arguments
+ return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN?
+
+ while (@_)
{
- while (@_)
- {
- $y = shift; $y = $self->new($y) if !ref($y);
- $x = __gcd($x,$y->copy()); last if $x->is_one(); # _gcd handles NaN
- }
+ $y = shift; $y = $self->new($y) if !ref($y);
+ next if $y->is_zero();
+ return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
+ $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
}
- $x->babs();
+ $x;
}
sub bnot
return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
return $x->binf('-');
}
-
- return $upgrade->bmul($x,$y,@r)
- if defined $upgrade && $y->isa($upgrade);
+
+ return $upgrade->bmul($x,$upgrade->new($y),@r)
+ if defined $upgrade && !$y->isa($self);
$r[3] = $y; # no push here
return $x->round(@r);
}
- if ($CAN{mod})
+ # calc new sign and in case $y == +/- 1, return $x
+ $x->{value} = $CALC->_mod($x->{value},$y->{value});
+ if (!$CALC->_is_zero($x->{value}))
{
- # calc new sign and in case $y == +/- 1, return $x
- $x->{value} = $CALC->_mod($x->{value},$y->{value});
- if (!$CALC->_is_zero($x->{value}))
- {
- my $xsign = $x->{sign};
- $x->{sign} = $y->{sign};
- if ($xsign ne $y->{sign})
- {
- my $t = $CALC->_copy($x->{value}); # copy $x
- $x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x
- }
- }
- else
+ my $xsign = $x->{sign};
+ $x->{sign} = $y->{sign};
+ if ($xsign ne $y->{sign})
{
- $x->{sign} = '+'; # dont leave -0
+ my $t = $CALC->_copy($x->{value}); # copy $x
+ $x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x
}
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
}
- # disable upgrade temporarily, otherwise endless loop due to bdiv()
- local $upgrade = undef;
- my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds)
- # modify in place
- foreach (qw/value sign _a _p/)
+ else
{
- $x->{$_} = $rem->{$_};
+ $x->{sign} = '+'; # dont leave -0
}
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
$x;
}
# put least residue into $x if $x was negative, and thus make it positive
$x->bmod($y) if $x->{sign} eq '-';
- if ($CAN{modinv})
- {
- my $sign;
- ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value});
- return $x->bnan() if !defined $x->{value}; # in case no GCD found
- return $x if !defined $sign; # already real result
- $x->{sign} = $sign; # flip/flop see below
- $x->bmod($y); # calc real result
- return $x;
- }
-
- require $EMU_LIB;
- __emu_bmodinv($self,$x,$y,@r);
+ my $sign;
+ ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value});
+ return $x->bnan() if !defined $x->{value}; # in case no GCD found
+ return $x if !defined $sign; # already real result
+ $x->{sign} = $sign; # flip/flop see below
+ $x->bmod($y); # calc real result
+ $x;
}
sub bmodpow
# check num for valid values (also NaN if there was no inverse but $exp < 0)
return $num->bnan() if $num->{sign} !~ /^[+-]$/;
- if ($CAN{modpow})
- {
- # $mod is positive, sign on $exp is ignored, result also positive
- $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value});
- return $num;
- }
-
- require $EMU_LIB;
- __emu_bmodpow($self,$num,$exp,$mod,@r);
+ # $mod is positive, sign on $exp is ignored, result also positive
+ $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value});
+ $num;
}
###############################################################################
return $x if $x->{sign} eq '+inf'; # inf => inf
return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
- if ($CAN{fac})
- {
- $x->{value} = $CALC->_fac($x->{value});
- return $x->round(@r);
- }
-
- require $EMU_LIB;
- __emu_bfac($self,$x,@r);
+ $x->{value} = $CALC->_fac($x->{value});
+ $x->round(@r);
}
sub bpow
# cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
- if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
- {
- # if $x == -1 and odd/even y => +1/-1
- return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r);
- # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
- }
+ my $new_sign = '+';
+ $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
+
+ # 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
- return $x->bnan() if $y->{sign} eq '-' && !$x->is_one();
-
- if ($CAN{pow})
- {
- $x->{value} = $CALC->_pow($x->{value},$y->{value});
- $x->{sign} = '+' if $CALC->_is_zero($y->{value});
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
- }
+ return $x->bnan() if $y->{sign} eq '-' && !$CALC->_is_one($x->{value});
- require $EMU_LIB;
- __emu_bpow($self,$x,$y,@r);
+ $x->{value} = $CALC->_pow($x->{value},$y->{value});
+ $x->{sign} = $new_sign;
+ $x->{sign} = '+' if $CALC->_is_zero($y->{value});
+ $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x;
}
sub blsft
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
- my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CAN{lsft};
- if (defined $t)
- {
- $x->{value} = $t; return $x->round(@r);
- }
- # fallback
- $x->bmul( $self->bpow($n, $y, @r), @r );
+ $x->{value} = $CALC->_lsft($x->{value},$y->{value},$n);
+ $x->round(@r);
}
sub brsft
$x->bdec(); # n == 2, but $y == 1: this fixes it
}
- my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CAN{rsft};
- if (defined $t)
- {
- $x->{value} = $t;
- return $x->round(@r);
- }
- # fallback
- $x->bdiv($self->bpow($n,$y, @r), @r);
- $x;
+ $x->{value} = $CALC->_rsft($x->{value},$y->{value},$n);
+ $x->round(@r);
}
sub band
my $sx = $x->{sign} eq '+' ? 1 : -1;
my $sy = $y->{sign} eq '+' ? 1 : -1;
- if ($CAN{and} && $sx == 1 && $sy == 1)
+ if ($sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_and($x->{value},$y->{value});
return $x->round(@r);
return $x if $x->modify('bior');
$r[3] = $y; # no push!
- local $Math::BigInt::upgrade = undef;
-
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
my $sx = $x->{sign} eq '+' ? 1 : -1;
# the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior()
# don't use lib for negative values
- if ($CAN{or} && $sx == 1 && $sy == 1)
+ if ($sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_or($x->{value},$y->{value});
return $x->round(@r);
my $sy = $y->{sign} eq '+' ? 1 : -1;
# don't use lib for negative values
- if ($CAN{xor} && $sx == 1 && $sy == 1)
+ if ($sx == 1 && $sy == 1)
{
$x->{value} = $CALC->_xor($x->{value},$y->{value});
return $x->round(@r);
my $x = shift;
$x = $class->new($x) unless ref $x;
- return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/;
-
- return $CALC->_zeros($x->{value}) if $CAN{zeros};
+ return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc
- # if not: since we do not know underlying internal representation:
- my $es = "$x"; $es =~ /([0]*)$/;
- return 0 if !defined $1; # no zeros
- CORE::length("$1"); # $1 as string, not as +0!
+ $CALC->_zeros($x->{value}); # must handle odd values, 0 etc
}
sub bsqrt
return $upgrade->bsqrt($x,@r) if defined $upgrade;
- if ($CAN{sqrt})
- {
- $x->{value} = $CALC->_sqrt($x->{value});
- return $x->round(@r);
- }
-
- require $EMU_LIB;
- __emu_bsqrt($self,$x,@r);
+ $x->{value} = $CALC->_sqrt($x->{value});
+ $x->round(@r);
}
sub broot
return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade;
- if ($CAN{root})
- {
- $x->{value} = $CALC->_root($x->{value},$y->{value});
- return $x->round(@r);
- }
-
- require $EMU_LIB;
- __emu_broot($self,$x,$y,@r);
+ $x->{value} = $CALC->_root($x->{value},$y->{value});
+ $x->round(@r);
}
sub exponent
# pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4
# pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3
- $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len;
+ $digit_round = '0'; $digit_round = substr($xs,$pl,1) if $pad <= $len;
$pl++; $pl ++ if $pad >= $len;
- $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0;
+ $digit_after = '0'; $digit_after = substr($xs,$pl,1) if $pad > 0;
# 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
if (($pad > 0) && ($pad <= $len))
{
- substr($$xs,-$pad,$pad) = '0' x $pad;
+ substr($xs,-$pad,$pad) = '0' x $pad;
$put_back = 1;
}
elsif ($pad > $len)
if ($round_up) # what gave test above?
{
$put_back = 1;
- $pad = $len, $$xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0
+ $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
while ($pad <= $len)
{
- $c = substr($$xs,-$pad,1) + 1; $c = '0' if $c eq '10';
- substr($$xs,-$pad,1) = $c; $pad++;
+ $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
}
- $$xs = '1'.$$xs if $c == 0;
+ $xs = '1'.$xs if $c == 0;
}
$x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in if needed
my $s = '';
$s = $x->{sign} if $x->{sign} eq '-';
- if ($CAN{as_hex})
- {
- return $s . ${$CALC->_as_hex($x->{value})};
- }
-
- require $EMU_LIB;
- __emu_as_hex(ref($x),$x,$s);
+ $s . $CALC->_as_hex($x->{value});
}
sub as_bin
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
my $s = ''; $s = $x->{sign} if $x->{sign} eq '-';
- if ($CAN{as_bin})
- {
- return $s . ${$CALC->_as_bin($x->{value})};
- }
-
- require $EMU_LIB;
- __emu_as_bin(ref($x),$x,$s);
-
+ return $s . $CALC->_as_bin($x->{value});
}
##############################################################################
{
eval "use $lib qw/@c/;";
}
- $CALC = $lib, last if $@ eq ''; # no error in loading lib?
+ if ($@ eq '')
+ {
+ my $ok = 1;
+ # loaded it ok, see if the api_version() is high enough
+ if ($lib->can('api_version') && $lib->api_version() >= 1.0)
+ {
+ $ok = 0;
+ # api_version matches, check if it really provides anything we need
+ for my $method (qw/
+ one two ten
+ str num
+ add mul div sub dec inc
+ acmp len digit is_one is_zero is_even is_odd
+ is_two is_ten
+ new copy check from_hex from_bin as_hex as_bin zeros
+ 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 ($ok == 0)
+ {
+ $CALC = $lib;
+ last; # found a usable one, break
+ }
+ else
+ {
+ if (($WARN{$lib}||0) < 2)
+ {
+ my $ver = eval "\$$lib\::VERSION";
+ require Carp;
+ Carp::carp ("Cannot load outdated $lib v$ver, please upgrade");
+ $WARN{$lib} = 2; # never warn again
+ }
+ }
+ }
}
if ($CALC eq '')
{
require Carp;
Carp::croak ("Couldn't load any math lib, not even 'Calc.pm'");
}
- _fill_can_cache();
+ _fill_can_cache(); # for emulating lower math lib functions
}
sub _fill_can_cache
# fill $CAN with the results of $CALC->can(...)
%CAN = ();
- for my $method (qw/gcd mod modinv modpow fac pow lsft rsft
- and signed_and or signed_or xor signed_xor
- from_hex as_hex from_bin as_bin
- zeros sqrt root log_int log
- /)
+ for my $method (qw/ signed_and or signed_or xor signed_xor /)
{
$CAN{$method} = $CALC->can("_$method") ? 1 : 0;
}
my $x = Math::BigInt->bzero();
# strip underscores
- $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
- $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
+ $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
+ $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g;
- return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
+ return $x->bnan() if $hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/;
- my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
+ my $sign = '+'; $sign = '-' if $hs =~ /^-/;
- $$hs =~ s/^[+-]//; # strip sign
- if ($CAN{'from_hex'})
- {
- $x->{value} = $CALC->_from_hex($hs);
- }
- else
- {
- # fallback to pure perl
- my $mul = Math::BigInt->bone();
- my $x65536 = Math::BigInt->new(65536);
- my $len = CORE::length($$hs)-2; # minus 2 for 0x
- $len = int($len/4); # 4-digit parts, w/o '0x'
- my $val; my $i = -4;
- while ($len >= 0)
- {
- $val = substr($$hs,$i,4);
- $val =~ s/^[+-]?0x// if $len == 0; # for last part only because
- $val = hex($val); # hex does not like wrong chars
- $i -= 4; $len --;
- $x += $mul * $val if $val != 0;
- $mul *= $x65536 if $len >= 0; # skip last mul
- }
- }
+ $hs =~ s/^[+-]//; # strip sign
+ $x->{value} = $CALC->_from_hex($hs);
$x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
$x;
}
my $x = Math::BigInt->bzero();
# strip underscores
- $$bs =~ s/([01])_([01])/$1$2/g;
- $$bs =~ s/([01])_([01])/$1$2/g;
- return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/;
+ $bs =~ s/([01])_([01])/$1$2/g;
+ $bs =~ s/([01])_([01])/$1$2/g;
+ return $x->bnan() if $bs !~ /^[+-]?0b[01]+$/;
- my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
- $$bs =~ s/^[+-]//; # strip sign
- if ($CAN{'from_bin'})
- {
- $x->{value} = $CALC->_from_bin($bs);
- }
- else
- {
- my $mul = Math::BigInt->bone();
- my $x256 = Math::BigInt->new(256);
- my $len = CORE::length($$bs)-2; # minus 2 for 0b
- $len = int($len/8); # 8-digit parts, w/o '0b'
- my $val; my $i = -8;
- while ($len >= 0)
- {
- $val = substr($$bs,$i,8);
- $val =~ s/^[+-]?0b// if $len == 0; # for last part only
- #$val = oct('0b'.$val); # does not work on Perl prior to 5.6.0
- # slower:
- # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8;
- $val = ord(pack('B8',substr('00000000'.$val,-8,8)));
- $i -= 8; $len --;
- $x += $mul * $val if $val != 0;
- $mul *= $x256 if $len >= 0; # skip last mul
- }
- }
+ my $sign = '+'; $sign = '-' if $bs =~ /^\-/;
+ $bs =~ s/^[+-]//; # strip sign
+
+ $x->{value} = $CALC->_from_bin($bs);
$x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0'
$x;
}
my $x = shift;
# strip white space at front, also extranous leading zeros
- $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
- $$x =~ s/^\s+//; # but this will
- $$x =~ s/\s+$//g; # strip white space at end
+ $x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2'
+ $x =~ s/^\s+//; # but this will
+ $x =~ s/\s+$//g; # strip white space at end
# shortcut, if nothing to split, return early
- if ($$x =~ /^[+-]?\d+\z/)
+ if ($x =~ /^[+-]?\d+\z/)
{
- $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
- return (\$sign, $x, \'', \'', \0);
+ $x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
+ return (\$sign, \$x, \'', \'', \0);
}
# invalid starting char?
- return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
+ return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
- return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
- return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
+ return __from_hex($x) if $x =~ /^[\-\+]?0x/; # hex string
+ return __from_bin($x) if $x =~ /^[\-\+]?0b/; # binary string
# strip underscores between digits
- $$x =~ s/(\d)_(\d)/$1$2/g;
- $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
+ $x =~ s/(\d)_(\d)/$1$2/g;
+ $x =~ s/(\d)_(\d)/$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
- #return if $$x =~ /[Ee].*[Ee]/; # more than one E => error
-
- my ($m,$e,$last) = split /[Ee]/,$$x;
+ my ($m,$e,$last) = split /[Ee]/,$x;
return if defined $last; # last defined => 1e2E3 or others
$e = '0' if !defined $e || $e eq "";
my $x = shift; my $ty = shift;
return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
- return $x * $ty / bgcd($x,$ty);
- }
-
-sub __gcd
- {
- # (BINT or num_str, BINT or num_str) return BINT
- # does modify both arguments
- # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296
- my ($x,$ty) = @_;
-
- return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/;
-
- while (!$ty->is_zero())
- {
- ($x, $ty) = ($ty,bmod($x,$ty));
- }
- $x;
+ $x * $ty / bgcd($x,$ty);
}
###############################################################################
use Math::BigInt lib => 'GMP';
+ my $str = '1234567890';
+ my @values = (64,74,18);
+ my $n = 1; my $sign = '-';
+
# Number creation
$x = Math::BigInt->new($str); # defaults to 0
+ $y = $x->copy(); # make a true copy
$nan = Math::BigInt->bnan(); # create a NotANumber
$zero = Math::BigInt->bzero(); # create a +0
$inf = Math::BigInt->binf(); # create a +inf
$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_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 extration
$x->bfac(); # factorial of $x (1*2*3*4*..$x)
$x->round($A,$P,$mode); # round to accuracy or precision using mode $mode
- $x->bround($N); # accuracy: preserve $N digits
- $x->bfround($N); # round to $Nth digit, no-op for BigInts
+ $x->bround($n); # accuracy: preserve $n digits
+ $x->bfround($n); # round to $nth digit, no-op for BigInts
# The following do not modify their arguments in BigInt (are no-ops),
# but do so in BigFloat:
# The following do not modify their arguments:
- bgcd(@values); # greatest common divisor (no OO style)
- blcm(@values); # lowest common multiplicator (no OO style)
+ # greatest common divisor (no OO style)
+ my $gcd = Math::BigInt::bgcd(@values);
+ # lowest common multiplicator (no OO style)
+ my $lcm = Math::BigInt::blcm(@values);
$x->length(); # return number of digits in number
- ($x,$f) = $x->length(); # length of number and length of fraction part,
+ ($xl,$f) = $x->length(); # length of number and length of fraction part,
# latter is always 0 digits long for BigInt's
$x->exponent(); # return exponent as BigInt
use vars qw/$VERSION/;
-$VERSION = '0.38';
+$VERSION = '0.40';
# Package to store unsigned big integers in decimal and do math with them
##############################################################################
# global constants, flags and accessory
+
+# announce that we are compatible with MBI v1.70 and up
+sub api_version () { 1; }
# constants for easier life
my $nan = 'NaN';
$RBASE = abs('1e-'.$BASE_LEN_SMALL); # see USE_MUL
$MAX_VAL = $MBASE-1;
- #print "BASE_LEN: $BASE_LEN MAX_VAL: $MAX_VAL BASE: $BASE RBASE: $RBASE ";
- #print "BASE_LEN_SMALL: $BASE_LEN_SMALL MBASE: $MBASE\n";
-
undef &_mul;
undef &_div;
# & here.
if ($caught == 2) # 2
{
- # print "# use mul\n";
# must USE_MUL since we cannot use DIV
*{_mul} = \&_mul_use_mul;
*{_div} = \&_div_use_mul;
}
else # 0 or 1
{
- # print "# use div\n";
# can USE_DIV instead
*{_mul} = \&_mul_use_div;
*{_div} = \&_div_use_div;
# (ref to string) return ref to num_array
# Convert a number from string format (without sign) to internal base
# 1ex format. Assumes normalized value as input.
- my $d = $_[1];
- my $il = length($$d)-1;
+ my $il = length($_[1])-1;
# < BASE_LEN due len-1 above
- return [ int($$d) ] if $il < $BASE_LEN; # shortcut for short numbers
+ return [ int($_[1]) ] if $il < $BASE_LEN; # shortcut for short numbers
# this leaves '00000' instead of int 0 and will be corrected after any op
[ reverse(unpack("a" . ($il % $BASE_LEN+1)
- . ("a$BASE_LEN" x ($il / $BASE_LEN)), $$d)) ];
+ . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ];
}
BEGIN
{
- $AND_MASK = __PACKAGE__->_new( \( 2 ** $AND_BITS ));
- $XOR_MASK = __PACKAGE__->_new( \( 2 ** $XOR_BITS ));
- $OR_MASK = __PACKAGE__->_new( \( 2 ** $OR_BITS ));
+ $AND_MASK = __PACKAGE__->_new( ( 2 ** $AND_BITS ));
+ $XOR_MASK = __PACKAGE__->_new( ( 2 ** $XOR_BITS ));
+ $OR_MASK = __PACKAGE__->_new( ( 2 ** $OR_BITS ));
}
sub _zero
[ 2 ];
}
+sub _ten
+ {
+ # create a 10 (used internally for shifting)
+ [ 10 ];
+ }
+
sub _copy
{
# make a true copy
$ret .= substr($z.$ar->[$l],-$BASE_LEN); # fastest way I could think of
$l--;
}
- \$ret;
+ $ret;
}
sub _num
{
- # Make a number (scalar int/float) from a BigInt object
+ # Make a number (scalar int/float) from a BigInt object
my $x = $_[1];
- return $x->[0] if scalar @$x == 1; # below $BASE
+
+ return 0+$x->[0] if scalar @$x == 1; # below $BASE
my $fac = 1;
my $num = 0;
foreach (@$x)
my $car = 0; my $i; my $j = 0;
if (!$s)
{
- #print "case 2\n";
for $i (@$sx)
{
last unless defined $sy->[$j] || $car;
# might leave leading zeros, so fix that
return __strip_zeros($sx);
}
- #print "case 1 (swap)\n";
for $i (@$sx)
{
# we can't do an early out if $x is < than $y, since we
# check each array elem in _m for having 0 at end as long as elem == 0
# Upon finding a elem != 0, stop
my $x = $_[1];
+
+ return 0 if scalar @$x == 1 && $x->[0] == 0;
+
my $zeros = 0; my $elem;
foreach my $e (@$x)
{
sub _is_zero
{
- # return true if arg (BINT or num_str) is zero (array '+', '0')
- my $x = $_[1];
-
- (((scalar @$x == 1) && ($x->[0] == 0))) <=> 0;
+ # return true if arg is zero
+ (((scalar @{$_[1]} == 1) && ($_[1]->[0] == 0))) <=> 0;
}
sub _is_even
{
- # return true if arg (BINT or num_str) is even
- my $x = $_[1];
- (!($x->[0] & 1)) <=> 0;
+ # return true if arg is even
+ (!($_[1]->[0] & 1)) <=> 0;
}
sub _is_odd
{
- # return true if arg (BINT or num_str) is even
- my $x = $_[1];
-
- (($x->[0] & 1)) <=> 0;
+ # return true if arg is even
+ (($_[1]->[0] & 1)) <=> 0;
}
sub _is_one
{
- # return true if arg (BINT or num_str) is one (array '+', '1')
- my $x = $_[1];
+ # return true if arg is one
+ (scalar @{$_[1]} == 1) && ($_[1]->[0] == 1) <=> 0;
+ }
+
+sub _is_two
+ {
+ # return true if arg is two
+ (scalar @{$_[1]} == 1) && ($_[1]->[0] == 2) <=> 0;
+ }
- (scalar @$x == 1) && ($x->[0] == 1) <=> 0;
+sub _is_ten
+ {
+ # return true if arg is ten
+ (scalar @{$_[1]} == 1) && ($_[1]->[0] == 10) <=> 0;
}
sub __strip_zeros
###############################################################################
-###############################################################################
-# some optional routines to make BigInt faster
sub _mod
{
if ($n != 10)
{
- $n = _new($c,\$n); return _div($c,$x, _pow($c,$n,$y));
+ $n = _new($c,$n); return _div($c,$x, _pow($c,$n,$y));
}
# shortcut (faster) for shifting by 10)
if ($n != 10)
{
- $n = _new($c,\$n); return _mul($c,$x, _pow($c,$n,$y));
+ $n = _new($c,$n); return _mul($c,$x, _pow($c,$n,$y));
}
# shortcut (faster) for shifting by 10) since we are in base 10eX
my $pow2 = _one();
- my $y_bin = ${_as_bin($c,$cy)}; $y_bin =~ s/^0b//;
+ my $y_bin = _as_bin($c,$cy); $y_bin =~ s/^0b//;
my $len = length($y_bin);
while (--$len > 0)
{
$cx; # return result
}
+#############################################################################
+
sub _log_int
{
# calculate integer log of $x to base $base
my $a;
my $base_mul = _mul($c, _copy($c,$base), $base);
- while (($a = _acmp($x,$trial,$x_org)) < 0)
+ while (($a = _acmp($c,$trial,$x_org)) < 0)
{
_mul($c,$trial,$base_mul); _add($c, $x, [2]);
}
# overstepped the result
_dec($c, $x);
_div($c,$trial,$base);
- $a = _acmp($x,$trial,$x_org);
+ $a = _acmp($c,$trial,$x_org);
if ($a > 0)
{
_dec($c, $x);
# an even better guess. Not implemented yet. Does it improve performance?
$x->[$l--] = 0 while ($l >= 0); # all other digits of guess are zero
- print "start x= ",${_str($c,$x)},"\n" if DEBUG;
+ print "start x= ",_str($c,$x),"\n" if DEBUG;
my $two = _two();
my $last = _zero();
my $lastlast = _zero();
$last = _copy($c,$x);
_add($c,$x, _div($c,_copy($c,$y),$x));
_div($c,$x, $two );
- print " x= ",${_str($c,$x)},"\n" if DEBUG;
+ print " x= ",_str($c,$x),"\n" if DEBUG;
}
print "\nsteps in sqrt: $steps, " if DEBUG;
_dec($c,$x) if _acmp($c,$y,_mul($c,_copy($c,$x),$x)) < 0; # overshot?
# if $n is a power of two, we can repeatedly take sqrt($X) and find the
# proper result, because sqrt(sqrt($x)) == root($x,4)
my $b = _as_bin($c,$n);
- if ($$b =~ /0b1(0+)$/)
+ if ($b =~ /0b1(0+)$/)
{
my $count = CORE::length($1); # 0b100 => len('00') => 2
my $cnt = $count; # counter for loop
($y1, $yr) = _div($c,$y1,$mask);
# make ints() from $xr, $yr
- # this is when the AND_BITS are greater tahn $BASE and is slower for
+ # this is when the AND_BITS are greater than $BASE and is slower for
# small (<256 bits) numbers, but faster for large numbers. Disabled
# due to KISS principle
# $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
# $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
-# _add($c,$x, _mul($c, _new( $c, \($xrr & $yrr) ), $m) );
+# _add($c,$x, _mul($c, _new( $c, ($xrr & $yrr) ), $m) );
# 0+ due to '&' doesn't work in strings
_add($c,$x, _mul($c, [ 0+$xr->[0] & 0+$yr->[0] ], $m) );
# make ints() from $xr, $yr (see _and())
#$b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
#$b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
- #_add($c,$x, _mul($c, _new( $c, \($xrr ^ $yrr) ), $m) );
+ #_add($c,$x, _mul($c, _new( $c, ($xrr ^ $yrr) ), $m) );
# 0+ due to '^' doesn't work in strings
_add($c,$x, _mul($c, [ 0+$xr->[0] ^ 0+$yr->[0] ], $m) );
# make ints() from $xr, $yr (see _and())
# $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
# $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
-# _add($c,$x, _mul($c, _new( $c, \($xrr | $yrr) ), $m) );
+# _add($c,$x, _mul($c, _new( $c, ($xrr | $yrr) ), $m) );
# 0+ due to '|' doesn't work in strings
_add($c,$x, _mul($c, [ 0+$xr->[0] | 0+$yr->[0] ], $m) );
if (@$x == 1)
{
my $t = sprintf("0x%x",$x->[0]);
- return \$t;
+ return $t;
}
my $x1 = _copy($c,$x);
$es = reverse $es;
$es =~ s/^[0]+//; # strip leading zeros
$es = '0x' . $es;
- \$es;
+ $es;
}
sub _as_bin
# handle zero case for older Perls
if ($] <= 5.005 && @$x == 1 && $x->[0] == 0)
{
- my $t = '0b0'; return \$t;
+ my $t = '0b0'; return $t;
}
if (@$x == 1 && $] >= 5.006)
{
my $t = sprintf("0b%b",$x->[0]);
- return \$t;
+ return $t;
}
my $x1 = _copy($c,$x);
$es = reverse $es;
$es =~ s/^[0]+//; # strip leading zeros
$es = '0b' . $es;
- \$es;
+ $es;
}
sub _from_hex
my $m = [ 0x10000 ]; # 16 bit at a time
my $x = _zero();
- my $len = length($$hs)-2;
+ my $len = length($hs)-2;
$len = int($len/4); # 4-digit parts, w/o '0x'
my $val; my $i = -4;
while ($len >= 0)
{
- $val = substr($$hs,$i,4);
+ $val = substr($hs,$i,4);
$val =~ s/^[+-]?0x// if $len == 0; # for last part only because
$val = hex($val); # hex does not like wrong chars
$i -= 4; $len --;
# instead of converting X (8) bit at a time, it is faster to "convert" the
# number to hex, and then call _from_hex.
- my $hs = $$bs;
+ my $hs = $bs;
$hs =~ s/^[+-]?0b//; # remove sign and 0b
my $l = length($hs); # bits
$hs = '0' x (8-($l % 8)) . $hs if ($l % 8) != 0; # padd left side w/ 0
my $h = unpack('H*', pack ('B*', $hs)); # repack as hex
- $c->_from_hex(\('0x'.$h));
+ $c->_from_hex('0x'.$h);
}
##############################################################################
my $acc = _copy($c,$num); my $t = _one();
- my $expbin = ${_as_bin($c,$exp)}; $expbin =~ s/^0b//;
+ my $expbin = _as_bin($c,$exp); $expbin =~ s/^0b//;
my $len = length($expbin);
while (--$len >= 0)
{
$num;
}
+sub _gcd
+ {
+ # greatest common divisor
+ my ($c,$x,$y) = @_;
+
+ while (! _is_zero($c,$y))
+ {
+ my $t = _copy($c,$y);
+ $y = _mod($c, $x, $y);
+ $x = $t;
+ }
+ $x;
+ }
+
##############################################################################
##############################################################################
=head1 METHODS
The following functions MUST be defined in order to support the use by
-Math::BigInt:
+Math::BigInt v1.70 or later:
+ api_version() return API version, minimum 1 for v1.70
_new(string) return ref to new object from ref to decimal string
_zero() return a new object with value 0
_one() return a new object with value 1
+ _two() return a new object with value 2
+ _ten() return a new object with value 10
_str(obj) return ref to a string representing the object
_num(obj) returns a Perl integer/floating point number
_len(obj) returns count of the decimal digits of the object
_digit(obj,n) returns the n'th decimal digit of object
- _is_one(obj) return true if argument is +1
+ _is_one(obj) return true if argument is 1
+ _is_two(obj) return true if argument is 2
+ _is_ten(obj) return true if argument is 10
_is_zero(obj) return true if argument is 0
_is_even(obj) return true if argument is even (0,2,4,6..)
_is_odd(obj) return true if argument is odd (1,3,5,7..)
_check(obj) check whether internal representation is still intact
return 0 for ok, otherwise error message as string
-The following functions are optional, and can be defined if the underlying lib
-has a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence
-slow) fallback routines to emulate these:
-
_from_hex(str) return ref to new object from ref to hexadecimal string
_from_bin(str) return ref to new object from ref to binary string
- _as_hex(str) return ref to scalar string containing the value as
+ _as_hex(str) return string containing the value as
unsigned hex string, with the '0x' prepended.
Leading zeros must be stripped.
_as_bin(str) Like as_hex, only as binary string containing only
'0b' must be prepended.
_rsft(obj,N,B) shift object in base B by N 'digits' right
- For unsupported bases B, return undef to signal failure
_lsft(obj,N,B) shift object in base B by N 'digits' left
- For unsupported bases B, return undef to signal failure
_xor(obj1,obj2) XOR (bit-wise) object 1 with object 2
Note: XOR, AND and OR pad with zeros if size mismatches
_and(obj1,obj2) AND (bit-wise) object 1 with object 2
_or(obj1,obj2) OR (bit-wise) object 1 with object 2
- _signed_or
- _signed_and
- _signed_xor
-
_mod(obj,obj) Return remainder of div of the 1st by the 2nd object
_sqrt(obj) return the square root of object (truncated to int)
_root(obj) return the n'th (n >= 3) root of obj (truncated to int)
_fac(obj) return factorial of object 1 (1*2*3*4..)
_pow(obj,obj) return object 1 to the power of object 2
return undef for NaN
- _gcd(obj,obj) return Greatest Common Divisor of two objects
-
_zeros(obj) return number of trailing decimal zeros
_modinv return inverse modulus
_modpow return modulus of power ($x ** $y) % $z
1 : result is exactly RESULT
0 : result was truncated to RESULT
undef : unknown whether result is exactly RESULT
+ _gcd(obj,obj) return Greatest Common Divisor of two objects
+
+The following functions are optional, and can be defined if the underlying lib
+has a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence
+slow) fallback routines to emulate these:
+
+ _signed_or
+ _signed_and
+ _signed_xor
+
Input strings come in as unsigned but with prefix (i.e. as '123', '0xabc'
or '0b1101').
Return values are always references to objects, strings, or true/false for
comparisation routines.
-Exceptions are C<_lsft()> and C<_rsft()>, which return undef if they can not
-shift the argument. This is used to delegate shifting of bases different than
-the one you can support back to Math::BigInt, which will use some generic code
-to calculate the result.
-
=head1 WRAP YOUR OWN
If you want to port your own favourite c-lib for big numbers to the
in late 2000.
Seperated from BigInt and shaped API with the help of John Peacock.
Fixed, sped-up and enhanced by Tels http://bloodgate.com 2001-2003.
+Further streamlining (api_version 1) by Tels 2004.
=head1 SEE ALSO
# use warnings; # dont use warnings for older Perls
use vars qw/$VERSION/;
-$VERSION = '0.03';
+$VERSION = '0.04';
package Math::BigInt;
$CALC_EMU = Math::BigInt->config()->{'lib'};
}
-sub __emu_blog
- {
- my ($self,$x,$base,@r) = @_;
-
- return $x->bnan() if $x->is_zero() || $base->is_zero() || $base->is_one();
-
- my $acmp = $x->bacmp($base);
- return $x->bone('+',@r) if $acmp == 0;
- return $x->bzero(@r) if $acmp < 0 || $x->is_one();
-
- # blog($x,$base) ** $base + $y = $x
-
- # this trial multiplication is very fast, even for large counts (like for
- # 2 ** 1024, since this still requires only 1024 very fast steps
- # (multiplication of a large number by a very small number is very fast))
- # See Calc for an even faster algorightmn
- my $x_org = $x->copy(); # preserve orgx
- $x->bzero(); # keep ref to $x
- my $trial = $base->copy();
- while ($trial->bacmp($x_org) <= 0)
- {
- $trial->bmul($base); $x->binc();
- }
- $x->round(@r);
- }
-
-sub __emu_bmodinv
- {
- my ($self,$x,$y,@r) = @_;
-
- my ($u, $u1) = ($self->bzero(), $self->bone());
- my ($a, $b) = ($y->copy(), $x->copy());
-
- # first step need always be done since $num (and thus $b) is never 0
- # Note that the loop is aligned so that the check occurs between #2 and #1
- # thus saving us one step #2 at the loop end. Typical loop count is 1. Even
- # a case with 28 loops still gains about 3% with this layout.
- my $q;
- ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1
- # Euclid's Algorithm (calculate GCD of ($a,$b) in $a and also calculate
- # two values in $u and $u1, we use only $u1 afterwards)
- my $sign = 1; # flip-flop
- while (!$b->is_zero()) # found GCD if $b == 0
- {
- # the original algorithm had:
- # ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2
- # The following creates exact the same sequence of numbers in $u1,
- # except for the sign ($u1 is now always positive). Since formerly
- # the sign of $u1 was alternating between '-' and '+', the $sign
- # flip-flop will take care of that, so that at the end of the loop
- # we have the real sign of $u1. Keeping numbers positive gains us
- # speed since badd() is faster than bsub() and makes it possible
- # to have the algorithmn in Calc for even more speed.
-
- ($u, $u1) = ($u1, $u->badd($u1->copy()->bmul($q))); # step #2
- $sign = - $sign; # flip sign
-
- ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 again
- }
-
- # If the gcd is not 1, then return NaN! It would be pointless to have
- # called bgcd to check this first, because we would then be performing
- # the same Euclidean Algorithm *twice* in case the gcd is 1.
- return $x->bnan() unless $a->is_one();
-
- $u1->bneg() if $sign != 1; # need to flip?
-
- $u1->bmod($y); # calc result
- $x->{value} = $u1->{value}; # and copy over to $x
- $x->{sign} = $u1->{sign}; # to modify in place
- $x->round(@r);
- }
-
-sub __emu_bmodpow
- {
- my ($self,$num,$exp,$mod,@r) = @_;
-
- # in the trivial case,
- return $num->bzero(@r) if $mod->is_one();
- return $num->bone('+',@r) if $num->is_zero() or $num->is_one();
-
- # $num->bmod($mod); # if $x is large, make it smaller first
- my $acc = $num->copy(); # but this is not really faster...
-
- $num->bone(); # keep ref to $num
-
- my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix
- my $len = CORE::length($expbin);
- while (--$len >= 0)
- {
- $num->bmul($acc)->bmod($mod) if substr($expbin,$len,1) eq '1';
- $acc->bmul($acc)->bmod($mod);
- }
-
- $num->round(@r);
- }
-
-sub __emu_bfac
- {
- my ($self,$x,@r) = @_;
-
- return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
-
- my $n = $x->copy();
- $x->bone();
- # seems we need not to temp. clear A/P of $x since the result is the same
- my $f = $self->new(2);
- while ($f->bacmp($n) < 0)
- {
- $x->bmul($f); $f->binc();
- }
- $x->bmul($f,@r); # last step and also round result
- }
-
-sub __emu_bpow
- {
- my ($self,$x,$y,@r) = @_;
-
- return $x->bone('+',@r) if $y->is_zero();
- return $x->round(@r) if $x->is_one() || $y->is_one();
- return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0)
-
- my $pow2 = $self->bone();
- my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//;
- my $len = CORE::length($y_bin);
- while (--$len > 0)
- {
- $pow2->bmul($x) if substr($y_bin,$len,1) eq '1'; # is odd?
- $x->bmul($x);
- }
- $x->bmul($pow2);
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- $x;
- }
-
sub __emu_band
{
my ($self,$x,$y,$sx,$sy,@r) = @_;
$bx = reverse $bx;
$by = reverse $by;
- # cut the longer string to the length of the shorter one (the result would
- # be 0 due to AND anyway)
+ # padd the shorter string
+ my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
+ my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
my $diff = CORE::length($bx) - CORE::length($by);
if ($diff > 0)
{
- $bx = substr($bx,0,CORE::length($by));
+ # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
+ $by .= $yy x $diff;
}
elsif ($diff < 0)
{
- $by = substr($by,0,CORE::length($bx));
+ # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
+ $bx .= $xx x abs($diff);
}
-
+
# and the strings together
my $r = $bx & $by;
# and reverse the result again
$bx = reverse $r;
- # one of $x or $y was negative, so need to flip bits in the result
- # in both cases (one or two of them negative, or both positive) we need
+ # One of $x or $y was negative, so need to flip bits in the result.
+ # In both cases (one or two of them negative, or both positive) we need
# to get the characters back.
if ($sign == 1)
{
$bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
}
+ # leading zeros will be stripped by _from_hex()
$bx = '0x' . $bx;
- if ($CALC_EMU->can('_from_hex'))
- {
- $x->{value} = $CALC_EMU->_from_hex( \$bx );
- }
- else
- {
- $r = $self->new($bx);
- $x->{value} = $r->{value};
- }
+ $x->{value} = $CALC_EMU->_from_hex( $bx );
# calculate sign of result
$x->{sign} = '+';
- #$x->{sign} = '-' if $sx == $sy && $sx == -1 && !$x->is_zero();
$x->{sign} = '-' if $sign == 1 && !$x->is_zero();
$x->bdec() if $sign == 1;
$bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
}
+ # leading zeros will be stripped by _from_hex()
$bx = '0x' . $bx;
- if ($CALC_EMU->can('_from_hex'))
- {
- $x->{value} = $CALC_EMU->_from_hex( \$bx );
- }
- else
- {
- $r = $self->new($bx);
- $x->{value} = $r->{value};
- }
+ $x->{value} = $CALC_EMU->_from_hex( $bx );
+
+ # calculate sign of result
+ $x->{sign} = '+';
+ $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
# if one of X or Y was negative, we need to decrement result
$x->bdec() if $sign == 1;
$bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
}
+ # leading zeros will be stripped by _from_hex()
$bx = '0x' . $bx;
- if ($CALC_EMU->can('_from_hex'))
- {
- $x->{value} = $CALC_EMU->_from_hex( \$bx );
- }
- else
- {
- $r = $self->new($bx);
- $x->{value} = $r->{value};
- }
+ $x->{value} = $CALC_EMU->_from_hex( $bx );
# calculate sign of result
$x->{sign} = '+';
$x->round(@r);
}
-sub __emu_bsqrt
- {
- my ($self,$x,@r) = @_;
-
- # this is slow:
- return $x->round(@r) if $x->is_zero(); # 0,1 => 0,1
-
- return $x->bone('+',@r) if $x < 4; # 1,2,3 => 1
- my $y = $x->copy();
- my $l = int($x->length()/2);
-
- $x->bone(); # keep ref($x), but modify it
- $x->blsft($l,10) if $l != 0; # first guess: 1.('0' x (l/2))
-
- my $last = $self->bzero();
- my $two = $self->new(2);
- my $lastlast = $self->bzero();
- #my $lastlast = $x+$two;
- while ($last != $x && $lastlast != $x)
- {
- $lastlast = $last; $last = $x->copy();
- $x->badd($y / $x);
- $x->bdiv($two);
- }
- $x->bdec() if $x * $x > $y; # overshot?
- $x->round(@r);
- }
-
-sub __emu_broot
- {
- my ($self,$x,$y,@r) = @_;
-
- return $x->bsqrt() if $y->bacmp(2) == 0; # 2 => square root
-
- # since we take at least a cubic root, and only 8 ** 1/3 >= 2 (==2):
- return $x->bone('+',@r) if $x < 8; # $x=2..7 => 1
-
- my $num = $x->numify();
-
- if ($num <= 1000000)
- {
- $x = $self->new( int ( sprintf ("%.8f", $num ** (1 / $y->numify() ))));
- return $x->round(@r);
- }
-
- # if $n is a power of two, we can repeatedly take sqrt($X) and find the
- # proper result, because sqrt(sqrt($x)) == root($x,4)
- # See Calc.pm for more details
- my $b = $y->as_bin();
- if ($b =~ /0b1(0+)$/)
- {
- my $count = CORE::length($1); # 0b100 => len('00') => 2
- my $cnt = $count; # counter for loop
- my $shift = $self->new(6);
- $x->blsft($shift); # add some zeros (even amount)
- while ($cnt-- > 0)
- {
- # 'inflate' $X by adding more zeros
- $x->blsft($shift);
- # calculate sqrt($x), $x is now a bit too big, again. In the next
- # round we make even bigger, again.
- $x->bsqrt($x);
- }
- # $x is still to big, so truncate result
- $x->brsft($shift);
- }
- else
- {
- # trial computation by starting with 2,4,6,8,10 etc until we overstep
- my $step;
- my $trial = $self->new(2);
- my $two = $self->new(2);
- my $s_128 = $self->new(128);
-
- local undef $Math::BigInt::accuracy;
- local undef $Math::BigInt::precision;
-
- # while still to do more than X steps
- do
- {
- $step = $self->new(2);
- while ( $trial->copy->bpow($y)->bacmp($x) < 0)
- {
- $step->bmul($two);
- $trial->badd($step);
- }
-
- # hit exactly?
- if ( $trial->copy->bpow($y)->bacmp($x) == 0)
- {
- $x->{value} = $trial->{value}; # make copy while preserving ref to $x
- return $x->round(@r);
- }
- # overstepped, so go back on step
- $trial->bsub($step);
- } while ($step > $s_128);
-
- $step = $two->copy();
- while ( $trial->copy->bpow($y)->bacmp($x) < 0)
- {
- $trial->badd($step);
- }
-
- # not hit exactly?
- if ( $x->bacmp( $trial->copy()->bpow($y) ) < 0)
- {
- $trial->bdec();
- }
- # copy result into $x (preserve ref)
- $x->{value} = $trial->{value};
- }
- $x->round(@r);
- }
-
-sub __emu_as_hex
- {
- my ($self,$x,$s) = @_;
-
- return '0x0' if $x->is_zero();
-
- my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h,$es);
- if ($] >= 5.006)
- {
- $x10000 = $self->new (0x10000); $h = 'h4';
- }
- else
- {
- $x10000 = $self->new (0x1000); $h = 'h3';
- }
- while (!$x1->is_zero())
- {
- ($x1, $xr) = bdiv($x1,$x10000);
- $es .= unpack($h,pack('v',$xr->numify()));
- }
- $es = reverse $es;
- $es =~ s/^[0]+//; # strip leading zeros
- $s . '0x' . $es;
- }
-
-sub __emu_as_bin
- {
- my ($self,$x,$s) = @_;
-
- return '0b0' if $x->is_zero();
-
- my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b,$es);
- if ($] >= 5.006)
- {
- $x10000 = $self->new (0x10000); $b = 'b16';
- }
- else
- {
- $x10000 = $self->new (0x1000); $b = 'b12';
- }
- while (!$x1->is_zero())
- {
- ($x1, $xr) = bdiv($x1,$x10000);
- $es .= unpack($b,pack('v',$xr->numify()));
- }
- $es = reverse $es;
- $es =~ s/^[0]+//; # strip leading zeros
- $s . '0b' . $es;
- }
-
##############################################################################
##############################################################################
=head1 AUTHORS
-(c) Tels http://bloodgate.com 2003 - based on BigInt code by
+(c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by
Tels from 2001-2003.
=head1 SEE ALSO
}
print "# INC = @INC\n";
- plan tests => 1772;
+ plan tests => 1814;
}
use Math::BigFloat lib => 'BareCalc';
}
print "# INC = @INC\n";
- plan tests => 2770;
+ plan tests => 2832;
}
use Math::BigInt lib => 'BareCalc';
}
print "# INC = @INC\n";
- plan tests => 679
+ plan tests => 684
+ 1; # our own tests
}
{
@args = split(/:/,$_,99); $ans = pop(@args);
}
- $try = "\$x = $class->new('$args[0]');";
+ $try = "\$x = $class->new(\"$args[0]\");";
if ($f eq "fnorm")
{
$try .= "\$x;";
# trailing zeros
#print $ans1->_trailing_zeros(),"\n";
print "# Has trailing zeros after '$try'\n"
- if !ok ($ans1->{_m}->_trailing_zeros(), 0);
+ if !ok ($CL->_zeros( $ans1->{_m}), 0);
}
}
} # end pattern or string
my $monster = '1e1234567890123456789012345678901234567890';
-# new
+# new and exponent
ok ($class->new($monster)->bsstr(),
'1e+1234567890123456789012345678901234567890');
+ok ($class->new($monster)->exponent(),
+ '1234567890123456789012345678901234567890');
# cmp
ok ($class->new($monster) > 0,1);
ok ($class->new($monster)->bmul(2)->bsstr(),
'2e+1234567890123456789012345678901234567890');
+# mantissa
+$monster = '1234567890123456789012345678901234567890e2';
+ok ($class->new($monster)->mantissa(),
+ '123456789012345678901234567890123456789');
+
###############################################################################
# zero,inf,one,nan
-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
&fpow
+NaN:1:NaN
+1:NaN:NaN
+NaN:-1:NaN
+-1:NaN:NaN
+NaN:-21:NaN
+-21:NaN:NaN
+NaN:21:NaN
+21:NaN:NaN
+0:0:1
+0:1:0
+0:9:0
+0:-2:inf
2:2:4
1:2:1
1:3:1
-inf:123.45:-inf
+inf:-123.45:inf
-inf:-123.45:-inf
+-2:2:4
+-2:3:-8
+-2:4:16
+-2:5:-32
+-3:2:9
+-3:3:-27
+-3:4:81
+-3:5:-243
# 2 ** 0.5 == sqrt(2)
# 1.41..7 and not 1.4170 since fallback (bsqrt(9) is '3', not 3.0...0)
2:0.5:1.41421356237309504880168872420969807857
}
print "# INC = @INC\n";
- plan tests => 1772
+ plan tests => 1814
+ 2; # own tests
}
$CL = "Math::BigInt::Calc";
ok ($class->config()->{class},$class);
-ok ($class->config()->{with},'Math::BigInt');
+ok ($class->config()->{with}, $CL);
require 'bigfltpm.inc'; # all tests here for sharing
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
+ plan tests => 308;
}
use Math::BigInt::Calc;
-BEGIN
- {
- plan tests => 300;
- }
-
my ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL) =
Math::BigInt::Calc->_base_len();
my $C = 'Math::BigInt::Calc'; # pass classname to sub's
# _new and _str
-my $x = $C->_new(\"123"); my $y = $C->_new(\"321");
-ok (ref($x),'ARRAY'); ok (${$C->_str($x)},123); ok (${$C->_str($y)},321);
+my $x = $C->_new("123"); my $y = $C->_new("321");
+ok (ref($x),'ARRAY'); ok ($C->_str($x),123); ok ($C->_str($y),321);
###############################################################################
# _add, _sub, _mul, _div
-ok (${$C->_str($C->_add($x,$y))},444);
-ok (${$C->_str($C->_sub($x,$y))},123);
-ok (${$C->_str($C->_mul($x,$y))},39483);
-ok (${$C->_str($C->_div($x,$y))},123);
+ok ($C->_str($C->_add($x,$y)),444);
+ok ($C->_str($C->_sub($x,$y)),123);
+ok ($C->_str($C->_mul($x,$y)),39483);
+ok ($C->_str($C->_div($x,$y)),123);
###############################################################################
# check that mul/div doesn't change $y
# and returns the same reference, not something new
-ok (${$C->_str($C->_mul($x,$y))},39483);
-ok (${$C->_str($x)},39483); ok (${$C->_str($y)},321);
+ok ($C->_str($C->_mul($x,$y)),39483);
+ok ($C->_str($x),39483); ok ($C->_str($y),321);
-ok (${$C->_str($C->_div($x,$y))},123);
-ok (${$C->_str($x)},123); ok (${$C->_str($y)},321);
+ok ($C->_str($C->_div($x,$y)),123);
+ok ($C->_str($x),123); ok ($C->_str($y),321);
-$x = $C->_new(\"39483");
+$x = $C->_new("39483");
my ($x1,$r1) = $C->_div($x,$y);
ok ("$x1","$x");
$C->_inc($x1);
ok ("$x1","$x");
-ok (${$C->_str($r1)},'0');
+ok ($C->_str($r1),'0');
-$x = $C->_new(\"39483"); # reset
+$x = $C->_new("39483"); # reset
###############################################################################
-my $z = $C->_new(\"2");
-ok (${$C->_str($C->_add($x,$z))},39485);
+my $z = $C->_new("2");
+ok ($C->_str($C->_add($x,$z)),39485);
my ($re,$rr) = $C->_div($x,$y);
-ok (${$C->_str($re)},123); ok (${$C->_str($rr)},2);
+ok ($C->_str($re),123); ok ($C->_str($rr),2);
# is_zero, _is_one, _one, _zero
ok ($C->_is_zero($x)||0,0);
ok ($C->_is_one($x)||0,0);
-ok (${$C->_str($C->_zero())},"0");
-ok (${$C->_str($C->_one())},"1");
+ok ($C->_str($C->_zero()),"0");
+ok ($C->_str($C->_one()),"1");
-# _two() (only used internally)
-ok (${$C->_str($C->_two())},"2");
+# _two() and _ten()
+ok ($C->_str($C->_two()),"2");
+ok ($C->_str($C->_ten()),"10");
+ok ($C->_is_ten($C->_two()),0);
+ok ($C->_is_two($C->_two()),1);
+ok ($C->_is_ten($C->_ten()),1);
+ok ($C->_is_two($C->_ten()),0);
ok ($C->_is_one($C->_one()),1);
+ok ($C->_is_one($C->_two()),0);
+ok ($C->_is_one($C->_ten()),0);
ok ($C->_is_one($C->_zero()) || 0,0);
ok ($C->_is_even($C->_one()) || 0,0); ok ($C->_is_even($C->_zero()),1);
# _len
-$x = $C->_new(\"1"); ok ($C->_len($x),1);
-$x = $C->_new(\"12"); ok ($C->_len($x),2);
-$x = $C->_new(\"123"); ok ($C->_len($x),3);
-$x = $C->_new(\"1234"); ok ($C->_len($x),4);
-$x = $C->_new(\"12345"); ok ($C->_len($x),5);
-$x = $C->_new(\"123456"); ok ($C->_len($x),6);
-$x = $C->_new(\"1234567"); ok ($C->_len($x),7);
-$x = $C->_new(\"12345678"); ok ($C->_len($x),8);
-$x = $C->_new(\"123456789"); ok ($C->_len($x),9);
-
-$x = $C->_new(\"8"); ok ($C->_len($x),1);
-$x = $C->_new(\"21"); ok ($C->_len($x),2);
-$x = $C->_new(\"321"); ok ($C->_len($x),3);
-$x = $C->_new(\"4321"); ok ($C->_len($x),4);
-$x = $C->_new(\"54321"); ok ($C->_len($x),5);
-$x = $C->_new(\"654321"); ok ($C->_len($x),6);
-$x = $C->_new(\"7654321"); ok ($C->_len($x),7);
-$x = $C->_new(\"87654321"); ok ($C->_len($x),8);
-$x = $C->_new(\"987654321"); ok ($C->_len($x),9);
+$x = $C->_new("1"); ok ($C->_len($x),1);
+$x = $C->_new("12"); ok ($C->_len($x),2);
+$x = $C->_new("123"); ok ($C->_len($x),3);
+$x = $C->_new("1234"); ok ($C->_len($x),4);
+$x = $C->_new("12345"); ok ($C->_len($x),5);
+$x = $C->_new("123456"); ok ($C->_len($x),6);
+$x = $C->_new("1234567"); ok ($C->_len($x),7);
+$x = $C->_new("12345678"); ok ($C->_len($x),8);
+$x = $C->_new("123456789"); ok ($C->_len($x),9);
+
+$x = $C->_new("8"); ok ($C->_len($x),1);
+$x = $C->_new("21"); ok ($C->_len($x),2);
+$x = $C->_new("321"); ok ($C->_len($x),3);
+$x = $C->_new("4321"); ok ($C->_len($x),4);
+$x = $C->_new("54321"); ok ($C->_len($x),5);
+$x = $C->_new("654321"); ok ($C->_len($x),6);
+$x = $C->_new("7654321"); ok ($C->_len($x),7);
+$x = $C->_new("87654321"); ok ($C->_len($x),8);
+$x = $C->_new("987654321"); ok ($C->_len($x),9);
for (my $i = 1; $i < 9; $i++)
{
my $a = "$i" . '0' x ($i-1);
- $x = $C->_new(\$a);
+ $x = $C->_new($a);
print "# Tried len '$a'\n" unless ok ($C->_len($x),$i);
}
# _digit
-$x = $C->_new(\"123456789");
+$x = $C->_new("123456789");
ok ($C->_digit($x,0),9);
ok ($C->_digit($x,1),8);
ok ($C->_digit($x,2),7);
# _copy
foreach (qw/ 1 12 123 1234 12345 123456 1234567 12345678 123456789/)
{
- $x = $C->_new(\"$_");
- ok (${$C->_str($C->_copy($x))},"$_");
- ok (${$C->_str($x)},"$_"); # did _copy destroy original x?
+ $x = $C->_new("$_");
+ ok ($C->_str($C->_copy($x)),"$_");
+ ok ($C->_str($x),"$_"); # did _copy destroy original x?
}
# _zeros
-$x = $C->_new(\"1256000000"); ok ($C->_zeros($x),6);
-$x = $C->_new(\"152"); ok ($C->_zeros($x),0);
-$x = $C->_new(\"123000"); ok ($C->_zeros($x),3);
+$x = $C->_new("1256000000"); ok ($C->_zeros($x),6);
+$x = $C->_new("152"); ok ($C->_zeros($x),0);
+$x = $C->_new("123000"); ok ($C->_zeros($x),3);
+$x = $C->_new("0"); ok ($C->_zeros($x),0);
# _lsft, _rsft
-$x = $C->_new(\"10"); $y = $C->_new(\"3");
-ok (${$C->_str($C->_lsft($x,$y,10))},10000);
-$x = $C->_new(\"20"); $y = $C->_new(\"3");
-ok (${$C->_str($C->_lsft($x,$y,10))},20000);
+$x = $C->_new("10"); $y = $C->_new("3");
+ok ($C->_str($C->_lsft($x,$y,10)),10000);
+$x = $C->_new("20"); $y = $C->_new("3");
+ok ($C->_str($C->_lsft($x,$y,10)),20000);
-$x = $C->_new(\"128"); $y = $C->_new(\"4");
-ok (${$C->_str($C->_lsft($x,$y,2))}, 128 << 4);
+$x = $C->_new("128"); $y = $C->_new("4");
+ok ($C->_str($C->_lsft($x,$y,2)), 128 << 4);
-$x = $C->_new(\"1000"); $y = $C->_new(\"3");
-ok (${$C->_str($C->_rsft($x,$y,10))},1);
-$x = $C->_new(\"20000"); $y = $C->_new(\"3");
-ok (${$C->_str($C->_rsft($x,$y,10))},20);
-$x = $C->_new(\"256"); $y = $C->_new(\"4");
-ok (${$C->_str($C->_rsft($x,$y,2))},256 >> 4);
+$x = $C->_new("1000"); $y = $C->_new("3");
+ok ($C->_str($C->_rsft($x,$y,10)),1);
+$x = $C->_new("20000"); $y = $C->_new("3");
+ok ($C->_str($C->_rsft($x,$y,10)),20);
+$x = $C->_new("256"); $y = $C->_new("4");
+ok ($C->_str($C->_rsft($x,$y,2)),256 >> 4);
-$x = $C->_new(\"6411906467305339182857313397200584952398");
-$y = $C->_new(\"45");
-ok (${$C->_str($C->_rsft($x,$y,10))},0);
+$x = $C->_new("6411906467305339182857313397200584952398");
+$y = $C->_new("45");
+ok ($C->_str($C->_rsft($x,$y,10)),0);
# _acmp
-$x = $C->_new(\"123456789");
-$y = $C->_new(\"987654321");
+$x = $C->_new("123456789");
+$y = $C->_new("987654321");
ok ($C->_acmp($x,$y),-1);
ok ($C->_acmp($y,$x),1);
ok ($C->_acmp($x,$x),0);
ok ($C->_acmp($y,$y),0);
-$x = $C->_new(\"12");
-$y = $C->_new(\"12");
+$x = $C->_new("12");
+$y = $C->_new("12");
ok ($C->_acmp($x,$y),0);
-$x = $C->_new(\"21");
+$x = $C->_new("21");
ok ($C->_acmp($x,$y),1);
ok ($C->_acmp($y,$x),-1);
-$x = $C->_new(\"123456789");
-$y = $C->_new(\"1987654321");
+$x = $C->_new("123456789");
+$y = $C->_new("1987654321");
ok ($C->_acmp($x,$y),-1);
ok ($C->_acmp($y,$x),+1);
-$x = $C->_new(\"1234567890123456789");
-$y = $C->_new(\"987654321012345678");
+$x = $C->_new("1234567890123456789");
+$y = $C->_new("987654321012345678");
ok ($C->_acmp($x,$y),1);
ok ($C->_acmp($y,$x),-1);
ok ($C->_acmp($x,$x),0);
ok ($C->_acmp($y,$y),0);
-$x = $C->_new(\"1234");
-$y = $C->_new(\"987654321012345678");
+$x = $C->_new("1234");
+$y = $C->_new("987654321012345678");
ok ($C->_acmp($x,$y),-1);
ok ($C->_acmp($y,$x),1);
ok ($C->_acmp($x,$x),0);
ok ($C->_acmp($y,$y),0);
# _modinv
-$x = $C->_new(\"8");
-$y = $C->_new(\"5033");
+$x = $C->_new("8");
+$y = $C->_new("5033");
my ($xmod,$sign) = $C->_modinv($x,$y);
-ok (${$C->_str($xmod)},'629'); # -629 % 5033 == 4404
+ok ($C->_str($xmod),'629'); # -629 % 5033 == 4404
ok ($sign, '-');
# _div
-$x = $C->_new(\"3333"); $y = $C->_new(\"1111");
-ok (${$C->_str(scalar $C->_div($x,$y))},3);
-$x = $C->_new(\"33333"); $y = $C->_new(\"1111"); ($x,$y) = $C->_div($x,$y);
-ok (${$C->_str($x)},30); ok (${$C->_str($y)},3);
-$x = $C->_new(\"123"); $y = $C->_new(\"1111");
-($x,$y) = $C->_div($x,$y); ok (${$C->_str($x)},0); ok (${$C->_str($y)},123);
+$x = $C->_new("3333"); $y = $C->_new("1111");
+ok ($C->_str(scalar $C->_div($x,$y)),3);
+$x = $C->_new("33333"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y);
+ok ($C->_str($x),30); ok ($C->_str($y),3);
+$x = $C->_new("123"); $y = $C->_new("1111");
+($x,$y) = $C->_div($x,$y); ok ($C->_str($x),0); ok ($C->_str($y),123);
# _num
foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/)
{
- $x = $C->_new(\"$_");
- ok (ref($x)||'','ARRAY'); ok (${$C->_str($x)},"$_");
+ $x = $C->_new("$_");
+ ok (ref($x)||'','ARRAY'); ok ($C->_str($x),"$_");
$x = $C->_num($x); ok (ref($x)||'',''); ok ($x,$_);
}
# _sqrt
-$x = $C->_new(\"144"); ok (${$C->_str($C->_sqrt($x))},'12');
-$x = $C->_new(\"144000000000000"); ok (${$C->_str($C->_sqrt($x))},'12000000');
+$x = $C->_new("144"); ok ($C->_str($C->_sqrt($x)),'12');
+$x = $C->_new("144000000000000"); ok ($C->_str($C->_sqrt($x)),'12000000');
# _root
-$x = $C->_new(\"81"); my $n = $C->_new(\"3"); # 4*4*4 = 64, 5*5*5 = 125
-ok (${$C->_str($C->_root($x,$n))},'4'); # 4.xx => 4.0
-$x = $C->_new(\"81"); $n = $C->_new(\"4"); # 3*3*3*3 == 81
-ok (${$C->_str($C->_root($x,$n))},'3');
+$x = $C->_new("81"); my $n = $C->_new("3"); # 4*4*4 = 64, 5*5*5 = 125
+ok ($C->_str($C->_root($x,$n)),'4'); # 4.xx => 4.0
+$x = $C->_new("81"); $n = $C->_new("4"); # 3*3*3*3 == 81
+ok ($C->_str($C->_root($x,$n)),'3');
# _pow (and _root)
-$x = $C->_new(\"0"); $n = $C->_new(\"3"); # 0 ** y => 0
-ok (${$C->_str($C->_pow($x,$n))}, 0);
-$x = $C->_new(\"3"); $n = $C->_new(\"0"); # x ** 0 => 1
-ok (${$C->_str($C->_pow($x,$n))}, 1);
-$x = $C->_new(\"1"); $n = $C->_new(\"3"); # 1 ** y => 1
-ok (${$C->_str($C->_pow($x,$n))}, 1);
-$x = $C->_new(\"5"); $n = $C->_new(\"1"); # x ** 1 => x
-ok (${$C->_str($C->_pow($x,$n))}, 5);
+$x = $C->_new("0"); $n = $C->_new("3"); # 0 ** y => 0
+ok ($C->_str($C->_pow($x,$n)), 0);
+$x = $C->_new("3"); $n = $C->_new("0"); # x ** 0 => 1
+ok ($C->_str($C->_pow($x,$n)), 1);
+$x = $C->_new("1"); $n = $C->_new("3"); # 1 ** y => 1
+ok ($C->_str($C->_pow($x,$n)), 1);
+$x = $C->_new("5"); $n = $C->_new("1"); # x ** 1 => x
+ok ($C->_str($C->_pow($x,$n)), 5);
-$x = $C->_new(\"81"); $n = $C->_new(\"3"); # 81 ** 3 == 531441
-ok (${$C->_str($C->_pow($x,$n))},81 ** 3);
+$x = $C->_new("81"); $n = $C->_new("3"); # 81 ** 3 == 531441
+ok ($C->_str($C->_pow($x,$n)),81 ** 3);
-ok (${$C->_str($C->_root($x,$n))},81);
+ok ($C->_str($C->_root($x,$n)),81);
-$x = $C->_new(\"81");
-ok (${$C->_str($C->_pow($x,$n))},81 ** 3);
-ok (${$C->_str($C->_pow($x,$n))},'150094635296999121'); # 531441 ** 3 ==
+$x = $C->_new("81");
+ok ($C->_str($C->_pow($x,$n)),81 ** 3);
+ok ($C->_str($C->_pow($x,$n)),'150094635296999121'); # 531441 ** 3 ==
-ok (${$C->_str($C->_root($x,$n))},'531441');
-ok (${$C->_str($C->_root($x,$n))},'81');
+ok ($C->_str($C->_root($x,$n)),'531441');
+ok ($C->_str($C->_root($x,$n)),'81');
-$x = $C->_new(\"81"); $n = $C->_new(\"14");
-ok (${$C->_str($C->_pow($x,$n))},'523347633027360537213511521');
-ok (${$C->_str($C->_root($x,$n))},'81');
+$x = $C->_new("81"); $n = $C->_new("14");
+ok ($C->_str($C->_pow($x,$n)),'523347633027360537213511521');
+ok ($C->_str($C->_root($x,$n)),'81');
-$x = $C->_new(\"523347633027360537213511520");
-ok (${$C->_str($C->_root($x,$n))},'80');
+$x = $C->_new("523347633027360537213511520");
+ok ($C->_str($C->_root($x,$n)),'80');
-$x = $C->_new(\"523347633027360537213511522");
-ok (${$C->_str($C->_root($x,$n))},'81');
+$x = $C->_new("523347633027360537213511522");
+ok ($C->_str($C->_root($x,$n)),'81');
my $res = [ qw/ 9 31 99 316 999 3162 9999/ ];
# 99 ** 2 = 9801, 999 ** 2 = 998001 etc
for my $i (2 .. 9)
{
- $x = '9' x $i; $x = $C->_new(\$x);
- $n = $C->_new(\"2");
+ $x = '9' x $i; $x = $C->_new($x);
+ $n = $C->_new("2");
my $rc = '9' x ($i-1). '8' . '0' x ($i-1) . '1';
print "# _pow( ", '9' x $i, ", 2) \n" unless
- ok (${$C->_str($C->_pow($x,$n))},$rc);
+ ok ($C->_str($C->_pow($x,$n)),$rc);
if ($i <= 7)
{
- $x = '9' x $i; $x = $C->_new(\$x);
- $n = '9' x $i; $n = $C->_new(\$n);
+ $x = '9' x $i; $x = $C->_new($x);
+ $n = '9' x $i; $n = $C->_new($n);
print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless
- ok (${$C->_str($C->_root($x,$n))},'1');
+ ok ($C->_str($C->_root($x,$n)),'1');
- $x = '9' x $i; $x = $C->_new(\$x);
- $n = $C->_new(\"2");
+ $x = '9' x $i; $x = $C->_new($x);
+ $n = $C->_new("2");
print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless
- ok (${$C->_str($C->_root($x,$n))}, $res->[$i-2]);
+ ok ($C->_str($C->_root($x,$n)), $res->[$i-2]);
}
}
##############################################################################
# _fac
-$x = $C->_new(\"0"); ok (${$C->_str($C->_fac($x))},'1');
-$x = $C->_new(\"1"); ok (${$C->_str($C->_fac($x))},'1');
-$x = $C->_new(\"2"); ok (${$C->_str($C->_fac($x))},'2');
-$x = $C->_new(\"3"); ok (${$C->_str($C->_fac($x))},'6');
-$x = $C->_new(\"4"); ok (${$C->_str($C->_fac($x))},'24');
-$x = $C->_new(\"5"); ok (${$C->_str($C->_fac($x))},'120');
-$x = $C->_new(\"10"); ok (${$C->_str($C->_fac($x))},'3628800');
-$x = $C->_new(\"11"); ok (${$C->_str($C->_fac($x))},'39916800');
-$x = $C->_new(\"12"); ok (${$C->_str($C->_fac($x))},'479001600');
-$x = $C->_new(\"13"); ok (${$C->_str($C->_fac($x))},'6227020800');
+$x = $C->_new("0"); ok ($C->_str($C->_fac($x)),'1');
+$x = $C->_new("1"); ok ($C->_str($C->_fac($x)),'1');
+$x = $C->_new("2"); ok ($C->_str($C->_fac($x)),'2');
+$x = $C->_new("3"); ok ($C->_str($C->_fac($x)),'6');
+$x = $C->_new("4"); ok ($C->_str($C->_fac($x)),'24');
+$x = $C->_new("5"); ok ($C->_str($C->_fac($x)),'120');
+$x = $C->_new("10"); ok ($C->_str($C->_fac($x)),'3628800');
+$x = $C->_new("11"); ok ($C->_str($C->_fac($x)),'39916800');
+$x = $C->_new("12"); ok ($C->_str($C->_fac($x)),'479001600');
+$x = $C->_new("13"); ok ($C->_str($C->_fac($x)),'6227020800');
# test that _fac modifes $x in place for small arguments
-$x = $C->_new(\"3"); $C->_fac($x); ok (${$C->_str($x)},'6');
-$x = $C->_new(\"13"); $C->_fac($x); ok (${$C->_str($x)},'6227020800');
+$x = $C->_new("3"); $C->_fac($x); ok ($C->_str($x),'6');
+$x = $C->_new("13"); $C->_fac($x); ok ($C->_str($x),'6227020800');
##############################################################################
# _inc and _dec
foreach (qw/1 11 121 1231 12341 1234561 12345671 123456781 1234567891/)
{
- $x = $C->_new(\"$_"); $C->_inc($x);
- print "# \$x = ",${$C->_str($x)},"\n"
- unless ok (${$C->_str($x)},substr($_,0,length($_)-1) . '2');
- $C->_dec($x); ok (${$C->_str($x)},$_);
+ $x = $C->_new("$_"); $C->_inc($x);
+ print "# \$x = ",$C->_str($x),"\n"
+ unless ok ($C->_str($x),substr($_,0,length($_)-1) . '2');
+ $C->_dec($x); ok ($C->_str($x),$_);
}
foreach (qw/19 119 1219 12319 1234519 12345619 123456719 1234567819/)
{
- $x = $C->_new(\"$_"); $C->_inc($x);
- print "# \$x = ",${$C->_str($x)},"\n"
- unless ok (${$C->_str($x)},substr($_,0,length($_)-2) . '20');
- $C->_dec($x); ok (${$C->_str($x)},$_);
+ $x = $C->_new("$_"); $C->_inc($x);
+ print "# \$x = ",$C->_str($x),"\n"
+ unless ok ($C->_str($x),substr($_,0,length($_)-2) . '20');
+ $C->_dec($x); ok ($C->_str($x),$_);
}
foreach (qw/999 9999 99999 9999999 99999999 999999999 9999999999 99999999999/)
{
- $x = $C->_new(\"$_"); $C->_inc($x);
- print "# \$x = ",${$C->_str($x)},"\n"
- unless ok (${$C->_str($x)}, '1' . '0' x (length($_)));
- $C->_dec($x); ok (${$C->_str($x)},$_);
+ $x = $C->_new("$_"); $C->_inc($x);
+ print "# \$x = ",$C->_str($x),"\n"
+ unless ok ($C->_str($x), '1' . '0' x (length($_)));
+ $C->_dec($x); ok ($C->_str($x),$_);
}
-$x = $C->_new(\"1000"); $C->_inc($x); ok (${$C->_str($x)},'1001');
-$C->_dec($x); ok (${$C->_str($x)},'1000');
+$x = $C->_new("1000"); $C->_inc($x); ok ($C->_str($x),'1001');
+$C->_dec($x); ok ($C->_str($x),'1000');
my $BL;
{
$x = '1' . '0' x $BL;
$z = '1' . '0' x ($BL-1); $z .= '1';
-$x = $C->_new(\$x); $C->_inc($x); ok (${$C->_str($x)},$z);
+$x = $C->_new($x); $C->_inc($x); ok ($C->_str($x),$z);
$x = '1' . '0' x $BL; $z = '9' x $BL;
-$x = $C->_new(\$x); $C->_dec($x); ok (${$C->_str($x)},$z);
+$x = $C->_new($x); $C->_dec($x); ok ($C->_str($x),$z);
# should not happen:
-# $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1);
+# $x = $C->_new("-2"); $y = $C->_new("4"); ok ($C->_acmp($x,$y),-1);
###############################################################################
# _mod
-$x = $C->_new(\"1000"); $y = $C->_new(\"3");
-ok (${$C->_str(scalar $C->_mod($x,$y))},1);
-$x = $C->_new(\"1000"); $y = $C->_new(\"2");
-ok (${$C->_str(scalar $C->_mod($x,$y))},0);
+$x = $C->_new("1000"); $y = $C->_new("3");
+ok ($C->_str(scalar $C->_mod($x,$y)),1);
+$x = $C->_new("1000"); $y = $C->_new("2");
+ok ($C->_str(scalar $C->_mod($x,$y)),0);
# _and, _or, _xor
-$x = $C->_new(\"5"); $y = $C->_new(\"2");
-ok (${$C->_str(scalar $C->_xor($x,$y))},7);
-$x = $C->_new(\"5"); $y = $C->_new(\"2");
-ok (${$C->_str(scalar $C->_or($x,$y))},7);
-$x = $C->_new(\"5"); $y = $C->_new(\"3");
-ok (${$C->_str(scalar $C->_and($x,$y))},1);
+$x = $C->_new("5"); $y = $C->_new("2");
+ok ($C->_str(scalar $C->_xor($x,$y)),7);
+$x = $C->_new("5"); $y = $C->_new("2");
+ok ($C->_str(scalar $C->_or($x,$y)),7);
+$x = $C->_new("5"); $y = $C->_new("3");
+ok ($C->_str(scalar $C->_and($x,$y)),1);
# _from_hex, _from_bin
-ok (${$C->_str(scalar $C->_from_hex(\"0xFf"))},255);
-ok (${$C->_str(scalar $C->_from_bin(\"0b10101011"))},160+11);
+ok ($C->_str( $C->_from_hex("0xFf")),255);
+ok ($C->_str( $C->_from_bin("0b10101011")),160+11);
# _as_hex, _as_bin
-ok (${$C->_str(scalar $C->_from_hex( $C->_as_hex( $C->_new(\"128"))))}, 128);
-ok (${$C->_str(scalar $C->_from_bin( $C->_as_bin( $C->_new(\"128"))))}, 128);
-ok (${$C->_str(scalar $C->_from_hex( $C->_as_hex( $C->_new(\"0"))))}, 0);
-ok (${$C->_str(scalar $C->_from_bin( $C->_as_bin( $C->_new(\"0"))))}, 0);
-ok ( ${$C->_as_hex( $C->_new(\"0"))}, '0x0');
-ok ( ${$C->_as_bin( $C->_new(\"0"))}, '0b0');
-ok ( ${$C->_as_hex( $C->_new(\"12"))}, '0xc');
-ok ( ${$C->_as_bin( $C->_new(\"12"))}, '0b1100');
+ok ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new("128")))), 128);
+ok ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new("128")))), 128);
+ok ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new("0")))), 0);
+ok ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new("0")))), 0);
+ok ($C->_as_hex( $C->_new("0")), '0x0');
+ok ($C->_as_bin( $C->_new("0")), '0b0');
+ok ($C->_as_hex( $C->_new("12")), '0xc');
+ok ($C->_as_bin( $C->_new("12")), '0b1100');
# _check
-$x = $C->_new(\"123456789");
+$x = $C->_new("123456789");
ok ($C->_check($x),0);
ok ($C->_check(123),'123 is not a reference');
111111111111111111111111111111:111111111111111111111111111111:0
12345678901234567890:12345678901234567890:0
&bgcd
+inf:12:NaN
+-inf:12:NaN
+12:inf:NaN
+12:-inf:NaN
+inf:inf:NaN
+inf:-inf:NaN
+-inf:-inf:NaN
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
+2:+3:1
+3:+2:1
-3:+2:1
+-3:-2:1
+-144:-60:12
+144:-60:12
+144:60:12
100:625:25
4096:81:1
1034:804:2
+281474976710656:0:0
+281474976710656:1:0
+281474976710656:+281474976710656:281474976710656
+281474976710656:-1:281474976710656
-2:-3:-4
-1:-1:-1
-6:-6:-6
-7:-4:-8
-7:4:0
-4:7:4
+# negative argument is bitwise shorter than positive [perl #26559]
+30:-3:28
+123:-1:123
# equal arguments are treated special, so also do some test with unequal ones
0xFFFF:0xFFFF:0x0xFFFF
0xFFFFFF:0xFFFFFF:0x0xFFFFFF
-6:-6:-6
-7:4:-3
-4:7:-1
++281474976710656:-1:-1
+30:-3:-1
+30:-4:-2
+300:-76:-68
+-76:300:-68
# equal arguments are treated special, so also do some test with unequal ones
0xFFFF:0xFFFF:0x0xFFFF
0xFFFFFF:0xFFFFFF:0x0xFFFFFF
-4:7:-5
4:-7:-3
-4:-7:5
+30:-3:-29
+30:-4:-30
+300:-76:-360
+-76:300:-360
# equal arguments are treated special, so also do some test with unequal ones
0xFFFF:0xFFFF:0
0xFFFFFF:0xFFFFFF:0
0:0:1
0:1:0
0:2:0
-0:-1:NaN
-0:-2:NaN
+0:-1:inf
+0:-2:inf
1:0:1
1:1:1
1:2:1
10:9:1000000000
10:20:100000000000000000000
123456:2:15241383936
+-2:2:4
+-2:3:-8
+-2:4:16
+-2:5:-32
+-3:2:9
+-3:3:-27
+-3:4:81
+-3:5:-243
&length
100:3
10:2
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 2770;
+ plan tests => 2832;
}
use Math::BigInt;
my $C = 'Math::BigInt::Scalar'; # pass classname to sub's
# _new and _str
-my $x = $C->_new(\"123"); my $y = $C->_new(\"321");
-ok (ref($x),'SCALAR'); ok (${$C->_str($x)},123); ok (${$C->_str($y)},321);
+my $x = $C->_new("123"); my $y = $C->_new("321");
+ok (ref($x),'SCALAR'); ok ($C->_str($x),123); ok ($C->_str($y),321);
# _add, _sub, _mul, _div
-ok (${$C->_str($C->_add($x,$y))},444);
-ok (${$C->_str($C->_sub($x,$y))},123);
-ok (${$C->_str($C->_mul($x,$y))},39483);
-ok (${$C->_str($C->_div($x,$y))},123);
+ok ($C->_str($C->_add($x,$y)),444);
+ok ($C->_str($C->_sub($x,$y)),123);
+ok ($C->_str($C->_mul($x,$y)),39483);
+ok ($C->_str($C->_div($x,$y)),123);
-ok (${$C->_str($C->_mul($x,$y))},39483);
-ok (${$C->_str($x)},39483);
-ok (${$C->_str($y)},321);
-my $z = $C->_new(\"2");
-ok (${$C->_str($C->_add($x,$z))},39485);
+ok ($C->_str($C->_mul($x,$y)),39483);
+ok ($C->_str($x),39483);
+ok ($C->_str($y),321);
+my $z = $C->_new("2");
+ok ($C->_str($C->_add($x,$z)),39485);
my ($re,$rr) = $C->_div($x,$y);
-ok (${$C->_str($re)},123); ok (${$C->_str($rr)},2);
+ok ($C->_str($re),123); ok ($C->_str($rr),2);
# is_zero, _is_one, _one, _zero
ok ($C->_is_zero($x),0);
ok ($C->_is_even($C->_one()),0); ok ($C->_is_even($C->_zero()),1);
# _digit
-$x = $C->_new(\"123456789");
+$x = $C->_new("123456789");
ok ($C->_digit($x,0),9);
ok ($C->_digit($x,1),8);
ok ($C->_digit($x,2),7);
ok ($C->_digit($x,-3),3);
# _copy
-$x = $C->_new(\"12356");
-ok (${$C->_str($C->_copy($x))},12356);
+$x = $C->_new("12356");
+ok ($C->_str($C->_copy($x)),12356);
# _acmp
-$x = $C->_new(\"123456789");
-$y = $C->_new(\"987654321");
+$x = $C->_new("123456789");
+$y = $C->_new("987654321");
ok ($C->_acmp($x,$y),-1);
ok ($C->_acmp($y,$x),1);
ok ($C->_acmp($x,$x),0);
ok ($C->_acmp($y,$y),0);
# _div
-$x = $C->_new(\"3333"); $y = $C->_new(\"1111");
-ok (${$C->_str( scalar $C->_div($x,$y))},3);
-$x = $C->_new(\"33333"); $y = $C->_new(\"1111"); ($x,$y) = $C->_div($x,$y);
-ok (${$C->_str($x)},30); ok (${$C->_str($y)},3);
-$x = $C->_new(\"123"); $y = $C->_new(\"1111");
-($x,$y) = $C->_div($x,$y); ok (${$C->_str($x)},0); ok (${$C->_str($y)},123);
+$x = $C->_new("3333"); $y = $C->_new("1111");
+ok ($C->_str( scalar $C->_div($x,$y)),3);
+$x = $C->_new("33333"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y);
+ok ($C->_str($x),30); ok ($C->_str($y),3);
+$x = $C->_new("123"); $y = $C->_new("1111");
+($x,$y) = $C->_div($x,$y); ok ($C->_str($x),0); ok ($C->_str($y),123);
# _num
-$x = $C->_new(\"12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345);
+$x = $C->_new("12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345);
# _len
-$x = $C->_new(\"12345"); $x = $C->_len($x); ok (ref($x)||'',''); ok ($x,5);
+$x = $C->_new("12345"); $x = $C->_len($x); ok (ref($x)||'',''); ok ($x,5);
# _and, _or, _xor
-$x = $C->_new(\"3"); $y = $C->_new(\"4"); ok (${$C->_str( $C->_or($x,$y))},7);
-$x = $C->_new(\"1"); $y = $C->_new(\"4"); ok (${$C->_str( $C->_xor($x,$y))},5);
-$x = $C->_new(\"7"); $y = $C->_new(\"3"); ok (${$C->_str( $C->_and($x,$y))},3);
+$x = $C->_new("3"); $y = $C->_new("4"); ok ($C->_str( $C->_or($x,$y)),7);
+$x = $C->_new("1"); $y = $C->_new("4"); ok ($C->_str( $C->_xor($x,$y)),5);
+$x = $C->_new("7"); $y = $C->_new("3"); ok ($C->_str( $C->_and($x,$y)),3);
# _pow
-$x = $C->_new(\"2"); $y = $C->_new(\"4"); ok (${$C->_str( $C->_pow($x,$y))},16);
-$x = $C->_new(\"2"); $y = $C->_new(\"5"); ok (${$C->_str( $C->_pow($x,$y))},32);
-$x = $C->_new(\"3"); $y = $C->_new(\"3"); ok (${$C->_str( $C->_pow($x,$y))},27);
+$x = $C->_new("2"); $y = $C->_new("4"); ok ($C->_str( $C->_pow($x,$y)),16);
+$x = $C->_new("2"); $y = $C->_new("5"); ok ($C->_str( $C->_pow($x,$y)),32);
+$x = $C->_new("3"); $y = $C->_new("3"); ok ($C->_str( $C->_pow($x,$y)),27);
-# should not happen:
-# $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1);
-
# _check
-$x = $C->_new(\"123456789");
+$x = $C->_new("123456789");
ok ($C->_check($x),0);
ok ($C->_check(123),'123 is not a reference');
}
print "# INC = @INC\n";
- plan tests => 50;
+ plan tests => 53;
}
use Math::BigFloat;
my $cl = "Math::BigFloat";
-# these tests are now really fast, since they collapse to blog(10), basically
+# These tests are now really fast, since they collapse to blog(10), basically
# Don't attempt to run them with older versions. You are warned.
# $x < 0 => NaN
# blog should handle bigint input
ok (Math::BigFloat::blog(Math::BigInt->new(100),10), 2);
+# some integer results
+ok ($cl->new(2)->bpow(32)->blog(2), '32'); # 2 ** 32
+ok ($cl->new(3)->bpow(32)->blog(3), '32'); # 3 ** 32
+ok ($cl->new(2)->bpow(65)->blog(2), '65'); # 2 ** 65
+
# test for bug in bsqrt() not taking negative _e into account
test_bpow ('200','0.5',10, '14.14213562');
test_bpow ('20','0.5',10, '4.472135955');
{
my ($x,$y,$scale,$result) = @_;
- print "# Tried: $x->bpow($y,$scale);\n"
+ print "# Tried: $x->bpow($y,$scale);\n"
unless ok ($cl->new($x)->bpow($y,$scale),$result);
}
unshift @INC, $location;
}
print "# INC = @INC\n";
- my $tests = 161;
+ my $tests = 160;
plan tests => $tests;
if ($] < 5.006)
{
$class = 'Math::BigInt';
+# XXX TODO this test does not work/fail.
# test whether use Math::BigInt qw/version/ works
-$try = "use $class ($version.'1');";
-$try .= ' $x = $class->new(123); $x = "$x";';
-eval $try;
-ok_undef ( $_ ); # should result in error!
+#$try = "use $class ($version.'1');";
+#$try .= ' $x = $class->new(123); $x = "$x";';
+#eval $try;
+#ok_undef ( $x ); # should result in error!
# test whether fallback to calc works
$try = "use $class ($version,'lib','foo, bar , ');";
$try .= ' $x = 2**10; $x = "$x";';
$ans = eval $try; ok ( $ans, "1024");
-# test wether calc => undef (array element not existing) works
-# no longer supported
-#$try = "use $class ($version,'LIB');";
-#$try = "require $class; $class\::import($version,'CALC');";
-#$try .= " \$x = $class\->new(2)**10; \$x = ".'"$x";';
-#print "$try\n";
-#$ans = eval $try; ok ( $ans, 1024);
-
# all done
###############################################################################
ok (ref($cfg),'HASH');
ok ($cfg->{lib},'Math::BigInt::Calc');
-ok ($cfg->{with},$mbi);
+ok ($cfg->{with},'Math::BigInt::Calc');
ok ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION);
ok ($cfg->{class},$mbf);
ok ($cfg->{upgrade}||'','');
ok ($c->bpow(2,16),65536);
ok ($c->bpow(2,$c->new(16)),65536);
-# ok ($c->new(2**15)->brsft(1),2**14);
-# ok ($c->brsft(2**15,1),2**14);
-# ok ($c->brsft(2**15,$c->new(1)),2**14);
+ ok ($c->new(2**15)->brsft(1),2**14);
+ ok ($c->brsft(2**15,1),2**14);
+ ok ($c->brsft(2**15,$c->new(1)),2**14);
ok ($c->new(2**13)->blsft(1),2**14);
ok ($c->blsft(2**13,1),2**14);
$x = $mbi->new('1234'); $x->accuracy(3); $x->bfround(-2);
ok_undef ($x->{_a});
+# test that bfround() and bround() work with large numbers
+
+$x = $mbf->new(1)->bdiv(5678,undef,-63);
+ok ($x, '0.000176118351532229658330398027474462839027826699542092286016203');
+
+$x = $mbf->new(1)->bdiv(5678,undef,-90);
+ok ($x, '0.000176118351532229658330398027474462839027826699542092286016202888340965128566396618527651');
+
+$x = $mbf->new(1)->bdiv(5678,80);
+ok ($x, '0.00017611835153222965833039802747446283902782669954209228601620288834096512856639662');
+
###############################################################################
# rounding with already set precision/accuracy
# mantissa/exponent format and A/P
$x = $mbf->new('12345.678'); $x->accuracy(4);
ok ($x,'12350'); ok ($x->{_a},4); ok_undef ($x->{_p});
-ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a});
-ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p});
+
+#ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a});
+#ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p});
# check for no A/P in case of fallback
# result
$try .= "\$x->$f(\$y);";
- # print "trying $try\n";
+ # print "trying $try\n";
$rc = eval $try;
# convert hex/binary targets to decimal
if ($ans =~ /^(0x0x|0b0b)/)
}
print "# INC = @INC\n";
- plan tests => 679
+ plan tests => 684
+ 23; # own tests
}
-use Math::BigInt 1.63;
-use Math::BigFloat 1.38;
+use Math::BigInt 1.70;
+use Math::BigFloat 1.43;
use vars qw/$mbi $mbf/;
$class->accuracy(undef); # reset for further tests
$class->precision(undef);
}
-
# bug with flog(Math::BigFloat,Math::BigInt)
$x = Math::BigFloat->new(100);
$x = $x->blog(Math::BigInt->new(10));
# normal require that calls import automatically (we thus have MBI afterwards)
require Math::BigFloat; my $x = Math::BigFloat->new(1); ++$x; ok ($x,2);
-ok (Math::BigFloat->config()->{with}, 'Math::BigInt' );
+ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Calc' );
# now override
Math::BigFloat->import ( with => 'Math::BigInt::Subclass' );
-ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Subclass' );
+# thw with argument is ignored
+ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Calc' );
# all tests done
}
print "# INC = @INC\n";
- plan tests => 1772
+ plan tests => 1814
+ 6; # + our own tests
}
}
print "# INC = @INC\n";
- plan tests => 2770
+ plan tests => 2832
+ 5; # +5 own tests
}
}
print "# INC = @INC\n";
- plan tests => 679;
+ plan tests => 684;
}
use Math::BigInt::Subclass;
0:0:1
0:1:0
0:2:0
-0:-1:NaN
-0:-2:NaN
+0:-1:inf
+0:-2:inf
1:0:1
1:1:1
1:2:1
-1:-2:1
-1:-3:-1
-1:-4:1
+-2:2:4
+-2:3:-8
+-2:4:16
+-2:5:-32
+-3:2:9
+-3:3:-27
+-3:4:81
+-3:5:-243
10:2:100
10:3:1000
10:4:10000
}
print "# INC = @INC\n";
- plan tests => 2082
+ plan tests => 2098
+ 2; # our own tests
}
}
print "# INC = @INC\n";
- plan tests => 3;
+ plan tests => 2;
}
use Math::BigFloat with => 'Math::BigInt::Subclass', lib => 'BareCalc';
-ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Subclass' );
+ok (Math::BigFloat->config()->{with}, 'Math::BigInt::BareCalc' );
-ok ($Math::BigInt::Subclass::lib, 'BareCalc' );
+# ok ($Math::BigInt::Subclass::lib, 'BareCalc' );
# it never arrives here, but that is a design decision in SubClass
-ok (Math::BigInt->config->{lib}, 'Math::BigInt::Calc' );
+ok (Math::BigInt->config->{lib}, 'Math::BigInt::BareCalc' );
# all tests done
}
print "# INC = @INC\n";
- plan tests => 1772
+ plan tests => 1814
+ 1;
}
$class = "Math::BigFloat";
$CL = "Math::BigInt::Calc";
-ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Subclass');
+# the with argument is ignored
+ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Calc');
require 'bigfltpm.inc'; # all tests here for sharing
require Exporter;
use Math::BigFloat;
-use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade
+use vars qw($VERSION @ISA $PACKAGE $upgrade $downgrade
$accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);
@ISA = qw(Exporter Math::BigFloat);
-@EXPORT_OK = qw();
-$VERSION = '0.11';
+$VERSION = '0.12';
use overload; # inherit from Math::BigFloat
+BEGIN { *objectify = \&Math::BigInt::objectify; }
+
##############################################################################
# global constants, flags and accessory
$_trap_inf = 0; # are infs ok? set w/ config()
my $nan = 'NaN';
-my $class = 'Math::BigRat';
my $MBI = 'Math::BigInt';
+my $CALC = 'Math::BigInt::Calc';
+my $class = 'Math::BigRat';
+my $IMPORT = 0;
sub isa
{
UNIVERSAL::isa(@_);
}
+sub BEGIN
+ {
+ *AUTOLOAD = \&Math::BigFloat::AUTOLOAD;
+ }
+
sub _new_from_float
{
# turn a single float input into a rational number (like '0.1')
my ($self,$f) = @_;
return $self->bnan() if $f->is_nan();
- return $self->binf('-inf') if $f->{sign} eq '-inf';
- return $self->binf('+inf') if $f->{sign} eq '+inf';
+ return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/;
- $self->{_n} = $f->{_m}->copy(); # mantissa
+ local $Math::BigInt::accuracy = undef;
+ local $Math::BigInt::precision = undef;
+ $self->{_n} = $MBI->new($CALC->_str ( $f->{_m} ),undef,undef);# mantissa
$self->{_d} = $MBI->bone();
- $self->{sign} = $f->{sign} || '+'; $self->{_n}->{sign} = '+';
- if ($f->{_e}->{sign} eq '-')
+ $self->{sign} = $f->{sign} || '+';
+ if ($f->{_es} eq '-')
{
# something like Math::BigRat->new('0.1');
- $self->{_d}->blsft($f->{_e}->copy()->babs(),10); # 1 / 1 => 1/10
+ # 1 / 1 => 1/10
+ $self->{_d}->blsft( $MBI->new($CALC->_str ( $f->{_e} )),10);
}
else
{
# something like Math::BigRat->new('10');
# 1 / 1 => 10/1
- $self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero();
+ $self->{_n}->blsft( $MBI->new($CALC->_str($f->{_e})),10) unless
+ $CALC->_is_zero($f->{_e});
}
$self;
}
local $Math::BigFloat::precision = undef;
local $Math::BigInt::accuracy = undef;
local $Math::BigInt::precision = undef;
- my $nf = Math::BigFloat->new($n);
+
+ my $nf = Math::BigFloat->new($n,undef,undef);
$self->{sign} = '+';
return $self->bnan() if $nf->is_nan();
- $self->{_n} = $nf->{_m};
+ $self->{_n} = $MBI->new( $CALC->_str( $nf->{_m} ) );
+
# now correct $self->{_n} due to $n
my $f = Math::BigFloat->new($d,undef,undef);
- $self->{_d} = $f->{_m};
return $self->bnan() if $f->is_nan();
- #print "n=$nf e$nf->{_e} d=$f e$f->{_e}\n";
+ $self->{_d} = $MBI->new( $CALC->_str( $f->{_m} ) );
+
# calculate the difference between nE and dE
- my $diff_e = $nf->{_e}->copy()->bsub ( $f->{_e} );
+ my $diff_e = $MBI->new ($nf->exponent())->bsub ( $f->exponent);
if ($diff_e->is_negative())
{
# < 0: mul d with it
$self->bnorm();
}
+sub copy
+ {
+ my ($c,$x);
+ if (@_ > 1)
+ {
+ # if two arguments, the first one is the class to "swallow" subclasses
+ ($c,$x) = @_;
+ }
+ else
+ {
+ $x = shift;
+ $c = ref($x);
+ }
+ return unless ref($x); # only for objects
+
+ my $self = {}; bless $self,$c;
+
+ $self->{sign} = $x->{sign};
+ $self->{_d} = $x->{_d}->copy();
+ $self->{_n} = $x->{_n}->copy();
+ $self->{_a} = $x->{_a} if defined $x->{_a};
+ $self->{_p} = $x->{_p} if defined $x->{_p};
+ $self;
+ }
+
##############################################################################
sub config
($self,$x,$y,@r) = objectify(2,@_);
}
- # TODO: $self instead or $class??
- $x = $class->new($x) unless $x->isa($class);
- $y = $class->new($y) unless $y->isa($class);
+ $x = $self->new($x) unless $x->isa($self);
+ $y = $self->new($y) unless $y->isa($self);
return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN');
($self,$x,$y,@r) = objectify(2,@_);
}
- # TODO: $self instead or $class??
- $x = $class->new($x) unless $x->isa($class);
- $y = $class->new($y) unless $y->isa($class);
+ $x = $self->new($x) unless $x->isa($self);
+ $y = $self->new($y) unless $y->isa($self);
return $self->_div_inf($x,$y)
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
# - / - == - * -
# 4 3 4 1
-# local $Math::BigInt::accuracy = undef;
-# local $Math::BigInt::precision = undef;
+ local $Math::BigInt::accuracy = undef;
+ local $Math::BigInt::precision = undef;
$x->{_n}->bmul($y->{_d});
$x->{_d}->bmul($y->{_n});
($self,$x,$y,@r) = objectify(2,@_);
}
- # TODO: $self instead or $class??
- $x = $class->new($x) unless $x->isa($class);
- $y = $class->new($y) unless $y->isa($class);
+ $x = $self->new($x) unless $x->isa($self);
+ $y = $self->new($y) unless $y->isa($self);
return $self->_div_inf($x,$y)
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
+ local $Math::BigInt::accuracy = undef;
+ local $Math::BigInt::precision = undef;
if ($x->{sign} eq '-')
{
$x->{_n}->badd($x->{_d}); # -5/2 => -7/2
return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf
+ local $Math::BigInt::accuracy = undef;
+ local $Math::BigInt::precision = undef;
if ($x->{sign} eq '-')
{
if ($x->{_n}->bacmp($x->{_d}) < 0)
sub is_int
{
# return true if arg (BRAT or num_str) is an integer
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
$x->{_d}->is_one(); # x/y && y != 1 => no integer
sub is_zero
{
# return true if arg (BRAT or num_str) is zero
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero();
0;
sub is_one
{
# return true if arg (BRAT or num_str) is +1 or -1 if signis given
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- my $sign = shift || ''; $sign = '+' if $sign ne '-';
+ my $sign = $_[2] || ''; $sign = '+' if $sign ne '-';
return 1
if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one());
0;
sub is_odd
{
# return true if arg (BFLOAT or num_str) is odd or false if even
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
($x->{_d}->is_one() && $x->{_n}->is_odd()); # x/2 is not, but 3/1
sub is_even
{
# return true if arg (BINT or num_str) is even or false if odd
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
return 1 if ($x->{_d}->is_one() # x/3 is never
0;
}
-BEGIN
- {
- *objectify = \&Math::BigInt::objectify;
- }
-
##############################################################################
# parts() and friends
sub length
{
- return 0;
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+ return $nan unless $x->is_int();
+ $x->{_n}->length(); # length(-123/1) => length(123)
}
sub digit
{
- return 0;
+ my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+ return $nan unless $x->is_int();
+ $x->{_n}->digit($n); # digit(-123/1,2) => digit(123,2)
}
##############################################################################
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
- ($self,$x,$y,@r) = objectify(2,@_);
+ ($self,$x,$y,@r) = objectify(2,$class,@_);
}
+ # blog(1,Y) => 0
+ return $x->bzero() if $x->is_one() && $y->{sign} eq '+';
+
# $x <= 0 => NaN
return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+';
return $self->new($x->as_number()->blog($y->as_number(),@r));
}
- warn ("blog() not fully implemented");
- $x->bnan();
+ # do it with floats
+ $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) );
+ }
+
+sub _as_float
+ {
+ my $x = shift;
+
+ local $Math::BigFloat::upgrade = undef;
+ local $Math::BigFloat::accuracy = undef;
+ local $Math::BigFloat::precision = undef;
+ # 22/7 => 3.142857143..
+ Math::BigFloat->new($x->{_n})->bdiv($x->{_d}, $x->accuracy());
}
sub broot
{
return $self->new($x->as_number()->broot($y->as_number(),@r));
}
-
- warn ("broot() not fully implemented");
- $x->bnan();
+
+ # do it with floats
+ $x->_new_from_float( $x->_as_float()->broot($y,@r) );
}
sub bmodpow
local $Math::BigInt::upgrade = undef;
local $Math::BigInt::precision = undef;
local $Math::BigInt::accuracy = undef;
+
$x->{_d} = Math::BigFloat->new($x->{_d})->bsqrt();
$x->{_n} = Math::BigFloat->new($x->{_n})->bsqrt();
# if sqrt(D) was not integer
- if ($x->{_d}->{_e}->{sign} ne '+')
+ if ($x->{_d}->{_es} ne '+')
{
- $x->{_n}->blsft($x->{_d}->{_e}->babs(),10); # 7.1/4.51 => 7.1/45.1
- $x->{_d} = $x->{_d}->{_m}; # 7.1/45.1 => 71/45.1
+ $x->{_n}->blsft($x->{_d}->exponent()->babs(),10); # 7.1/4.51 => 7.1/45.1
+ $x->{_d} = $MBI->new($CALC->_str($x->{_d}->{_m})); # 7.1/45.1 => 71/45.1
}
# if sqrt(N) was not integer
- if ($x->{_n}->{_e}->{sign} ne '+')
+ if ($x->{_n}->{_es} ne '+')
{
- $x->{_d}->blsft($x->{_n}->{_e}->babs(),10); # 71/45.1 => 710/45.1
- $x->{_n} = $x->{_n}->{_m}; # 710/45.1 => 710/451
+ $x->{_d}->blsft($x->{_n}->exponent()->babs(),10); # 71/45.1 => 710/45.1
+ $x->{_n} = $MBI->new($CALC->_str($x->{_n}->{_m})); # 710/45.1 => 710/451
}
# convert parts to $MBI again
- $x->{_n} = $x->{_n}->as_number();
- $x->{_d} = $x->{_d}->as_number();
+ $x->{_n} = $x->{_n}->as_number() unless $x->{_n}->isa($MBI);
+ $x->{_d} = $x->{_d}->as_number() unless $x->{_d}->isa($MBI);
$x->bnorm()->round(@r);
}
sub blsft
{
- my ($self,$x,$y,$b,$a,$p,$r) = objectify(3,@_);
+ my ($self,$x,$y,$b,@r) = objectify(3,@_);
- $x->bmul( $b->copy()->bpow($y), $a,$p,$r);
+ $b = 2 unless defined $b;
+ $b = $self->new($b) unless ref ($b);
+ $x->bmul( $b->copy()->bpow($y), @r);
$x;
}
sub brsft
{
- my ($self,$x,$y,$b,$a,$p,$r) = objectify(2,@_);
+ my ($self,$x,$y,$b,@r) = objectify(2,@_);
- $x->bdiv( $b->copy()->bpow($y), $a,$p,$r);
+ $b = 2 unless defined $b;
+ $b = $self->new($b) unless ref ($b);
+ $x->bdiv( $b->copy()->bpow($y), @r);
$x;
}
sub bacmp
{
# compare two numbers (as unsigned)
-
+
# set up parameters
my ($self,$x,$y) = (ref($_[0]),@_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
- ($self,$x,$y) = objectify(2,@_);
+ ($self,$x,$y) = objectify(2,$class,@_);
}
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
sub as_number
{
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
$t;
}
+sub as_bin
+ {
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+ return $x unless $x->is_int();
+
+ my $s = $x->{sign}; $s = '' if $s eq '+';
+ $s . $x->{_n}->as_bin();
+ }
+
+sub as_hex
+ {
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+ return $x unless $x->is_int();
+
+ my $s = $x->{sign}; $s = '' if $s eq '+';
+ $s . $x->{_n}->as_hex();
+ }
+
sub import
{
my $self = shift;
my $l = scalar @_;
my $lib = ''; my @a;
+ $IMPORT++;
+
for ( my $i = 0; $i < $l ; $i++)
{
# print "at $_[$i] (",$_[$i+1]||'undef',")\n";
push @a, $_[$i];
}
}
- # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
+ # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still work
my $mbilib = eval { Math::BigInt->config()->{lib} };
if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
{
require Carp; Carp::croak ("Couldn't load $MBI: $! $@");
}
+ $CALC = Math::BigFloat->config()->{lib};
+
# any non :constant stuff is handled by our parent, Exporter
# even if @_ is empty, to give it a chance
$self->SUPER::import(@a); # for subclasses
ok ($class->config()->{lib},$CL);
+use strict;
+
while (<DATA>)
{
chomp;
{
@args = split(/:/,$_,99); $ans = pop(@args);
}
- $try = "\$x = new $class \"$args[0]\";";
+ $try = "\$x = $class->new('$args[0]');";
if ($f eq "fnorm")
{
$try .= "\$x;";
} elsif ($f eq "finf") {
- $try .= "\$x->binf('$args[1]');";
+ $try .= "\$x->finf('$args[1]');";
} elsif ($f eq "is_inf") {
$try .= "\$x->is_inf('$args[1]');";
} elsif ($f eq "fone") {
$try .= "\$x->bone('$args[1]');";
} elsif ($f eq "fstr") {
$try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);";
- $try .= '$x->bstr();';
+ $try .= '$x->fstr();';
} elsif ($f eq "parts") {
# ->bstr() to see if an object is returned
$try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();';
} elsif ($f eq "mantissa") {
# ->bstr() to see if an object is returned
$try .= '$x->mantissa()->bstr();';
- } elsif ($f eq "numify") {
- $try .= "\$x->numify();";
- } elsif ($f eq "length") {
- $try .= "\$x->length();";
+ } elsif ($f =~ /^(numify|length|as_number|as_hex|as_bin)$/) {
+ $try .= "\$x->$f();";
# some unary ops (test the fxxx form, since that is done by AUTOLOAD)
} elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) {
- $try .= "\$x->b$1();";
+ $try .= "\$x->f$1();";
# some is_xxx test function
} elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) {
$try .= "\$x->$f();";
- } elsif ($f eq "as_number") {
- $try .= '$x->as_number();';
} elsif ($f eq "finc") {
$try .= '++$x;';
} elsif ($f eq "fdec") {
$try .= '--$x;';
}elsif ($f eq "fround") {
- $try .= "$setup; \$x->bround($args[1]);";
+ $try .= "$setup; \$x->fround($args[1]);";
} elsif ($f eq "ffround") {
- $try .= "$setup; \$x->bfround($args[1]);";
+ $try .= "$setup; \$x->ffround($args[1]);";
} elsif ($f eq "fsqrt") {
- $try .= "$setup; \$x->bsqrt();";
- } elsif ($f eq "flog") {
- $try .= "$setup; \$x->blog();";
+ $try .= "$setup; \$x->fsqrt();";
} elsif ($f eq "ffac") {
- $try .= "$setup; \$x->bfac();";
+ $try .= "$setup; \$x->ffac();";
+ } elsif ($f eq "flog") {
+ if ($args[1] ne '')
+ {
+ $try .= "\$y = $class->new($args[1]);";
+ $try .= "$setup; \$x->flog(\$y);";
+ }
+ else
+ {
+ $try .= "$setup; \$x->flog();";
+ }
}
else
{
- $try .= "\$y = new $class \"$args[1]\";";
+ $try .= "\$y = $class->new(\"$args[1]\");";
if ($f eq "fcmp") {
$try .= '$x <=> $y;';
} elsif ($f eq "facmp") {
- $try .= '$x->bacmp($y);';
+ $try .= '$x->facmp($y);';
} elsif ($f eq "fpow") {
$try .= '$x ** $y;';
+ } elsif ($f eq "froot") {
+ $try .= "$setup; \$x->froot(\$y);";
} elsif ($f eq "fadd") {
$try .= '$x + $y;';
} elsif ($f eq "fsub") {
} elsif ($f eq "fdiv") {
$try .= "$setup; \$x / \$y;";
} elsif ($f eq "fdiv-list") {
- $try .= "$setup; join(',',\$x->bdiv(\$y));";
+ $try .= "$setup; join(',',\$x->fdiv(\$y));";
} elsif ($f eq "frsft") {
$try .= '$x >> $y;';
} elsif ($f eq "flsft") {
$try .= '$x % $y;';
} else { warn "Unknown op '$f'"; }
}
- # print "# Trying: '$try'\n";
+ print "# Trying: '$try'\n";
$ans1 = eval $try;
if ($ans =~ m|^/(.*)$|)
{
else
{
print "# Tried: '$try'\n" if !ok ($ans1, $ans);
-# if (ref($ans1) eq "$class")
-# {
-# # float numbers are normalized (for now), so mantissa shouldn't have
-# # trailing zeros
-# #print $ans1->_trailing_zeros(),"\n";
-# print "# Has trailing zeros after '$try'\n"
-# if !ok ($ans1->{_m}->_trailing_zeros(), 0);
-# }
+ if (ref($ans1) eq "$class")
+ {
+ # float numbers are normalized (for now), so mantissa shouldn't have
+ # trailing zeros
+ #print $ans1->_trailing_zeros(),"\n";
+ print "# Has trailing zeros after '$try'\n"
+ if ref($ans) eq 'HASH' && exists $ans->{_m} && !ok ($ans1->{_m}->_trailing_zeros(), 0);
+ }
}
} # end pattern or string
}
ok ($y,1200); ok ($x,1200);
###############################################################################
+# Really huge, big, ultra-mega-biggy-monster exponents
+# Technically, the exponents should not be limited (they are BigInts), but
+# practically there are a few places were they are limited to a Perl scalar.
+# This is sometimes for speed, sometimes because otherwise the number wouldn't
+# fit into your memory (just think of 1e123456789012345678901234567890 + 1!)
+# anyway. We don't test everything here, but let's make sure it just basically
+# works.
+
+#
+#my $monster = '1e1234567890123456789012345678901234567890';
+#
+## new
+#ok ($class->new($monster)->bsstr(),
+# '1e+1234567890123456789012345678901234567890');
+## cmp
+#ok ($class->new($monster) > 0,1);
+#
+## sub/mul
+#ok ($class->new($monster)->bsub( $monster),0);
+#ok ($class->new($monster)->bmul(2)->bsstr(),
+# '2e+1234567890123456789012345678901234567890');
+
+###############################################################################
# zero,inf,one,nan
$x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $class->new(2); $x->finf(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $class->new(2); $x->fone(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
$x = $class->new(2); $x->fnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
+###############################################################################
+# bone/binf etc as plain calls (Lite failed them)
+
+ok ($class->fzero(),0);
+ok ($class->fone(),1);
+ok ($class->fone('+'),1);
+ok ($class->fone('-'),-1);
+ok ($class->fnan(),'NaN');
+ok ($class->finf(),'inf');
+ok ($class->finf('+'),'inf');
+ok ($class->finf('-'),'-inf');
+ok ($class->finf('-inf'),'-inf');
+$class->accuracy(undef); $class->precision(undef); # reset
+
+###############################################################################
+# bug in bsstr()/numify() showed up in after-rounding in bdiv()
+
+$x = $class->new('0.008'); $y = $class->new(2);
+$x->bdiv(3,$y);
+ok ($x,'0.0027');
+
###############################################################################
# fsqrt() with set global A/P or A/P enabled on $x, also a test whether fsqrt()
# correctly modifies $x
-$class->accuracy(undef); $class->precision(undef); # reset
$x = $class->new(12); $class->precision(-2); $x->fsqrt(); ok ($x,'3.46');
$class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464');
-# A and P set => NaN
-${${class}.'::accuracy'} = 4; $x = $class->new(12); $x->fsqrt(3); ok ($x,'NaN');
-# supplied arg overrides set global
-$class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46');
+{
+ no strict 'refs';
+ # A and P set => NaN
+ ${${class}.'::accuracy'} = 4; $x = $class->new(12);
+ $x->fsqrt(3); ok ($x,'NaN');
+ # supplied arg overrides set global
+ $class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46');
+ $class->accuracy(undef); $class->precision(undef); # reset for further tests
+}
+
+#############################################################################
+# can we call objectify (broken until v1.52)
+
+{
+ no strict;
+ $try =
+ '@args' . " = $class" . "::objectify(2,$class,4,5);".'join(" ",@args);';
+ $ans = eval $try;
+ ok ($ans,"$class 4 5");
+}
-$class->accuracy(undef); $class->precision(undef); # reset for further tests
+#############################################################################
+# is_one('-') (broken until v1.64)
+
+ok ($class->new(-1)->is_one(),0);
+ok ($class->new(-1)->is_one('-'),1);
1; # all done
__DATA__
$div_scale = 40;
&flog
-0:NaN
--1:NaN
--2:NaN
-1:0
+0::NaN
+-1::NaN
+-2::NaN
+# base > 0, base != 1
+2:-1:NaN
+2:0:NaN
+2:1:NaN
+# log(1) is always 1, regardless of $base
+1::0
+1:1:0
+1:2:0
# this is too slow for the testsuite
+#2:0.6931471805599453094172321214581765680755
#2.718281828:0.9999999998311266953289851340574956564911
#$div_scale = 20;
#2.718281828:0.99999999983112669533
-1:0
-# too slow, too (or hangs?)
+# too slow, too
#123:4.8112184355
-# $div_scale = 14;
+$div_scale = 14;
#10:0:2.302585092994
#1000:0:6.90775527898214
#100:0:4.60517018598809
-#2:0:0.693147180559945
+2::0.69314718055995
#3.1415:0:1.14470039286086
+# too slow
#12345:0:9.42100640177928
#0.001:0:-6.90775527898214
# reset for further tests
$div_scale = 40;
+1::0
&frsft
NaNfrsft:2:NaN
0:2:0
-2:-2
-123.456:-123
-200:-200
+# test for bug in brsft() not handling cases that return 0
+0.000641:0
+0.0006412:0
+0.00064123:0
+0.000641234:0
+0.0006412345:0
+0.00064123456:0
+0.000641234567:0
+0.0006412345678:0
+0.00064123456789:0
+0.1:0
+0.01:0
+0.001:0
+0.0001:0
+0.00001:0
+0.000001:0
+0.0000001:0
+0.00000001:0
+0.000000001:0
+0.0000000001:0
+0.00000000001:0
+0.12345:0
+0.123456:0
+0.1234567:0
+0.12345678:0
+0.123456789:0
&finf
1:+:inf
2:-:-inf
3:abc:inf
+&as_hex
++inf:inf
+-inf:-inf
+hexNaN:NaN
+0:0x0
+5:0x5
+-5:-0x5
+&as_bin
++inf:inf
+-inf:-inf
+hexNaN:NaN
+0:0b0
+5:0b101
+-5:-0b101
&numify
+# uses bsstr() so 5 => 5e+0 to be compatible w/ Perls output
0:0e+1
+1:1e+0
1234:1234e+0
NaN:NaN
+inf:inf
-inf:-inf
+-5:-5e+0
+100:1e+2
+-100:-1e+2
&fnan
abc:NaN
2:NaN
+inf:inf
-inf:-inf
abcfsstr:NaN
+-abcfsstr:NaN
1234.567:1234567e-3
+123:123e+0
+-5:-5e+0
+-100:-1e+2
&fstr
+inf:::inf
-inf:::-inf
11111b:NaN
+1z:NaN
-1z:NaN
+0e999:0
+0e-999:0
+-0e999:0
+-0e-999:0
0:0
+0:0
+00:0
-inf:123.45:-inf
+inf:-123.45:inf
-inf:-123.45:-inf
+# 2 ** 0.5 == sqrt(2)
+# 1.41..7 and not 1.4170 since fallback (bsqrt(9) is '3', not 3.0...0)
+2:0.5:1.41421356237309504880168872420969807857
+#2:0.2:1.148698354997035006798626946777927589444
+#6:1.5:14.6969384566990685891837044482353483518
+$div_scale = 20;
+#62.5:12.5:26447206647554886213592.3959144
+$div_scale = 40;
&fneg
fnegNaN:NaN
+inf:-inf
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
-+inf:-inf:0
--inf:+inf:0
++inf:-inf:NaN
+-inf:+inf:NaN
+inf:+inf:inf
-inf:-inf:-inf
baddNaN:+inf:NaN
+0:abc:NaN
+inf:-inf:inf
-inf:+inf:-inf
-+inf:+inf:0
--inf:-inf:0
++inf:+inf:NaN
+-inf:-inf:NaN
baddNaN:+inf:NaN
baddNaN:+inf:NaN
+inf:baddNaN:NaN
152403346:12345:4321
87654321:87654321:0
# now some floating point tests
-#123:2.5:0.5
-#1230:2.5:0
-#123.4:2.5:0.9
-#123e1:25:5
+123:2.5:0.5
+1230:2.5:0
+123.4:2.5:0.9
+123e1:25:5
&ffac
Nanfac:NaN
-1:NaN
++inf:inf
+-inf:NaN
0:1
1:1
2:2
10:3628800
11:39916800
12:479001600
+&froot
+# sqrt()
++0:2:0
++1:2:1
+-1:2:NaN
+# -$x ** (1/2) => -$y, but not in froot()
+-123.456:2:NaN
++inf:2:inf
+-inf:2:NaN
+2:2:1.41421356237309504880168872420969807857
+-2:2:NaN
+4:2:2
+9:2:3
+16:2:4
+100:2:10
+123.456:2:11.11107555549866648462149404118219234119
+15241.38393:2:123.4559999756998444766131352122991626468
+1.44:2:1.2
+12:2:3.464101615137754587054892683011744733886
+0.49:2:0.7
+0.0049:2:0.07
+# invalid ones
+1:NaN:NaN
+-1:NaN:NaN
+0:NaN:NaN
+-inf:NaN:NaN
++inf:NaN:NaN
+NaN:0:NaN
+NaN:2:NaN
+NaN:inf:NaN
+NaN:inf:NaN
+12:-inf:NaN
+12:inf:NaN
++0:0:NaN
++1:0:NaN
+-1:0:NaN
+-2:0:NaN
+-123.45:0:NaN
++inf:0:NaN
+12:1:12
+-12:1:NaN
+8:-1:NaN
+-8:-1:NaN
+# cubic root
+8:3:2
+-8:3:NaN
+# fourths root
+16:4:2
+81:4:3
+# see t/bigroot() for more tests
&fsqrt
+0:0
-1:NaN
144e20:120000000000
# proved to be an endless loop under 7-9
12:3.464101615137754587054892683011744733886
+0.49:0.7
+0.0049:0.07
&is_nan
123:0
abc:1
-51:-51
-51.2:-52
12.2:12
+0.12345:0
+0.123456:0
+0.1234567:0
+0.12345678:0
+0.123456789:0
&fceil
0:0
abc:NaN
}
print "# INC = @INC\n";
-# plan tests => 1585;
plan tests => 1;
}
-#use Math::BigInt;
-#use Math::BigRat;
-use Math::BigRat::Test; # test via this
+use Math::BigRat::Test; # test via this Subclass
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigRat::Test";
ok (1,1);
-# does not fully work yet
-#require 'bigfltpm.inc'; # all tests here for sharing
+# fails stil 185 tests
+#require 'bigfltpm.inc'; # all tests here for sharing
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 170;
+ plan tests => 174;
}
# testing of Math::BigRat
$x = $cr->$func($mbf->new(1232)); ok ($x,'1232');
$x = $cr->$func($mbf->new(1232.3)); ok ($x,'12323/10');
}
-
+
$x = $cr->new('-0'); ok ($x,'0'); ok ($x->{_n}, '0'); ok ($x->{_d},'1');
$x = $cr->new('NaN'); ok ($x,'NaN'); ok ($x->{_n}, '0'); ok ($x->{_d},'0');
$x = $cr->new('-NaN'); ok ($x,'NaN'); ok ($x->{_n}, '0'); ok ($x->{_d},'0');
##############################################################################
$x = $cr->new('1/4'); $y = $cr->new('1/3');
+
ok ($x + $y, '7/12');
ok ($x * $y, '1/12');
ok ($x / $y, '3/4');
ok ($x->copy()->broot($y), 2 ** 8);
ok (ref($x->copy()->broot($y)), $cr);
+
ok ($x->copy()->bmodpow($y,$z), 1);
ok (ref($x->copy()->bmodpow($y,$z)), $cr);
ok ($x->copy()->bmodinv($y), $z);
ok (ref($x->copy()->bmodinv($y)), $cr);
+# square root with exact result
+$x = $cr->new('1.44');
+ok ($x->copy()->broot(2), '12/10');
+ok (ref($x->copy()->broot(2)), $cr);
+
+# log with exact result
+$x = $cr->new('256.1');
+ok ($x->copy()->blog(2), '8000563442710106079310294693803606983661/1000000000000000000000000000000000000000');
+ok (ref($x->copy()->blog(2)), $cr);
+
+
##############################################################################
# done
$float =~ s/\..*//;
return $float;
}
- my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split(\$float);
+ my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($float);
return $float if !defined $mis; # doesn't look like a number to me
my $ec = int($$ev);
my $sign = $$mis; $sign = '' if $sign eq '+';
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.03';
+$VERSION = '0.02';
+
+sub api_version () { 1; }
# Package to to test Bigint's simulation of Calc
# uses Calc, but only features the strictly necc. methods.
-use Math::BigInt::Calc '0.33';
+use Math::BigInt::Calc '0.40';
BEGIN
{
no strict 'refs';
- foreach (qw/ base_len new zero one two copy str num add sub mul div inc dec
- acmp len digit zeros
- is_zero is_one is_odd is_even is_one check
- to_small to_large
- /)
+ foreach (qw/
+ base_len new zero one two ten copy str num add sub mul div mod inc dec
+ acmp len digit zeros
+ rsft lsft
+ fac pow gcd log_int sqrt root
+ is_zero is_one is_odd is_even is_one is_two is_ten check
+ as_hex as_bin from_hex from_bin
+ modpow modinv
+ and xor or
+ /)
{
my $name = "Math::BigInt::Calc::_$_";
*{"Math::BigInt::BareCalc::_$_"} = \&$name;
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.11';
+$VERSION = '0.12';
+
+sub api_version() { 1; }
##############################################################################
# global constants, flags and accessory
sub _new
{
- # (string) return ref to num
+ # create scalar ref from string
my $d = $_[1];
- my $x = $$d; # make copy
- return \$x;
+ my $x = $d; # make copy
+ \$x;
}
+sub _from_hex
+ {
+ # not used
+ }
+
+sub _from_bin
+ {
+ # not used
+ }
+
sub _zero
{
- my $x = 0; return \$x;
+ my $x = 0; \$x;
}
sub _one
{
- my $x = 1; return \$x;
+ my $x = 1; \$x;
+ }
+
+sub _two
+ {
+ my $x = 2; \$x;
+ }
+
+sub _ten
+ {
+ my $x = 10; \$x;
}
sub _copy
{
my $x = $_[1];
my $z = $$x;
- return \$z;
+ \$z;
}
# catch and throw away
sub _str
{
# make string
- return \"${$_[1]}";
+ "${$_[1]}";
}
sub _num
{
# make a number
- return ${$_[1]};
+ 0+${$_[1]};
+ }
+
+sub _zeros
+ {
+ my $x = $_[1];
+
+ $x =~ /\d(0*)$/;
+ length($1 || '');
+ }
+
+sub _rsft
+ {
+ # not used
+ }
+
+sub _lsft
+ {
+ # not used
+ }
+
+sub _mod
+ {
+ # not used
+ }
+
+sub _gcd
+ {
+ # not used
+ }
+
+sub _sqrt
+ {
+ # not used
+ }
+
+sub _root
+ {
+ # not used
+ }
+
+sub _fac
+ {
+ # not used
+ }
+
+sub _modinv
+ {
+ # not used
+ }
+
+sub _modpow
+ {
+ # not used
}
+sub _log_int
+ {
+ # not used
+ }
+
+sub _as_hex
+ {
+ sprintf("0x%x",${$_[1]});
+ }
+
+sub _as_bin
+ {
+ sprintf("0b%b",${$_[1]});
+ }
##############################################################################
# actual math code
{
# return true if arg is zero
my ($c,$x) = @_;
- return ($$x == 0) <=> 0;
+ ($$x == 0) <=> 0;
}
sub _is_even
{
# return true if arg is even
my ($c,$x) = @_;
- return (!($$x & 1)) <=> 0;
+ (!($$x & 1)) <=> 0;
}
sub _is_odd
{
# return true if arg is odd
my ($c,$x) = @_;
- return ($$x & 1) <=> 0;
+ ($$x & 1) <=> 0;
}
sub _is_one
{
# return true if arg is one
my ($c,$x) = @_;
- return ($$x == 1) <=> 0;
+ ($$x == 1) <=> 0;
+ }
+
+sub _is_two
+ {
+ # return true if arg is one
+ my ($c,$x) = @_;
+ ($$x == 2) <=> 0;
+ }
+
+sub _is_ten
+ {
+ # return true if arg is one
+ my ($c,$x) = @_;
+ ($$x == 10) <=> 0;
}
###############################################################################
-#!/usr/bin/perl -w
-
package Math::BigRat::Test;
require 5.005_02;
use Exporter;
use Math::BigRat;
use Math::BigFloat;
-use vars qw($VERSION @ISA $PACKAGE
+use vars qw($VERSION @ISA
$accuracy $precision $round_mode $div_scale);
-@ISA = qw(Exporter Math::BigRat);
-$VERSION = 0.03;
+@ISA = qw(Math::BigRat Exporter);
+$VERSION = 0.04;
use overload; # inherit overload from BigRat
# return $self;
#}
+BEGIN
+ {
+ *fstr = \&bstr;
+ *fsstr = \&bsstr;
+ *objectify = \&Math::BigInt::objectify;
+ *AUTOLOAD = \&Math::BigRat::AUTOLOAD;
+ no strict 'refs';
+ foreach my $method ( qw/ div acmp floor ceil root sqrt log fac modpow modinv/)
+ {
+ *{'b' . $method} = \&{'Math::BigRat::b' . $method};
+ }
+ }
+
+sub fround
+ {
+ my ($x,$a) = @_;
+
+ #print "$a $accuracy $precision $round_mode\n";
+ Math::BigFloat->round_mode($round_mode);
+ Math::BigFloat->accuracy($a || $accuracy);
+ Math::BigFloat->precision(undef);
+ my $y = Math::BigFloat->new($x->bsstr(),undef,undef);
+ $class->new($y->fround($a));
+ }
+
+sub ffround
+ {
+ my ($x,$p) = @_;
+
+ Math::BigFloat->round_mode($round_mode);
+ Math::BigFloat->accuracy(undef);
+ Math::BigFloat->precision($p || $precision);
+ my $y = Math::BigFloat->new($x->bsstr(),undef,undef);
+ $class->new($y->ffround($p));
+ }
+
sub bstr
{
# calculate a BigFloat compatible string output
my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
+# print " bstr \$x ", $accuracy || $x->{_a} || 'notset', " ", $precision || $x->{_p} || 'notset', "\n";
return $s.$x->{_n} if $x->{_d}->is_one();
my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d});
- return $s.$output->bstr();
+ local $Math::BigFloat::accuracy = $accuracy || $x->{_a};
+ local $Math::BigFloat::precision = $precision || $x->{_p};
+ $s.$output->bstr();
+ }
+
+sub numify
+ {
+ $_[0]->bsstr();
}
sub bsstr
my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3
- return $s.$x->{_n}->bsstr() if $x->{_d}->is_one();
my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d});
return $s.$output->bsstr();
}
projects / p5sagit/p5-mst-13.2.git / commitdiff