package Math::BigFloat;
-$VERSION = 1.16;
+$VERSION = '1.20';
require 5.005;
use Exporter;
use Math::BigInt qw/objectify/;
badd bmul bdiv bmod bnorm bsub
bgcd blcm bround bfround
bpow bnan bzero bfloor bceil
- bacmp bstr binc bdec bint binf
+ bacmp bstr binc bdec binf
is_odd is_even is_nan is_inf is_positive is_negative
is_zero is_one sign
);
my $NaNOK=1;
# constant for easier life
my $nan = 'NaN';
-my $ten = Math::BigInt->new(10); # shortcut for speed
# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
$rnd_mode = 'even';
$precision = undef;
$div_scale = 40;
+# in case we call SUPER::->foo() and this wants to call modify()
+# sub modify () { 0; }
+
{
# checks for AUTOLOAD
my %methods = map { $_ => 1 }
return $self;
}
-# some shortcuts for easier life
-sub bfloat
- {
- # exportable version of new
- return $class->new(@_);
- }
-
-sub bint
- {
- # exportable version of new
- return $class->new(@_,0)->bround(0,'trunc');
- }
-
sub bnan
{
# create a bigfloat 'NaN', if given a BigFloat, set it to 'NaN'
{
my $c = $self; $self = {}; bless $self, $c;
}
- $self->{_e} = new Math::BigInt 0;
- $self->{_m} = new Math::BigInt 0;
+ $self->{_m} = Math::BigInt->bzero();
+ $self->{_e} = Math::BigInt->bzero();
$self->{sign} = $nan;
return $self;
}
{
my $c = $self; $self = {}; bless $self, $c;
}
- $self->{_e} = new Math::BigInt 0;
- $self->{_m} = new Math::BigInt 0;
+ $self->{_m} = Math::BigInt->bzero();
+ $self->{_e} = Math::BigInt->bzero();
$self->{sign} = $sign.'inf';
return $self;
}
+sub bone
+ {
+ # create a bigfloat '+-1', if given a BigFloat, set it to '+-1'
+ my $self = shift;
+ my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
+
+ $self = $class if !defined $self;
+ if (!ref($self))
+ {
+ my $c = $self; $self = {}; bless $self, $c;
+ }
+ $self->{_m} = Math::BigInt->bone();
+ $self->{_e} = Math::BigInt->bzero();
+ $self->{sign} = $sign;
+ return $self;
+ }
+
sub bzero
{
# create a bigfloat '+0', if given a BigFloat, set it to 0
{
my $c = $self; $self = {}; bless $self, $c;
}
- $self->{_m} = new Math::BigInt 0;
- $self->{_e} = new Math::BigInt 1;
+ $self->{_m} = Math::BigInt->bzero();
+ $self->{_e} = Math::BigInt->bone();
$self->{sign} = '+';
return $self;
}
# internal format is always normalized (no leading zeros, "-0" => "+0")
my ($self,$x) = objectify(1,@_);
- #return "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
- #return "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
- return $x->{sign} if $x->{sign} !~ /^[+-]$/;
- return '0' if $x->is_zero();
-
- my $es = $x->{_m}->bstr();
- if ($x->{_e}->is_zero())
+ #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
+ #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
+ if ($x->{sign} !~ /^[+-]$/)
{
- $es = $x->{sign}.$es if $x->{sign} eq '-';
- return $es;
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
}
- if ($x->{_e}->sign() eq '-')
+ my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.';
+
+ my $not_zero = !$x->is_zero();
+ if ($not_zero)
{
- if ($x->{_e} <= -CORE::length($es))
- {
- # print "style: 0.xxxx\n";
- my $r = $x->{_e}->copy(); $r->babs()->bsub( CORE::length($es) );
- $es = '0.'. ('0' x $r) . $es;
- }
- else
+ $es = $x->{_m}->bstr();
+ $len = CORE::length($es);
+ if (!$x->{_e}->is_zero())
+# {
+# $es = $x->{sign}.$es if $x->{sign} eq '-';
+# }
+# else
{
- # print "insert '.' at $x->{_e} in '$es'\n";
- substr($es,$x->{_e},0) = '.';
+ if ($x->{_e}->sign() eq '-')
+ {
+ $dot = '';
+ if ($x->{_e} <= -$len)
+ {
+ # print "style: 0.xxxx\n";
+ my $r = $x->{_e}->copy(); $r->babs()->bsub( CORE::length($es) );
+ $es = '0.'. ('0' x $r) . $es; $cad = -($len+$r);
+ }
+ else
+ {
+ # print "insert '.' at $x->{_e} in '$es'\n";
+ substr($es,$x->{_e},0) = '.'; $cad = $x->{_e};
+ }
+ }
+ else
+ {
+ # expand with zeros
+ $es .= '0' x $x->{_e}; $len += $x->{_e}; $cad = 0;
+ }
}
+ } # if not zero
+ $es = $x->{sign}.$es if $x->{sign} eq '-';
+ # if set accuracy or precision, pad with zeros
+ if ((defined $x->{_a}) && ($not_zero))
+ {
+ # 123400 => 6, 0.1234 => 4, 0.001234 => 4
+ my $zeros = $x->{_a} - $cad; # cad == 0 => 12340
+ $zeros = $x->{_a} - $len if $cad != $len;
+ #print "acc padd $x->{_a} $zeros (len $len cad $cad)\n";
+ $es .= $dot.'0' x $zeros if $zeros > 0;
}
- else
+ elsif ($x->{_p} || 0 < 0)
{
- # expand with zeros
- $es .= '0' x $x->{_e};
+ # 123400 => 6, 0.1234 => 4, 0.001234 => 6
+ my $zeros = -$x->{_p} + $cad;
+ #print "pre padd $x->{_p} $zeros (len $len cad $cad)\n";
+ $es .= $dot.'0' x $zeros if $zeros > 0;
}
- $es = $x->{sign}.$es if $x->{sign} eq '-';
return $es;
}
# internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
my ($self,$x) = objectify(1,@_);
- return "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
- return "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
- return $x->{sign} if $x->{sign} !~ /^[+-]$/;
+ #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
+ #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
my $sign = $x->{_e}->{sign}; $sign = '' if $sign eq '-';
my $sep = 'e'.$sign;
return $x->{_m}->bstr().$sep.$x->{_e}->bstr();
sub numify
{
# Make a number from a BigFloat object
- # simple return string and let Perl's atoi() handle the rest
+ # simple return string and let Perl's atoi()/atof() handle the rest
my ($self,$x) = objectify(1,@_);
return $x->bsstr();
}
# {
# $class->SUPER::bneg($class,@_);
# }
+
+# tels 2001-08-04
+# todo: this must be overwritten and return NaN for non-integer values
+# band(), bior(), bxor(), too
#sub bnot
# {
# $class->SUPER::bnot($class,@_);
}
# check sign for speed first
- return 1 if $x->{sign} eq '+' && $y->{sign} eq '-';
+ return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
- return 0 if $x->is_zero() && $y->is_zero(); # 0 <=> 0
- return -1 if $x->is_zero() && $y->{sign} eq '+'; # 0 <=> +y
- return 1 if $y->is_zero() && $x->{sign} eq '+'; # +x <=> 0
+ # shortcut
+ my $xz = $x->is_zero();
+ my $yz = $y->is_zero();
+ return 0 if $xz && $yz; # 0 <=> 0
+ return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
+ return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
# adjust so that exponents are equal
my $lx = $x->{_m}->length() + $x->{_e};
# return result as BFLOAT
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
- return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
-
+ # inf and NaN handling
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
+ {
+ # NaN first
+ return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ # inf handline
+ if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
+ {
+ # + and + => +, - and - => -, + and - => 0, - and + => 0
+ return $x->bzero() if $x->{sign} ne $y->{sign};
+ return $x;
+ }
+ # +-inf + something => +inf
+ # something +-inf => +-inf
+ $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
+ return $x;
+ }
+
# speed: no add for 0+y or x+0
return $x if $y->is_zero(); # x+0
if ($x->is_zero()) # 0+y
{
# return true if arg (BINT or num_str) is zero (array '+', '0')
my $x = shift; $x = $class->new($x) unless ref $x;
- #my ($self,$x) = objectify(1,@_);
- return ($x->{sign} ne $nan && $x->{_m}->is_zero());
+
+ return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero();
+ return 0;
}
sub is_one
# print "mbf bmul $x->{_m}e$x->{_e} $y->{_m}e$y->{_e}\n";
return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ # handle result = 0
+ return $x->bzero() if $x->is_zero() || $y->is_zero();
+ # inf handling
+ if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
+ {
+ # result will always be +-inf:
+ # +inf * +/+inf => +inf, -inf * -/-inf => +inf
+ # +inf * -/-inf => -inf, -inf * +/+inf => -inf
+ return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf('-');
+ }
+
# aEb * cEd = (a*c)E(b+d)
$x->{_m} = $x->{_m} * $y->{_m};
#print "m: $x->{_m}\n";
# (BFLOAT,BFLOAT) (quo,rem) or BINT (only rem)
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ # x / +-inf => 0, reminder x
+ return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero()
+ if $y->{sign} =~ /^[+-]inf$/;
+
+ # NaN if x == NaN or y == NaN or x==y==0
return wantarray ? ($x->bnan(),bnan()) : $x->bnan()
- if ($x->{sign} eq $nan || $y->is_nan() || $y->is_zero());
+ if (($x->is_nan() || $y->is_nan()) ||
+ ($x->is_zero() && $y->is_zero()));
+
+ # 5 / 0 => +inf, -6 / 0 => -inf
+ return wantarray
+ ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
+ if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
$y = $class->new($y) if ref($y) ne $class; # promote bigints
# print "mbf bdiv $x ",ref($x)," ",$y," ",ref($y),"\n";
# we need to limit the accuracy to protect against overflow
my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r); # ignore $p
+ my $fallback = 0;
if (!defined $scale)
{
# simulate old behaviour
$scale = $div_scale+1; # one more for proper riund
- $a = $div_scale; # and round to it
+ $a = $div_scale; # and round to it
+ $fallback = 1; # to clear a/p afterwards
}
my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length();
$scale = $lx if $lx > $scale;
$x->bnorm(); # remove trailing 0's
#print "after div: m: $x->{_m} e: $x->{_e}\n";
$x->round($a,$p,$r); # then round accordingly
+ if ($fallback)
+ {
+ # clear a/p after round, since user did not request it
+ $x->{_a} = undef;
+ $x->{_p} = undef;
+ }
if (wantarray)
{
my $rem = $x->copy();
$rem->bmod($y,$a,$p,$r);
+ if ($fallback)
+ {
+ # clear a/p after round, since user did not request it
+ $x->{_a} = undef;
+ $x->{_p} = undef;
+ }
return ($x,$rem);
}
return $x;
# we need to limit the accuracy to protect against overflow
my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r); # ignore $p
+ my $fallback = 0;
if (!defined $scale)
{
# simulate old behaviour
$scale = $div_scale+1; # one more for proper riund
$a = $div_scale; # and round to it
+ $fallback = 1; # to clear a/p afterwards
}
my $lx = $x->{_m}->length();
$scale = $lx if $scale < $lx;
# start with some reasonable guess
#$x *= 10 ** ($len - $org->{_e}); $x /= 2; # !?!?
+ $lx = $lx+$x->{_e};
$lx = 1 if $lx < 1;
my $gs = Math::BigFloat->new('1'. ('0' x $lx));
$gs = $x->copy();
}
$x->round($a,$p,$r);
+ if ($fallback)
+ {
+ # clear a/p after round, since user did not request it
+ $x->{_a} = undef;
+ $x->{_p} = undef;
+ }
+ $x;
}
sub bpow
return $x if $x->{sign} =~ /^[+-]inf$/;
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
- return $x->bzero()->binc() if $y->is_zero();
+ return $x->bone() if $y->is_zero();
return $x if $x->is_one() || $y->is_one();
my $y1 = $y->as_number(); # make bigint
if ($x == -1)
return $y1->is_odd() ? $x : $x->babs(1);
}
return $x if $x->is_zero() && $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0)
- # 0 ** -y => 1 / (0 ** y) => / 0!
- return $x->bnan() if $x->is_zero() && $y->{sign} eq '-';
+ # 0 ** -y => 1 / (0 ** y) => / 0! (1 / 0 => +inf)
+ return $x->binf() if $x->is_zero() && $y->{sign} eq '-';
# calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
$y1->babs();
my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_);
return $x if !defined $scale; # no-op
+ # never round a 0, +-inf, NaN
+ return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero();
# print "MBF bfround $x to scale $scale mode $mode\n";
- return $x if $x->is_nan() or $x->is_zero();
if ($scale < 0)
{
# 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
if ($scale < $zad)
{
- $x->{_m} = Math::BigInt->new(0);
- $x->{_e} = Math::BigInt->new(1);
- $x->{sign} = '+';
- return $x;
+ return $x->bzero();
}
if ($scale == $zad) # for 0.006, scale -2 and trunc
{
if (($scale > $dbt) && ($dbt < 0))
{
# if not enough digits before dot, round to zero
- $x->{_m} = Math::BigInt->new(0);
- $x->{_e} = Math::BigInt->new(1);
- $x->{sign} = '+';
- return $x;
+ return $x->bzero();
}
if (($scale >= 0) && ($dbt == 0))
{
$scale = $x->{_m}->length() - $scale;
}
}
- #print "using $scale for $x->{_m} with '$mode'\n";
- # pass sign to bround for '+inf' and '-inf' rounding modes
+ # print "using $scale for $x->{_m} with '$mode'\n";
+ # 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
# print "bround $scale $mode\n";
# 0 => return all digits, scale < 0 makes no sense
return $x if ($scale <= 0);
- return $x if $x->is_nan() or $x->is_zero(); # never round a 0
+ # never round a 0, +-inf, NaN
+ return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero();
# if $e longer than $m, we have 0.0000xxxyyy style number, and must
# subtract the delta from scale, to simulate keeping the zeros
$x->{_m}->{sign} = $x->{sign};
$x->{_m}->bround($scale,$mode); # round mantissa
$x->{_m}->{sign} = '+'; # fix sign back
- return $x->bnorm(); # del trailing zeros gen. by bround()
+ $x->bnorm(); # del trailing zeros gen. by bround()
}
sub bfloor
$x->{_m}->brsft($zeros,10); $x->{_e} += $zeros;
}
# for something like 0Ey, set y to 1
- $x->{_e}->bzero()->binc() if $x->{_m}->is_zero();
+ $x->{sign} = '+', $x->{_e}->bzero()->binc() if $x->{_m}->is_zero();
$x->{_m}->{_f} = MB_NEVER_ROUND;
$x->{_e}->{_f} = MB_NEVER_ROUND;
return $x; # MBI bnorm is no-op
=head1 EXAMPLES
- use Math::BigFloat qw(bstr bint);
# not ready yet
- $x = bstr("1234") # string "1234"
- $x = "$x"; # same as bstr()
- $x = bneg("1234") # BigFloat "-1234"
- $x = Math::BigFloat->bneg("1234"); # BigFloat "1234"
- $x = Math::BigFloat->babs("-12345"); # BigFloat "12345"
- $x = Math::BigFloat->bnorm("-0 00"); # BigFloat "0"
- $x = bint(1) + bint(2); # BigFloat "3"
- $x = bint(1) + "2"; # ditto (auto-BigFloatify of "2")
- $x = bint(1); # BigFloat "1"
- $x = $x + 5 / 2; # BigFloat "3"
- $x = $x ** 3; # BigFloat "27"
- $x *= 2; # BigFloat "54"
- $x = new Math::BigFloat; # BigFloat "0"
- $x--; # BigFloat "-1"
=head1 Autocreating constants
constants the expression 2E-100 will be calculated as normal floating point
number.
-=head1 PERFORMANCE
-
-Greatly enhanced ;o)
-SectionNotReadyYet.
-
=head1 BUGS
=over 2
# _f : flags, used by MBF to flag parts of a float as untouchable
# _cow : copy on write: number of objects that share the data (NRY)
+# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since
+# underlying lib might change the reference!
+
package Math::BigInt;
my $class = "Math::BigInt";
require 5.005;
-$VERSION = 1.36;
+$VERSION = '1.40';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub
bgcd blcm
bround
blsft brsft band bior bxor bnot bpow bnan bzero
- bacmp bstr bsstr binc bdec bint binf bfloor bceil
+ bacmp bstr bsstr binc bdec binf bfloor bceil
is_odd is_even is_zero is_one is_nan is_inf sign
is_positive is_negative
length as_number
'^' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bxor($a[1]); },
# can modify arg of ++ and --, so avoid a new-copy for speed, but don't
-# use $_[0]->_one(), it modifies $_[0] to be 1!
+# use $_[0]->__one(), it modifies $_[0] to be 1!
'++' => sub { $_[0]->binc() },
'--' => sub { $_[0]->bdec() },
}
# split str in m mantissa, e exponent, i integer, f fraction, v value, s sign
my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
- if (ref $mis && !ref $miv)
- {
- # _from_hex or _from_bin
- $self->{value} = $mis->{value};
- $self->{sign} = $mis->{sign};
- return $self; # throw away $mis
- }
if (!ref $mis)
{
die "$wanted is not a number initialized to $class" if !$NaNOK;
$self->{sign} = $nan;
return $self;
}
+ if (!ref $miv)
+ {
+ # _from_hex or _from_bin
+ $self->{value} = $mis->{value};
+ $self->{sign} = $mis->{sign};
+ return $self; # throw away $mis
+ }
# make integer from mantissa by adjusting exp, then convert to bigint
$self->{sign} = $$mis; # store sign
$self->{value} = $CALC->_zero(); # for all the NaN cases
return $self;
}
-# some shortcuts for easier life
-sub bint
- {
- # exportable version of new
- return $class->new(@_);
- }
-
sub bnan
{
# create a bigint 'NaN', if given a BigInt, set it to 'NaN'
# create a bigint '+0', if given a BigInt, set it to 0
my $self = shift;
$self = $class if !defined $self;
- #print "bzero $self\n";
if (!ref($self))
{
return $self;
}
+sub bone
+ {
+ # create a bigint '+1' (or -1 if given sign '-'),
+ # if given a BigInt, set it to +1 or -1, respecively
+ my $self = shift;
+ my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
+ $self = $class if !defined $self;
+ #print "bone $self\n";
+
+ if (!ref($self))
+ {
+ my $c = $self; $self = {}; bless $self, $c;
+ }
+ return if $self->modify('bone');
+ $self->{value} = $CALC->_one();
+ $self->{sign} = $sign;
+ #print "result: $self\n";
+ return $self;
+ }
+
##############################################################################
# string conversation
# internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
my ($self,$x) = objectify(1,@_);
- return $x->{sign} if $x->{sign} !~ /^[+-]$/;
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
my ($m,$e) = $x->parts();
- # can be only '+', so
+ # e can only be positive
my $sign = 'e+';
# MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s;
return $m->bstr().$sign.$e->bstr();
{
# make a string from bigint object
my $x = shift; $x = $class->new($x) unless ref $x;
- return $x->{sign} if $x->{sign} !~ /^[+-]$/;
+ if ($x->{sign} !~ /^[+-]$/)
+ {
+ return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
+ return 'inf'; # +inf
+ }
my $es = ''; $es = $x->{sign} if $x->{sign} eq '-';
return $es.${$CALC->_str($x->{value})};
}
my $r = shift; # round_mode, if given by caller
my @args = @_; # all 'other' arguments (0 for unary, 1 for binary ops)
+ $self = new($self) unless ref($self); # if not object, make one
+ my $c = ref($args[0]); # find out class of argument
+ unshift @args,$self; # add 'first' argument
+
+ no strict 'refs';
+ my $z = "$c\::accuracy"; my $aa = $$z; my $ap = undef;
+ if (!defined $aa)
+ {
+ $z = "$c\::precision"; $ap = $$z;
+ }
+
# leave bigfloat parts alone
return $self if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
- unshift @args,$self; # add 'first' argument
-
- $self = new($self) unless ref($self); # if not object, make one
-
- # find out class of argument to round
- my $c = ref($args[0]);
-
# now pick $a or $p, but only if we have got "arguments"
if ((!defined $a) && (!defined $p) && (@args > 0))
{
# if none defined, use globals (#2)
if (!defined $p)
{
- no strict 'refs';
- my $z = "$c\::accuracy"; $a = $$z;
- if (!defined $a)
- {
- $z = "$c\::precision"; $p = $$z;
- }
+ $a = $aa; $p = $ap; # save the check: if !defined $a;
}
} # endif !$a
} # endif !$a || !$P && args > 0
{
# (num_str or BINT) return BINT
# Normalize number -- no-op here
- my $self = shift;
-
- return $self;
+ return $_[0];
}
sub babs
{
# (BINT or num_str) return BINT
# make number absolute, or return absolute BINT from string
- #my ($self,$x) = objectify(1,@_);
my $x = shift; $x = $class->new($x) unless ref $x;
return $x if $x->modify('babs');
# post-normalized abs for internal use (does nothing for NaN)
{
# (BINT or num_str) return BINT
# negate number or make a negated number from string
- my ($self,$x,$a,$p,$r) = objectify(1,@_);
+ my $x = shift; $x = $class->new($x) unless ref $x;
return $x if $x->modify('bneg');
# for +0 dont negate (to have always normalized)
return $x if $x->is_zero();
$x->{sign} =~ tr/+\-/-+/; # does nothing for NaN
- # $x->round($a,$p,$r); # changing this makes $x - $y modify $y!!
$x;
}
{
# handle +-inf and NaN
return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- return 0 if ($x->{sign} eq $y->{sign}) && ($x->{sign} =~ /^[+-]inf$/);
+ return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/;
return +1 if $x->{sign} eq '+inf';
return -1 if $x->{sign} eq '-inf';
return -1 if $y->{sign} eq '+inf';
return +1 if $y->{sign} eq '-inf';
}
+ # check sign for speed first
+ return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
+ return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0
+
+ # shortcut
+ my $xz = $x->is_zero();
+ my $yz = $y->is_zero();
+ return 0 if $xz && $yz; # 0 <=> 0
+ return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
+ return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0
# normal compare now
&cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0;
}
# Returns one of undef, <0, =0, >0. (suitable for sort)
# (BINT, BINT) return cond_code
my ($self,$x,$y) = objectify(2,@_);
- return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- #acmp($x->{value},$y->{value}) <=> 0;
+
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
+ {
+ # handle +-inf and NaN
+ return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
+ return +1; # inf is always bigger
+ }
$CALC->_acmp($x->{value},$y->{value}) <=> 0;
}
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
return $x if $x->modify('badd');
- return $x->bnan() if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/));
+ # inf and NaN handling
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
+ {
+ # NaN first
+ return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ # inf handline
+ if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
+ {
+ # + and + => +, - and - => -, + and - => 0, - and + => 0
+ return $x->bzero() if $x->{sign} ne $y->{sign};
+ return $x;
+ }
+ # +-inf + something => +inf
+ # something +-inf => +-inf
+ $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/;
+ return $x;
+ }
+
my @bn = ($a,$p,$r,$y); # make array for round calls
# speed: no add for 0+y or x+0
return $x->round(@bn) if $y->is_zero(); # x+0
{
# make copy, clobbering up x
$x->{value} = $CALC->_copy($y->{value});
- #$x->{value} = [ @{$y->{value}} ];
$x->{sign} = $y->{sign} || $nan;
return $x->round(@bn);
}
- # shortcuts
- my $xv = $x->{value};
- my $yv = $y->{value};
my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
if ($sx eq $sy)
{
- $CALC->_add($xv,$yv); # if same sign, absolute add
+ $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add
$x->{sign} = $sx;
}
else
{
- my $a = $CALC->_acmp ($yv,$xv); # absolute compare
+ my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare
if ($a > 0)
{
#print "swapped sub (a=$a)\n";
- $CALC->_sub($yv,$xv,1); # absolute sub w/ swapped params
+ $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap
$x->{sign} = $sy;
}
elsif ($a == 0)
else # a < 0
{
#print "unswapped sub (a=$a)\n";
- $CALC->_sub($xv, $yv); # absolute sub
+ $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
$x->{sign} = $sx;
}
}
my ($self,$x,$a,$p,$r) = objectify(1,@_);
# my $x = shift; $x = $class->new($x) unless ref $x; my $self = ref($x);
return $x if $x->modify('binc');
- $x->badd($self->_one())->round($a,$p,$r);
+ $x->badd($self->__one())->round($a,$p,$r);
}
sub bdec
# decrement arg by one
my ($self,$x,$a,$p,$r) = objectify(1,@_);
return $x if $x->modify('bdec');
- $x->badd($self->_one('-'))->round($a,$p,$r);
+ $x->badd($self->__one('-'))->round($a,$p,$r);
}
sub blcm
{
while (@_)
{
- $x = _gcd($x,shift); last if $x->is_one(); # _gcd handles NaN
+ $x = __gcd($x,shift); last if $x->is_one(); # _gcd handles NaN
}
}
$x->babs();
#my ($self,$x) = objectify(1,@_);
my $x = shift; $x = $class->new($x) unless ref $x;
- return 0 if $x->{sign} !~ /^[+-]$/;
+ return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't
return $CALC->_is_zero($x->{value});
- #return (@{$x->{value}} == 1) && ($x->{sign} eq '+')
- # && ($x->{value}->[0] == 0);
}
sub is_nan
# or -1 if sign is given
#my ($self,$x) = objectify(1,@_);
my $x = shift; $x = $class->new($x) unless ref $x;
- my $sign = shift || '+';
+ my $sign = shift || ''; $sign = '+' if $sign ne '-';
- # catch also NaN, +inf, -inf
- return 0 if $x->{sign} ne $sign || $x->{sign} !~ /^[+-]$/;
+ return 0 if $x->{sign} ne $sign;
return $CALC->_is_one($x->{value});
- #return (@{$x->{value}} == 1) && ($x->{sign} eq $sign)
- # && ($x->{value}->[0] == 1);
}
sub is_odd
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
return $CALC->_is_odd($x->{value});
- #return (($x->{sign} ne $nan) && ($x->{value}->[0] & 1));
}
sub is_even
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
return $CALC->_is_even($x->{value});
- #return (($x->{sign} ne $nan) && (!($x->{value}->[0] & 1)));
- #return (($x->{sign} !~ /^[+-]$/) && ($CALC->_is_even($x->{value})));
}
sub is_positive
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
return $x if $x->modify('bmul');
- return $x->bnan() if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/));
+ return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
+ # handle result = 0
+ return $x if $x->is_zero();
+ return $x->bzero() if $y->is_zero();
+ # inf handling
+ if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
+ {
+ # result will always be +-inf:
+ # +inf * +/+inf => +inf, -inf * -/-inf => +inf
+ # +inf * -/-inf => -inf, -inf * +/+inf => -inf
+ return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
+ return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
+ return $x->binf('-');
+ }
- return $x->bzero() if $x->is_zero() || $y->is_zero(); # handle result = 0
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
- $CALC->_mul($x->{value},$y->{value}); # do actual math
+ $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
return $x->round($a,$p,$r,$y);
}
return $x if $x->modify('bdiv');
- # 5 / 0 => +inf, -6 / 0 => -inf (0 / 0 => 1 or +inf or NaN?)
- #return wantarray
- # ? ($x->binf($x->{sign}),binf($x->{sign})) : $x->binf($x->{sign})
- # if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
+ # x / +-inf => 0, reminder x
+ return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero()
+ if $y->{sign} =~ /^[+-]inf$/;
- # NaN?
+ # NaN if x == NaN or y == NaN or x==y==0
return wantarray ? ($x->bnan(),bnan()) : $x->bnan()
- if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $y->is_zero());
+ if (($x->is_nan() || $y->is_nan()) ||
+ ($x->is_zero() && $y->is_zero()));
+
+ # 5 / 0 => +inf, -6 / 0 => -inf
+ return wantarray
+ ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign})
+ if ($x->{sign} =~ /^[+-]$/ && $y->is_zero());
+
+ # old code: always NaN if /0
+ #return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan()
+ # if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $y->is_zero());
# 0 / something
return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero();
elsif ($cmp == 0)
{
# shortcut, both are the same, so set to +/- 1
- $x->_one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
+ $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
return $x unless wantarray;
return ($x,$self->bzero());
}
return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x
return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;
- return $x->_one() if $y->is_zero();
+ return $x->__one() if $y->is_zero();
return $x if $x->is_one() || $y->is_one();
#if ($x->{sign} eq '-' && @{$x->{value}} == 1 && $x->{value}->[0] == 1)
if ($x->{sign} eq '-' && $CALC->_is_one($x->{value}))
{
# if $x == -1 and odd/even y => +1/-1
return $y->is_odd() ? $x : $x->babs();
- # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; LOL
+ # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1;
}
- # 1 ** -y => 1 / (1**y), so do test for negative $y after above's clause
+ # 1 ** -y => 1 / (1 ** |y|)
+ # so do test for negative $y after above's clause
return $x->bnan() if $y->{sign} eq '-';
return $x if $x->is_zero(); # 0**y => 0 (if not y <= 0)
if ($CALC->can('_pow'))
{
- $CALC->_pow($x->{value},$y->{value});
+ $x->{value} = $CALC->_pow($x->{value},$y->{value});
return $x->round($a,$p,$r);
}
# based on the assumption that shifting in base 10 is fast, and that mul
# afterwards like this:
# 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6
# creates deep recursion?
- #my $zeros = $x->_trailing_zeros();
- #if ($zeros > 0)
- # {
- # $x->brsft($zeros,10); # remove zeros
- # $x->bpow($y); # recursion (will not branch into here again)
- # $zeros = $y * $zeros; # real number of zeros to add
- # $x->blsft($zeros,10);
- # return $x->round($a,$p,$r);
- # }
-
- my $pow2 = $self->_one();
+# my $zeros = $x->_trailing_zeros();
+# if ($zeros > 0)
+# {
+# $x->brsft($zeros,10); # remove zeros
+# $x->bpow($y); # recursion (will not branch into here again)
+# $zeros = $y * $zeros; # real number of zeros to add
+# $x->blsft($zeros,10);
+# return $x->round($a,$p,$r);
+# }
+
+ my $pow2 = $self->__one();
my $y1 = $class->new($y);
my ($res);
while (!$y1->is_one())
return $x if $x->modify('blsft');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
- $n = 2 if !defined $n; return $x if $n == 0;
- return $x->bnan() if $n < 0 || $y->{sign} eq '-';
- #if ($n != 10)
- # {
- $x->bmul( $self->bpow($n, $y) );
- # }
- #else
- # {
- # # shortcut (faster) for shifting by 10) since we are in base 10eX
- # # multiples of 5:
- # my $src = scalar @{$x->{value}}; # source
- # my $len = $y->numify(); # shift-len as normal int
- # my $rem = $len % 5; # reminder to shift
- # my $dst = $src + int($len/5); # destination
- #
- # my $v = $x->{value}; # speed-up
- # my $vd; # further speedup
- # #print "src $src:",$v->[$src]||0," dst $dst:",$v->[$dst]||0," rem $rem\n";
- # $v->[$src] = 0; # avoid first ||0 for speed
- # while ($src >= 0)
- # {
- # $vd = $v->[$src]; $vd = '00000'.$vd;
- # #print "s $src d $dst '$vd' ";
- # $vd = substr($vd,-5+$rem,5-$rem);
- # #print "'$vd' ";
- # $vd .= $src > 0 ? substr('00000'.$v->[$src-1],-5,$rem) : '0' x $rem;
- # #print "'$vd' ";
- # $vd = substr($vd,-5,5) if length($vd) > 5;
- # #print "'$vd'\n";
- # $v->[$dst] = int($vd);
- # $dst--; $src--;
- # }
- # # set lowest parts to 0
- # while ($dst >= 0) { $v->[$dst--] = 0; }
- # # fix spurios last zero element
- # splice @$v,-1 if $v->[-1] == 0;
- # #print "elems: "; my $i = 0;
- # #foreach (reverse @$v) { print "$i $_ "; $i++; } print "\n";
- # # old way: $x->bmul( $self->bpow($n, $y) );
- # }
- return $x;
+ $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
+
+ my $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft');
+ if (defined $t)
+ {
+ $x->{value} = $t; return $x;
+ }
+ # fallback
+ return $x->bmul( $self->bpow($n, $y) );
}
sub brsft
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
- #if ($n != 10)
- # {
- scalar bdiv($x, $self->bpow($n, $y));
- # }
- #else
- # {
- # # shortcut (faster) for shifting by 10)
- # # multiples of 5:
- # my $dst = 0; # destination
- # my $src = $y->numify(); # as normal int
- # my $rem = $src % 5; # reminder to shift
- # $src = int($src / 5); # source
- # my $len = scalar @{$x->{value}} - $src; # elems to go
- # my $v = $x->{value}; # speed-up
- # if ($rem == 0)
- # {
- # splice (@$v,0,$src); # even faster, 38.4 => 39.3
- # }
- # else
- # {
- # my $vd;
- # $v->[scalar @$v] = 0; # avoid || 0 test inside loop
- # while ($dst < $len)
- # {
- # $vd = '00000'.$v->[$src];
- # #print "$dst $src '$vd' ";
- # $vd = substr($vd,-5,5-$rem);
- # #print "'$vd' ";
- # $src++;
- # $vd = substr('00000'.$v->[$src],-$rem,$rem) . $vd;
- # #print "'$vd1' ";
- # #print "'$vd'\n";
- # $vd = substr($vd,-5,5) if length($vd) > 5;
- # $v->[$dst] = int($vd);
- # $dst++;
- # }
- # splice (@$v,$dst) if $dst > 0; # kill left-over array elems
- # pop @$v if $v->[-1] == 0; # kill last element
- # } # else rem == 0
- # # old way: scalar bdiv($x, $self->bpow($n, $y));
- # }
- return $x;
+
+ my $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft');
+ if (defined $t)
+ {
+ $x->{value} = $t; return $x;
+ }
+ # fallback
+ return scalar bdiv($x, $self->bpow($n, $y));
}
sub band
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
return $x->bzero() if $y->is_zero();
- if ($CALC->can('_and'))
+ my $sign = 0; # sign of result
+ $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-');
+ my $sx = 1; $sx = -1 if $x->{sign} eq '-';
+ my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+
+ if ($CALC->can('_and') && $sx == 1 && $sy == 1)
{
- $CALC->_and($x->{value},$y->{value});
+ $x->{value} = $CALC->_and($x->{value},$y->{value});
return $x->round($a,$p,$r);
}
-
+
my $m = new Math::BigInt 1; my ($xr,$yr);
- my $x10000 = new Math::BigInt (0x10000);
- my $y1 = copy(ref($x),$y); # make copy
- my $x1 = $x->copy(); $x->bzero(); # modify x in place!
+ my $x10000 = new Math::BigInt (0x1000);
+ my $y1 = copy(ref($x),$y); # make copy
+ $y1->babs(); # and positive
+ my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
+ use integer; # need this for negative bools
while (!$x1->is_zero() && !$y1->is_zero())
{
($x1, $xr) = bdiv($x1, $x10000);
($y1, $yr) = bdiv($y1, $x10000);
- #print ref($xr), " $xr ", $xr->numify(),"\n";
- #print ref($yr), " $yr ", $yr->numify(),"\n";
- #print "res: ",$yr->numify() & $xr->numify(),"\n";
- my $u = bmul( $class->new( $xr->numify() & $yr->numify() ), $m);
- #print "res: $u\n";
- $x->badd( bmul( $class->new( $xr->numify() & $yr->numify() ), $m));
+ # make both op's numbers!
+ $x->badd( bmul( $class->new(
+ abs($sx*int($xr->numify()) & $sy*int($yr->numify()))),
+ $m));
$m->bmul($x10000);
}
+ $x->bneg() if $sign;
return $x->round($a,$p,$r);
}
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
return $x if $y->is_zero();
- if ($CALC->can('_or'))
+
+ my $sign = 0; # sign of result
+ $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-');
+ my $sx = 1; $sx = -1 if $x->{sign} eq '-';
+ my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+
+ # don't use lib for negative values
+ if ($CALC->can('_or') && $sx == 1 && $sy == 1)
{
- $CALC->_or($x->{value},$y->{value});
+ $x->{value} = $CALC->_or($x->{value},$y->{value});
return $x->round($a,$p,$r);
}
my $m = new Math::BigInt 1; my ($xr,$yr);
my $x10000 = new Math::BigInt (0x10000);
- my $y1 = copy(ref($x),$y); # make copy
- my $x1 = $x->copy(); $x->bzero(); # modify x in place!
+ my $y1 = copy(ref($x),$y); # make copy
+ $y1->babs(); # and positive
+ my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
+ use integer; # need this for negative bools
while (!$x1->is_zero() || !$y1->is_zero())
{
($x1, $xr) = bdiv($x1,$x10000);
($y1, $yr) = bdiv($y1,$x10000);
- $x->badd( bmul( $class->new( $xr->numify() | $yr->numify() ), $m));
+ # make both op's numbers!
+ $x->badd( bmul( $class->new(
+ abs($sx*int($xr->numify()) | $sy*int($yr->numify()))),
+ $m));
+# $x->badd( bmul( $class->new(int($xr->numify()) | int($yr->numify())), $m));
$m->bmul($x10000);
}
+ $x->bneg() if $sign;
return $x->round($a,$p,$r);
}
return $x if $y->is_zero();
return $x->bzero() if $x == $y; # shortcut
- if ($CALC->can('_xor'))
+ my $sign = 0; # sign of result
+ $sign = 1 if $x->{sign} ne $y->{sign};
+ my $sx = 1; $sx = -1 if $x->{sign} eq '-';
+ my $sy = 1; $sy = -1 if $y->{sign} eq '-';
+
+ # don't use lib for negative values
+ if ($CALC->can('_xor') && $sx == 1 && $sy == 1)
{
- $CALC->_xor($x->{value},$y->{value});
+ $x->{value} = $CALC->_xor($x->{value},$y->{value});
return $x->round($a,$p,$r);
}
my $m = new Math::BigInt 1; my ($xr,$yr);
my $x10000 = new Math::BigInt (0x10000);
my $y1 = copy(ref($x),$y); # make copy
- my $x1 = $x->copy(); $x->bzero(); # modify x in place!
+ $y1->babs(); # and positive
+ my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
+ use integer; # need this for negative bools
while (!$x1->is_zero() || !$y1->is_zero())
{
($x1, $xr) = bdiv($x1, $x10000);
($y1, $yr) = bdiv($y1, $x10000);
- $x->badd( bmul( $class->new( $xr->numify() ^ $yr->numify() ), $m));
+ # make both op's numbers!
+ $x->badd( bmul( $class->new(
+ abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))),
+ $m));
+# $x->badd( bmul( $class->new(int($xr->numify()) ^ int($yr->numify())), $m));
$m->bmul($x10000);
}
+ $x->bneg() if $sign;
return $x->round($a,$p,$r);
}
my $x = shift;
$x = $class->new($x) unless ref $x;
- return 0 if $x->is_zero() || $x->is_nan() || $x->is_inf();
+ return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/;
return $CALC->_zeros($x->{value}) if $CALC->can('_zeros');
# print "MBI round: $x to $scale $mode\n";
# -scale means what? tom? hullo? -$scale needed by MBF round, but what for?
- return $x if $x->is_nan() || $x->is_zero() || $scale == 0;
+ return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0;
# we have fewer digits than we want to scale to
my $len = $x->length();
}
elsif ($pad > $len)
{
- $x->{value} = $CALC->_zero(); # round to '0'
+ $x->bzero(); # round to '0'
}
- #print "res $$xs\n";
+ # print "res $pad $len $x $$xs\n";
}
# move this later on after the inc of the string
#$x->{value} = $CALC->_new($xs); # put back in
##############################################################################
# private stuff (internal use only)
-sub _one
+sub __one
{
# internal speedup, set argument to 1, or create a +/- 1
my $self = shift;
- #my $x = $self->bzero(); $x->{value} = [ 1 ]; $x->{sign} = shift || '+'; $x;
my $x = $self->bzero(); $x->{value} = $CALC->_one();
$x->{sign} = shift || '+';
return $x;
# Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y
# Math::BigInt::badd(1,2); => scalar x, scalar y
# In the last case we check number of arguments to turn it silently into
- # $class,1,2. (We cannot take '1' as class ;o)
+ # $class,1,2. (We can not take '1' as class ;o)
# badd($class,1) is not supported (it should, eventually, try to add undef)
# currently it tries 'Math::BigInt' + 1, which will not work.
{
# this causes a different low lib to take care...
$CALC = $_[$i+1] || $CALC;
- my $s = 2; $s = 1 if @a-$j < 2; # avoid "cannot modify non-existant..."
+ my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
splice @a, $j, $s; $j -= $s;
}
}
#$self->SUPER::import(@a); # does not work
$self->export_to_level(1,$self,@a); # need this instead
- # load core math lib
- $CALC = 'Math::BigInt::'.$CALC if $CALC !~ /^Math::BigInt/i;
- my $c = $CALC;
- $c =~ s!::!/!g; # XXX portability, e.g. MacOS?
- $c .= '.pm' if $c !~ /\.pm$/;
- require $c;
+ # try to load core math lib
+ my @c = split /\s*,\s*/,$CALC;
+ push @c,'Calc'; # if all fail, try this
+ foreach my $lib (@c)
+ {
+ $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i;
+ $lib =~ s/\.pm$//;
+ if ($] < 5.6)
+ {
+ # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
+ # used in the same script, or eval inside import().
+ (my $mod = $lib . '.pm') =~ s!::!/!g;
+ # require does not automatically :: => /, so portability problems arise
+ eval { require $mod; $lib->import(); }
+ }
+ else
+ {
+ eval "use $lib;";
+ }
+ $CALC = $lib, last if $@ eq '';
+ }
}
-sub _strip_zeros
- {
- # internal normalization function that strips leading zeros from the array
- # args: ref to array
- my $s = shift;
-
- my $cnt = scalar @$s; # get count of parts
- my $i = $cnt-1;
- #print "strip: cnt $cnt i $i\n";
- # '0', '3', '4', '0', '0',
- # 0 1 2 3 4
- # cnt = 5, i = 4
- # i = 4
- # i = 3
- # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos)
- # >= 1: skip first part (this can be zero)
- while ($i > 0) { last if $s->[$i] != 0; $i--; }
- $i++; splice @$s,$i if ($i < $cnt); # $i cant be 0
- return $s;
- }
-
-sub _from_hex
+sub __from_hex
{
# convert a (ref to) big hex string to BigInt, return undef for error
my $hs = shift;
return $x;
}
-sub _from_bin
+sub __from_bin
{
# convert a (ref to) big binary string to BigInt, return undef for error
my $bs = shift;
{
# (ref to num_str) return num_str
# internal, take apart a string and return the pieces
+ # strip leading/trailing whitespace, leading zeros, underscore, reject
+ # invalid input
my $x = shift;
- # pre-parse input
- $$x =~ s/^\s+//g; # strip white space at front
+ # 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+//g; # strip white space (no longer)
- return if $$x eq "";
- return _from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
- return _from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
+ # shortcut, if nothing to split, return early
+ if ($$x =~ /^[+-]?\d+$/)
+ {
+ $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+';
+ return (\$sign, $x, \'', \'', \0);
+ }
- return if $$x !~ /^[\-\+]?\.?[0-9]/;
+ # invalid starting char?
+ return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/;
$$x =~ s/(\d)_(\d)/$1$2/g; # strip underscores between digits
$$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3
+ return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string
+ return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string
+
# 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
return $x * $ty / bgcd($x,$ty);
}
-sub _gcd
+sub __gcd
{
# (BINT or num_str, BINT or num_str) return BINT
# does modify first arg
use Math::BigInt;
# Number creation
- $x = Math::BigInt->new($str); # defaults to 0
- $nan = Math::BigInt->bnan(); # create a NotANumber
- $zero = Math::BigInt->bzero();# create a "+0"
+ $x = Math::BigInt->new($str); # defaults to 0
+ $nan = Math::BigInt->bnan(); # create a NotANumber
+ $zero = Math::BigInt->bzero(); # create a +0
+ $inf = Math::BigInt->binf(); # create a +inf
+ $inf = Math::BigInt->binf('-'); # create a -inf
+ $one = Math::BigInt->bone(); # create a +1
+ $one = Math::BigInt->bone('-'); # create a -1
# Testing
- $x->is_zero(); # return whether arg is zero or not
- $x->is_nan(); # return whether arg is NaN or not
+ $x->is_zero(); # true if arg is +0
+ $x->is_nan(); # true if arg is NaN
$x->is_one(); # true if arg is +1
$x->is_one('-'); # true if arg is -1
$x->is_odd(); # true if odd, false for even
# set
$x->bzero(); # set $x to 0
$x->bnan(); # set $x to NaN
+ $x->bone(); # set $x to +1
+ $x->bone('-'); # set $x to -1
$x->bneg(); # negation
$x->babs(); # absolute value
things that need to be answered are marked with '?'.
In the next paragraph follows a short description of terms used here (because
-these may differ from terms used by other people or documentation).
+these may differ from terms used by others people or documentation).
During the rest of this document, the shortcuts A (for accuracy), P (for
precision), F (fallback) and R (rounding mode) will be used.
was). It could also have p < 0, when the digits after the decimal point
are zero.
- !The string output of such a number should be padded with zeros:
- !
- ! Initial value P Result String
- ! 1234.01 -3 1000 1000
- ! 1234 -2 1200 1200
- ! 1234.5 -1 1230 1230
- ! 1234.001 1 1234 1234.0
- ! 1234.01 0 1234 1234
- ! 1234.01 2 1234.01 1234.01
- ! 1234.01 5 1234.01 1234.01000
+The string output (of floating point numbers) will be padded with zeros:
+
+ Initial value P A Result String
+ ------------------------------------------------------------
+ 1234.01 -3 1000 1000
+ 1234 -2 1200 1200
+ 1234.5 -1 1230 1230
+ 1234.001 1 1234 1234.0
+ 1234.01 0 1234 1234
+ 1234.01 2 1234.01 1234.01
+ 1234.01 5 1234.01 1234.01000
+
+For BigInts, no padding occurs.
=head2 Accuracy A
when there are zeros in it or trailing zeros. For example, 123.456 has
A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3.
+The string output (of floating point numbers) will be padded with zeros:
+
+ Initial value P A Result String
+ ------------------------------------------------------------
+ 1234.01 3 1230 1230
+ 1234.01 6 1234.01 1234.01
+ 1234.1 8 1234.1 1234.1000
+
+For BigInts, no padding occurs.
+
=head2 Fallback F
-When both A and P are undefined, this is used as a fallback accuracy.
+When both A and P are undefined, this is used as a fallback accuracy when
+dividing numbers.
=head2 Rounding mode R
operation according to the rules below
* Negative P is ignored in Math::BigInt, since BigInts never have digits
after the decimal point
- !* Math::BigFloat uses Math::BigInts internally, but setting A or P inside
- ! Math::BigInt as globals should not tamper with the parts of a BigFloat.
- ! Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
+ * Math::BigFloat uses Math::BigInts internally, but setting A or P inside
+ Math::BigInt as globals should not tamper with the parts of a BigFloat.
+ Thus a flag is used to mark all Math::BigFloat numbers as 'never round'
=item Precedence
* fdiv will calculate 1 more digit than required (determined by
A, P or F), and, if F is not used, round the result
(this will still fail in the case of a result like 0.12345000000001 with A
- or P of 5, but this cannot be helped - or can it?)
+ or P of 5, but this can not be helped - or can it?)
* Thus you can have the math done by on Math::Big* class in three modes:
+ never round (this is the default):
This is done by setting A and P to undef. No math operation
=head1 INTERNALS
-The actual numbers are stored as unsigned big integers, and math with them is
-done (by default) by a module called Math::BigInt::Calc. This is equivalent to:
+The actual numbers are stored as unsigned big integers (with seperate sign).
+You should neither care about nor depend on the internal representation; it
+might change without notice. Use only method calls like C<< $x->sign(); >>
+instead relying on the internal hash keys like in C<< $x->{sign}; >>.
+
+=head2 MATH LIBRARY
- use Math::BigInt lib => 'calc';
+Math with the numbers is done (by default) by a module called
+Math::BigInt::Calc. This is equivalent to saying:
+
+ use Math::BigInt lib => 'Calc';
You can change this by using:
use Math::BigInt lib => 'BitVect';
-('Math::BitInt::BitVect' works, too.)
+The following would first try to find Math::BigInt::Foo, then
+Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
-Calc.pm uses as internal format an array of elements of base 100000 digits
-with the least significant digit first, BitVect.pm uses a bit vector of base 2,
-most significant bit first.
+ use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
-The sign C</^[+-]$/> is stored separately. The string 'NaN' is used to
-represent the result when input arguments are not numbers. '+inf' and
-'-inf' represent infinity.
+Calc.pm uses as internal format an array of elements of some decimal base
+(usually 1e5, but this might change to 1e7) with the least significant digit
+first, while BitVect.pm uses a bit vector of base 2, most significant bit
+first. Other modules might use even different means of representing the
+numbers. See the respective module documentation for further details.
-You should neither care about nor depend on the internal representation; it
-might change without notice. Use only method calls like C<< $x->sign(); >>
-instead of relying on the internal hash keys like in C<< $x->{sign}; >>.
+=head2 SIGN
+
+The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
+
+A sign of 'NaN' is used to represent the result when input arguments are not
+numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
+minus infinity. You will get '+inf' when dividing a positive number by 0, and
+'-inf' when dividing any negative number by 0.
=head2 mantissa(), exponent() and parts()
C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them
in one go. Both the returned mantissa and exponent have a sign.
-Currently, for BigInts C<$e> will be always 0, except for NaN where it will be
-NaN and for $x == 0, then it will be 1 (to be compatible with Math::BigFloat's
-internal representation of a zero as C<0E1>).
+Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf,
+where it will be NaN; and for $x == 0, where it will be 1
+(to be compatible with Math::BigFloat's internal representation of a zero as
+C<0E1>).
C<$m> will always be a copy of the original number. The relation between $e
and $m might change in the future, but will always be equivalent in a
=head1 EXAMPLES
- use Math::BigInt qw(bstr bint);
+ use Math::BigInt qw(bstr);
+
+ sub bint { Math::BigInt->new(shift); }
+
$x = bstr("1234") # string "1234"
$x = "$x"; # same as bstr()
$x = bneg("1234") # Bigint "-1234"
big numbers. Other operations are now constant (O(1), like bneg(), babs()
etc), instead of O(N) and thus nearly always take much less time.
-For more benchmark results see http://bloodgate.com/perl/benchmarks.html
+If you find the Calc module to slow, try to install any of the replacement
+modules and see if they help you.
-=head2 Replacing the math library
+=head2 Alternative math libraries
You can use an alternative library to drive Math::BigInt via:
use Math::BigInt lib => 'Module';
-The default is called Math::BigInt::Calc and is a pure-perl base 100,000
-math package that consists of the standard routine present in earlier versions
-of Math::BigInt.
+The default is called Math::BigInt::Calc and is a pure-perl implementation
+that consists mainly of the standard routine present in earlier versions of
+Math::BigInt.
There are also Math::BigInt::Scalar (primarily for testing) and
-Math::BigInt::BitVect; these and others can be found via
-L<http://search.cpan.org/>:
+Math::BigInt::BitVect; as well as Math::BigInt::Pari and likely others.
+All these can be found via L<http://search.cpan.org/>:
use Math::BigInt lib => 'BitVect';
my $x = Math::BigInt->new(2);
print $x ** (1024*1024);
+For more benchmark results see http://bloodgate.com/perl/benchmarks.html
+
=head1 BUGS
=over 2
-=item :constant and eval()
+=item Out of Memory!
Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and
C<eval()> in your code will crash with "Out of memory". This is probably an
overload/exporter bug. You can workaround by not having C<eval()>
-and ':constant' at the same time or upgrade your Perl.
+and ':constant' at the same time or upgrade your Perl to a newer version.
+
+=item Fails to load Calc on Perl prior 5.6.0
+
+Since eval(' use ...') can not be used in conjunction with ':constant', BigInt
+will fall back to eval { require ... } when loading the math lib on Perls
+prior to 5.6.0. This simple replaces '::' with '/' and thus might fail on
+filesystems using a different seperator.
=back
$y = Math::BigInt->new($y);
ok ($x,$y); # okay
+There is not yet a way to get a number automatically represented in exactly
+the way Perl represents it.
+
=item int()
C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
This also works for other subclasses, like Math::String.
+It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
+
=item bdiv
The following will probably not do what you expect:
nonzero) always has the same sign as the second operand; so, for
example,
- 1 / 4 => ( 0, 1)
- 1 / -4 => (-1,-3)
+ 1 / 4 => ( 0, 1)
+ 1 / -4 => (-1,-3)
-3 / 4 => (-1, 1)
-3 / -4 => ( 0,-3)
=item bpow
C<bpow()> (and the rounding functions) now modifies the first argument and
-return it, unlike the old code which left it alone and only returned the
+returns it, unlike the old code which left it alone and only returned the
result. This is to be consistent with C<badd()> etc. The first three will
modify $x, the last one won't:
L<Math::BigFloat> and L<Math::Big>.
+L<Math::BigInt::BitVect> and L<Math::BigInt::Pari>.
+
=head1 AUTHORS
Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
use 5.005;
use strict;
-use warnings;
+# use warnings; # dont use warnings for older Perls
require Exporter;
_is_zero _is_one
_is_even _is_odd
_check _zero _one _copy _zeros
+ _rsft _lsft
);
-$VERSION = '0.06';
+$VERSION = '0.09';
# Package to store unsigned big integers in decimal and do math with them
# constants for easier life
my $nan = 'NaN';
-my $BASE_LEN = 5;
+
+my $BASE_LEN = 7;
my $BASE = int("1e".$BASE_LEN); # var for trying to change it to 1e7
-my $RBASE = 1e-5; # see USE_MUL
-my $class = 'Math::BigInt::Calc';
+my $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+
+BEGIN
+ {
+ # Daniel Pfeiffer: determine largest group of digits that is precisely
+ # multipliable with itself plus carry
+ my ($e, $num) = 4;
+ do {
+ $num = ('9' x ++$e) + 0;
+ $num *= $num + 1;
+ } until ($num == $num - 1 or $num - 1 == $num - 2);
+ $BASE_LEN = $e-1;
+ $BASE = int("1e".$BASE_LEN);
+ $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+ }
+
+# for quering and setting, to debug/benchmark things
+sub _base_len
+ {
+ my $b = shift;
+ if (defined $b)
+ {
+ $BASE_LEN = $b;
+ $BASE = int("1e".$BASE_LEN);
+ $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL
+ }
+ $BASE_LEN;
+ }
##############################################################################
# create objects from various representations
# (string) return ref to num_array
# Convert a number from string format to internal base 100000 format.
# Assumes normalized value as input.
- shift @_ if $_[0] eq $class;
- my $d = shift;
+ my $d = $_[1];
# print "_new $d $$d\n";
my $il = CORE::length($$d)-1;
# these leaves '00000' instead of int 0 and will be corrected after any op
- return [ reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $$d)) ];
+ return [ reverse(unpack("a" . ($il % $BASE_LEN+1)
+ . ("a$BASE_LEN" x ($il / $BASE_LEN)), $$d)) ];
}
sub _zero
sub _copy
{
- shift @_ if $_[0] eq $class;
- my $x = shift;
- return [ @$x ];
+ return [ @{$_[1]} ];
}
##############################################################################
# (ref to BINT) return num_str
# Convert number from internal base 100000 format to string format.
# internal format is always normalized (no leading zeros, "-0" => "+0")
- shift @_ if $_[0] eq $class;
- my $ar = shift;
+ my $ar = $_[1];
my $ret = "";
my $l = scalar @$ar; # number of parts
return $nan if $l < 1; # should not happen
# leading zero parts in internal representation)
$l --; $ret .= $ar->[$l]; $l--;
# Interestingly, the pre-padd method uses more time
- # the old grep variant takes longer (14 to 10 sec)
+ # the old grep variant takes longer (14 to 10 sec)
+ my $z = '0' x ($BASE_LEN-1);
while ($l >= 0)
{
- $ret .= substr('0000'.$ar->[$l],-5); # fastest way I could think of
+ $ret .= substr($z.$ar->[$l],-$BASE_LEN); # fastest way I could think of
$l--;
}
return \$ret;
sub _num
{
# Make a number (scalar int/float) from a BigInt object
- shift @_ if $_[0] eq $class;
- my $x = shift;
+ my $x = $_[1];
return $x->[0] if scalar @$x == 1; # below $BASE
my $fac = 1;
my $num = 0;
sub _add
{
# (ref to int_num_array, ref to int_num_array)
- # routine to add two base 1e5 numbers
+ # routine to add two base 1eX numbers
# stolen from Knuth Vol 2 Algorithm A pg 231
# there are separate routines to add and sub as per Knuth pg 233
# This routine clobbers up array x, but not y.
- shift @_ if $_[0] eq $class;
- my ($x,$y) = @_;
+ my ($c,$x,$y) = @_;
# for each in Y, add Y to X and carry. If after that, something is left in
# X, foreach in X add carry to X and then return X, carry
sub _sub
{
# (ref to int_num_array, ref to int_num_array)
- # subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
+ # subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
# subtract Y from X (X is always greater/equal!) by modifying x in place
- shift @_ if $_[0] eq $class;
- my ($sx,$sy,$s) = @_;
+ my ($c,$sx,$sy,$s) = @_;
my $car = 0; my $i; my $j = 0;
if (!$s)
# (BINT, BINT) return nothing
# multiply two numbers in internal representation
# modifies first arg, second need not be different from first
- shift @_ if $_[0] eq $class;
- my ($xv,$yv) = @_;
+ my ($c,$xv,$yv) = @_;
my @prod = (); my ($prod,$car,$cty,$xi,$yi);
# since multiplying $x with $x fails, make copy in this case
- $yv = [@$xv] if "$xv" eq "$yv";
- # looping through @$y if $xi == 0 is silly! optimize it!
+ $yv = [@$xv] if "$xv" eq "$yv"; # same references?
for $xi (@$xv)
{
$car = 0; $cty = 0;
+
+ # slow variant
+# for $yi (@$yv)
+# {
+# $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
+# $prod[$cty++] =
+# $prod - ($car = int($prod * RBASE)) * $BASE; # see USE_MUL
+# }
+# $prod[$cty] += $car if $car; # need really to check for 0?
+# $xi = shift @prod;
+
+ # faster variant
+ # looping through this if $xi == 0 is silly - so optimize it away!
+ $xi = (shift @prod || 0), next if $xi == 0;
for $yi (@$yv)
{
$prod = $xi * $yi + ($prod[$cty] || 0) + $car;
+## this is actually a tad slower
+## $prod = $prod[$cty]; $prod += ($car + $xi * $yi); # no ||0 here
$prod[$cty++] =
- $prod - ($car = int($prod * 1e-5)) * $BASE; # see USE_MUL
+ $prod - ($car = int($prod * $RBASE)) * $BASE; # see USE_MUL
}
$prod[$cty] += $car if $car; # need really to check for 0?
$xi = shift @prod;
}
-# for $xi (@$xv)
-# {
-# $car = 0; $cty = 0;
-# # looping through this if $xi == 0 is silly! optimize it!
-# if (($xi||0) != 0)
-# {
-# for $yi (@$yv)
-# {
-# $prod = $prod[$cty]; $prod += ($car + $xi * $yi); # no ||0 here
-# $prod[$cty++] =
-# $prod - ($car = int($prod * 1e-5)) * $BASE; # see USE_MUL
-# }
-# }
-# $prod[$cty] += $car if $car; # need really to check for 0?
-# $xi = shift @prod;
-# }
push @$xv, @prod;
__strip_zeros($xv);
# normalize (handled last to save check for $y->is_zero()
# ref to array, ref to array, modify first array and return remainder if
# in list context
# no longer handles sign
- shift @_ if $_[0] eq $class;
- my ($x,$yorg) = @_;
+ my ($c,$x,$yorg) = @_;
my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1);
my (@d,$tmp,$q,$u2,$u1,$u0);
#warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
# if $v1 == 0;
$q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1));
- --$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*$BASE+$u2);
+ --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2);
if ($q)
{
($car, $bar) = (0,0);
{
$prd = $q * $y->[$yi] + $car;
$prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL
- $x->[$xi] += 1e5 if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
+ $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0));
}
if ($x->[-1] < $car + $bar)
{
$car = 0; --$q;
for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi)
{
- $x->[$xi] -= 1e5
+ $x->[$xi] -= $BASE
if ($car = (($x->[$xi] += $y->[$yi] + $car) > $BASE));
}
}
}
##############################################################################
+# shifts
+
+sub _rsft
+ {
+ my ($c,$x,$y,$n) = @_;
+
+ if ($n != 10)
+ {
+ return; # we cant do this here, due to now _pow, so signal failure
+ }
+ else
+ {
+ # shortcut (faster) for shifting by 10)
+ # multiples of $BASE_LEN
+ my $dst = 0; # destination
+ my $src = _num($c,$y); # as normal int
+ my $rem = $src % $BASE_LEN; # reminder to shift
+ $src = int($src / $BASE_LEN); # source
+ if ($rem == 0)
+ {
+ splice (@$x,0,$src); # even faster, 38.4 => 39.3
+ }
+ else
+ {
+ my $len = scalar @$x - $src; # elems to go
+ my $vd; my $z = '0'x $BASE_LEN;
+ $x->[scalar @$x] = 0; # avoid || 0 test inside loop
+ while ($dst < $len)
+ {
+ $vd = $z.$x->[$src];
+ #print "$dst $src '$vd' ";
+ $vd = substr($vd,-$BASE_LEN,$BASE_LEN-$rem);
+ #print "'$vd' ";
+ $src++;
+ $vd = substr($z.$x->[$src],-$rem,$rem) . $vd;
+ #print "'$vd1' ";
+ #print "'$vd'\n";
+ $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
+ $x->[$dst] = int($vd);
+ $dst++;
+ }
+ splice (@$x,$dst) if $dst > 0; # kill left-over array elems
+ pop @$x if $x->[-1] == 0; # kill last element if 0
+ } # else rem == 0
+ }
+ $x;
+ }
+
+sub _lsft
+ {
+ my ($c,$x,$y,$n) = @_;
+
+ if ($n != 10)
+ {
+ return; # we cant do this here, due to now _pow, so signal failure
+ }
+ else
+ {
+ # shortcut (faster) for shifting by 10) since we are in base 10eX
+ # multiples of $BASE_LEN:
+ my $src = scalar @$x; # source
+ my $len = _num($c,$y); # shift-len as normal int
+ my $rem = $len % $BASE_LEN; # reminder to shift
+ my $dst = $src + int($len/$BASE_LEN); # destination
+ my $vd; # further speedup
+ #print "src $src:",$x->[$src]||0," dst $dst:",$v->[$dst]||0," rem $rem\n";
+ $x->[$src] = 0; # avoid first ||0 for speed
+ my $z = '0' x $BASE_LEN;
+ while ($src >= 0)
+ {
+ $vd = $x->[$src]; $vd = $z.$vd;
+ #print "s $src d $dst '$vd' ";
+ $vd = substr($vd,-$BASE_LEN+$rem,$BASE_LEN-$rem);
+ #print "'$vd' ";
+ $vd .= $src > 0 ? substr($z.$x->[$src-1],-$BASE_LEN,$rem) : '0' x $rem;
+ #print "'$vd' ";
+ $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN;
+ #print "'$vd'\n";
+ $x->[$dst] = int($vd);
+ $dst--; $src--;
+ }
+ # set lowest parts to 0
+ while ($dst >= 0) { $x->[$dst--] = 0; }
+ # fix spurios last zero element
+ splice @$x,-1 if $x->[-1] == 0;
+ #print "elems: "; my $i = 0;
+ #foreach (reverse @$v) { print "$i $_ "; $i++; } print "\n";
+ }
+ $x;
+ }
+
+##############################################################################
# testing
sub _acmp
# ref to array, ref to array, return <0, 0, >0
# arrays must have at least one entry; this is not checked for
- shift @_ if $_[0] eq $class;
- my ($cx, $cy) = @_;
+ my ($c,$cx, $cy) = @_;
#print "$cx $cy\n";
my ($i,$a,$x,$y,$k);
# calculate length based on digits, not parts
- $x = _len($cx); $y = _len($cy);
+ $x = _len('',$cx); $y = _len('',$cy);
# print "length: ",($x-$y),"\n";
- return $x-$y if ($x - $y); # if different in length
+ my $lxy = $x - $y; # if different in length
+ return -1 if $lxy < 0;
+ return 1 if $lxy > 0;
#print "full compare\n";
$i = 0; $a = 0;
# first way takes 5.49 sec instead of 4.87, but has the early out advantage
# print "$cx->[$j] $cy->[$j] $a",$cx->[$j]-$cy->[$j],"\n";
last if ($a = $cx->[$j] - $cy->[$j]); $j--;
}
- return $a;
+ return 1 if $a > 0;
+ return -1 if $a < 0;
+ return 0; # equal
# while it early aborts, it is even slower than the manual variant
#grep { return $a if ($a = $_ - $cy->[$i++]); } @$cx;
# grep way, go trough all (bad for early ne)
# computer number of digits in bigint, minus the sign
# int() because add/sub sometimes leaves strings (like '00005') instead of
# int ('5') in this place, causing length to fail
- shift @_ if $_[0] eq $class;
- my $cx = shift;
+ my $cx = $_[1];
- return (@$cx-1)*5+length(int($cx->[-1]));
+ return (@$cx-1)*$BASE_LEN+length(int($cx->[-1]));
}
sub _digit
{
# return the nth digit, negative values count backward
# zero is rightmost, so _digit(123,0) will give 3
- shift @_ if $_[0] eq $class;
- my $x = shift;
- my $n = shift || 0;
+ my ($c,$x,$n) = @_;
- my $len = _len($x);
+ my $len = _len('',$x);
$n = $len+$n if $n < 0; # -1 last, -2 second-to-last
$n = abs($n); # if negative was too big
$len--; $n = $len if $n > $len; # n to big?
- my $elem = int($n / 5); # which array element
- my $digit = $n % 5; # which digit in this element
+ my $elem = int($n / $BASE_LEN); # which array element
+ my $digit = $n % $BASE_LEN; # which digit in this element
$elem = '0000'.@$x[$elem]; # get element padded with 0's
return substr($elem,-$digit-1,1);
}
# return amount of trailing zeros in decimal
# check each array elem in _m for having 0 at end as long as elem == 0
# Upon finding a elem != 0, stop
- shift @_ if $_[0] eq $class;
- my $x = shift;
+ my $x = $_[1];
my $zeros = 0; my $elem;
foreach my $e (@$x)
{
if ($e != 0)
{
- $elem = "$e"; # preserve x
- $elem =~ s/.*?(0*$)/$1/; # strip anything not zero
- $zeros *= 5; # elems * 5
- $zeros += CORE::length($elem); # count trailing zeros
- last; # early out
+ $elem = "$e"; # preserve x
+ $elem =~ s/.*?(0*$)/$1/; # strip anything not zero
+ $zeros *= $BASE_LEN; # elems * 5
+ $zeros += CORE::length($elem); # count trailing zeros
+ last; # early out
}
- $zeros ++; # real else branch: 50% slower!
+ $zeros ++; # real else branch: 50% slower!
}
return $zeros;
}
sub _is_zero
{
# return true if arg (BINT or num_str) is zero (array '+', '0')
- shift @_ if $_[0] eq $class;
- my ($x) = shift;
+ my $x = $_[1];
return (((scalar @$x == 1) && ($x->[0] == 0))) <=> 0;
}
sub _is_even
{
# return true if arg (BINT or num_str) is even
- shift @_ if $_[0] eq $class;
- my ($x) = shift;
+ my $x = $_[1];
return (!($x->[0] & 1)) <=> 0;
}
sub _is_odd
{
# return true if arg (BINT or num_str) is even
- shift @_ if $_[0] eq $class;
- my ($x) = shift;
+ my $x = $_[1];
return (($x->[0] & 1)) <=> 0;
}
sub _is_one
{
# return true if arg (BINT or num_str) is one (array '+', '1')
- shift @_ if $_[0] eq $class;
- my ($x) = shift;
+ my $x = $_[1];
return (scalar @$x == 1) && ($x->[0] == 1) <=> 0;
}
{
# internal normalization function that strips leading zeros from the array
# args: ref to array
- #trace(@_);
- shift @_ if $_[0] eq $class;
my $s = shift;
my $cnt = scalar @$s; # get count of parts
sub _check
{
# no checks yet, pull it out from the test suite
- shift @_ if $_[0] eq $class;
+ my $x = $_[1];
- my ($x) = shift;
return "$x is not a reference" if !ref($x);
# are all parts are valid?
module which follows the same API as this can be used instead by
using the following call:
- use Math::BigInt Calc => BigNum;
+ use Math::BigInt lib => BigNum;
=head1 EXPORT
or '0b1101').
Testing of input parameter validity is done by the caller, so you need not
-worry about underflow (C<_sub()>, C<_dec()>) nor about division by zero or
-similar cases.
+worry about underflow (f.i. in C<_sub()>, C<_dec()>) nor about division by
+zero or similar cases.
+
+The first parameter can be modified, that includes the possibility that you
+return a reference to a completely different object instead. Although keeping
+the reference the same is prefered.
+
+Return values are always references to objects or strings. 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 10 back
+to 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
+Math::BigInt interface, you can take any of the already existing modules as
+a rough guideline. You should really wrap up the latest BigInt and BigFloat
+testsuites with your module, and replace the following line:
+
+ use Math::BigInt;
+
+by
+
+ use Math::BigInt lib => 'yourlib';
+
+This way you ensure that your library really works 100% within Math::BigInt.
=head1 LICENSE
=head1 SEE ALSO
-L<Math::BigInt>, L<Math::BigFloat>.
+L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect> and
+L<Math::BigInt::Pari>.
=cut
$| = 1;
unshift @INC, '../lib'; # for running manually
# chdir 't' if -d 't';
- plan tests => 945;
+ plan tests => 1158;
}
-use Math::BigFloat;
use Math::BigInt;
+use Math::BigFloat;
my ($x,$y,$f,@args,$ans,$try,$ans1,$ans1_str,$setup);
while (<DATA>)
$try .= "\$x;";
} elsif ($f eq "binf") {
$try .= "\$x->binf('$args[1]');";
+ } elsif ($f eq "bnan") {
+ $try .= "\$x->bnan();";
+ } elsif ($f eq "numify") {
+ $try .= "\$x->numify();";
+ } elsif ($f eq "bone") {
+ $try .= "\$x->bone('$args[1]');";
+ } elsif ($f eq "bstr") {
+ $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);";
+ $try .= '$x->bstr();';
} elsif ($f eq "bsstr") {
- $try .= "\$x->bsstr();";
+ $try .= '$x->bsstr();';
+ } elsif ($f eq "parts") {
+ $try .= '($a,$b) = $x->parts(); "$a $b";';
} elsif ($f eq "fneg") {
- $try .= "-\$x;";
+ $try .= '$x->bneg();';
} elsif ($f eq "bfloor") {
$try .= "\$x->bfloor();";
} elsif ($f eq "bceil") {
$try .= "\$x->is_zero()+0;";
} elsif ($f eq "is_one") {
$try .= "\$x->is_one()+0;";
+ } elsif ($f eq "is_positive") {
+ $try .= "\$x->is_positive()+0;";
+ } elsif ($f eq "is_negative") {
+ $try .= "\$x->is_negative()+0;";
} elsif ($f eq "is_odd") {
$try .= "\$x->is_odd()+0;";
} elsif ($f eq "is_even") {
} elsif ($f eq "as_number") {
$try .= "\$x->as_number();";
} elsif ($f eq "fabs") {
- $try .= "abs \$x;";
+ $try .= '$x->babs();';
+ } elsif ($f eq "finc") {
+ $try .= '++$x;';
+ } elsif ($f eq "fdec") {
+ $try .= '--$x;';
}elsif ($f eq "fround") {
$try .= "$setup; \$x->fround($args[1]);";
} elsif ($f eq "ffround") {
-123.456:-123
-200:-200
&binf
-1:+:+inf
+1:+:inf
2:-:-inf
-3:abc:+inf
-&bsstr
-+inf:+inf
+3:abc:inf
+&numify
+0:0e+1
++1:1e+0
+1234:1234e+0
+NaN:NaN
++inf:inf
-inf:-inf
+&bnan
abc:NaN
+2:NaN
+-2:NaN
+0:NaN
+&bone
+2:+:1
+-2:-:-1
+-2:+:1
+2:-:-1
+0::1
+-2::1
+abc::1
+2:abc:1
+&bsstr
++inf:inf
+-inf:-inf
+abcbsstr:NaN
+1234.567:1234567e-3
+&bstr
++inf:::inf
+-inf:::-inf
+abcbsstr:::NaN
+1234.567:9::1234.56700
+1234.567::-6:1234.567000
+12345:5::12345
+0.001234:6::0.00123400
+0.001234::-8:0.00123400
+0:4::0
+0::-4:0.0000
&fnorm
-+inf:+inf
++inf:inf
-inf:-inf
+infinity:NaN
+-inf:NaN
-123456E-2:-1234.56
1e1:10
2e-11:0.00000000002
+# excercise _split
+ .02e-1:0.002
+ 000001:1
+ -00001:-1
+ -1:-1
+ 000.01:0.01
+ -000.0023:-0.0023
+ 1.1e1:11
-3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
-4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004
&fpow
128:-2:0.00006103515625
abc:123.456:NaN
123.456:abc:NaN
-+inf:123.45:+inf
++inf:123.45:inf
-inf:123.45:-inf
-+inf:-123.45:+inf
++inf:-123.45:inf
-inf:-123.45:-inf
&fneg
-abc:NaN
+fnegNaN:NaN
++inf:-inf
+-inf:inf
+0:0
+1:-1
-1:1
+123.456789:-123.456789
-123456.789:123456.789
&fabs
-abc:NaN
+fabsNaN:NaN
++inf:inf
+-inf:inf
+0:0
+1:1
-1:1
-123456.789:123456.789
&fround
$rnd_mode = "trunc"
++inf:5:inf
+-inf:5:-inf
+0:5:0
+NaNfround:5:NaN
+10123456789:5:10123000000
-10123456789:5:-10123000000
+10123456789.123:5:10123000000
-60123456789.0123:5:-60123000000
&ffround
$rnd_mode = "trunc"
++inf:5:inf
+-inf:5:-inf
+0:5:0
+NaNffround:5:NaN
+1.23:-1:1.2
+1.234:-1:1.2
+1.2345:-1:1.2
0.01234567:-9:0.01234567
0.01234567:-12:0.01234567
&fcmp
-abc:abc:
-abc:+0:
-+0:abc:
+fcmpNaN:fcmpNaN:
+fcmpNaN:+0:
++0:fcmpNaN:
+0:+0:0
-1:+0:-1
+0:-1:1
+inf:-54321.12345:1
+inf:+inf:0
-inf:-inf:0
++inf:-inf:1
+-inf:+inf:-1
# return undef
+inf:NaN:
-NaN:+inf:
+NaN:inf:
-inf:NaN:
NaN:-inf:
+&fdec
+fdecNaN:NaN
++inf:inf
+-inf:-inf
++0:-1
++1:0
+-1:-2
+1.23:0.23
+-1.23:-2.23
+&finc
+fincNaN:NaN
++inf:inf
+-inf:-inf
++0:1
++1:2
+-1:0
+1.23:2.23
+-1.23:-0.23
&fadd
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
++inf:-inf:0
+-inf:+inf:0
++inf:+inf:inf
+-inf:-inf:-inf
+baddNaN:+inf:NaN
+baddNaN:+inf:NaN
++inf:baddNaN:NaN
+-inf:baddNaN:NaN
+0:+0:0
+1:+0:1
+0:+1:1
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
++inf:-inf:inf
+-inf:+inf:-inf
++inf:+inf:0
+-inf:-inf:0
+baddNaN:+inf:NaN
+baddNaN:+inf:NaN
++inf:baddNaN:NaN
+-inf:baddNaN:NaN
+0:+0:0
+1:+0:1
+0:+1:-1
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
++inf:NaNmul:NaN
++inf:NaNmul:NaN
+NaNmul:+inf:NaN
+NaNmul:-inf:NaN
++inf:+inf:inf
++inf:-inf:-inf
++inf:-inf:-inf
++inf:+inf:inf
++inf:123.34:inf
++inf:-123.34:-inf
+-inf:123.34:-inf
+-inf:-123.34:inf
+123.34:+inf:inf
+-123.34:+inf:-inf
+123.34:-inf:-inf
+-123.34:-inf:inf
+0:+0:0
+0:+1:0
+1:+0:0
abc:abc:NaN
abc:+1:abc:NaN
+1:abc:NaN
+-1:abc:NaN
+0:abc:NaN
+0:+0:NaN
+0:+1:0
-+1:+0:NaN
++1:+0:inf
++3214:+0:inf
+0:-1:0
--1:+0:NaN
+-1:+0:-inf
+-3214:+0:-inf
+1:+1:1
-1:-1:1
+1:-1:-1
-1:+1:-1
+1:+2:0.5
+2:+1:2
+123:+inf:0
+123:-inf:0
+10:+5:2
+100:+4:25
+1000:+8:125
-16:NaN
-123.45:NaN
nanfsqrt:NaN
-+inf:+inf
++inf:inf
-inf:NaN
+1:1
+2:1.41421356237309504880168872420969807857
-inf:0
123.456:0
-123.456:0
+&is_positive
+0:1
+1:1
+-1:0
+-123:0
+NaN:0
+-inf:0
++inf:1
+&is_negative
+0:0
+1:0
+-1:1
+-123:1
+NaN:0
+-inf:1
++inf:0
+&parts
+0:0 1
+1:1 0
+123:123 0
+-123:-123 0
+-1200:-12 2
&is_zero
NaNzero:0
++inf:0
+-inf:0
0:1
-1:0
1:0
&is_one
+NaNone:0
++inf:0
+-inf:0
0:0
2:0
1:1
&bfloor
0:0
abc:NaN
-+inf:+inf
++inf:inf
-inf:-inf
1:1
-51:-51
&bceil
0:0
abc:NaN
-+inf:+inf
++inf:inf
-inf:-inf
1:1
-51:-51
$| = 1;
# chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 29;
+ plan tests => 52;
}
-# testing of Math::BigInt::Calc, primarily for interface/api and not for the
+# testing of Math::BigInt::BitVect, primarily for interface/api and not for the
# math functionality
use Math::BigInt::Calc;
-my $s123 = \'123'; my $s321 = \'321';
+my $C = 'Math::BigInt::Calc'; # pass classname to sub's
+
# _new and _str
-my $x = _new($s123); my $u = _str($x);
-ok ($$u,123); ok ($x->[0],123); ok (@$x,1);
-my $y = _new($s321);
+my $x = _new($C,\"123"); my $y = _new($C,\"321");
+ok (ref($x),'ARRAY'); ok (${_str($C,$x)},123); ok (${_str($C,$y)},321);
# _add, _sub, _mul, _div
-ok (${_str(_add($x,$y))},444);
-ok (${_str(_sub($x,$y))},123);
-ok (${_str(_mul($x,$y))},39483);
-ok (${_str(_div($x,$y))},123);
-
-# division with reminder
-my $z = _new(\"111");
- _mul($x,$y);
-ok (${_str($x)},39483);
-_add($x,$z);
-ok (${_str($x)},39594);
-my ($re,$rr) = _div($x,$y);
+ok (${_str($C,_add($C,$x,$y))},444);
+ok (${_str($C,_sub($C,$x,$y))},123);
+ok (${_str($C,_mul($C,$x,$y))},39483);
+ok (${_str($C,_div($C,$x,$y))},123);
-ok (${_str($re)},123); ok (${_str($rr)},111);
+ok (${_str($C,_mul($C,$x,$y))},39483);
+ok (${_str($C,$x)},39483);
+ok (${_str($C,$y)},321);
+my $z = _new($C,\"2");
+ok (${_str($C,_add($C,$x,$z))},39485);
+my ($re,$rr) = _div($C,$x,$y);
-# _copy
-$x = _new(\"12356");
-ok (${_str(_copy($x))},12356);
-
-# digit
-$x = _new(\"123456789");
-ok (_digit($x,0),9);
-ok (_digit($x,1),8);
-ok (_digit($x,2),7);
-ok (_digit($x,-1),1);
-ok (_digit($x,-2),2);
-ok (_digit($x,-3),3);
+ok (${_str($C,$re)},123); ok (${_str($C,$rr)},2);
# is_zero, _is_one, _one, _zero
-$x = _new(\"12356");
-ok (_is_zero($x),0);
-ok (_is_one($x),0);
+ok (_is_zero($C,$x),0);
+ok (_is_one($C,$x),0);
-# _zeros
-$x = _new(\"1256000000"); ok (_zeros($x),6);
-$x = _new(\"152"); ok (_zeros($x),0);
-$x = _new(\"123000"); ok (_zeros($x),3);
+ok (_is_one($C,_one()),1); ok (_is_one($C,_zero()),0);
+ok (_is_zero($C,_zero()),1); ok (_is_zero($C,_one()),0);
+
+# is_odd, is_even
+ok (_is_odd($C,_one()),1); ok (_is_odd($C,_zero()),0);
+ok (_is_even($C,_one()),0); ok (_is_even($C,_zero()),1);
-ok (_is_one(_one()),1); ok (_is_one(_zero()),0);
-ok (_is_zero(_zero()),1); ok (_is_zero(_one()),0);
+# _digit
+$x = _new($C,\"123456789");
+ok (_digit($C,$x,0),9);
+ok (_digit($C,$x,1),8);
+ok (_digit($C,$x,2),7);
+ok (_digit($C,$x,-1),1);
+ok (_digit($C,$x,-2),2);
+ok (_digit($C,$x,-3),3);
+
+# _copy
+$x = _new($C,\"12356");
+ok (${_str($C,_copy($C,$x))},12356);
+
+# _zeros
+$x = _new($C,\"1256000000"); ok (_zeros($C,$x),6);
+$x = _new($C,\"152"); ok (_zeros($C,$x),0);
+$x = _new($C,\"123000"); ok (_zeros($C,$x),3);
+
+# _lsft, _rsft
+$x = _new($C,\"10"); $y = _new($C,\"3");
+ok (${_str($C,_lsft($C,$x,$y,10))},10000);
+$x = _new($C,\"20"); $y = _new($C,\"3");
+ok (${_str($C,_lsft($C,$x,$y,10))},20000);
+$x = _new($C,\"128"); $y = _new($C,\"4");
+if (!defined _lsft($C,$x,$y,2))
+ {
+ ok (1,1)
+ }
+else
+ {
+ ok ('_lsft','undef');
+ }
+$x = _new($C,\"1000"); $y = _new($C,\"3");
+ok (${_str($C,_rsft($C,$x,$y,10))},1);
+$x = _new($C,\"20000"); $y = _new($C,\"3");
+ok (${_str($C,_rsft($C,$x,$y,10))},20);
+$x = _new($C,\"256"); $y = _new($C,\"4");
+if (!defined _rsft($C,$x,$y,2))
+ {
+ ok (1,1)
+ }
+else
+ {
+ ok ('_rsft','undef');
+ }
-ok (_check($x),0);
-ok (_check(123),'123 is not a reference');
+# _acmp
+$x = _new($C,\"123456789");
+$y = _new($C,\"987654321");
+ok (_acmp($C,$x,$y),-1);
+ok (_acmp($C,$y,$x),1);
+ok (_acmp($C,$x,$x),0);
+ok (_acmp($C,$y,$y),0);
+
+# _div
+$x = _new($C,\"3333"); $y = _new($C,\"1111");
+ok (${_str($C, scalar _div($C,$x,$y))},3);
+$x = _new($C,\"33333"); $y = _new($C,\"1111"); ($x,$y) = _div($C,$x,$y);
+ok (${_str($C,$x)},30); ok (${_str($C,$y)},3);
+$x = _new($C,\"123"); $y = _new($C,\"1111");
+($x,$y) = _div($C,$x,$y); ok (${_str($C,$x)},0); ok (${_str($C,$y)},123);
+
+# _num
+$x = _new($C,\"12345"); $x = _num($C,$x); ok (ref($x)||'',''); ok ($x,12345);
+
+# should not happen:
+# $x = _new($C,\"-2"); $y = _new($C,\"4"); ok (_acmp($C,$x,$y),-1);
+
+# _check
+$x = _new($C,\"123456789");
+ok (_check($C,$x),0);
+ok (_check($C,123),'123 is not a reference');
# done
1;
+
$| = 1;
# chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 1222;
+ plan tests => 1424;
}
-my $version = '1.36'; # for $VERSION tests, match current release (by hand!)
+my $version = '1.40'; # for $VERSION tests, match current release (by hand!)
##############################################################################
# for testing inheritance of _swap
package Math::Foo;
use Math::BigInt;
+#use Math::BigInt lib => 'BitVect'; # for testing
use vars qw/@ISA/;
@ISA = (qw/Math::BigInt/);
use Math::BigInt;
#use Math::BigInt lib => 'BitVect'; # for testing
-#use Math::BigInt lib => 'Small'; # for testing
-my $CALC = Math::BigInt::_core_lib();
+my $CALC = Math::BigInt::_core_lib(); ok ($CALC,'Math::BigInt::Calc');
my (@args,$f,$try,$x,$y,$z,$a,$exp,$ans,$ans1,@a,$m,$e,$round_mode);
$try .= '$x->is_odd()+0;';
} elsif ($f eq "is_even") {
$try .= '$x->is_even()+0;';
+ } elsif ($f eq "is_negative") {
+ $try .= '$x->is_negative()+0;';
+ } elsif ($f eq "is_positive") {
+ $try .= '$x->is_positive()+0;';
} elsif ($f eq "is_inf") {
$try .= "\$x->is_inf('$args[1]')+0;";
} elsif ($f eq "binf") {
$try .= "\$x->binf('$args[1]');";
+ } elsif ($f eq "bone") {
+ $try .= "\$x->bone('$args[1]');";
+ } elsif ($f eq "bnan") {
+ $try .= "\$x->bnan();";
} elsif ($f eq "bfloor") {
$try .= '$x->bfloor();';
} elsif ($f eq "bceil") {
} elsif ($f eq "bsstr") {
$try .= '$x->bsstr();';
} elsif ($f eq "bneg") {
- $try .= '-$x;';
+ $try .= '$x->bneg();';
} elsif ($f eq "babs") {
- $try .= 'abs $x;';
+ $try .= '$x->babs();';
} elsif ($f eq "binc") {
$try .= '++$x;';
} elsif ($f eq "bdec") {
$try .= "\$x * \$y;";
}elsif ($f eq "bdiv"){
$try .= "\$x / \$y;";
+ }elsif ($f eq "bdiv-list"){
+ $try .= 'join (",",$x->bdiv($y));';
}elsif ($f eq "bmod"){
$try .= "\$x % \$y;";
}elsif ($f eq "bgcd")
} # endwhile data tests
close DATA;
-# XXX Tels 06/29/2001 following tests never fail or do not work :(
+# XXX Tels 06/29/2001 following tests never fail or do not work :( !?
# test whether use Math::BigInt qw/version/ works
$try = "use Math::BigInt ($version.'1');";
ok ( $ans1, "1427247692705959881058285969449495136382746624");
# test wether Math::BigInt::Small via use works (w/ dff. spellings of calc)
-#$try = "use Math::BigInt ($version,'CALC','Small');";
+#$try = "use Math::BigInt ($version,'lib','Small');";
#$try .= ' $x = 2**10; $x = "$x";';
#$ans1 = eval $try;
#ok ( $ans1, "1024");
-#$try = "use Math::BigInt ($version,'cAlC','Math::BigInt::Small');";
+#$try = "use Math::BigInt ($version,'LiB','Math::BigInt::Small');";
#$try .= ' $x = 2**10; $x = "$x";';
#$ans1 = eval $try;
#ok ( $ans1, "1024");
# test wether calc => undef (array element not existing) works
-#$try = "use Math::BigInt ($version,'CALC');";
+#$try = "use Math::BigInt ($version,'LIB');";
#$try = "require Math::BigInt; Math::BigInt::import($version,'CALC');";
#$try .= ' $x = Math::BigInt->new(2)**10; $x = "$x";';
#$ans1 = eval $try;
#ok ( $ans1, 1024);
+# test whether fallback to calc works
+$try = "use Math::BigInt ($version,'lib','foo, bar , ');";
+$try .= ' Math::BigInt::_core_lib();';
+$ans1 = eval $try;
+ok ( $ans1, "Math::BigInt::Calc");
+
# test some more
@a = ();
for (my $i = 1; $i < 10; $i++)
}
ok "@a", "1 2 3 4 5 6 7 8 9";
-# test whether selfmultiplication works correctly (result is 2**64)
+# test whether self-multiplication works correctly (result is 2**64)
$try = '$x = new Math::BigInt "+4294967296";';
$try .= '$a = $x->bmul($x);';
$ans1 = eval $try;
print "# Tried: '$try'\n" if !ok ($ans1, Math::BigInt->new(2) ** 64);
+# test self-pow
+$try = '$x = Math::BigInt->new(10);';
+$try .= '$a = $x->bpow($x);';
+$ans1 = eval $try;
+print "# Tried: '$try'\n" if !ok ($ans1, Math::BigInt->new(10) ** 10);
# test whether op destroys args or not (should better not)
print "# For '$try'\n" if (!ok "$ans" , "ok" );
###############################################################################
+# the followin tests only make sense with Math::BigInt::Calc
+
+###############################################################################
# check proper length of internal arrays
$x = Math::BigInt->new(99999); is_valid($x);
$x -= 1; ok ($x,99999); is_valid($x);
###############################################################################
-# check numify, these tests only make sense with Math::BigInt::Calc, since
-# only this uses $BASE
+# check numify
my $BASE = int(1e5); # should access Math::BigInt::Calc::BASE
$x = Math::BigInt->new($BASE-1); ok ($x->numify(),$BASE-1);
ok ($x, 23456);
###############################################################################
+# bug in shortcut in mul()
+
+# construct a number with a zero-hole of BASE_LEN
+my $bl = Math::BigInt::Calc::_base_len();
+$x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl;
+$y = '1' x (2*$bl);
+#print "$x * $y\n";
+$x = Math::BigInt->new($x)->bmul($y);
+# result is 123..$bl . $bl x (3*bl-1) . $bl...321 . '0' x $bl
+$y = ''; my $d = '';
+for (my $i = 1; $i <= $bl; $i++)
+ {
+ $y .= $i; $d = $i.$d;
+ }
+#print "$y $d\n";
+$y .= $bl x (3*$bl-1) . $d . '0' x $bl;
+ok ($x,$y);
+
+###############################################################################
# bug with rest "-0" in div, causing further div()s to fail
$x = Math::BigInt->new('-322056000'); ($x,$y) = $x->bdiv('-12882240');
ok (ref($x),'Math::Foo');
###############################################################################
+# test whether +inf eq inf
+
+$y = 1e1000000; # create inf, since bareword inf does not work
+$x = Math::BigInt->new('+inf'); ok ($x,$y);
+
+###############################################################################
# all tests done
###############################################################################
}
__END__
+&is_negative
+0:0
+-1:1
+1:0
++inf:0
+-inf:1
+NaNneg:0
+&is_positive
+0:1
+-1:0
+1:1
++inf:1
+-inf:0
+NaNneg:0
&is_odd
abc:0
0:0
+987654321:+123456789:1
-987654321:+123456789:1
-123:+4567889:-1
+# NaNs
+acmpNaN:123:
+123:acmpNaN:
+acmpNaN:acmpNaN:
+# infinity
++inf:+inf:0
+-inf:-inf:0
++inf:-inf:0
+-inf:+inf:0
++inf:123:1
+-inf:123:1
++inf:-123:1
+-inf:-123:1
+# return undef
++inf:NaN:
+NaN:inf:
+-inf:NaN:
+NaN:-inf:
&bnorm
123:123
# binary input
0b011:3
0b101:5
0b1000000000000000000000000000000:1073741824
+0b_101:NaN
+0b1_0_1:5
# hex input
-0x0:0
0xabcdefgh:NaN
-0xABCDEF:-11259375
-0x1234:-4660
0x12345678:305419896
+0x1_2_3_4_56_78:305419896
+0x_123:NaN
# inf input
-+inf:+inf
++inf:inf
-inf:-inf
0inf:NaN
# normal input
-1010E-2:NaN
-1.01E+1:NaN
-1.01E-1:NaN
+1234.00:1234
+&bnan
+1:NaN
+2:NaN
+abc:NaN
+&bone
+2:+:+1
+2:-:-1
+boneNaN:-:-1
+boneNaN:+:+1
+2:abc:+1
+3::+1
&binf
-1:+:+inf
+1:+:inf
2:-:-inf
-3:abc:+inf
+3:abc:inf
&is_inf
+inf::1
-inf::1
100:1e+2
abc:NaN
&bneg
+bnegNaN:NaN
++inf:-inf
+-inf:inf
abd:NaN
+0:+0
+1:-1
+123456789:-123456789
-123456789:+123456789
&babs
-abc:NaN
+babsNaN:NaN
++inf:inf
+-inf:inf
+0:+0
+1:+1
-1:+1
+123456789:+123456789
-123456789:+123456789
&bcmp
-abc:abc:
-abc:+0:
-+0:abc:
+bcmpNaN:bcmpNaN:
+bcmpNaN:+0:
++0:bcmpNaN:
+0:+0:0
-1:+0:-1
+0:-1:1
+inf:-5432112345:1
+inf:+inf:0
-inf:-inf:0
++inf:-inf:1
+-inf:+inf:-1
# return undef
+inf:NaN:
-NaN:+inf:
+NaN:inf:
-inf:NaN:
NaN:-inf:
&binc
abc:NaN
++inf:inf
+-inf:-inf
+0:+1
+1:+2
-1:+0
&bdec
abc:NaN
++inf:inf
+-inf:-inf
+0:-1
+1:+0
-1:-2
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
++inf:-inf:0
+-inf:+inf:0
++inf:+inf:inf
+-inf:-inf:-inf
+baddNaN:+inf:NaN
+baddNaN:+inf:NaN
++inf:baddNaN:NaN
+-inf:baddNaN:NaN
+0:+0:+0
+1:+0:+1
+0:+1:+1
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
++inf:-inf:inf
+-inf:+inf:-inf
++inf:+inf:0
+-inf:-inf:0
+0:+0:+0
+1:+0:+1
+0:+1:-1
abc:abc:NaN
abc:+0:NaN
+0:abc:NaN
+NaNmul:+inf:NaN
+NaNmul:-inf:NaN
+-inf:NaNmul:NaN
++inf:NaNmul:NaN
++inf:+inf:inf
++inf:-inf:-inf
+-inf:+inf:-inf
+-inf:-inf:inf
+0:+0:+0
+0:+1:+0
+1:+0:+0
+25:+25:+625
+12345:+12345:+152399025
+99999:+11111:+1111088889
+&bdiv-list
+100:20:5,0
+4095:4095:1,0
+-4095:-4095:1,0
+4095:-4095:-1,0
+-4095:4095:-1,0
&bdiv
abc:abc:NaN
abc:+1:abc:NaN
-# really?
-#+5:0:+inf
-#-5:0:-inf
+1:abc:NaN
+0:+0:NaN
++5:0:inf
+-5:0:-inf
++1:+0:inf
+0:+1:+0
-+1:+0:NaN
+0:-1:+0
--1:+0:NaN
+-1:+0:-inf
+1:+1:+1
-1:-1:+1
+1:-1:-1
1:-3:-1
-5:3:-2
4:-3:-2
+123:+inf:0
+123:-inf:0
&bmod
abc:abc:NaN
abc:+1:abc:NaN
-2:-3:-2
4:-3:-2
1:-3:-2
+4095:4095:0
&bgcd
abc:abc:NaN
abc:+0:NaN
+281474976710656:+0:+0
+281474976710656:+1:+0
+281474976710656:+281474976710656:+281474976710656
+-2:-3:-4
+-1:-1:-1
+-6:-6:-6
+-7:-4:-8
+-7:4:0
+-4:7:4
&bior
abc:abc:NaN
abc:0:NaN
+281474976710656:+0:+281474976710656
+281474976710656:+1:+281474976710657
+281474976710656:+281474976710656:+281474976710656
+-2:-3:-1
+-1:-1:-1
+-6:-6:-6
+-7:4:-3
+-4:7:-1
&bxor
abc:abc:NaN
abc:0:NaN
+281474976710656:+0:+281474976710656
+281474976710656:+1:+281474976710657
+281474976710656:+281474976710656:+0
+-2:-3:3
+-1:-1:0
+-6:-6:0
+-7:4:-3
+-4:7:-5
+4:-7:-3
+-4:-7:5
&bnot
abc:NaN
+0:-1
+8:-9
+281474976710656:-281474976710657
+-1:0
+-2:1
+-12:11
&digit
0:0:0
12:0:2
-2:-1:NaN
2:-2:NaN
-2:-2:NaN
-+inf:1234500012:+inf
++inf:1234500012:inf
-inf:1234500012:-inf
-+inf:-12345000123:+inf
++inf:-12345000123:inf
-inf:-12345000123:-inf
# 1 ** -x => 1 / (1 ** x)
-1:0:1
Nan:NaN
&bround
$round_mode('trunc')
+0:12:0
+NaNbround:12:NaN
++inf:12:inf
+-inf:12:-inf
1234:0:1234
1234:2:1200
123456:4:123400
&is_zero
0:1
NaNzero:0
++inf:0
+-inf:0
123:0
-1:0
1:0
&is_one
0:0
+NaNone:0
++inf:0
+-inf:0
1:1
2:0
-1:0
# floor and ceil tests are pretty pointless in integer space...but play safe
&bfloor
0:0
+NaNfloor:NaN
++inf:inf
+-inf:-inf
-1:-1
-2:-2
2:2
3:3
abc:NaN
&bceil
+NaNceil:NaN
++inf:inf
+-inf:-inf
0:0
-1:-1
-2:-2
$z = $y * $x; ok ($z,80780);
$z = $x ** 2; ok ($z,15241);
$z = $x * $x; ok ($z,15241);
-# not yet: $z = -$x; ok ($z,-123.46); ok ($x,123.456);
+# not: $z = -$x; ok ($z,-123.46); ok ($x,123.456);
$z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62);
$x = Math::BigFloat->new(123456); $x->{_a} = 4;
$z = $x->copy; $z++; ok ($z,123500);
projects / p5sagit/p5-mst-13.2.git / commitdiff