lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package
lib/Math/BigInt.pm An arbitrary precision integer arithmetic package
lib/Math/BigInt/Calc.pm Pure Perl module to support Math::BigInt
-lib/Math/BigInt/t/bare_mbi.t Test Math::BigInt::CareCalc
+lib/Math/BigInt/t/bare_mbi.t Test MBI under Math::BigInt::BareCalc
+lib/Math/BigInt/t/bare_mbf.t Test MBF under Math::BigInt::BareCalc
lib/Math/BigInt/t/bigfltpm.inc Shared tests for bigfltpm.t and sub_mbf.t
lib/Math/BigInt/t/bigfltpm.t See if BigFloat.pm works
lib/Math/BigInt/t/bigintc.t See if BigInt/Calc.pm works
lib/Math/BigInt/t/bigintpm.inc Shared tests for bigintpm.t and sub_mbi.t
lib/Math/BigInt/t/bigintpm.t See if BigInt.pm works
lib/Math/BigInt/t/calling.t Test calling conventions
+lib/Math/BigInt/t/config.t Test Math::BigInt->config()
+lib/Math/BigInt/t/constant.t Test Math::BigInt/BigFloat under :constant
+lib/Math/BigInt/t/inf_nan.t Special tests for inf and NaN handling
lib/Math/BigInt/t/mbimbf.inc Actual BigInt/BigFloat accuracy, precicion and fallback, round_mode tests
lib/Math/BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precicion and fallback, round_mode
lib/Math/BigInt/t/require.t Test if require Math::BigInt works
lib/Math/BigInt/t/sub_mbf.t Empty subclass test of BigFloat
lib/Math/BigInt/t/sub_mbi.t Empty subclass test of BigInt
lib/Math/BigInt/t/sub_mif.t Test A & P with subclasses using mbimbf.inc
+lib/Math/BigInt/t/upgrade.inc Actual tests for upgrade.t
+lib/Math/BigInt/t/upgrade.t Test if use Math::BigInt(); under upgrade works
lib/Math/BigInt/t/use.t Test if use Math::BigInt(); works
lib/Math/Complex.pm A Complex package
lib/Math/Complex.t See if Math::Complex works
-#!/usr/bin/perl -w
-
# The following hash values are internally used:
# _e: exponent (BigInt)
# _m: mantissa (absolute BigInt)
package Math::BigFloat;
-$VERSION = '1.27';
+$VERSION = '1.28';
require 5.005;
use Exporter;
use Math::BigInt qw/objectify/;
use strict;
use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/;
+use vars qw/$upgrade $downgrade/;
my $class = "Math::BigFloat";
use overload
ref($_[0])->bcmp($_[1],$_[0]) :
ref($_[0])->bcmp($_[0],$_[1])},
'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint
+'log' => sub { $_[0]->blog() },
;
##############################################################################
$precision = undef;
$div_scale = 40;
+$upgrade = undef;
+$downgrade = undef;
+
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
# valid method aliases for AUTOLOAD
my %methods = map { $_ => 1 }
qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
- fint facmp fcmp fzero fnan finf finc fdec flog
+ fint facmp fcmp fzero fnan finf finc fdec flog ffac
fceil ffloor frsft flsft fone flog
/;
# valid method's that can be hand-ed up (for AUTOLOAD)
# sign => sign (+/-), or "NaN"
my ($class,$wanted,@r) = @_;
-
+
# avoid numify-calls by not using || on $wanted!
return $class->bzero() if !defined $wanted; # default to 0
return $wanted->copy() if UNIVERSAL::isa($wanted,'Math::BigFloat');
$self->{_e} -= CORE::length($$mfv) if CORE::length($$mfv) != 0;
$self->{sign} = $$mis;
}
- # print "mbf new ",join(' ',@r),"\n";
+ # print "mbf new $self->{sign} $self->{_m} e $self->{_e}\n";
$self->bnorm()->round(@r); # first normalize, then round
}
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';
+ return +1;
}
# check sign for speed first
my $lym = $y->{_m}->length();
my $lx = $lxm + $x->{_e};
my $ly = $lym + $y->{_e};
- # print "x $x y $y lx $lx ly $ly\n";
- my $l = $lx - $ly; $l = -$l if $x->{sign} eq '-';
- # print "$l $x->{sign}\n";
+ my $l = $lx - $ly; $l->bneg() if $x->{sign} eq '-';
return $l <=> 0 if $l != 0;
# lengths (corrected by exponent) are equal
}
my $rc = $xm->bcmp($ym);
$rc = -$rc if $x->{sign} eq '-'; # -124 < -123
- return $rc <=> 0;
+ $rc <=> 0;
}
sub bacmp
return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
return 0 if ($x->is_inf() && $y->is_inf());
return 1 if ($x->is_inf() && !$y->is_inf());
- return -1 if (!$x->is_inf() && $y->is_inf());
+ return -1;
}
# shortcut
my $lym = $y->{_m}->length();
my $lx = $lxm + $x->{_e};
my $ly = $lym + $y->{_e};
- # print "x $x y $y lx $lx ly $ly\n";
my $l = $lx - $ly;
- # print "$l $x->{sign}\n";
return $l <=> 0 if $l != 0;
# lengths (corrected by exponent) are equal
{
$xm = $x->{_m}->copy()->blsft(-$diff,10);
}
- my $rc = $xm->bcmp($ym);
- return $rc <=> 0;
+ $xm->bcmp($ym) <=> 0;
}
sub badd
# return result as BFLOAT
my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ #print "mbf badd $x $y\n";
# inf and NaN handling
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/))
{
sub blog
{
- my ($self,$x,$base,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(2,@_);
+ my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(2,@_);
# http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log
# _ _
# taylor: | u 1 u^3 1 u^5 |
# ln (x) = 2 | --- + - * --- + - * --- + ... | x > 0
- # |_ v 3 v 5 v _|
+ # |_ v 3 v^3 5 v^5 _|
- return $x->bzero(@r) if $x->is_one();
- return $x->bone(@r) if $x->bcmp($base) == 0;
+ # we need to limit the accuracy to protect against overflow
+ my $fallback = 0;
+ my $scale = 0;
+ my @params = $x->_find_round_parameters($a,$p,$r);
- my $d = $r[0] || $self->accuracy() || 40;
- $d += 2; # 2 more for rounding
-
- my $u = $x->copy(); $u->bdec();
- my $v = $x->copy(); $v->binc();
+ # no rounding at all, so must use fallback
+ if (scalar @params == 1)
+ {
+ # simulate old behaviour
+ $params[1] = $self->div_scale(); # and round to it as accuracy
+ $scale = $params[1]+4; # at least four more for proper round
+ $params[3] = $r; # round mode by caller or undef
+ $fallback = 1; # to clear a/p afterwards
+ }
+ else
+ {
+ # the 4 below is empirical, and there might be cases where it is not
+ # enough...
+ $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined
+ }
- $x->bdec()->bdiv($v,$d); # first term: u/v
+ return $x->bzero(@params) if $x->is_one();
+ return $x->bnan() if $x->{sign} ne '+' || $x->is_zero();
+ #return $x->bone('+',@params) if $x->bcmp($base) == 0;
- $u *= $u; $v *= $v;
- my $below = $v->copy()->bmul($v);
- my $over = $u->copy()->bmul($u);
+ # when user set globals, they would interfere with our calculation, so
+ # disable then and later re-enable them
+ no strict 'refs';
+ my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
+ my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
+ # we also need to disable any set A or P on $x (_find_round_parameters took
+ # them already into account), since these would interfere, too
+ delete $x->{_a}; delete $x->{_p};
+ # need to disable $upgrade in BigInt, to aoid deep recursion
+ local $Math::BigInt::upgrade = undef;
+
+ my $v = $x->copy(); $v->binc(); # v = x+1
+ $x->bdec(); my $u = $x->copy(); # u = x-1; x = x-1
+
+ $x->bdiv($v,$scale); # first term: u/v
+
+ my $below = $v->copy();
+ my $over = $u->copy();
+ $u *= $u; $v *= $v; # u^2, v^2
+ $below->bmul($v); # u^3, v^3
+ $over->bmul($u);
my $factor = $self->new(3); my $two = $self->new(2);
my $diff = $self->bone();
- my $limit = $self->new("1E-". ($d-1)); my $last;
+ my $limit = $self->new("1E-". ($scale-1)); my $last;
# print "diff $diff limit $limit\n";
- while ($diff > $limit)
+ while ($diff->bcmp($limit) > 0)
{
- print "$x $over $below $factor\n";
+ #print "$x $over $below $factor\n";
$diff = $x->copy()->bsub($last)->babs();
- print "diff $diff $limit\n";
+ #print "diff $diff $limit\n";
$last = $x->copy();
- $x += $over->copy()->bdiv($below->copy()->bmul($factor),$d);
+ $x += $over->copy()->bdiv($below->copy()->bmul($factor),$scale);
$over *= $u; $below *= $v; $factor->badd($two);
}
$x->bmul($two);
- return $x->round(@r);
+
+ # shortcut to not run trough _find_round_parameters again
+ if (defined $params[1])
+ {
+ $x->bround($params[1],$params[3]); # then round accordingly
+ }
+ else
+ {
+ $x->bfround($params[2],$params[3]); # then round accordingly
+ }
+ if ($fallback)
+ {
+ # clear a/p after round, since user did not request it
+ $x->{_a} = undef; $x->{_p} = undef;
+ }
+ # restore globals
+ $$abr = $ab; $$pbr = $pb;
+
+ $x;
}
sub blcm
$x;
}
+###############################################################################
+# 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]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+
+ return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
+ $x->{_e}->{sign} eq '+'; # 1e-1 => no integer
+ 0;
+ }
+
sub is_zero
{
- # return true if arg (BFLOAT or num_str) is zero (array '+', '0')
+ # return true if arg (BFLOAT or num_str) is zero
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero();
- return 0;
+ 0;
}
sub is_one
{
- # return true if arg (BFLOAT or num_str) is +1 (array '+', '1')
- # or -1 if signis given
+ # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
my $sign = shift || ''; $sign = '+' if $sign ne '-';
return 1
if ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one());
- return 0;
+ 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,@_);
- return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
- return 1 if ($x->{_e}->is_zero() && $x->{_m}->is_odd());
- return 0;
+ return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
+ ($x->{_e}->is_zero() && $x->{_m}->is_odd());
+ 0;
}
sub is_even
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't
- return 1 if $x->{_m}->is_zero(); # 0e1 is even
- return 1 if ($x->{_e}->is_zero() && $x->{_m}->is_even()); # 123.45 is never
- return 0;
+# return 1 if $x->{_m}->is_zero(); # 0e1 is even
+ return 1 if ($x->{_e}->{sign} eq '+' # 123.45 is never
+ && $x->{_m}->is_even()); # but 1200 is
+ 0;
}
sub bmul
$scale = $ly if $ly > $scale;
my $diff = $ly - $lx;
$scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx!
+
+ # make copy of $x in case of list context for later reminder calculation
+ my $rem;
+ if (wantarray && !$y->is_one())
+ {
+ $rem = $x->copy();
+ }
$x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+';
if (wantarray)
{
- my $rem;
if (!$y->is_one())
{
- $rem = $x->copy();
- $rem->bmod($y,$params[1],$params[2],$params[3]);
+ $rem->bmod($y,$params[1],$params[2],$params[3]); # copy already done
}
else
{
$x->blsft($shifty,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
{
$x->{_e}->bsub($shifty) if $shifty != 0;
# now mantissas are equalized, exponent of $x is adjusted, so calc result
+# $ym->{sign} = '-' if $neg; # bmod() will make the correction for us
+
$x->{_m}->bmod($ym);
$x->{sign} = '+' if $x->{_m}->is_zero(); # fix sign for -0
# disable then and later re-enable them
no strict 'refs';
my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
- $abr = "$self\::precision"; my $pb = $$abr; $$abr = undef;
+ my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
# we also need to disable any set A or P on $x (_find_round_parameters took
# them already into account), since these would interfere, too
delete $x->{_a}; delete $x->{_p};
+ # need to disable $upgrade in BigInt, to aoid deep recursion
+ local $Math::BigInt::upgrade = undef;
my $xas = $x->as_number();
my $gs = $xas->copy()->bsqrt(); # some guess
+
if (($x->{_e}->{sign} ne '-') # guess can't be accurate if there are
# digits after the dot
- && ($xas->bcmp($gs * $gs) == 0)) # guess hit the nail on the head?
+ && ($xas->bacmp($gs * $gs) == 0)) # guess hit the nail on the head?
{
# exact result
$x->{_m} = $gs; $x->{_e} = Math::BigInt->bzero(); $x->bnorm();
# clear a/p after round, since user did not request it
$x->{_a} = undef; $x->{_p} = undef;
}
+ ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb;
return $x;
}
$gs = $self->new( $gs ); # BigInt to BigFloat
my $lx = $x->{_m}->length();
$scale = $lx if $scale < $lx;
my $e = $self->new("1E-$scale"); # make test variable
- return $x->bnan() if $e->sign() eq 'NaN';
+# return $x->bnan() if $e->sign() eq 'NaN';
my $y = $x->copy();
my $two = $self->new(2);
$y = $self->new($y) unless $y->isa('Math::BigFloat');
my $rem;
-# my $steps = 0;
while ($diff >= $e)
{
-# return $x->bnan() if $gs->is_zero();
-
$rem = $y->copy()->bdiv($gs,$scale)->badd($gs)->bdiv($two,$scale);
$diff = $rem->copy()->bsub($gs)->babs();
$gs = $rem->copy();
-# $steps++;
}
-# print "steps $steps\n";
# copy over to modify $x
$x->{_m} = $rem->{_m}; $x->{_e} = $rem->{_e};
$x->{_a} = undef; $x->{_p} = undef;
}
# restore globals
- ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb;
+ $$abr = $ab; $$pbr = $pb;
$x;
}
+sub bfac
+ {
+ # (BINT or num_str, BINT or num_str) return BINT
+ # compute factorial numbers
+ # modifies first argument
+ my ($self,$x,@r) = objectify(1,@_);
+
+ return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
+ return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
+
+ return $x->bnan() if $x->{_e}->{sign} ne '+'; # digits after dot?
+
+ # use BigInt's bfac() for faster calc
+ $x->{_m}->blsft($x->{_e},10); # un-norm m
+ $x->{_e}->bzero(); # norm $x again
+ $x->{_m}->bfac(); # factorial
+ $x->bnorm();
+
+ #my $n = $x->copy();
+ #$x->bone();
+ #my $f = $self->new(2);
+ #while ($f->bacmp($n) < 0)
+ # {
+ # $x->bmul($f); $f->binc();
+ # }
+ #$x->bmul($f); # last step
+ $x->round(@r); # round
+ }
+
sub bpow
{
# (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
return $x->bzero() if $scale < $zad;
if ($scale == $zad) # for 0.006, scale -3 and trunc
{
- $scale = -$len-1;
+ $scale = -$len;
}
else
{
{
# 123 => 100 means length(123) = 3 - $scale (2) => 1
- # calculate digits before dot
- my $dbt = $x->{_m}->length(); $dbt += $x->{_e} if $x->{_e}->sign() eq '-';
- # if not enough digits before dot, round to zero
- return $x->bzero() if ($scale > $dbt) && ($dbt < 0);
- # scale always >= 0 here
- if ($dbt == 0)
- {
- # 0.49->bfround(1): scale == 1, dbt == 0: => 0.0
- # 0.51->bfround(0): scale == 0, dbt == 0: => 1.0
- # 0.5->bfround(0): scale == 0, dbt == 0: => 0
- # 0.05->bfround(0): scale == 0, dbt == 0: => 0
- # print "$scale $dbt $x->{_m}\n";
- $scale = -$x->{_m}->length();
- }
- elsif ($dbt > 0)
- {
- # correct by subtracting scale
- $scale = $dbt - $scale;
- }
+ my $dbt = $x->{_m}->length();
+ # digits before dot
+ my $dbd = $dbt + $x->{_e};
+ # should be the same, so treat it as this
+ $scale = 1 if $scale == 0;
+ # shortcut if already integer
+ return $x if $scale == 1 && $dbt <= $dbd;
+ # maximum digits before dot
+ ++$dbd;
+
+ if ($scale > $dbd)
+ {
+ # not enough digits before dot, so round to zero
+ return $x->bzero;
+ }
+ elsif ( $scale == $dbd )
+ {
+ # maximum
+ $scale = -$dbt;
+ }
else
- {
- $scale = $x->{_m}->length() - $scale;
- }
+ {
+ $scale = $dbd - $scale;
+ }
+
}
# print "using $scale for $x->{_m} with '$mode'\n";
# pass sign to bround for rounding modes '+inf' and '-inf'
sub AUTOLOAD
{
- # make fxxx and bxxx work
- # my $self = $_[0];
+ # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx()
+ # or falling back to MBI::bxxx()
my $name = $AUTOLOAD;
$name =~ s/.*:://; # split package
- #print "$name\n";
no strict 'refs';
if (!method_alias($name))
{
return &{'Math::BigInt'."::$name"}(@_);
}
my $bname = $name; $bname =~ s/^f/b/;
- *{$class."\:\:$name"} = \&$bname;
+ *{$class."::$name"} = \&$bname;
&$bname; # uses @_
}
sub import
{
my $self = shift;
- for ( my $i = 0; $i < @_ ; $i++ )
+ my $l = scalar @_; my $j = 0; my @a = @_;
+ for ( my $i = 0; $i < $l ; $i++, $j++)
{
if ( $_[$i] eq ':constant' )
{
# this rest causes overlord er load to step in
# print "overload @_\n";
overload::constant float => sub { $self->new(shift); };
- splice @_, $i, 1; last;
+ splice @a, $j, 1; $j--;
+ }
+ elsif ($_[$i] eq 'upgrade')
+ {
+ # this causes upgrading
+ $upgrade = $_[$i+1]; # or undef to disable
+ my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
+ splice @a, $j, $s; $j -= $s;
}
}
# any non :constant stuff is handled by our parent, Exporter
# even if @_ is empty, to give it a chance
- $self->SUPER::import(@_); # for subclasses
- $self->export_to_level(1,$self,@_); # need this, too
+ $self->SUPER::import(@a); # for subclasses
+ $self->export_to_level(1,$self,@a); # need this, too
}
sub bnorm
use Math::BigFloat;
- # Number creation
- $x = Math::BigInt->new($str); # defaults to 0
- $nan = Math::BigInt->bnan(); # create a NotANumber
- $zero = Math::BigInt->bzero();# create a "+0"
+ # Number creation
+ $x = Math::BigFloat->new($str); # defaults to 0
+ $nan = Math::BigFloat->bnan(); # create a NotANumber
+ $zero = Math::BigFloat->bzero(); # create a +0
+ $inf = Math::BigFloat->binf(); # create a +inf
+ $inf = Math::BigFloat->binf('-'); # create a -inf
+ $one = Math::BigFloat->bone(); # create a +1
+ $one = Math::BigFloat->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
$x->is_even(); # true if even, false for odd
$x->is_positive(); # true if >= 0
$x->is_negative(); # true if < 0
- $x->is_inf(sign) # true if +inf or -inf (sign default '+')
+ $x->is_inf(sign); # true if +inf, or -inf (default is '+')
+
$x->bcmp($y); # compare numbers (undef,<0,=0,>0)
$x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
$x->sign(); # return the sign, either +,- or NaN
+ $x->digit($n); # return the nth digit, counting from right
+ $x->digit(-$n); # return the nth digit, counting from left
# The following all modify their first argument:
-
+
# set
$x->bzero(); # set $i to 0
$x->bnan(); # set $i to NaN
+ $x->bone(); # set $x to +1
+ $x->bone('-'); # set $x to -1
+ $x->binf(); # set $x to inf
+ $x->binf('-'); # set $x to -inf
$x->bneg(); # negation
$x->babs(); # absolute value
$x->bior($y); # bit-wise inclusive or
$x->bxor($y); # bit-wise exclusive or
$x->bnot(); # bit-wise not (two's complement)
-
+
+ $x->bsqrt(); # calculate square-root
+ $x->bfac(); # factorial of $x (1*2*3*4*..$x)
+
$x->bround($N); # accuracy: preserver $N digits
$x->bfround($N); # precision: round to the $Nth digit
# The following do not modify their arguments:
-
bgcd(@values); # greatest common divisor
blcm(@values); # lowest common multiplicator
$x->bstr(); # return string
$x->bsstr(); # return string in scientific notation
-
+
+ $x->bfloor(); # return integer less or equal than $x
+ $x->bceil(); # return integer greater or equal than $x
+
$x->exponent(); # return exponent as BigInt
$x->mantissa(); # return mantissa as BigInt
$x->parts(); # return (mantissa,exponent) as BigInt
-#!/usr/bin/perl -w
-
# The following hash values are used:
# value: unsigned int with actual value (as a Math::BigInt::Calc or similiar)
# sign : +,-,NaN,+inf,-inf
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.49';
+$VERSION = '1.51';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify _swap bgcd blcm);
use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/;
+use vars qw/$upgrade $downgrade/;
use strict;
# Inside overload, the first arg is always an object. If the original code had
'|=' => sub { $_[0]->bior($_[1]); },
'**=' => sub { $_[0]->bpow($_[1]); },
+# not supported by Perl yet
'..' => \&_pointpoint,
'<=>' => sub { $_[2] ?
ref($_[0])->bcmp($_[0],$_[1])},
'cmp' => sub {
$_[2] ?
- $_[1] cmp $_[0]->bstr() :
- $_[0]->bstr() cmp $_[1] },
+ "$_[1]" cmp $_[0]->bstr() :
+ $_[0]->bstr() cmp "$_[1]" },
'log' => sub { $_[0]->copy()->blog(); },
'int' => sub { $_[0]->copy(); },
'neg' => sub { $_[0]->copy()->bneg(); },
'abs' => sub { $_[0]->copy()->babs(); },
+'sqrt' => sub { $_[0]->copy()->bsqrt(); },
'~' => sub { $_[0]->copy()->bnot(); },
'*' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmul($a[1]); },
# v5.6.1 dumps on that: return !$_[0]->is_zero() || undef; :-(
my $t = !$_[0]->is_zero();
undef $t if $t == 0;
- return $t;
+ $t;
},
# the original qw() does not work with the TIESCALAR below, why?
my $CALC = 'Math::BigInt::Calc'; # module to do low level math
my $IMPORT = 0; # did import() yet?
-sub _core_lib () { return $CALC; } # for test suite
$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
$accuracy = undef;
$precision = undef;
$div_scale = 40;
+$upgrade = undef; # default is no upgrade
+$downgrade = undef; # default is no downgrade
+
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
my $m = shift;
die "Unknown round mode $m"
if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
- ${"${class}::round_mode"} = $m; return $m;
+ return ${"${class}::round_mode"} = $m;
}
return ${"${class}::round_mode"};
}
+sub upgrade
+ {
+ no strict 'refs';
+ # make Class->round_mode() work
+ my $self = shift;
+ my $class = ref($self) || $self || __PACKAGE__;
+ if (defined $_[0])
+ {
+ my $u = shift;
+ return ${"${class}::upgrade"} = $u;
+ }
+ return ${"${class}::upgrade"};
+ }
+
sub div_scale
{
no strict 'refs';
{
# set global
${"${class}::accuracy"} = $a;
+ ${"${class}::precision"} = undef; # clear P
}
return $a; # shortcut
}
# $object->precision() or fallback to global
$x->bfround($p) if defined $p;
$x->{_p} = $p; # set/overwrite, even if not rounded
- $x->{_a} = undef; # clear P
+ $x->{_a} = undef; # clear A
}
else
{
# set global
${"${class}::precision"} = $p;
+ ${"${class}::accuracy"} = undef; # clear A
}
return $p; # shortcut
}
return ${"${class}::precision"};
}
+sub config
+ {
+ # return (later set?) configuration data as hash ref
+ my $class = shift || 'Math::BigInt';
+
+ no strict 'refs';
+ my $lib = $CALC;
+ my $cfg = {
+ lib => $lib,
+ lib_version => ${"${lib}::VERSION"},
+ class => $class,
+ };
+ foreach (
+ qw/upgrade downgrade precisison accuracy round_mode VERSION div_scale/)
+ {
+ $cfg->{lc($_)} = ${"${class}::$_"};
+ };
+ $cfg;
+ }
+
sub _scale_a
{
# select accuracy parameter based on precedence,
if ($diff < 0) # Not integer
{
#print "NOI 1\n";
+ return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
$self->{sign} = $nan;
}
else # diff >= 0
{
# fraction and negative/zero E => NOI
#print "NOI 2 \$\$mfv '$$mfv'\n";
+ return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
$self->{sign} = $nan;
}
elsif ($e < 0)
if ($$miv !~ s/0{$e}$//) # can strip so many zero's?
{
#print "NOI 3\n";
+ return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
$self->{sign} = $nan;
}
}
# do not round for new($x,undef,undef) since that is used by MBF to signal
# no rounding
$self->round($a,$p,$r) unless @_ == 4 && !defined $a && !defined $p;
+ # print "mbi new $self\n";
return $self;
}
# (numstr or BINT) return BINT
# Normalize number -- no-op here
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- return $x;
+ $x;
}
sub babs
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
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->{sign} =~ tr/+-/-+/ if !$x->is_zero(); # does nothing for NaN
$x;
}
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';
+ return +1;
}
# check sign for speed first
return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y
# $x->{sign} eq '-'
return -1 if $y->{sign} eq '+';
- return $CALC->_acmp($y->{value},$x->{value}); # swaped
-
- # &cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0;
+ $CALC->_acmp($y->{value},$x->{value}); # swaped (lib does only 0,1,-1)
}
sub bacmp
return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/;
return +1; # inf is always bigger
}
- $CALC->_acmp($x->{value},$y->{value}) <=> 0;
+ $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1
}
sub badd
my ($self,$x,$y,@r) = objectify(2,@_);
return $x if $x->modify('badd');
+# print "mbi badd ",join(' ',caller()),"\n";
+# print "upgrade => ",$upgrade||'undef',
+# " \$x (",ref($x),") \$y (",ref($y),")\n";
+# return $upgrade->badd($x,$y,@r) if defined $upgrade &&
+# ((ref($x) eq $upgrade) || (ref($y) eq $upgrade));
+# print "still badd\n";
$r[3] = $y; # no push!
# inf and NaN handling
# inf handline
if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
{
- # + and + => +, - and - => -, + and - => 0, - and + => 0
- return $x->bzero(@r) if $x->{sign} ne $y->{sign};
- return $x;
+ # +inf++inf or -inf+-inf => same, rest is NaN
+ return $x if $x->{sign} eq $y->{sign};
+ return $x->bnan();
}
# +-inf + something => +inf
# something +-inf => +-inf
return $x;
}
- # speed: no add for 0+y or x+0
- return $x->round(@r) if $y->is_zero(); # x+0
- if ($x->is_zero()) # 0+y
- {
- # make copy, clobbering up x
- $x->{value} = $CALC->_copy($y->{value});
- $x->{sign} = $y->{sign} || $nan;
- return $x->round(@r);
- }
-
my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs
if ($sx eq $sy)
{
# (BINT or num_str, BINT or num_str) return num_str
# subtract second arg from first, modify first
- my ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ my ($self,$x,$y,@r) = objectify(2,@_);
return $x if $x->modify('bsub');
-
- if (!$y->is_zero()) # don't need to do anything if $y is 0
- {
- $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
- $x->badd($y,$a,$p,$r); # badd does not leave internal zeros
- $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
+# return $upgrade->badd($x,$y,@r) if defined $upgrade &&
+# ((ref($x) eq $upgrade) || (ref($y) eq $upgrade));
+
+ if ($y->is_zero())
+ {
+ return $x->round(@r);
}
+
+ $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN
+ $x->badd($y,@r); # badd does not leave internal zeros
+ $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN)
$x; # already rounded by badd() or no round necc.
}
sub blog
{
# not implemented yet
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ return $upgrade->blog($x,$base,$a,$p,$r) if defined $upgrade;
+
return $x->bnan();
}
$x->bneg()->bdec(); # bdec already does round
}
+# is_foo test routines
+
sub is_zero
{
# return true if arg (BINT or num_str) is zero (array '+', '0')
0;
}
+sub is_int
+ {
+ # return true when arg (BINT or num_str) is an integer
+ # always true for BigInt, but different for Floats
+ # we don't need $self, so undef instead of ref($_[0]) make it slightly faster
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+ $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't
+ }
+
###############################################################################
sub bmul
$r[3] = $y; # no push here
return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
- # handle result = 0
- return $x->round(@r) if $x->is_zero();
- return $x->bzero()->round(@r) if $y->is_zero();
+
# inf handling
if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/))
{
+ return $x->bnan() if $x->is_zero() || $y->is_zero();
# result will always be +-inf:
# +inf * +/+inf => +inf, -inf * -/-inf => +inf
# +inf * -/-inf => -inf, -inf * +/+inf => -inf
$x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => +
- $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
- return $x->round(@r);
+ $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
+ $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
+ $x->round(@r);
}
sub _div_inf
if (($x->is_nan() || $y->is_nan()) ||
($x->is_zero() && $y->is_zero()));
- # +inf / +inf == -inf / -inf == 1, remainder is 0 (A / A = 1, remainder 0)
- if (($x->{sign} eq $y->{sign}) &&
- ($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
- {
- return wantarray ? ($x->bone(),$self->bzero()) : $x->bone();
- }
- # +inf / -inf == -inf / +inf == -1, remainder 0
- if (($x->{sign} ne $y->{sign}) &&
- ($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
+ # +-inf / +-inf == NaN, reminder also NaN
+ if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/))
{
- return wantarray ? ($x->bone('-'),$self->bzero()) : $x->bone('-');
+ return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan();
}
# x / +-inf => 0, remainder x (works even if x == 0)
if ($y->{sign} =~ /^[+-]inf$/)
return
wantarray ? ($x->round(@r),$self->bzero(@r)):$x->round(@r) if $x->is_zero();
- # Is $x in the interval [0, $y) ?
+ # Is $x in the interval [0, $y) (aka $x <= $y) ?
my $cmp = $CALC->_acmp($x->{value},$y->{value});
- if (($cmp < 0) and ($x->{sign} eq $y->{sign}))
+ if (($cmp < 0) and (($x->{sign} eq $y->{sign}) or !wantarray))
{
+ return $upgrade->bdiv($x,$y,@r) if defined $upgrade;
+
return $x->bzero()->round(@r) unless wantarray;
my $t = $x->copy(); # make copy first, because $x->bzero() clobbers $x
return ($x->bzero()->round(@r),$t);
{
# calc new sign and in case $y == +/- 1, return $x
$x->{value} = $CALC->_mod($x->{value},$y->{value});
- my $xsign = $x->{sign};
if (!$CALC->_is_zero($x->{value}))
{
+ my $xsign = $x->{sign};
$x->{sign} = $y->{sign};
$x = $y-$x if $xsign ne $y->{sign}; # one of them '-'
}
}
return $x->round(@r);
}
- $x = (&bdiv($self,$x,$y,@r))[1]; # slow way (also rounds)
+ my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds)
+ # modify in place
+ foreach (qw/value sign _a _p/)
+ {
+ $x->{$_} = $rem->{$_};
+ }
+ $x;
}
+sub bfac
+ {
+ # (BINT or num_str, BINT or num_str) return BINT
+ # compute factorial numbers
+ # modifies first argument
+ my ($self,$x,@r) = objectify(1,@_);
+
+ return $x if $x->modify('bfac');
+
+ return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN
+ return $x->bone(@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1
+
+ if ($CALC->can('_fac'))
+ {
+ $x->{value} = $CALC->_fac($x->{value});
+ return $x->round(@r);
+ }
+
+ my $n = $x->copy();
+ $x->bone();
+ my $f = $self->new(2);
+ while ($f->bacmp($n) < 0)
+ {
+ $x->bmul($f); $f->binc();
+ }
+ $x->bmul($f); # last step
+ $x->round(@r); # round
+ }
+
sub bpow
{
# (BINT or num_str, BINT or num_str) return BINT
{
# (BINT or num_str, BINT or num_str) return BINT
# compute x << y, base n, y >= 0
- my ($self,$x,$y,$n) = objectify(2,@_);
+ my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
return $x if $x->modify('blsft');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
+ return $x->round($a,$p,$r) if $y->is_zero();
$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 $CALC->can('_lsft');
if (defined $t)
{
- $x->{value} = $t; return $x;
+ $x->{value} = $t; return $x->round($a,$p,$r);
}
# fallback
- return $x->bmul( $self->bpow($n, $y) );
+ return $x->bmul( $self->bpow($n, $y, $a, $p, $r), $a, $p, $r );
}
sub brsft
{
# (BINT or num_str, BINT or num_str) return BINT
# compute x >> y, base n, y >= 0
- my ($self,$x,$y,$n) = objectify(2,@_);
+ my ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_);
return $x if $x->modify('brsft');
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
+ return $x->round($a,$p,$r) if $y->is_zero();
+ return $x->bzero($a,$p,$r) if $x->is_zero(); # 0 => 0
$n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-';
+ # this only works for negative numbers when shifting in base 2
+ if (($x->{sign} eq '-') && ($n == 2))
+ {
+ return $x->round($a,$p,$r) if $x->is_one('-'); # -1 => -1
+ if (!$y->is_one())
+ {
+ # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al
+ # but perhaps there is a better emulation for two's complement shift...
+ # if $y != 1, we must simulate it by doing:
+ # convert to bin, flip all bits, shift, and be done
+ $x->binc(); # -3 => -2
+ my $bin = $x->as_bin();
+ $bin =~ s/^-0b//; # strip '-0b' prefix
+ $bin =~ tr/10/01/; # flip bits
+ # now shift
+ if (length($bin) <= $y)
+ {
+ $bin = '0'; # shifting to far right creates -1
+ # 0, because later increment makes
+ # that 1, attached '-' makes it '-1'
+ # because -1 >> x == -1 !
+ }
+ else
+ {
+ $bin =~ s/.{$y}$//; # cut off at the right side
+ $bin = '1' . $bin; # extend left side by one dummy '1'
+ $bin =~ tr/10/01/; # flip bits back
+ }
+ my $res = $self->new('0b'.$bin); # add prefix and convert back
+ $res->binc(); # remember to increment
+ $x->{value} = $res->{value}; # take over value
+ return $x->round($a,$p,$r); # we are done now, magic, isn't?
+ }
+ $x->bdec(); # n == 2, but $y == 1: this fixes it
+ }
+
my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft');
if (defined $t)
{
- $x->{value} = $t; return $x;
+ $x->{value} = $t;
+ return $x->round($a,$p,$r);
}
# fallback
- return scalar bdiv($x, $self->bpow($n, $y));
+ $x->bdiv($self->bpow($n,$y, $a,$p,$r), $a,$p,$r);
+ $x;
}
sub band
return $x if $x->modify('band');
+ local $Math::BigInt::upgrade = undef;
+
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
return $x->bzero() if $y->is_zero() || $x->is_zero();
return $x->round($a,$p,$r);
}
- my $m = Math::BigInt->bone(); my ($xr,$yr);
- my $x10000 = new Math::BigInt (0x1000);
+ my $m = $self->bone(); my ($xr,$yr);
+ my $x10000 = $self->new (0x1000);
my $y1 = copy(ref($x),$y); # make copy
$y1->babs(); # and positive
my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
return $x if $x->modify('bior');
+ local $Math::BigInt::upgrade = undef;
+
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
return $x if $y->is_zero();
return $x->round($a,$p,$r);
}
- my $m = Math::BigInt->bone(); my ($xr,$yr);
- my $x10000 = Math::BigInt->new(0x10000);
+ my $m = $self->bone(); my ($xr,$yr);
+ my $x10000 = $self->new(0x10000);
my $y1 = copy(ref($x),$y); # make copy
$y1->babs(); # and positive
my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
return $x if $x->modify('bxor');
+ local $Math::BigInt::upgrade = undef;
+
return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/);
return $x if $y->is_zero();
}
my $m = $self->bone(); my ($xr,$yr);
- my $x10000 = Math::BigInt->new(0x10000);
+ my $x10000 = $self->new(0x10000);
my $y1 = copy(ref($x),$y); # make copy
$y1->babs(); # and positive
my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place!
{
my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ return $x if $x->modify('bsqrt');
+
return $x->bnan() if $x->{sign} ne '+'; # -x or inf or NaN => NaN
return $x->bzero($a,$p) if $x->is_zero(); # 0 => 0
return $x->round($a,$p,$r) if $x->is_one(); # 1 => 1
- return $x->bone($a,$p) if $x < 4; # 2,3 => 1
+
+ return $upgrade->bsqrt($x,$a,$p,$r) if defined $upgrade;
if ($CALC->can('_sqrt'))
{
return $x->round($a,$p,$r);
}
+ return $x->bone($a,$p) if $x < 4; # 2,3 => 1
my $y = $x->copy();
my $l = int($x->length()/2);
$x /= $two;
}
$x-- if $x * $x > $y; # overshot?
- return $x->round($a,$p,$r);
+ $x->round($a,$p,$r);
}
sub exponent
my $x = shift; $x = $class->new($x) unless ref $x;
my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
return $x if !defined $scale; # no-op
+ return $x if $x->modify('bfround');
# no-op for BigInts if $n <= 0
if ($scale <= 0)
my $x = shift; $x = $class->new($x) unless ref $x;
my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_);
return $x if !defined $scale; # no-op
+ return $x if $x->modify('bround');
if ($x->is_zero() || $scale == 0)
{
overload::constant integer => sub { $self->new(shift) };
splice @a, $j, 1; $j --;
}
+ elsif ($_[$i] eq 'upgrade')
+ {
+ # this causes upgrading
+ $upgrade = $_[$i+1]; # or undef to disable
+ my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
+ splice @a, $j, $s; $j -= $s;
+ }
elsif ($_[$i] =~ /^lib$/i)
{
# this causes a different low lib to take care...
$CALC = $_[$i+1] || '';
- my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
+ my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..."
splice @a, $j, $s; $j -= $s;
}
}
$x->is_positive(); # true if >= 0
$x->is_negative(); # true if < 0
$x->is_inf(sign); # true if +inf, or -inf (sign is default '+')
+ $x->is_int(); # true if $x is an integer (not a float)
$x->bcmp($y); # compare numbers (undef,<0,=0,>0)
$x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
$x->bnan(); # set $x to NaN
$x->bone(); # set $x to +1
$x->bone('-'); # set $x to -1
+ $x->binf(); # set $x to inf
+ $x->binf('-'); # set $x to -inf
$x->bneg(); # negation
$x->babs(); # absolute value
$x->bnot(); # bitwise not (two's complement)
$x->bsqrt(); # calculate square-root
+ $x->bfac(); # factorial of $x (1*2*3*4*..$x)
$x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
$x->bround($N); # accuracy: preserve $N digits
=back
+=head1 METHODS
+
+Each of the methods below accepts three additional parameters. These arguments
+$A, $P and $R are accuracy, precision and round_mode. Please see more in the
+section about ACCURACY and ROUNDIND.
+
+=head2 brsft
+
+ $x->brsft($y,$n);
+
+Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and
+2, but others work, too.
+
+Right shifting usually amounts to dividing $x by $n ** $y and truncating the
+result:
+
+
+ $x = Math::BigInt->new(10);
+ $x->brsft(1); # same as $x >> 1: 5
+ $x = Math::BigInt->new(1234);
+ $x->brsft(2,10); # result 12
+
+There is one exception, and that is base 2 with negative $x:
+
+
+ $x = Math::BigInt->new(-5);
+ print $x->brsft(1);
+
+This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the
+result).
+
+=head2 new
+
+ $x = Math::BigInt->new($str,$A,$P,$R);
+
+Creates a new BigInt object from a string or another BigInt object. The
+input is accepted as decimal, hex (with leading '0x') or binary (with leading
+'0b').
+
+=head2 bnan
+
+ $x = Math::BigInt->bnan();
+
+Creates a new BigInt object representing NaN (Not A Number).
+If used on an object, it will set it to NaN:
+
+ $x->bnan();
+
+=head2 bzero
+
+ $x = Math::BigInt->bzero();
+
+Creates a new BigInt object representing zero.
+If used on an object, it will set it to zero:
+
+ $x->bzero();
+
+=head2 binf
+
+ $x = Math::BigInt->binf($sign);
+
+Creates a new BigInt object representing infinity. The optional argument is
+either '-' or '+', indicating whether you want infinity or minus infinity.
+If used on an object, it will set it to infinity:
+
+ $x->binf();
+ $x->binf('-');
+
+=head2 bone
+
+ $x = Math::BigInt->binf($sign);
+
+Creates a new BigInt object representing one. The optional argument is
+either '-' or '+', indicating whether you want one or minus one.
+If used on an object, it will set it to one:
+
+ $x->bone(); # +1
+ $x->bone('-'); # -1
+
+=head2 is_one()/is_zero()/is_nan()/is_positive()/is_negative()/is_inf()/is_odd()/is_even()/is_int()
+
+ $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
+ $x->is_even(); # true if even, false for odd
+ $x->is_positive(); # true if >= 0
+ $x->is_negative(); # true if < 0
+ $x->is_inf(); # true if +inf
+ $x->is_inf('-'); # true if -inf (sign is default '+')
+ $x->is_int(); # true if $x is an integer
+
+These methods all test the BigInt for one condition and return true or false
+depending on the input.
+
+=head2 bcmp
+
+ $x->bcmp($y); # compare numbers (undef,<0,=0,>0)
+
+=head2 bacmp
+
+ $x->bacmp($y); # compare absolutely (undef,<0,=0,>0)
+
+=head2 sign
+
+ $x->sign(); # return the sign, either +,- or NaN
+
+=head2 bcmp
+
+ $x->digit($n); # return the nth digit, counting from right
+
+=head2 bneg
+
+ $x->bneg();
+
+Negate the number, e.g. change the sign between '+' and '-', or between '+inf'
+and '-inf', respectively. Does nothing for NaN or zero.
+
+=head2 babs
+
+ $x->babs();
+
+Set the number to it's absolute value, e.g. change the sign from '-' to '+'
+and from '-inf' to '+inf', respectively. Does nothing for NaN or positive
+numbers.
+
+=head2 bnorm
+
+ $x->bnorm(); # normalize (no-op)
+
+=head2 bnot
+
+ $x->bnot(); # two's complement (bit wise not)
+
+=head2 binc
+
+ $x->binc(); # increment x by 1
+
+=head2 bdec
+
+ $x->bdec(); # decrement x by 1
+
+=head2 badd
+
+ $x->badd($y); # addition (add $y to $x)
+
+=head2 bsub
+
+ $x->bsub($y); # subtraction (subtract $y from $x)
+
+=head2 bmul
+
+ $x->bmul($y); # multiplication (multiply $x by $y)
+
+=head2 bdiv
+
+ $x->bdiv($y); # divide, set $x to quotient
+ # return (quo,rem) or quo if scalar
+
+=head2 bmod
+
+ $x->bmod($y); # modulus (x % y)
+
+=head2 bpow
+
+ $x->bpow($y); # power of arguments (x ** y)
+
+=head2 blsft
+
+ $x->blsft($y); # left shift
+ $x->blsft($y,$n); # left shift, by base $n (like 10)
+
+=head2 brsft
+
+ $x->brsft($y); # right shift
+ $x->brsft($y,$n); # right shift, by base $n (like 10)
+
+=head2 band
+
+ $x->band($y); # bitwise and
+
+=head2 bior
+
+ $x->bior($y); # bitwise inclusive or
+
+=head2 bxor
+
+ $x->bxor($y); # bitwise exclusive or
+
+=head2 bnot
+
+ $x->bnot(); # bitwise not (two's complement)
+
+=head2 bsqrt
+
+ $x->bsqrt(); # calculate square-root
+
+=head2 bfac
+
+ $x->bfac(); # factorial of $x (1*2*3*4*..$x)
+
+=head2 round
+
+ $x->round($A,$P,$round_mode); # round to accuracy or precision using mode $r
+
+=head2 bround
+
+ $x->bround($N); # accuracy: preserve $N digits
+
+=head2 bfround
+
+ $x->bfround($N); # round to $Nth digit, no-op for BigInts
+
+=head2 bfloor
+
+ $x->bfloor();
+
+Set $x to the integer less or equal than $x. This is a no-op in BigInt, but
+does change $x in BigFloat.
+
+=head2 bceil
+
+ $x->bceil();
+
+Set $x to the integer greater or equal than $x. This is a no-op in BigInt, but
+does change $x in BigFloat.
+
+=head2 bgcd
+
+ bgcd(@values); # greatest common divisor (no OO style)
+
+=head2 blcm
+
+ blcm(@values); # lowest common multiplicator (no OO style)
+
+head2 length
+
+ $x->length();
+ ($xl,$fl) = $x->length();
+
+Returns the number of digits in the decimal representation of the number.
+In list context, returns the length of the integer and fraction part. For
+BigInt's, the length of the fraction part will always be 0.
+
+=head2 exponent
+
+ $x->exponent();
+
+Return the exponent of $x as BigInt.
+
+=head2 mantissa
+
+ $x->mantissa();
+
+Return the signed mantissa of $x as BigInt.
+
+=head2 parts
+
+ $x->parts(); # return (mantissa,exponent) as BigInt
+
+=head2 copy
+
+ $x->copy(); # make a true copy of $x (unlike $y = $x;)
+
+=head2 as_number
+
+ $x->as_number(); # return as BigInt (in BigInt: same as copy())
+
+=head2 bsrt
+
+ $x->bstr(); # normalized string
+
+=head2 bsstr
+
+ $x->bsstr(); # normalized string in scientific notation
+
+=head2 as_hex
+
+ $x->as_hex(); # as signed hexadecimal string with prefixed 0x
+
+=head2 as_bin
+
+ $x->as_bin(); # as signed binary string with prefixed 0b
+
=head1 ACCURACY and PRECISION
Since version v1.33, Math::BigInt and Math::BigFloat have full support for
=item Setting/Accessing
- * You can set the A global via $Math::BigInt::accuracy or
- $Math::BigFloat::accuracy or whatever class you are using.
- * You can also set P globally by using $Math::SomeClass::precision likewise.
+ * You can set the A global via Math::BigInt->accuracy() or
+ Math::BigFloat->accuracy() or whatever class you are using.
+ * You can also set P globally by using Math::SomeClass->precision() likewise.
* Globals are classwide, and not inherited by subclasses.
- * to undefine A, use $Math::SomeCLass::accuracy = undef
- * to undefine P, use $Math::SomeClass::precision = undef
+ * to undefine A, use Math::SomeCLass->accuracy(undef);
+ * to undefine P, use Math::SomeClass->precision(undef);
+ * Setting Math::SomeClass->accuracy() clears automatically
+ Math::SomeClass->precision(), and vice versa.
* To be valid, A must be > 0, P can have any value.
* If P is negative, this means round to the P'th place to the right of the
decimal point; positive values mean to the left of the decimal point.
P of 0 means round to integer.
- * to find out the current global A, take $Math::SomeClass::accuracy
- * use $x->accuracy() for the local setting of $x.
- * to find out the current global P, take $Math::SomeClass::precision
- * use $x->precision() for the local setting
+ * to find out the current global A, take Math::SomeClass->accuracy()
+ * to find out the current global P, take Math::SomeClass->precision()
+ * use $x->accuracy() respective $x->precision() for the local setting of $x.
+ * Please note that $x->accuracy() respecive $x->precision() fall back to the
+ defined globals, when $x's A or P is not set.
=item Creating numbers
- !* When you create a number, there should be a way to define its A & P
- * When a number without specific A or P is created, but the globals are
- defined, these should be used to round the number immediately and also
- stored locally with the number. Thus changing the global defaults later on
+ * When you create a number, you can give it's desired A or P via:
+ $x = Math::BigInt->new($number,$A,$P);
+ * Only one of A or P can be defined, otherwise the result is NaN
+ * If no A or P is give ($x = Math::BigInt->new($number) form), then the
+ globals (if set) will be used. Thus changing the global defaults later on
will not change the A or P of previously created numbers (i.e., A and P of
- $x will be what was in effect when $x was created)
+ $x will be what was in effect when $x was created)
+ * If given undef for A and P, B<no> rounding will occur, and the globals will
+ B<not> be used. This is used by subclasses to create numbers without
+ suffering rounding in the parent. Thus a subclass is able to have it's own
+ globals enforced upon creation of a number by using
+ $x = Math::BigInt->new($number,undef,undef):
+
+ use Math::Bigint::SomeSubclass;
+ use Math::BigInt;
+
+ Math::BigInt->accuracy(2);
+ Math::BigInt::SomeSubClass->accuracy(3);
+ $x = Math::BigInt::SomeSubClass->new(1234);
+
+ $x is now 1230, and not 1200. A subclass might choose to implement
+ this otherwise, e.g. falling back to the parent's A and P.
=item Usage
Since you can set/get both A and P, there is a rule that will practically
enforce only A or P to be in effect at a time, even if both are set.
This is called precedence.
- !* If two objects are involved in an operation, and one of them has A in
- ! effect, and the other P, this should result in a warning or an error,
- ! probably in NaN.
+ * If two objects are involved in an operation, and one of them has A in
+ effect, and the other P, this results in an error (NaN).
* A takes precendence over P (Hint: A comes before P). If A is defined, it
is used, otherwise P is used. If neither of them is defined, nothing is
used, i.e. the result will have as many digits as it can (with an
the value of F, the higher value will be used instead of F.
This is to limit the digits (A) of the result (just consider what would
happen with unlimited A and P in the case of 1/3 :-)
- * fdiv will calculate 1 more digit than required (determined by
+ * fdiv will calculate (at least) 4 more digits than required (determined by
A, P or F), and, if F is not used, round the result
(this will still fail in the case of a result like 0.12345000000001 with A
or P of 5, but this can not be helped - or can it?)
* you will be able to give A, P and R as an argument to all the calculation
routines; the second parameter is A, the third one is P, and the fourth is
- R (shift place by one for binary operations like add). P is used only if
+ R (shift right by one for binary operations like badd). P is used only if
the first parameter (A) is undefined. These three parameters override the
globals in the order detailed as follows, i.e. the first defined value
wins:
+ parameter A
+ parameter P
+ local A (if defined on both of the operands: smaller one is taken)
- + local P (if defined on both of the operands: smaller one is taken)
+ + local P (if defined on both of the operands: bigger one is taken)
+ global A
+ global P
+ global F
* You can set A and P locally by using $x->accuracy() and $x->precision()
and thus force different A and P for different objects/numbers.
* Setting A or P this way immediately rounds $x to the new value.
+ * $x->accuracy() clears $x->precision(), and vice versa.
=item Rounding
use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
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.
+(usually 1e5 or 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.
=head2 SIGN
For more benchmark results see L<http://bloodgate.com/perl/benchmarks.html>.
+=head2 SUBCLASSING
+
+=head1 Subclassing Math::BigInt
+
+The basic design of Math::BigInt allows simple subclasses with very little
+work, as long as a few simple rules are followed:
+
+=over 2
+
+=item *
+
+The public API must remain consistent, i.e. if a sub-class is overloading
+addition, the sub-class must use the same name, in this case badd(). The
+reason for this is that Math::BigInt is optimized to call the object methods
+directly.
+
+=item *
+
+The private object hash keys like C<$x->{sign}> may not be changed, but
+additional keys can be added, like C<$x->{_custom}>.
+
+=item *
+
+Accessor functions are available for all existing object hash keys and should
+be used instead of directly accessing the internal hash keys. The reason for
+this is that Math::BigInt itself has a pluggable interface which permits it
+to support different storage methods.
+
+=back
+
+More complex sub-classes may have to replicate more of the logic internal of
+Math::BigInt if they need to change more basic behaviors. A subclass that
+needs to merely change the output only needs to overload C<bstr()>.
+
+All other object methods and overloaded functions can be directly inherited
+from the parent class.
+
+At the very minimum, any subclass will need to provide it's own C<new()> and can
+store additional hash keys in the object. There are also some package globals
+that must be defined, e.g.:
+
+ # Globals
+ $accuracy = undef;
+ $precision = -2; # round to 2 decimal places
+ $round_mode = 'even';
+ $div_scale = 40;
+
+Additionally, you might want to provide the following two globals to allow
+auto-upgrading and auto-downgrading to work correctly:
+
+ $upgrade = undef;
+ $downgrade = undef;
+
+This allows Math::BigInt to correctly retrieve package globals from the
+subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or
+t/Math/BigFloat/SubClass.pm completely functional subclass examples.
+
+Don't forget to
+
+ use overload;
+
+in your subclass to automatically inherit the overloading from the parent. If
+you like, you can change part of the overloading, look at Math::String for an
+example.
+
+=head1 UPGRADING
+
+When used like this:
+
+ use Math::BigInt upgrade => 'Foo::Bar';
+
+certain operations will 'upgrade' their calculation and thus the result to
+the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat:
+
+ use Math::BigInt upgrade => 'Math::BigFloat';
+
+As a shortcut, you can use the module C<bignum>:
+
+ use bignum;
+
+Also good for oneliners:
+
+ perl -Mbignum -le 'print 2 ** 255'
+
+This makes it possible to mix arguments of different classes (as in 2.5 + 2)
+as well es preserve accuracy (as in sqrt(3)).
+
+Beware: This feature is not fully implemented yet.
+
+=head2 Auto-upgrade
+
+The following methods upgrade themselves unconditionally; that is if upgrade
+is in effect, they will always hand up their work:
+
+=over 2
+
+=item bsqrt()
+
+=item div()
+
+=item blog()
+
+=back
+
+Beware: This list is not complete.
+
+All other methods upgrade themselves only when one (or all) of their
+arguments are of the class mentioned in $upgrade (This might change in later
+versions to a more sophisticated scheme):
+
=head1 BUGS
=over 2
This section also applies to other overloaded math packages, like Math::String.
+One solution to you problem might be L<autoupgrading|upgrading>.
+
=item bsqrt()
C<bsqrt()> works only good if the result is a big integer, e.g. the square
print $x->bsqrt(),"\n"; # 3.46
print $x->bsqrt(3),"\n"; # 3.464
+=item brsft()
+
+For negative numbers in base see also L<brsft|brsft>.
+
=back
=head1 LICENSE
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.20';
+$VERSION = '0.22';
# Package to store unsigned big integers in decimal and do math with them
# This routine clobbers up array x, but not y.
my ($c,$x,$y) = @_;
+
+ return $x if (@$y == 1) && $y->[0] == 0; # $x + 0 => $x
+ if ((@$x == 1) && $x->[0] == 0) # 0 + $y => $y->copy
+ {
+ # twice as slow as $x = [ @$y ], but necc. to retain $x as ref :(
+ @$x = @$y; return $x;
+ }
# 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
# modifies first arg, second need not be different from first
my ($c,$xv,$yv) = @_;
- # shortcut for two very short numbers
- # +0 since part maybe string '00001' from new()
+ # shortcut for two very short numbers (improved by Nathan Zook)
# works also if xv and yv are the same reference
- if ((@$xv == 1) && (@$yv == 1)
- && (length($xv->[0]+0) <= $BASE_LEN2)
- && (length($yv->[0]+0) <= $BASE_LEN2))
- {
- $xv->[0] *= $yv->[0];
- return $xv;
- }
-
+ if ((@$xv == 1) && (@$yv == 1))
+ {
+ if (($xv->[0] *= $yv->[0]) >= $MBASE)
+ {
+ $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $MBASE;
+ };
+ return $xv;
+ }
+ # shortcut for result == 0
+ if ( ((@$xv == 1) && ($xv->[0] == 0)) ||
+ ((@$yv == 1) && ($yv->[0] == 0)) )
+ {
+ @$xv = (0);
+ return $xv;
+ }
+
# since multiplying $x with $x fails, make copy in this case
$yv = [@$xv] if "$xv" eq "$yv"; # same references?
if ($LEN_CONVERT != 0)
# modifies first arg, second need not be different from first
my ($c,$xv,$yv) = @_;
- # shortcut for two very short numbers
- # +0 since part maybe string '00001' from new()
+ # shortcut for two very short numbers (improved by Nathan Zook)
# works also if xv and yv are the same reference
- if ((@$xv == 1) && (@$yv == 1)
- && (length($xv->[0]+0) <= $BASE_LEN2)
- && (length($yv->[0]+0) <= $BASE_LEN2))
- {
- $xv->[0] *= $yv->[0];
- return $xv;
- }
+ if ((@$xv == 1) && (@$yv == 1))
+ {
+ if (($xv->[0] *= $yv->[0]) >= $MBASE)
+ {
+ $xv->[0] =
+ $xv->[0] - ($xv->[1] = int($xv->[0] / $MBASE)) * $MBASE;
+ };
+ return $xv;
+ }
+ # shortcut for result == 0
+ if ( ((@$xv == 1) && ($xv->[0] == 0)) ||
+ ((@$yv == 1) && ($yv->[0] == 0)) )
+ {
+ @$xv = (0);
+ return $xv;
+ }
+
# since multiplying $x with $x fails, make copy in this case
$yv = [@$xv] if "$xv" eq "$yv"; # same references?
$cx;
}
-sub _sqrt1
+sub _fac
+ {
+ # factorial of $x
+ # ref to array, return ref to array
+ my ($c,$cx) = @_;
+
+ if ((@$cx == 1) && ($cx->[0] <= 2))
+ {
+ $cx->[0] = 1 * ($cx->[0]||1); # 0,1 => 1, 2 => 2
+ return $cx;
+ }
+
+ # go forward until $base is exceeded
+ # limit is either $x or $base (x == 100 means as result too high)
+ my $steps = 100; $steps = $cx->[0] if @$cx == 1;
+ my $r = 2; my $cf = 3; my $step = 1; my $last = $r;
+ while ($r < $BASE && $step < $steps)
+ {
+ $last = $r; $r *= $cf++; $step++;
+ }
+ if ((@$cx == 1) && ($step == $cx->[0]))
+ {
+ # completely done
+ $cx = [$last];
+ return $cx;
+ }
+ my $n = _copy($c,$cx);
+ $cx = [$last];
+
+ #$cx = _one();
+ while (!(@$n == 1 && $n->[0] == $step))
+ {
+ _mul($c,$cx,$n); _dec($c,$n);
+ }
+ $cx;
+ }
+
+use constant DEBUG => 0;
+
+my $steps = 0;
+
+sub steps { $steps };
+
+sub _sqrt
{
# square-root of $x
# ref to array, return ref to array
return $x;
}
my $y = _copy($c,$x);
- my $l = _len($c,$x) / 2; # hopefully _len/2 is < $BASE
- # my $l2 = [ _len($c,$x) / 2 ]; # old way: hopefully _len/2 is < $BASE
-
- splice @$x,0; $x->[0] = 1; # keep ref($x), but modify it
-
- # old way
- # _lsft($c,$x,$l2,10);
+ # hopefully _len/2 is < $BASE, the -1 is to always undershot the guess
+ # since our guess will "grow"
+ my $l = int((_len($c,$x)-1) / 2);
+
+ my $lastelem = $x->[-1]; # for guess
+ my $elems = scalar @$x - 1;
+ # not enough digits, but could have more?
+ if ((length($lastelem) <= 3) && ($elems > 1))
+ {
+ # right-align with zero pad
+ my $len = length($lastelem) & 1;
+ print "$lastelem => " if DEBUG;
+ $lastelem .= substr($x->[-2] . '0' x $BASE_LEN,0,$BASE_LEN);
+ # former odd => make odd again, or former even to even again
+ $lastelem = $lastelem / 10 if (length($lastelem) & 1) != $len;
+ print "$lastelem\n" if DEBUG;
+ }
# construct $x (instead of _lsft($c,$x,$l,10)
my $r = $l % $BASE_LEN; # 10000 00000 00000 00000 ($BASE_LEN=5)
$l = int($l / $BASE_LEN);
- $x->[$l--] = int('1' . '0' x $r);
- $x->[$l--] = 0 while ($l >= 0);
+ print "l = $l " if DEBUG;
+
+ splice @$x,$l; # keep ref($x), but modify it
+
+ # we make the first part of the guess not '1000...0' but int(sqrt($lastelem))
+ # that gives us:
+ # 14400 00000 => sqrt(14400) => 120
+ # 144000 000000 => sqrt(144000) => 379
+
+ # $x->[$l--] = int('1' . '0' x $r); # old way of guessing
+ print "$lastelem (elems $elems) => " if DEBUG;
+ $lastelem = $lastelem / 10 if ($elems & 1 == 1); # odd or even?
+ my $g = sqrt($lastelem); $g =~ s/\.//; # 2.345 => 2345
+ $r -= 1 if $elems & 1 == 0; # 70 => 7
+
+ # padd with zeros if result is too short
+ $x->[$l--] = int(substr($g . '0' x $r,0,$r+1));
+ print "now ",$x->[-1] if DEBUG;
+ print " would have been ", int('1' . '0' x $r),"\n" if DEBUG;
+
+ # If @$x > 1, we could compute the second elem of the guess, too, to create
+ # an even better guess. Not implemented yet.
+ $x->[$l--] = 0 while ($l >= 0); # all other digits of guess are zero
+ print "start x= ",${_str($c,$x)},"\n" if DEBUG;
my $two = _two();
my $last = _zero();
my $lastlast = _zero();
+ $steps = 0 if DEBUG;
while (_acmp($c,$last,$x) != 0 && _acmp($c,$lastlast,$x) != 0)
{
+ $steps++ if DEBUG;
$lastlast = _copy($c,$last);
$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 "\nsteps in sqrt: $steps, " if DEBUG;
_dec($c,$x) if _acmp($c,$y,_mul($c,_copy($c,$x),$x)) < 0; # overshot?
+ print " final ",$x->[-1],"\n" if DEBUG;
$x;
}
_mod(obj,obj) Return remainder of div of the 1st by the 2nd object
_sqrt(obj) return the square root of object (truncate 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
_gcd(obj,obj) return Greatest Common Divisor of two objects
--- /dev/null
+#!/usr/bin/perl -w
+
+use Test;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/bare_mbf.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../t/lib);
+ }
+ unshift @INC, '../lib';
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ plan tests => 1585;
+ }
+
+use Math::BigInt lib => 'BareCalc';
+use Math::BigFloat;
+
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
+$class = "Math::BigFloat";
+$CL = "Math::BigInt::BareCalc";
+
+require 'bigfltpm.inc'; # all tests here for sharing
}
print "# INC = @INC\n";
- plan tests => 2005;
+ plan tests => 2095;
}
use Math::BigInt lib => 'BareCalc';
-print "# ",Math::BigInt::_core_lib(),"\n";
+print "# ",Math::BigInt->config()->{lib},"\n";
use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigInt";
$CL = "Math::BigInt::BareCalc";
-my $version = '1.49'; # for $VERSION tests, match current release (by hand!)
+my $version = '1.51'; # for $VERSION tests, match current release (by hand!)
require 'bigintpm.inc'; # perform same tests as bigintpm
#include this file into another test for subclass testing...
+
+ok ($class->config()->{lib},$CL);
+
while (<DATA>)
{
chop;
$try .= "\$x->numify();";
} elsif ($f eq "length") {
$try .= "\$x->length();";
- # some unary ops (test the bxxx form, since that is done by AUTOLOAD)
+ # some unary ops (test the fxxx form, since that is done by AUTOLOAD)
} elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) {
$try .= "\$x->f$1();";
# some is_xxx test function
- } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan)$/) {
+ } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) {
$try .= "\$x->$f();";
} elsif ($f eq "as_number") {
$try .= '$x->as_number();';
$try .= "$setup; \$x->ffround($args[1]);";
} elsif ($f eq "fsqrt") {
$try .= "$setup; \$x->fsqrt();";
+ } elsif ($f eq "flog") {
+ $try .= "$setup; \$x->flog();";
+ } elsif ($f eq "ffac") {
+ $try .= "$setup; \$x->ffac();";
}
else
{
$try .= "\$y = new $class \"$args[1]\";";
if ($f eq "fcmp") {
$try .= '$x <=> $y;';
- } elsif ($f eq "flog") {
- $try .= '$x->flog($y);';
} elsif ($f eq "facmp") {
$try .= '$x->facmp($y);';
} elsif ($f eq "fpow") {
$try .= '$x * $y;';
} elsif ($f eq "fdiv") {
$try .= "$setup; \$x / \$y;";
+ } elsif ($f eq "fdiv-list") {
+ $try .= "$setup; join(',',\$x->fdiv(\$y));";
} elsif ($f eq "frsft") {
$try .= '$x >> $y;';
} elsif ($f eq "flsft") {
ok ($y,1200); ok ($x,1200);
###############################################################################
-# fdiv() in list context
-
-$x = $class->bzero(); ($x,$y) = $x->fdiv(0);
-ok ($x,'NaN'); ok ($y,'NaN');
-
-# fdiv() in list context
-$x = $class->bzero(); ($x,$y) = $x->fdiv(1);
-ok ($x,0); ok ($y,0);
+# 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});
$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');
+${${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');
}
__DATA__
-#&flog
-#$div_scale = 14;
-#10:0:2.30258509299405
+$div_scale = 40;
+&flog
+0:NaN
+-1:NaN
+-2:NaN
+1:0
+# this is too slow for the testsuite
+#2.718281828:0.9999999998311266953289851340574956564911
+#$div_scale = 20;
+#2.718281828:0.99999999983112669533
+1:0
+# too slow, too (or hangs?)
+#123:4.8112184355
+# $div_scale = 14;
+#10:0:2.302585092994
#1000:0:6.90775527898214
#100:0:4.60517018598809
#2:0:0.693147180559945
#3.1415:0:1.14470039286086
#12345:0:9.42100640177928
#0.001:0:-6.90775527898214
-## reset for further tests
-#$div_scale = 40;
+# reset for further tests
+$div_scale = 40;
&frsft
-#NaNfrsft:NaN
+NaNfrsft:2:NaN
0:2:0
1:1:0.5
2:1:1
123:1:61.5
32:3:4
&flsft
-#NaNflsft:NaN
+NaNflsft:0:NaN
2:1:4
4:3:32
5:3:40
+99999999999:+9:899999999991
6:120:720
10:10000:100000
+&fdiv-list
+0:0:NaN,NaN
+0:1:0,0
+9:4:2.25,1
+9:5:1.8,4
&fdiv
$div_scale = 40; $round_mode = 'even'
abc:abc:NaN
-inf:-5:0
5:5:0
-5:-5:0
-inf:inf:0
--inf:-inf:0
--inf:inf:0
-inf:-inf:0
+inf:inf:NaN
+-inf:-inf:NaN
+-inf:inf:NaN
+inf:-inf:NaN
8:0:8
inf:0:inf
# exceptions to reminder rule
1230:2.5:0
123.4:2.5:0.9
123e1:25:5
+&ffac
+Nanfac:NaN
+-1:NaN
+0:1
+1:1
+2:2
+3:6
+4:24
+5:120
+6:720
+10:3628800
+11:39916800
+12:479001600
&fsqrt
+0:0
-1:NaN
# sqrt(1.44) = 1.2, sqrt(e10) = e5 => 12e4
1.44E10:120000
2e10:141421.356237309504880168872420969807857
+144e20:120000000000
# proved to be an endless loop under 7-9
12:3.464101615137754587054892683011744733886
&is_nan
123.45:0
-123.45:0
2:0
+&is_int
+NaNis_int:0
+0:1
+1:1
+2:1
+-2:1
+-1:1
+-inf:0
++inf:0
+123.4567:0
+-0.1:0
+-0.002:0
&is_even
abc:0
0:1
-inf:0
123.456:0
-123.456:0
+0.01:0
+-0.01:0
+120:1
+1200:1
+-1200:1
&is_positive
0:1
1:1
}
print "# INC = @INC\n";
- plan tests => 1528;
+ plan tests => 1585;
}
use Math::BigInt;
use Math::BigFloat;
-use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup);
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigFloat";
+$CL = "Math::BigInt::Calc";
require 'bigfltpm.inc'; # all tests here for sharing
{
my $additional = 0;
$additional = 27 if $Math::BigInt::Calc::VERSION > 0.18;
- plan tests => 71 + $additional;
+ plan tests => 80 + $additional;
}
# testing of Math::BigInt::Calc, primarily for interface/api and not for the
# _num
$x = $C->_new(\"12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345);
+# _sqrt
+$x = $C->_new(\"144"); ok (${$C->_str($C->_sqrt($x))},'12');
+
+# _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');
+
# _inc
$x = $C->_new(\"1000"); $C->_inc($x); ok (${$C->_str($x)},'1001');
$C->_dec($x); ok (${$C->_str($x)},'1000');
##############################################################################
package main;
-my $CALC = $class->_core_lib(); ok ($CALC,$CL);
+my $CALC = $class->config()->{lib}; ok ($CALC,$CL);
-my ($f,$z,$a,$exp,@a,$m,$e,$round_mode);
+my ($f,$z,$a,$exp,@a,$m,$e,$round_mode,$expected_class);
while (<DATA>)
{
}
@args = split(/:/,$_,99); $ans = pop(@args);
+ $expected_class = $class;
+ if ($ans =~ /(.*?)=(.*)/)
+ {
+ $expected_class = $2; $ans = $1;
+ }
$try = "\$x = $class->new(\"$args[0]\");";
if ($f eq "bnorm")
{
$try = "\$x = $class->bnorm(\"$args[0]\");";
# some is_xxx tests
- } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan)$/) {
+ } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) {
$try .= "\$x->$f();";
} elsif ($f eq "as_hex") {
$try .= '$x->as_hex();';
} elsif ($f eq "bone") {
$try .= "\$x->bone('$args[1]');";
# some unary ops
- } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt)$/) {
+ } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt|fac)$/) {
$try .= "\$x->$f();";
} elsif ($f eq "length") {
$try .= '$x->length();';
{
# print "try: $try ans: $ans1 $ans\n";
print "# Tried: '$try'\n" if !ok ($ans1, $ans);
+ ok (ref($ans),$expected_class) if $expected_class ne $class;
}
# check internal state of number objects
is_valid($ans1,$f) if ref $ans1;
+inf:1
-inf:0
NaNneg:0
+&is_int
+-inf:0
++inf:0
+NaNis_int:0
+1:1
+0:1
+123e12:1
&is_odd
abc:0
0:0
10000001:1
10000002:0
2:0
+120:0
+121:1
&is_even
abc:0
0:1
10000001:0
10000002:1
2:1
+120:1
+121:0
&bacmp
+0:-0:0
+0:+1:-1
+12:2:10:1200
+1234:-3:10:NaN
1234567890123:12:10:1234567890123000000000000
+-3:1:2:-6
+-5:1:2:-10
+-2:1:2:-4
+-102533203:1:2:-205066406
&brsft
abc:abc:NaN
+8:+2:2
1230000000000:10:10:123
09876123456789067890:12:10:9876123
1234561234567890123:13:10:123456
+820265627:1:2:410132813
+# test shifting negative numbers in base 2
+-15:1:2:-8
+-14:1:2:-7
+-13:1:2:-7
+-12:1:2:-6
+-11:1:2:-6
+-10:1:2:-5
+-9:1:2:-5
+-8:1:2:-4
+-7:1:2:-4
+-6:1:2:-3
+-5:1:2:-3
+-4:1:2:-2
+-3:1:2:-2
+-2:1:2:-1
+-1:1:2:-1
+-1640531254:2:2:-410132814
+-1640531254:1:2:-820265627
+-820265627:1:2:-410132814
+-205066405:1:2:-102533203
&bsstr
1e+34:1e+34
123.456E3:123456e+0
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
+0:+0:0
+1:+0:1
+0:+1:-1
4095:-4095:-1,0
-4095:4095:-1,0
123:2:61,1
+9:5:1,4
+9:4:2,1
# inf handling and general remainder
5:8:0,5
0:8:0,0
-inf:-5:inf,0
5:5:1,0
-5:-5:1,0
-inf:inf:1,0
--inf:-inf:1,0
--inf:inf:-1,0
-inf:-inf:-1,0
+inf:inf:NaN,NaN
+-inf:-inf:NaN,NaN
+-inf:inf:NaN,NaN
+inf:-inf:NaN,NaN
8:0:inf,8
inf:0:inf,inf
# exceptions to reminder rule
-inf:-5:inf
5:5:1
-5:-5:1
-inf:inf:1
--inf:-inf:1
--inf:inf:-1
-inf:-inf:-1
+inf:inf:NaN
+-inf:-inf:NaN
+-inf:inf:NaN
+inf:-inf:NaN
8:0:inf
inf:0:inf
-8:0:-inf
-inf:-5:0
5:5:0
-5:-5:0
-inf:inf:0
--inf:-inf:0
--inf:inf:0
-inf:-inf:0
+inf:inf:NaN
+-inf:-inf:NaN
+-inf:inf:NaN
+inf:-inf:NaN
8:0:8
inf:0:inf
# exceptions to reminder rule
4095:4095:0
100041000510123:3:0
152403346:12345:4321
+9:5:4
&bgcd
abc:abc:NaN
abc:+0:NaN
0:0,1
+inf:inf,inf
-inf:-inf,inf
+&bfac
+-1:NaN
+NaNfac:NaN
++inf:NaN
+-inf:NaN
+0:1
+1:1
+2:2
+3:6
+4:24
+5:120
+6:720
+10:3628800
+11:39916800
+12:479001600
&bpow
abc:12:NaN
12:abc:NaN
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 2005;
+ plan tests => 2095;
}
use Math::BigInt;
# test whether fallback to calc works
$try = "use $class ($version,'lib','foo, bar , ');";
-$try .= "$class\->_core_lib();";
+$try .= "$class\->config()->{lib};";
$ans = eval $try;
ok ( $ans, "Math::BigInt::Calc");
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ chdir 't' if -d 't';
+ unshift @INC, '../lib'; # for running manually
+ plan tests => 10;
+ }
+
+# test whether Math::BigInt constant works
+
+use Math::BigInt;
+
+ok (Math::BigInt->can('config'));
+
+my $cfg = Math::BigInt->config();
+
+ok (ref($cfg),'HASH');
+
+ok ($cfg->{lib},'Math::BigInt::Calc');
+ok ($cfg->{lib_version},'0.22');
+ok ($cfg->{class},'Math::BigInt');
+ok ($cfg->{upgrade}||'','');
+ok ($cfg->{div_scale},40);
+
+ok ($cfg->{precision}||0,0); # should test for undef
+ok ($cfg->{accuracy}||0,0);
+
+ok ($cfg->{round_mode},'even');
+
+# all tests done
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ chdir 't' if -d 't';
+ unshift @INC, '../lib'; # for running manually
+ plan tests => 5;
+ }
+
+use Math::BigInt ':constant';
+
+ok (2 ** 255,'57896044618658097711785492504343953926634992332820282019728792003956564819968');
+
+use Math::BigFloat ':constant';
+ok (1.0 / 3.0, '0.3333333333333333333333333333333333333333');
+
+# stress-test Math::BigFloat->import()
+
+Math::BigFloat->import( qw/:constant/ );
+ok (1,1);
+
+Math::BigFloat->import( qw/:constant upgrade Math::BigRat/ );
+ok (1,1);
+
+Math::BigFloat->import( qw/upgrade Math::BigRat :constant/ );
+ok (1,1);
+
+# all tests done
+
--- /dev/null
+#!/usr/bin/perl -w
+
+use Test;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ plan tests => 7*6*4;
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+ }
+
+use Math::BigInt;
+
+my (@args,$x,$y,$z);
+
+# +
+foreach (qw/
+ -inf:-inf:-inf
+ -1:-inf:-inf
+ -0:-inf:-inf
+ 0:-inf:-inf
+ 1:-inf:-inf
+ inf:-inf:NaN
+ NaN:-inf:NaN
+
+ -inf:-1:-inf
+ -1:-1:-2
+ -0:-1:-1
+ 0:-1:-1
+ 1:-1:0
+ inf:-1:inf
+ NaN:-1:NaN
+
+ -inf:0:-inf
+ -1:0:-1
+ -0:0:0
+ 0:0:0
+ 1:0:1
+ inf:0:inf
+ NaN:0:NaN
+
+ -inf:1:-inf
+ -1:1:0
+ -0:1:1
+ 0:1:1
+ 1:1:2
+ inf:1:inf
+ NaN:1:NaN
+
+ -inf:inf:NaN
+ -1:inf:inf
+ -0:inf:inf
+ 0:inf:inf
+ 1:inf:inf
+ inf:inf:inf
+ NaN:inf:NaN
+
+ -inf:NaN:NaN
+ -1:NaN:NaN
+ -0:NaN:NaN
+ 0:NaN:NaN
+ 1:NaN:NaN
+ inf:NaN:NaN
+ NaN:NaN:NaN
+ /)
+ {
+ @args = split /:/,$_;
+ $x = Math::BigInt->new($args[0]);
+ $y = Math::BigInt->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
+ print "# $args[0] + $args[1] should be $args[2] but is ",$x->bstr(),"\n"
+ if !ok ($x->badd($y)->bstr(),$args[2]);
+ }
+
+# -
+foreach (qw/
+ -inf:-inf:NaN
+ -1:-inf:inf
+ -0:-inf:inf
+ 0:-inf:inf
+ 1:-inf:inf
+ inf:-inf:inf
+ NaN:-inf:NaN
+
+ -inf:-1:-inf
+ -1:-1:0
+ -0:-1:1
+ 0:-1:1
+ 1:-1:2
+ inf:-1:inf
+ NaN:-1:NaN
+
+ -inf:0:-inf
+ -1:0:-1
+ -0:0:-0
+ 0:0:0
+ 1:0:1
+ inf:0:inf
+ NaN:0:NaN
+
+ -inf:1:-inf
+ -1:1:-2
+ -0:1:-1
+ 0:1:-1
+ 1:1:0
+ inf:1:inf
+ NaN:1:NaN
+
+ -inf:inf:-inf
+ -1:inf:-inf
+ -0:inf:-inf
+ 0:inf:-inf
+ 1:inf:-inf
+ inf:inf:NaN
+ NaN:inf:NaN
+
+ -inf:NaN:NaN
+ -1:NaN:NaN
+ -0:NaN:NaN
+ 0:NaN:NaN
+ 1:NaN:NaN
+ inf:NaN:NaN
+ NaN:NaN:NaN
+ /)
+ {
+ @args = split /:/,$_;
+ $x = Math::BigInt->new($args[0]);
+ $y = Math::BigInt->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
+ print "# $args[0] - $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bsub($y)->bstr(),$args[2]);
+ }
+
+# *
+foreach (qw/
+ -inf:-inf:inf
+ -1:-inf:inf
+ -0:-inf:NaN
+ 0:-inf:NaN
+ 1:-inf:-inf
+ inf:-inf:-inf
+ NaN:-inf:NaN
+
+ -inf:-1:inf
+ -1:-1:1
+ -0:-1:0
+ 0:-1:-0
+ 1:-1:-1
+ inf:-1:-inf
+ NaN:-1:NaN
+
+ -inf:0:NaN
+ -1:0:-0
+ -0:0:-0
+ 0:0:0
+ 1:0:0
+ inf:0:NaN
+ NaN:0:NaN
+
+ -inf:1:-inf
+ -1:1:-1
+ -0:1:-0
+ 0:1:0
+ 1:1:1
+ inf:1:inf
+ NaN:1:NaN
+
+ -inf:inf:-inf
+ -1:inf:-inf
+ -0:inf:NaN
+ 0:inf:NaN
+ 1:inf:inf
+ inf:inf:inf
+ NaN:inf:NaN
+
+ -inf:NaN:NaN
+ -1:NaN:NaN
+ -0:NaN:NaN
+ 0:NaN:NaN
+ 1:NaN:NaN
+ inf:NaN:NaN
+ NaN:NaN:NaN
+ /)
+ {
+ @args = split /:/,$_;
+ $x = Math::BigInt->new($args[0]);
+ $y = Math::BigInt->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
+ print "# $args[0] * $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bmul($y)->bstr(),$args[2]);
+ }
+
+# /
+foreach (qw/
+ -inf:-inf:NaN
+ -1:-inf:0
+ -0:-inf:0
+ 0:-inf:-0
+ 1:-inf:-0
+ inf:-inf:NaN
+ NaN:-inf:NaN
+
+ -inf:-1:inf
+ -1:-1:1
+ -0:-1:0
+ 0:-1:-0
+ 1:-1:-1
+ inf:-1:-inf
+ NaN:-1:NaN
+
+ -inf:0:-inf
+ -1:0:-inf
+ -0:0:NaN
+ 0:0:NaN
+ 1:0:inf
+ inf:0:inf
+ NaN:0:NaN
+
+ -inf:1:-inf
+ -1:1:-1
+ -0:1:-0
+ 0:1:0
+ 1:1:1
+ inf:1:inf
+ NaN:1:NaN
+
+ -inf:inf:NaN
+ -1:inf:-0
+ -0:inf:-0
+ 0:inf:0
+ 1:inf:0
+ inf:inf:NaN
+ NaN:inf:NaN
+
+ -inf:NaN:NaN
+ -1:NaN:NaN
+ -0:NaN:NaN
+ 0:NaN:NaN
+ 1:NaN:NaN
+ inf:NaN:NaN
+ NaN:NaN:NaN
+ /)
+ {
+ @args = split /:/,$_;
+ $x = Math::BigInt->new($args[0]);
+ $y = Math::BigInt->new($args[1]);
+ $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
+ print "# $args[0] / $args[1] should be $args[2] but is $x\n"
+ if !ok ($x->bdiv($y)->bstr(),$args[2]);
+
+ }
+
+
ok ($x->copy()->round(4),'123.5');
ok ($x->copy()->round(5,2),'NaN');
ok ($x->copy()->round(undef,-2),'123.46');
-ok ($x->copy()->round(undef,2),100);
+ok ($x->copy()->round(undef,2),120);
$x = $mbi->new('123');
ok ($x->round(5,2),'NaN');
$z = $u->copy()->bmul($y,2,undef,'odd'); ok ($z,31000);
$z = $u->copy()->bmul($y,3,undef,'odd'); ok ($z,30900);
$z = $u->copy()->bmul($y,undef,0,'odd'); ok ($z,30863);
-$z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30860);
+$z = $u->copy()->bmul($y,undef,1,'odd'); ok ($z,30863);
+$z = $u->copy()->bmul($y,undef,2,'odd'); ok ($z,30860);
+$z = $u->copy()->bmul($y,undef,3,'odd'); ok ($z,30900);
$z = $u->copy()->bmul($y,undef,-1,'odd'); ok ($z,30862.5);
# breakage:
$x->bround(6); # must be no-op
ok ($x,'12345');
-$x = $mbf->new('0.0061'); $x->bfround(-2);
-ok ($x,'0.01');
+$x = $mbf->new('0.0061'); $x->bfround(-2); ok ($x,'0.01');
+$x = $mbf->new('0.004'); $x->bfround(-2); ok ($x,'0.00');
+$x = $mbf->new('0.005'); $x->bfround(-2); ok ($x,'0.00');
+
+$x = $mbf->new('12345'); $x->bfround(2); ok ($x,'12340');
+$x = $mbf->new('12340'); $x->bfround(2); ok ($x,'12340');
# MBI::bfround should clear A for negative P
$x = $mbi->new('1234'); $x->accuracy(3); $x->bfround(-2);
print "# Tried: '$try'\n" if !ok ($rc, 'NaN');
}
+# see if $x->bsub(0) really rounds
+$x = $mbi->new(123); $mbi->accuracy(2); $x->bsub(0);
+ok ($x,120);
+$mbi->accuracy(undef);
+
###############################################################################
# test whether shortcuts returning zero/one preserve A and P
my ($ans1,$f,$a,$p,$xp,$yp,$xa,$ya,$try,$ans,@args);
-my $CALC = Math::BigInt::_core_lib();
+my $CALC = Math::BigInt->config()->{lib};
while (<DATA>)
{
chop;
$a = $xa || $ya; $p = $xp || $yp;
# print "Check a=$a p=$p\n";
- print "# Tried: '$try'\n";
+ # print "# Tried: '$try'\n";
ok ($x->{_a}, $a) && ok_undef ($x->{_p}) if $a ne '';
ok ($x->{_p}, $p) && ok_undef ($x->{_a}) if $p ne '';
}
# the A or P of the result is calculated automatically
__DATA__
&badd
-# bsub uses badd anyway, so it should be right
123,,:123,,:246
123,3,:0,,:123
123,,-3:0,,:123
}
print "# INC = @INC\n";
- plan tests => 428
- + 8; # own test
+ plan tests => 435
+ + 16; # own tests
}
-use Math::BigInt 1.49;
-use Math::BigFloat 1.26;
+use Math::BigInt 1.50;
+use Math::BigFloat 1.27;
use vars qw/$mbi $mbf/;
$mbi->round_mode('odd'); ok ($Math::BigInt::rnd_mode,'odd');
$mbf->round_mode('odd'); ok ($Math::BigInt::rnd_mode,'odd');
+foreach my $class (qw/Math::BigInt Math::BigFloat/)
+ {
+ ok ($class->accuracy(5),5); # set A
+ ok_undef ($class->precision()); # and now P must be cleared
+ ok ($class->precision(5),5); # set P
+ ok_undef ($class->accuracy()); # and now A must be cleared
+ }
+
}
print "# INC = @INC\n";
- plan tests => 1528
+ plan tests => 1585
+ 4; # + 4 own tests
}
use Math::BigFloat::Subclass;
-use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup);
+use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL);
$class = "Math::BigFloat::Subclass";
+$CL = "Math::BigInt::Calc";
require 'bigfltpm.inc'; # perform same tests as bigfltpm
}
print "# INC = @INC\n";
- plan tests => 2005
+ plan tests => 2095
+ 4; # +4 own tests
}
my $location = $0; $location =~ s/sub_mif.t//i;
if ($ENV{PERL_CORE})
{
- @INC = qw(../t/lib); # testing with the core distribution
+ @INC = qw(../t/lib); # testing with the core distribution
}
- unshift @INC, '../lib'; # for testing manually
+ unshift @INC, '../lib'; # for testing manually
if (-d 't')
{
chdir 't';
unshift @INC, $location;
}
print "# INC = @INC\n";
-
- plan tests => 428;
+
+ plan tests => 435;
}
use Math::BigInt::Subclass;
--- /dev/null
+#include this file into another for subclass testing
+
+# This file is nearly identical to bigintpm.t, except that certain results
+# are _requird_ to be different due to "upgrading" or "promoting" to BigFloat.
+# The reverse is not true, any unmarked results can be either BigInt or
+# BigFloat, depending on how good the internal optimization is.
+
+# Plaese note that the testcount goes up by two for each extra result marked
+# with ^, since then we test whether it has the proper class and that it left
+# the upgrade variable alone.
+
+my $version = ${"$class\::VERSION"};
+
+##############################################################################
+# for testing inheritance of _swap
+
+package Math::Foo;
+
+use Math::BigInt lib => $main::CL;
+use vars qw/@ISA/;
+@ISA = (qw/Math::BigInt/);
+
+use overload
+# customized overload for sub, since original does not use swap there
+'-' => sub { my @a = ref($_[0])->_swap(@_);
+ $a[0]->bsub($a[1])};
+
+sub _swap
+ {
+ # a fake _swap, which reverses the params
+ my $self = shift; # for override in subclass
+ if ($_[2])
+ {
+ my $c = ref ($_[0] ) || 'Math::Foo';
+ return ( $_[0]->copy(), $_[1] );
+ }
+ else
+ {
+ return ( Math::Foo->new($_[1]), $_[0] );
+ }
+ }
+
+##############################################################################
+package main;
+
+my $CALC = $class->config()->{lib}; ok ($CALC,$CL);
+
+my ($f,$z,$a,$exp,@a,$m,$e,$round_mode,$expected_class);
+
+while (<DATA>)
+ {
+ chop;
+ next if /^#/; # skip comments
+ if (s/^&//)
+ {
+ $f = $_; next;
+ }
+ elsif (/^\$/)
+ {
+ $round_mode = $_; $round_mode =~ s/^\$/$class\->/; next;
+ }
+
+ @args = split(/:/,$_,99); $ans = pop(@args);
+ $expected_class = $class;
+ if ($ans =~ /\^$/)
+ {
+ $expected_class = $ECL; $ans =~ s/\^$//;
+ }
+ $try = "\$x = $class->new(\"$args[0]\");";
+ if ($f eq "bnorm")
+ {
+ $try = "\$x = $class->bnorm(\"$args[0]\");";
+ # some is_xxx tests
+ } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) {
+ $try .= "\$x->$f();";
+ } elsif ($f eq "as_hex") {
+ $try .= '$x->as_hex();';
+ } elsif ($f eq "as_bin") {
+ $try .= '$x->as_bin();';
+ } elsif ($f eq "is_inf") {
+ $try .= "\$x->is_inf('$args[1]');";
+ } elsif ($f eq "binf") {
+ $try .= "\$x->binf('$args[1]');";
+ } elsif ($f eq "bone") {
+ $try .= "\$x->bone('$args[1]');";
+ # some unary ops
+ } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt|fac)$/) {
+ $try .= "\$x->$f();";
+ } elsif ($f eq "length") {
+ $try .= '$x->length();';
+ } elsif ($f eq "exponent"){
+ # ->bstr() to see if an object is returned
+ $try .= '$x = $x->exponent()->bstr();';
+ } elsif ($f eq "mantissa"){
+ # ->bstr() to see if an object is returned
+ $try .= '$x = $x->mantissa()->bstr();';
+ } elsif ($f eq "parts"){
+ $try .= '($m,$e) = $x->parts();';
+ # ->bstr() to see if an object is returned
+ $try .= '$m = $m->bstr(); $m = "NaN" if !defined $m;';
+ $try .= '$e = $e->bstr(); $e = "NaN" if !defined $e;';
+ $try .= '"$m,$e";';
+ } else {
+ $try .= "\$y = $class->new('$args[1]');";
+ if ($f eq "bcmp")
+ {
+ $try .= '$x <=> $y;';
+ } elsif ($f eq "bround") {
+ $try .= "$round_mode; \$x->bround(\$y);";
+ } elsif ($f eq "bacmp"){
+ $try .= '$x->bacmp($y);';
+ } elsif ($f eq "badd"){
+ $try .= '$x + $y;';
+ } elsif ($f eq "bsub"){
+ $try .= '$x - $y;';
+ } elsif ($f eq "bmul"){
+ $try .= '$x * $y;';
+ } elsif ($f eq "bdiv"){
+ $try .= '$x / $y;';
+ } elsif ($f eq "bdiv-list"){
+ $try .= 'join (",",$x->bdiv($y));';
+ # overload via x=
+ } elsif ($f =~ /^.=$/){
+ $try .= "\$x $f \$y;";
+ # overload via x
+ } elsif ($f =~ /^.$/){
+ $try .= "\$x $f \$y;";
+ } elsif ($f eq "bmod"){
+ $try .= '$x % $y;';
+ } elsif ($f eq "bgcd")
+ {
+ if (defined $args[2])
+ {
+ $try .= " \$z = $class->new('$args[2]'); ";
+ }
+ $try .= "$class\::bgcd(\$x, \$y";
+ $try .= ", \$z" if (defined $args[2]);
+ $try .= " );";
+ }
+ elsif ($f eq "blcm")
+ {
+ if (defined $args[2])
+ {
+ $try .= " \$z = $class->new('$args[2]'); ";
+ }
+ $try .= "$class\::blcm(\$x, \$y";
+ $try .= ", \$z" if (defined $args[2]);
+ $try .= " );";
+ }elsif ($f eq "blsft"){
+ if (defined $args[2])
+ {
+ $try .= "\$x->blsft(\$y,$args[2]);";
+ }
+ else
+ {
+ $try .= "\$x << \$y;";
+ }
+ }elsif ($f eq "brsft"){
+ if (defined $args[2])
+ {
+ $try .= "\$x->brsft(\$y,$args[2]);";
+ }
+ else
+ {
+ $try .= "\$x >> \$y;";
+ }
+ }elsif ($f eq "band"){
+ $try .= "\$x & \$y;";
+ }elsif ($f eq "bior"){
+ $try .= "\$x | \$y;";
+ }elsif ($f eq "bxor"){
+ $try .= "\$x ^ \$y;";
+ }elsif ($f eq "bpow"){
+ $try .= "\$x ** \$y;";
+ }elsif ($f eq "digit"){
+ $try = "\$x = $class->new('$args[0]'); \$x->digit($args[1]);";
+ } else { warn "Unknown op '$f'"; }
+ } # end else all other ops
+
+ $ans1 = eval $try;
+ # convert hex/binary targets to decimal
+ if ($ans =~ /^(0x0x|0b0b)/)
+ {
+ $ans =~ s/^0[xb]//; $ans = Math::BigInt->new($ans)->bstr();
+ }
+ if ($ans eq "")
+ {
+ ok_undef ($ans1);
+ }
+ else
+ {
+ # print "try: $try ans: $ans1 $ans\n";
+ print "# Tried: '$try'\n" if !ok ($ans1, $ans);
+ if ($expected_class ne $class)
+ {
+ ok (ref($ans1),$expected_class); # also checks that it really is ref!
+ ok ($Math::BigInt::upgrade,'Math::BigFloat'); # still okay?
+ }
+ }
+ # check internal state of number objects
+ is_valid($ans1,$f) if ref $ans1;
+ } # endwhile data tests
+close DATA;
+
+# all tests done
+
+1;
+
+###############################################################################
+###############################################################################
+# Perl 5.005 does not like ok ($x,undef)
+
+sub ok_undef
+ {
+ my $x = shift;
+
+ ok (1,1) and return if !defined $x;
+ ok ($x,'undef');
+ }
+
+###############################################################################
+# sub to check validity of a BigInt internally, to ensure that no op leaves a
+# number object in an invalid state (f.i. "-0")
+
+sub is_valid
+ {
+ my ($x,$f,$c) = @_;
+
+ # The checks here are loosened a bit to allow BigInt or BigFloats to pass
+
+ my $e = 0; # error?
+ # ok as reference?
+ # $e = "Not a reference to $c" if (ref($x) || '') ne $c;
+
+ # has ok sign?
+ $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'"
+ if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/;
+
+ $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0;
+ #$e = $CALC->_check($x->{value}) if $e eq '0';
+
+ # test done, see if error did crop up
+ ok (1,1), return if ($e eq '0');
+
+ ok (1,$e." after op '$f'");
+ }
+
+__DATA__
+&.=
+1234:-345:1234-345
+&+=
+1:2:3
+-1:-2:-3
+&-=
+1:2:-1
+-1:-2:1
+&*=
+2:3:6
+-1:5:-5
+&%=
+100:3:1
+8:9:8
+&/=
+100:3:33
+-8:2:-4
+&|=
+2:1:3
+&&=
+5:7:5
+&^=
+5:7:2
+&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
+1:1
+3:1
+-1:1
+-3:1
+10000001:1
+10000002:0
+2:0
+120:0
+121:1
+&is_int
+NaN:0
+inf:0
+-inf:0
+1:1
+12:1
+123e12:1
+&is_even
+abc:0
+0:1
+1:0
+3:0
+-1:0
+-3:0
+10000001:0
+10000002:1
+2:1
+120:1
+121:0
+&bacmp
++0:-0:0
++0:+1:-1
+-1:+1:0
++1:-1:0
+-1:+2:-1
++2:-1:1
+-123456789:+987654321:-1
++123456789:-987654321:-1
++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
+12.3:12.3^
+# binary input
+0babc:NaN
+0b123:NaN
+0b0:0
+-0b0:0
+-0b1:-1
+0b0001:1
+0b001:1
+0b011:3
+0b101:5
+0b1001:9
+0b10001:17
+0b100001:33
+0b1000001:65
+0b10000001:129
+0b100000001:257
+0b1000000001:513
+0b10000000001:1025
+0b100000000001:2049
+0b1000000000001:4097
+0b10000000000001:8193
+0b100000000000001:16385
+0b1000000000000001:32769
+0b10000000000000001:65537
+0b100000000000000001:131073
+0b1000000000000000001:262145
+0b10000000000000000001:524289
+0b100000000000000000001:1048577
+0b1000000000000000000001:2097153
+0b10000000000000000000001:4194305
+0b100000000000000000000001:8388609
+0b1000000000000000000000001:16777217
+0b10000000000000000000000001:33554433
+0b100000000000000000000000001:67108865
+0b1000000000000000000000000001:134217729
+0b10000000000000000000000000001:268435457
+0b100000000000000000000000000001:536870913
+0b1000000000000000000000000000001:1073741825
+0b10000000000000000000000000000001:2147483649
+0b100000000000000000000000000000001:4294967297
+0b1000000000000000000000000000000001:8589934593
+0b10000000000000000000000000000000001:17179869185
+0b_101:NaN
+0b1_0_1:5
+0b0_0_0_1:1
+# hex input
+-0x0:0
+0xabcdefgh:NaN
+0x1234:4660
+0xabcdef:11259375
+-0xABCDEF:-11259375
+-0x1234:-4660
+0x12345678:305419896
+0x1_2_3_4_56_78:305419896
+0xa_b_c_d_e_f:11259375
+0x_123:NaN
+0x9:9
+0x11:17
+0x21:33
+0x41:65
+0x81:129
+0x101:257
+0x201:513
+0x401:1025
+0x801:2049
+0x1001:4097
+0x2001:8193
+0x4001:16385
+0x8001:32769
+0x10001:65537
+0x20001:131073
+0x40001:262145
+0x80001:524289
+0x100001:1048577
+0x200001:2097153
+0x400001:4194305
+0x800001:8388609
+0x1000001:16777217
+0x2000001:33554433
+0x4000001:67108865
+0x8000001:134217729
+0x10000001:268435457
+0x20000001:536870913
+0x40000001:1073741825
+0x80000001:2147483649
+0x100000001:4294967297
+0x200000001:8589934593
+0x400000001:17179869185
+0x800000001:34359738369
+# inf input
+inf:inf
++inf:inf
+-inf:-inf
+0inf:NaN
+# abnormal input
+:NaN
+abc:NaN
+ 1 a:NaN
+1bcd2:NaN
+11111b:NaN
++1z:NaN
+-1z:NaN
+# only one underscore between two digits
+_123:NaN
+_123_:NaN
+123_:NaN
+1__23:NaN
+1E1__2:NaN
+1_E12:NaN
+1E_12:NaN
+1_E_12:NaN
++_1E12:NaN
++0_1E2:100
++0_0_1E2:100
+-0_0_1E2:-100
+-0_0_1E+0_0_2:-100
+E1:NaN
+E23:NaN
+1.23E1:12.3^
+1.23E-1:0.123^
+# bug with two E's in number beeing valid
+1e2e3:NaN
+1e2r:NaN
+1e2.0:NaN
+# leading zeros
+012:12
+0123:123
+01234:1234
+012345:12345
+0123456:123456
+01234567:1234567
+012345678:12345678
+0123456789:123456789
+01234567891:1234567891
+012345678912:12345678912
+0123456789123:123456789123
+01234567891234:1234567891234
+# normal input
+0:0
++0:0
++00:0
++000:0
+000000000000000000:0
+-0:0
+-0000:0
++1:1
++01:1
++001:1
++00000100000:100000
+123456789:123456789
+-1:-1
+-01:-1
+-001:-1
+-123456789:-123456789
+-00000100000:-100000
+1_2_3:123
+10000000000E-1_0:1
+1E2:100
+1E1:10
+1E0:1
+1.23E2:123
+100E-1:10
+# floating point input
+# .2e2:20
+1.E3:1000
+1.01E2:101
+1010E-1:101
+-1010E0:-1010
+-1010E1:-10100
+1234.00:1234
+# non-integer numbers
+-1010E-2:-10.1^
+-1.01E+1:-10.1^
+-1.01E-1:-0.101^
+&bnan
+1:NaN
+2:NaN
+abc:NaN
+&bone
+2:+:1
+2:-:-1
+boneNaN:-:-1
+boneNaN:+:1
+2:abc:1
+3::1
+&binf
+1:+:inf
+2:-:-inf
+3:abc:inf
+&is_nan
+123:0
+abc:1
+NaN:1
+-123:0
+&is_inf
++inf::1
+-inf::1
+abc::0
+1::0
+NaN::0
+-1::0
++inf:-:0
++inf:+:1
+-inf:-:1
+-inf:+:0
+# it must be exactly /^[+-]inf$/
++infinity::0
+-infinity::0
+&blsft
+abc:abc:NaN
++2:+2:8
++1:+32:4294967296
++1:+48:281474976710656
++8:-2:NaN
+# excercise base 10
++12345:4:10:123450000
+-1234:0:10:-1234
++1234:0:10:1234
++2:2:10:200
++12:2:10:1200
++1234:-3:10:NaN
+1234567890123:12:10:1234567890123000000000000
+&brsft
+abc:abc:NaN
++8:+2:2
++4294967296:+32:1
++281474976710656:+48:1
++2:-2:NaN
+# excercise base 10
+-1234:0:10:-1234
++1234:0:10:1234
++200:2:10:2
++1234:3:10:1
++1234:2:10:12
++1234:-3:10:NaN
+310000:4:10:31
+12300000:5:10:123
+1230000000000:10:10:123
+09876123456789067890:12:10:9876123
+1234561234567890123:13:10:123456
+&bsstr
+1e+34:1e+34
+123.456E3:123456e+0
+100:1e+2
+abc:NaN
+&bneg
+bnegNaN:NaN
++inf:-inf
+-inf:inf
+abd:NaN
+0:0
+1:-1
+-1:1
++123456789:-123456789
+-123456789:123456789
+&babs
+babsNaN:NaN
++inf:inf
+-inf:inf
+0:0
+1:1
+-1:1
++123456789:123456789
+-123456789:123456789
+&bcmp
+bcmpNaN:bcmpNaN:
+bcmpNaN:0:
+0:bcmpNaN:
+0:0:0
+-1:0:-1
+0:-1:1
+1:0:1
+0:1:-1
+-1:1:-1
+1:-1:1
+-1:-1:0
+1:1:0
+123:123:0
+123:12:1
+12:123:-1
+-123:-123:0
+-123:-12:-1
+-12:-123:1
+123:124:-1
+124:123:1
+-123:-124:1
+-124:-123:-1
+100:5:1
+-123456789:987654321:-1
++123456789:-987654321:1
+-987654321:123456789:-1
+-inf:5432112345:-1
++inf:5432112345:1
+-inf:-5432112345:-1
++inf:-5432112345:1
++inf:+inf:0
+-inf:-inf:0
++inf:-inf:1
+-inf:+inf:-1
+5:inf:-1
+5:inf:-1
+-5:-inf:1
+-5:-inf:1
+# return undef
++inf:NaN:
+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
+&badd
+abc:abc:NaN
+abc:0:NaN
++0:abc:NaN
++inf:-inf:NaN
+-inf:+inf:NaN
++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
+1:1:2
+-1:0:-1
+0:-1:-1
+-1:-1:-2
+-1:+1:0
++1:-1:0
++9:+1:10
++99:+1:100
++999:+1:1000
++9999:+1:10000
++99999:+1:100000
++999999:+1:1000000
++9999999:+1:10000000
++99999999:+1:100000000
++999999999:+1:1000000000
++9999999999:+1:10000000000
++99999999999:+1:100000000000
++10:-1:9
++100:-1:99
++1000:-1:999
++10000:-1:9999
++100000:-1:99999
++1000000:-1:999999
++10000000:-1:9999999
++100000000:-1:99999999
++1000000000:-1:999999999
++10000000000:-1:9999999999
++123456789:987654321:1111111110
+-123456789:987654321:864197532
+-123456789:-987654321:-1111111110
++123456789:-987654321:-864197532
+#2:2.5:4.5^
+#-123:-1.5:-124.5^
+#-1.2:1:-0.2^
+&bsub
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++inf:-inf:inf
+-inf:+inf:-inf
++inf:+inf:NaN
+-inf:-inf:NaN
++0:+0:0
++1:+0:1
++0:+1:-1
++1:+1:0
+-1:+0:-1
++0:-1:1
+-1:-1:0
+-1:+1:-2
++1:-1:2
++9:+1:8
++99:+1:98
++999:+1:998
++9999:+1:9998
++99999:+1:99998
++999999:+1:999998
++9999999:+1:9999998
++99999999:+1:99999998
++999999999:+1:999999998
++9999999999:+1:9999999998
++99999999999:+1:99999999998
++10:-1:11
++100:-1:101
++1000:-1:1001
++10000:-1:10001
++100000:-1:100001
++1000000:-1:1000001
++10000000:-1:10000001
++100000000:-1:100000001
++1000000000:-1:1000000001
++10000000000:-1:10000000001
++123456789:+987654321:-864197532
+-123456789:+987654321:-1111111110
+-123456789:-987654321:864197532
++123456789:-987654321:1111111110
+&bmul
+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
++0:-1:0
+-1:+0:0
+123456789123456789:0:0
+0:123456789123456789:0
+-1:-1:1
+-1:+1:-1
++1:-1:-1
++1:+1:1
++2:+3:6
+-2:+3:-6
++2:-3:-6
+-2:-3:6
+111:111:12321
+10101:10101:102030201
+1001001:1001001:1002003002001
+100010001:100010001:10002000300020001
+10000100001:10000100001:100002000030000200001
+11111111111:9:99999999999
+22222222222:9:199999999998
+33333333333:9:299999999997
+44444444444:9:399999999996
+55555555555:9:499999999995
+66666666666:9:599999999994
+77777777777:9:699999999993
+88888888888:9:799999999992
+99999999999:9:899999999991
++25:+25:625
++12345:+12345:152399025
++99999:+11111:1111088889
+9999:10000:99990000
+99999:100000:9999900000
+999999:1000000:999999000000
+9999999:10000000:99999990000000
+99999999:100000000:9999999900000000
+999999999:1000000000:999999999000000000
+9999999999:10000000000:99999999990000000000
+99999999999:100000000000:9999999999900000000000
+999999999999:1000000000000:999999999999000000000000
+9999999999999:10000000000000:99999999999990000000000000
+99999999999999:100000000000000:9999999999999900000000000000
+999999999999999:1000000000000000:999999999999999000000000000000
+9999999999999999:10000000000000000:99999999999999990000000000000000
+99999999999999999:100000000000000000:9999999999999999900000000000000000
+999999999999999999:1000000000000000000:999999999999999999000000000000000000
+9999999999999999999:10000000000000000000:99999999999999999990000000000000000000
+&bdiv-list
+100:20:5,0
+4095:4095:1,0
+-4095:-4095:1,0
+4095:-4095:-1,0
+-4095:4095:-1,0
+123:2:61,1
+9:5:1,4
+9:4:2,1
+# inf handling and general remainder
+5:8:0.625,5
+0:8:0,0
+11:2:5,1
+11:-2:-5,-1
+-11:2:-5,1
+# see table in documentation in MBI
+0:inf:0,0
+0:-inf:0,0
+5:inf:0,5
+5:-inf:0,5
+-5:inf:0,-5
+-5:-inf:0,-5
+inf:5:inf,0
+-inf:5:-inf,0
+inf:-5:-inf,0
+-inf:-5:inf,0
+5:5:1,0
+-5:-5:1,0
+inf:inf:NaN,NaN
+-inf:-inf:NaN,NaN
+-inf:inf:NaN,NaN
+inf:-inf:NaN,NaN
+8:0:inf,8
+inf:0:inf,inf
+# exceptions to reminder rule
+-8:0:-inf,-8
+-inf:0:-inf,-inf
+0:0:NaN,NaN
+&bdiv
+abc:abc:NaN
+abc:1:NaN
+1:abc:NaN
+0:0:NaN
+# inf handling (see table in doc)
+0:inf:0
+0:-inf:0
+5:inf:0
+5:-inf:0
+-5:inf:0
+-5:-inf:0
+inf:5:inf
+-inf:5:-inf
+inf:-5:-inf
+-inf:-5:inf
+5:5:1
+-5:-5:1
+inf:inf:NaN
+-inf:-inf:NaN
+-inf:inf:NaN
+inf:-inf:NaN
+8:0:inf
+inf:0:inf
+-8:0:-inf
+-inf:0:-inf
+0:0:NaN
+11:2:5
+-11:-2:5
+-11:2:-5
+11:-2:-5
+0:1:0
+0:-1:0
+1:1:1
+-1:-1:1
+1:-1:-1
+-1:1:-1
+1:2:0.5^
+2:1:2
+1000000000:9:111111111
+2000000000:9:222222222
+3000000000:9:333333333
+4000000000:9:444444444
+5000000000:9:555555555
+6000000000:9:666666666
+7000000000:9:777777777
+8000000000:9:888888888
+9000000000:9:1000000000
+35500000:113:314159
+71000000:226:314159
+106500000:339:314159
+1000000000:3:333333333
++10:+5:2
++100:+4:25
++1000:+8:125
++10000:+16:625
+999999999999:9:111111111111
+999999999999:99:10101010101
+999999999999:999:1001001001
+999999999999:9999:100010001
+999999999999999:99999:10000100001
++1111088889:99999:11111
+-5:-3:1
+-5:3:-1
+4:3:1
+4:-3:-1
+1:3:0.3333333333333333333333333333333333333333
+1:-3:-0.3333333333333333333333333333333333333333
+-2:-3:0.6666666666666666666666666666666666666667
+-2:3:-0.6666666666666666666666666666666666666667
+#8:5:1.6^
+#-8:5:-1.6^
+8:5:1
+-8:5:-1
+14:-3:-4
+-14:3:-4
+-14:-3:4
+14:3:4
+# bug in Calc with '99999' vs $BASE-1
+10000000000000000000000000000000000000000000000000000000000000000000000000000000000:10000000375084540248994272022843165711074:999999962491547381984643365663244474111576
+12:24:0.5^
+&bmod
+# inf handling, see table in doc
+0:inf:0
+0:-inf:0
+5:inf:5
+5:-inf:5
+-5:inf:-5
+-5:-inf:-5
+inf:5:0
+-inf:5:0
+inf:-5:0
+-inf:-5:0
+5:5:0
+-5:-5:0
+inf:inf:NaN
+-inf:-inf:NaN
+-inf:inf:NaN
+inf:-inf:NaN
+8:0:8
+inf:0:inf
+# exceptions to reminder rule
+-inf:0:-inf
+-8:0:-8
+0:0:NaN
+abc:abc:NaN
+abc:1:abc:NaN
+1:abc:NaN
+0:0:NaN
+0:1:0
+1:0:1
+0:-1:0
+-1:0:-1
+1:1:0
+-1:-1:0
+1:-1:0
+-1:1:0
+1:2:1
+2:1:0
+1000000000:9:1
+2000000000:9:2
+3000000000:9:3
+4000000000:9:4
+5000000000:9:5
+6000000000:9:6
+7000000000:9:7
+8000000000:9:8
+9000000000:9:0
+35500000:113:33
+71000000:226:66
+106500000:339:99
+1000000000:3:1
+10:5:0
+100:4:0
+1000:8:0
+10000:16:0
+999999999999:9:0
+999999999999:99:0
+999999999999:999:0
+999999999999:9999:0
+999999999999999:99999:0
+-9:+5:1
++9:-5:-1
+-9:-5:-4
+-5:3:1
+-2:3:1
+4:3:1
+1:3:1
+-5:-3:-2
+-2:-3:-2
+4:-3:-2
+1:-3:-2
+4095:4095:0
+100041000510123:3:0
+152403346:12345:4321
+9:5:4
+&bgcd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:0
++0:+1:1
++1:+0:1
++1:+1:1
++2:+3:1
++3:+2:1
+-3:+2:1
+100:625:25
+4096:81:1
+1034:804:2
+27:90:56:1
+27:90:54:9
+&blcm
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:NaN
++1:+0:0
++0:+1:0
++27:+90:270
++1034:+804:415668
+&band
+abc:abc:NaN
+abc:0:NaN
+0:abc:NaN
+1:2:0
+3:2:2
++8:+2:0
++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
+# equal arguments are treated special, so also do some test with unequal ones
+0xFFFF:0xFFFF:0x0xFFFF
+0xFFFFFF:0xFFFFFF:0x0xFFFFFF
+0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF
+0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0xF0F0:0xF0F0:0x0xF0F0
+0x0F0F:0x0F0F:0x0x0F0F
+0xF0F0F0:0xF0F0F0:0x0xF0F0F0
+0x0F0F0F:0x0F0F0F:0x0x0F0F0F
+0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0
+0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F
+0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0
+0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F
+0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0
+0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F
+0x1F0F0F0F0F0F:0x3F0F0F0F0F0F:0x0x1F0F0F0F0F0F
+&bior
+abc:abc:NaN
+abc:0:NaN
+0:abc:NaN
+1:2:3
++8:+2:10
++281474976710656:0:281474976710656
++281474976710656:1:281474976710657
++281474976710656:281474976710656:281474976710656
+-2:-3:-1
+-1:-1:-1
+-6:-6:-6
+-7:4:-3
+-4:7:-1
+# equal arguments are treated special, so also do some test with unequal ones
+0xFFFF:0xFFFF:0x0xFFFF
+0xFFFFFF:0xFFFFFF:0x0xFFFFFF
+0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF
+0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0:0xFFFF:0x0xFFFF
+0:0xFFFFFF:0x0xFFFFFF
+0:0xFFFFFFFF:0x0xFFFFFFFF
+0:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0xFFFF:0:0x0xFFFF
+0xFFFFFF:0:0x0xFFFFFF
+0xFFFFFFFF:0:0x0xFFFFFFFF
+0xFFFFFFFFFF:0:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF
+0xF0F0:0xF0F0:0x0xF0F0
+0x0F0F:0x0F0F:0x0x0F0F
+0xF0F0:0x0F0F:0x0xFFFF
+0xF0F0F0:0xF0F0F0:0x0xF0F0F0
+0x0F0F0F:0x0F0F0F:0x0x0F0F0F
+0x0F0F0F:0xF0F0F0:0x0xFFFFFF
+0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0
+0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F
+0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF
+0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0
+0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F
+0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF
+0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0
+0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F
+0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
+0x1F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
+&bxor
+abc:abc:NaN
+abc:0:NaN
+0:abc:NaN
+1:2:3
++8:+2:10
++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
+# equal arguments are treated special, so also do some test with unequal ones
+0xFFFF:0xFFFF:0
+0xFFFFFF:0xFFFFFF:0
+0xFFFFFFFF:0xFFFFFFFF:0
+0xFFFFFFFFFF:0xFFFFFFFFFF:0
+0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0
+0:0xFFFF:0x0xFFFF
+0:0xFFFFFF:0x0xFFFFFF
+0:0xFFFFFFFF:0x0xFFFFFFFF
+0:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0xFFFF:0:0x0xFFFF
+0xFFFFFF:0:0x0xFFFFFF
+0xFFFFFFFF:0:0x0xFFFFFFFF
+0xFFFFFFFFFF:0:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF
+0xF0F0:0xF0F0:0
+0x0F0F:0x0F0F:0
+0xF0F0:0x0F0F:0x0xFFFF
+0xF0F0F0:0xF0F0F0:0
+0x0F0F0F:0x0F0F0F:0
+0x0F0F0F:0xF0F0F0:0x0xFFFFFF
+0xF0F0F0F0:0xF0F0F0F0:0
+0x0F0F0F0F:0x0F0F0F0F:0
+0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF
+0xF0F0F0F0F0:0xF0F0F0F0F0:0
+0x0F0F0F0F0F:0x0F0F0F0F0F:0
+0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF
+0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0
+0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0
+0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
+&bnot
+abc:NaN
++0:-1
++8:-9
++281474976710656:-281474976710657
+-1:0
+-2:1
+-12:11
+&digit
+0:0:0
+12:0:2
+12:1:1
+123:0:3
+123:1:2
+123:2:1
+123:-1:1
+123:-2:2
+123:-3:3
+123456:0:6
+123456:1:5
+123456:2:4
+123456:3:3
+123456:4:2
+123456:5:1
+123456:-1:1
+123456:-2:2
+123456:-3:3
+100000:-3:0
+100000:0:0
+100000:1:0
+&mantissa
+abc:NaN
+1e4:1
+2e0:2
+123:123
+-1:-1
+-2:-2
++inf:inf
+-inf:-inf
+&exponent
+abc:NaN
+1e4:4
+2e0:0
+123:0
+-1:0
+-2:0
+0:1
++inf:inf
+-inf:inf
+&parts
+abc:NaN,NaN
+1e4:1,4
+2e0:2,0
+123:123,0
+-1:-1,0
+-2:-2,0
+0:0,1
++inf:inf,inf
+-inf:-inf,inf
+&bfac
+-1:NaN
+NaNfac:NaN
++inf:NaN
+-inf:NaN
+0:1
+1:1
+2:2
+3:6
+4:24
+5:120
+6:720
+10:3628800
+11:39916800
+12:479001600
+&bpow
+abc:12:NaN
+12:abc:NaN
+0:0:1
+0:1:0
+0:2:0
+0:-1:NaN
+0:-2:NaN
+1:0:1
+1:1:1
+1:2:1
+1:3:1
+1:-1:1
+1:-2:1
+1:-3:1
+2:0:1
+2:1:2
+2:2:4
+2:3:8
+3:3:27
+2:-1:NaN
+-2:-1:NaN
+2:-2:NaN
+-2:-2:NaN
++inf:1234500012:inf
+-inf:1234500012:-inf
++inf:-12345000123:inf
+-inf:-12345000123:-inf
+# 1 ** -x => 1 / (1 ** x)
+-1:0:1
+-2:0:1
+-1:1:-1
+-1:2:1
+-1:3:-1
+-1:4:1
+-1:5:-1
+-1:-1:-1
+-1:-2:1
+-1:-3:-1
+-1:-4:1
+10:2:100
+10:3:1000
+10:4:10000
+10:5:100000
+10:6:1000000
+10:7:10000000
+10:8:100000000
+10:9:1000000000
+10:20:100000000000000000000
+123456:2:15241383936
+&length
+100:3
+10:2
+1:1
+0:1
+12345:5
+10000000000000000:17
+-123:3
+215960156869840440586892398248:30
+&bsqrt
+145:12.04159457879229548012824103037860805243^
+144:12^
+143:11.95826074310139802112984075619561661399^
+16:4
+170:13.03840481040529742916594311485836883306^
+169:13
+168:12.96148139681572046193193487217599331541^
+4:2
+3:1.732050807568877293527446341505872366943^
+2:1.41421356237309504880168872420969807857^
+9:3
+12:3.464101615137754587054892683011744733886^
+256:16
+100000000:10000
+4000000000000:2000000
+152399026:12345.00004050222755607815159966235881398^
+152399025:12345
+152399024:12344.99995949777231103967404745303741942^
+1:1
+0:0
+-2:NaN
+-123:NaN
+Nan:NaN
++inf: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
+123456:5:123450
+123456:6:123456
++10123456789:5:10123000000
+-10123456789:5:-10123000000
++10123456789:9:10123456700
+-10123456789:9:-10123456700
++101234500:6:101234000
+-101234500:6:-101234000
+#+101234500:-4:101234000
+#-101234500:-4:-101234000
+$round_mode('zero')
++20123456789:5:20123000000
+-20123456789:5:-20123000000
++20123456789:9:20123456800
+-20123456789:9:-20123456800
++201234500:6:201234000
+-201234500:6:-201234000
+#+201234500:-4:201234000
+#-201234500:-4:-201234000
++12345000:4:12340000
+-12345000:4:-12340000
+$round_mode('+inf')
++30123456789:5:30123000000
+-30123456789:5:-30123000000
++30123456789:9:30123456800
+-30123456789:9:-30123456800
++301234500:6:301235000
+-301234500:6:-301234000
+#+301234500:-4:301235000
+#-301234500:-4:-301234000
++12345000:4:12350000
+-12345000:4:-12340000
+$round_mode('-inf')
++40123456789:5:40123000000
+-40123456789:5:-40123000000
++40123456789:9:40123456800
+-40123456789:9:-40123456800
++401234500:6:401234000
++401234500:6:401234000
+#-401234500:-4:-401235000
+#-401234500:-4:-401235000
++12345000:4:12340000
+-12345000:4:-12350000
+$round_mode('odd')
++50123456789:5:50123000000
+-50123456789:5:-50123000000
++50123456789:9:50123456800
+-50123456789:9:-50123456800
++501234500:6:501235000
+-501234500:6:-501235000
+#+501234500:-4:501235000
+#-501234500:-4:-501235000
++12345000:4:12350000
+-12345000:4:-12350000
+$round_mode('even')
++60123456789:5:60123000000
+-60123456789:5:-60123000000
++60123456789:9:60123456800
+-60123456789:9:-60123456800
++601234500:6:601234000
+-601234500:6:-601234000
+#+601234500:-4:601234000
+#-601234500:-4:-601234000
+#-601234500:-9:0
+#-501234500:-9:0
+#-601234500:-8:0
+#-501234500:-8:0
++1234567:7:1234567
++1234567:6:1234570
++12345000:4:12340000
+-12345000:4:-12340000
+&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
+-2: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
+2:2
+3:3
+abc:NaN
+&as_hex
+128:0x80
+-128:-0x80
+0:0x0
+-0:0x0
+1:0x1
+0x123456789123456789:0x123456789123456789
++inf:inf
+-inf:-inf
+NaNas_hex:NaN
+&as_bin
+128:0b10000000
+-128:-0b10000000
+0:0b0
+-0:0b0
+1:0b1
+0b1010111101010101010110110110110110101:0b1010111101010101010110110110110110101
++inf:inf
+-inf:-inf
+NaNas_bin:NaN
--- /dev/null
+#!/usr/bin/perl -w
+
+use Test;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/upgrade.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ @INC = qw(../t/lib); # testing with the core distribution
+ }
+ unshift @INC, '../lib'; # for testing manually
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ plan tests => 1991;
+ }
+
+use Math::BigInt upgrade => 'Math::BigFloat';
+use Math::BigFloat;
+
+use vars qw ($scale $class $try $x $y $f @args $ans $ans1 $ans1_str $setup
+ $ECL $CL);
+$class = "Math::BigInt";
+$CL = "Math::BigInt::Calc";
+$ECL = "Math::BigFloat";
+
+ok (Math::BigInt->upgrade(),'Math::BigFloat');
+
+require 'upgrade.inc'; # all tests here for sharing
@ISA = qw(Exporter Math::BigFloat);
-$VERSION = 0.02;
+$VERSION = 0.03;
+
+use overload; # inherit overload from BigInt
# Globals
$accuracy = $precision = undef;
@ISA = qw(Exporter Math::BigInt);
@EXPORT_OK = qw(bgcd);
-$VERSION = 0.02;
+$VERSION = 0.03;
+
+use overload; # inherit overload from BigInt
# Globals
$accuracy = $precision = undef;
projects / p5sagit/p5-mst-13.2.git / commitdiff