summaryrefslogtreecommitdiff
path: root/lib/Math
diff options
context:
space:
mode:
authorTels <nospam-abuse@bloodgate.com>2005-01-01 19:59:51 +0100
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2005-01-04 08:36:50 +0000
commitb68b7ab1e328997a801e104fc190aa117fc75775 (patch)
tree40601ec203bce143a7c0b70593e8f236f7972227 /lib/Math
parent755db5d606be076ff7c6dcb6af89e15fb080c85e (diff)
downloadperl-b68b7ab1e328997a801e104fc190aa117fc75775.tar.gz
Math::BigInt v1.74, Math::BigRat v0.14, bignum v0.16
Message-Id: <200501011859.52858@bloodgate.com> p4raw-id: //depot/perl@23739
Diffstat (limited to 'lib/Math')
-rw-r--r--lib/Math/BigFloat.pm94
-rw-r--r--lib/Math/BigInt.pm375
-rw-r--r--lib/Math/BigInt/Calc.pm102
-rw-r--r--lib/Math/BigInt/CalcEmu.pm24
-rw-r--r--lib/Math/BigInt/t/bare_mbf.t2
-rw-r--r--lib/Math/BigInt/t/bare_mbi.t2
-rw-r--r--lib/Math/BigInt/t/bigfltpm.inc63
-rwxr-xr-xlib/Math/BigInt/t/bigfltpm.t2
-rw-r--r--lib/Math/BigInt/t/bigintpm.inc44
-rwxr-xr-xlib/Math/BigInt/t/bigintpm.t2
-rw-r--r--lib/Math/BigInt/t/inf_nan.t76
-rw-r--r--lib/Math/BigInt/t/lib_load.t45
-rwxr-xr-xlib/Math/BigInt/t/sub_mbf.t2
-rwxr-xr-xlib/Math/BigInt/t/sub_mbi.t2
-rw-r--r--lib/Math/BigInt/t/upgrade.inc2
-rw-r--r--lib/Math/BigInt/t/with_sub.t2
-rw-r--r--lib/Math/BigRat.pm198
-rwxr-xr-xlib/Math/BigRat/t/bigrat.t11
-rw-r--r--lib/Math/BigRat/t/bigratpm.inc38
-rwxr-xr-xlib/Math/BigRat/t/bigratpm.t2
20 files changed, 749 insertions, 339 deletions
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index fbe0cf660b..7466472ee6 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -12,7 +12,7 @@ package Math::BigFloat;
# _a : accuracy
# _p : precision
-$VERSION = '1.47';
+$VERSION = '1.48';
require 5.005;
require Exporter;
@@ -89,13 +89,13 @@ BEGIN
# 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 ffac
+ fint facmp fcmp fzero fnan finf finc fdec flog ffac fneg
fceil ffloor frsft flsft fone flog froot
/;
# valid method's that can be hand-ed up (for AUTOLOAD)
my %hand_ups = map { $_ => 1 }
qw / is_nan is_inf is_negative is_positive is_pos is_neg
- accuracy precision div_scale round_mode fneg fabs fnot
+ accuracy precision div_scale round_mode fabs fnot
objectify upgrade downgrade
bone binf bnan bzero
/;
@@ -337,7 +337,7 @@ sub bstr
# (ref to BFLOAT or num_str ) return num_str
# Convert number from internal format to (non-scientific) string format.
# internal format is always normalized (no leading zeros, "-0" => "+0")
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
if ($x->{sign} !~ /^[+-]$/)
{
@@ -400,7 +400,7 @@ sub bsstr
# (ref to BFLOAT or num_str ) return num_str
# Convert number from internal format to scientific string format.
# internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
if ($x->{sign} !~ /^[+-]$/)
{
@@ -423,6 +423,19 @@ sub numify
##############################################################################
# public stuff (usually prefixed with "b")
+sub bneg
+ {
+ # (BINT or num_str) return BINT
+ # negate number or make a negated number from string
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+ return $x if $x->modify('bneg');
+
+ # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
+ $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_m}));
+ $x;
+ }
+
# tels 2001-08-04
# XXX TODO this must be overwritten and return NaN for non-integer values
# band(), bior(), bxor(), too
@@ -1094,19 +1107,39 @@ sub blcm
my ($self,@arg) = objectify(0,@_);
my $x = $self->new(shift @arg);
- while (@arg) { $x = _lcm($x,shift @arg); }
+ while (@arg) { $x = Math::BigInt::__lcm($x,shift @arg); }
$x;
}
-sub bgcd
- {
- # (BFLOAT or num_str, BFLOAT or num_str) return BINT
+sub bgcd
+ {
+ # (BINT or num_str, BINT or num_str) return BINT
# does not modify arguments, but returns new object
- # GCD -- Euclids algorithm Knuth Vol 2 pg 296
-
- my ($self,@arg) = objectify(0,@_);
- my $x = $self->new(shift @arg);
- while (@arg) { $x = _gcd($x,shift @arg); }
+
+ my $y = shift;
+ $y = __PACKAGE__->new($y) if !ref($y);
+ my $self = ref($y);
+ my $x = $y->copy()->babs(); # keep arguments
+
+ return $x->bnan() if $x->{sign} !~ /^[+-]$/ # x NaN?
+ || !$x->is_int(); # only for integers now
+
+ while (@_)
+ {
+ my $t = shift; $t = $self->new($t) if !ref($t);
+ $y = $t->copy()->babs();
+
+ return $x->bnan() if $y->{sign} !~ /^[+-]$/ # y NaN?
+ || !$y->is_int(); # only for integers now
+
+ # greatest common divisor
+ while (! $y->is_zero())
+ {
+ ($x,$y) = ($y->copy(), $x->copy()->bmod($y));
+ }
+
+ last if $x->is_one();
+ }
$x;
}
@@ -1963,10 +1996,8 @@ sub bfround
# expects and returns normalized numbers!
my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
- return $x if $x->modify('bfround');
-
- my ($scale,$mode) = $x->_scale_p($self->precision(),$self->round_mode(),@_);
- return $x if !defined $scale; # no-op
+ my ($scale,$mode) = $x->_scale_p(@_);
+ return $x if !defined $scale || $x->modify('bfround'); # no-op
# never round a 0, +-inf, NaN
if ($x->is_zero())
@@ -2076,25 +2107,23 @@ sub bround
require Carp; Carp::croak ('bround() needs positive accuracy');
}
- my ($scale,$mode) = $x->_scale_a($self->accuracy(),$self->round_mode(),@_);
- return $x if !defined $scale; # no-op
-
- return $x if $x->modify('bround');
+ my ($scale,$mode) = $x->_scale_a(@_);
+ return $x if !defined $scale || $x->modify('bround'); # no-op
# scale is now either $x->{_a}, $accuracy, or the user parameter
# test whether $x already has lower accuracy, do nothing in this case
# but do round if the accuracy is the same, since a math operation might
# want to round a number with A=5 to 5 digits afterwards again
- return $x if defined $_[0] && defined $x->{_a} && $x->{_a} < $_[0];
+ return $x if defined $x->{_a} && $x->{_a} < $scale;
# scale < 0 makes no sense
+ # scale == 0 => keep all digits
# never round a +-inf, NaN
- return $x if ($scale < 0) || $x->{sign} !~ /^[+-]$/;
+ return $x if ($scale <= 0) || $x->{sign} !~ /^[+-]$/;
- # 1: $scale == 0 => keep all digits
- # 2: never round a 0
- # 3: if we should keep more digits than the mantissa has, do nothing
- if ($scale == 0 || $x->is_zero() || $MBI->_len($x->{_m}) <= $scale)
+ # 1: never round a 0
+ # 2: if we should keep more digits than the mantissa has, do nothing
+ if ($x->is_zero() || $MBI->_len($x->{_m}) <= $scale)
{
$x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale;
return $x;
@@ -2321,6 +2350,7 @@ sub import
}
}
+ $lib =~ tr/a-zA-Z0-9,://cd; # restrict to sane characters
# let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work
my $mbilib = eval { Math::BigInt->config()->{lib} };
if ((defined $mbilib) && ($MBI eq 'Math::BigInt::Calc'))
@@ -2345,8 +2375,12 @@ sub import
{
require Carp; Carp::croak ("Couldn't load $lib: $! $@");
}
+ # find out which one was actually loaded
$MBI = Math::BigInt->config()->{lib};
+ # register us with MBI to get notified of future lib changes
+ Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } );
+
# any non :constant stuff is handled by our parent, Exporter
# even if @_ is empty, to give it a chance
$self->SUPER::import(@a); # for subclasses
@@ -2993,7 +3027,7 @@ the same terms as Perl itself.
=head1 AUTHORS
Mark Biggar, overloaded interface by Ilya Zakharevich.
-Completely rewritten by Tels http://bloodgate.com in 2001, 2002, and still
-at it in 2003.
+Completely rewritten by Tels L<http://bloodgate.com> in 2001 - 2004, and still
+at it in 2005.
=cut
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
index 541753581f..f7ff61278c 100644
--- a/lib/Math/BigInt.pm
+++ b/lib/Math/BigInt.pm
@@ -18,10 +18,11 @@ package Math::BigInt;
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.73';
-use Exporter;
-@ISA = qw( Exporter );
+$VERSION = '1.74';
+
+@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify bgcd blcm);
+
# _trap_inf and _trap_nan are internal and should never be accessed from the
# outside
use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode
@@ -53,17 +54,18 @@ use overload
'^=' => sub { $_[0]->bxor($_[1]); },
'&=' => sub { $_[0]->band($_[1]); },
'|=' => sub { $_[0]->bior($_[1]); },
-'**=' => sub { $_[0]->bpow($_[1]); },
+'**=' => sub { $_[0]->bpow($_[1]); },
'<<=' => sub { $_[0]->blsft($_[1]); },
'>>=' => sub { $_[0]->brsft($_[1]); },
# not supported by Perl yet
'..' => \&_pointpoint,
+# we might need '==' and '!=' to get things like "NaN == NaN" right
'<=>' => sub { $_[2] ?
ref($_[0])->bcmp($_[1],$_[0]) :
- $_[0]->bcmp($_[1])},
+ $_[0]->bcmp($_[1]); },
'cmp' => sub {
$_[2] ?
"$_[1]" cmp $_[0]->bstr() :
@@ -75,6 +77,10 @@ use overload
'exp' => sub { exp($_[0]->numify()) },
'atan2' => sub { atan2($_[0]->numify(),$_[1]) },
+# are not yet overloadable
+#'hex' => sub { print "hex"; $_[0]; },
+#'oct' => sub { print "oct"; $_[0]; },
+
'log' => sub { $_[0]->copy()->blog($_[1]); },
'int' => sub { $_[0]->copy(); },
'neg' => sub { $_[0]->copy()->bneg(); },
@@ -137,8 +143,8 @@ use overload
##############################################################################
# global constants, flags and accessory
-# these are public, but their usage is not recommended, use the accessor
-# methods instead
+# These vars are public, but their direct usage is not recommended, use the
+# accessor methods instead
$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
$accuracy = undef;
@@ -148,9 +154,7 @@ $div_scale = 40;
$upgrade = undef; # default is no upgrade
$downgrade = undef; # default is no downgrade
-# these are internally, and not to be used from the outside
-
-sub MB_NEVER_ROUND () { 0x0001; }
+# These are internally, and not to be used from the outside at all
$_trap_nan = 0; # are NaNs ok? set w/ config()
$_trap_inf = 0; # are infs ok? set w/ config()
@@ -162,6 +166,7 @@ my $IMPORT = 0; # was import() called yet?
# used to make require work
my %WARN; # warn only once for low-level libs
my %CAN; # cache for $CALC->can(...)
+my %CALLBACKS; # callbacks to notify on lib loads
my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math
##############################################################################
@@ -212,8 +217,7 @@ sub upgrade
# need to set new value?
if (@_ > 0)
{
- my $u = shift;
- return ${"${class}::upgrade"} = $u;
+ return ${"${class}::upgrade"} = $_[0];
}
${"${class}::upgrade"};
}
@@ -227,8 +231,7 @@ sub downgrade
# need to set new value?
if (@_ > 0)
{
- my $u = shift;
- return ${"${class}::downgrade"} = $u;
+ return ${"${class}::downgrade"} = $_[0];
}
${"${class}::downgrade"};
}
@@ -245,7 +248,7 @@ sub div_scale
{
require Carp; Carp::croak ('div_scale must be greater than zero');
}
- ${"${class}::div_scale"} = shift;
+ ${"${class}::div_scale"} = $_[0];
}
${"${class}::div_scale"};
}
@@ -299,12 +302,12 @@ sub accuracy
return $a; # shortcut
}
- my $r;
+ my $a;
# $object->accuracy() or fallback to global
- $r = $x->{_a} if ref($x);
+ $a = $x->{_a} if ref($x);
# but don't return global undef, when $x's accuracy is 0!
- $r = ${"${class}::accuracy"} if !defined $r;
- $r;
+ $a = ${"${class}::accuracy"} if !defined $a;
+ $a;
}
sub precision
@@ -345,12 +348,12 @@ sub precision
return $p; # shortcut
}
- my $r;
+ my $p;
# $object->precision() or fallback to global
- $r = $x->{_p} if ref($x);
+ $p = $x->{_p} if ref($x);
# but don't return global undef, when $x's precision is 0!
- $r = ${"${class}::precision"} if !defined $r;
- $r;
+ $p = ${"${class}::precision"} if !defined $p;
+ $p;
}
sub config
@@ -419,22 +422,34 @@ sub _scale_a
{
# select accuracy parameter based on precedence,
# used by bround() and bfround(), may return undef for scale (means no op)
- my ($x,$s,$m,$scale,$mode) = @_;
- $scale = $x->{_a} if !defined $scale;
- $scale = $s if (!defined $scale);
- $mode = $m if !defined $mode;
- return ($scale,$mode);
+ my ($x,$scale,$mode) = @_;
+
+ $scale = $x->{_a} unless defined $scale;
+
+ no strict 'refs';
+ my $class = ref($x);
+
+ $scale = ${ $class . '::accuracy' } unless defined $scale;
+ $mode = ${ $class . '::round_mode' } unless defined $mode;
+
+ ($scale,$mode);
}
sub _scale_p
{
# select precision parameter based on precedence,
# used by bround() and bfround(), may return undef for scale (means no op)
- my ($x,$s,$m,$scale,$mode) = @_;
- $scale = $x->{_p} if !defined $scale;
- $scale = $s if (!defined $scale);
- $mode = $m if !defined $mode;
- return ($scale,$mode);
+ my ($x,$scale,$mode) = @_;
+
+ $scale = $x->{_p} unless defined $scale;
+
+ no strict 'refs';
+ my $class = ref($x);
+
+ $scale = ${ $class . '::precision' } unless defined $scale;
+ $mode = ${ $class . '::round_mode' } unless defined $mode;
+
+ ($scale,$mode);
}
##############################################################################
@@ -455,7 +470,7 @@ sub copy
}
return unless ref($x); # only for objects
- my $self = {}; bless $self,$c;
+ my $self = bless {}, $c;
$self->{sign} = $x->{sign};
$self->{value} = $CALC->_copy($x->{value});
@@ -761,8 +776,7 @@ sub bsstr
# (ref to BFLOAT or num_str ) return num_str
# Convert number from internal format to scientific string format.
# internal format is always normalized (no leading zeros, "-0E0" => "+0E0")
- my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
- # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
if ($x->{sign} !~ /^[+-]$/)
{
@@ -778,8 +792,7 @@ sub bsstr
sub bstr
{
# make a string from bigint object
- my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) if !ref($x);
- # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
if ($x->{sign} !~ /^[+-]$/)
{
@@ -832,9 +845,6 @@ sub _find_round_parameters
# $r round_mode, if given by caller
# @args all 'other' arguments (0 for unary, 1 for binary ops)
- # leave bigfloat parts alone
- return ($self) if exists $self->{_f} && ($self->{_f} & MB_NEVER_ROUND) != 0;
-
my $c = ref($self); # find out class of argument(s)
no strict 'refs';
@@ -892,10 +902,6 @@ sub round
# $r round_mode, if given by caller
# @args all 'other' arguments (0 for unary, 1 for binary ops)
- # leave bigfloat parts alone (that is only used in BigRat for now and can be
- # removed once we rewrote BigRat))
- return ($self) if exists $self->{_f} && ($self->{_f} & MB_NEVER_ROUND) != 0;
-
my $c = ref($self); # find out class of argument(s)
no strict 'refs';
@@ -962,7 +968,7 @@ sub babs
{
# (BINT or num_str) return BINT
# make number absolute, or return absolute BINT from string
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return $x if $x->modify('babs');
# post-normalized abs for internal use (does nothing for NaN)
@@ -974,12 +980,12 @@ sub bneg
{
# (BINT or num_str) return BINT
# negate number or make a negated number from string
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return $x if $x->modify('bneg');
- # for +0 dont negate (to have always normalized)
- $x->{sign} =~ tr/+-/-+/ if !$x->is_zero(); # does nothing for NaN
+ # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
+ $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $CALC->_is_zero($x->{value}));
$x;
}
@@ -1117,8 +1123,7 @@ sub badd
$x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub
}
}
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- $x;
+ $x->round(@r);
}
sub bsub
@@ -1139,11 +1144,7 @@ sub bsub
return $upgrade->new($x)->bsub($upgrade->new($y),@r) if defined $upgrade &&
((!$x->isa($self)) || (!$y->isa($self)));
- if ($y->is_zero())
- {
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
- }
+ return $x->round(@r) if $y->is_zero();
require Scalar::Util;
if (Scalar::Util::refaddr($x) == Scalar::Util::refaddr($y))
@@ -1168,15 +1169,13 @@ sub binc
if ($x->{sign} eq '+')
{
$x->{value} = $CALC->_inc($x->{value});
- $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
+ return $x->round($a,$p,$r);
}
elsif ($x->{sign} eq '-')
{
$x->{value} = $CALC->_dec($x->{value});
$x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0
- $x->round($a,$p,$r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- return $x;
+ return $x->round($a,$p,$r);
}
# inf, nan handling etc
$x->badd($self->bone(),$a,$p,$r); # badd does round
@@ -1190,12 +1189,12 @@ sub bdec
if ($x->{sign} eq '-')
{
- # < 0
+ # x already < 0
$x->{value} = $CALC->_inc($x->{value});
}
else
{
- return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+'; # inf/NaN
+ return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+'; # inf or NaN
# >= 0
if ($CALC->_is_zero($x->{value}))
{
@@ -1208,8 +1207,7 @@ sub bdec
$x->{value} = $CALC->_dec($x->{value});
}
}
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- $x;
+ $x->round(@r);
}
sub blog
@@ -1218,11 +1216,11 @@ sub blog
# $base of $x)
# set up parameters
- my ($self,$x,$base,@r) = (ref($_[0]),@_);
+ my ($self,$x,$base,@r) = (undef,@_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
- ($self,$x,$base,@r) = objectify(1,$class,@_);
+ ($self,$x,$base,@r) = objectify(1,ref($x),@_);
}
return $x if $x->modify('blog');
@@ -1279,9 +1277,9 @@ sub bgcd
while (@_)
{
$y = shift; $y = $self->new($y) if !ref($y);
- next if $y->is_zero();
return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN?
- $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one();
+ $x->{value} = $CALC->_gcd($x->{value},$y->{value});
+ last if $CALC->_is_one($x->{value});
}
$x;
}
@@ -1365,8 +1363,11 @@ sub is_positive
{
# return true when arg (BINT or num_str) is positive (>= 0)
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
-
- $x->{sign} =~ /^\+/ ? 1 : 0; # +inf is also positive, but NaN not
+
+ return 1 if $x->{sign} eq '+inf'; # +inf is positive
+
+ # 0+ is neither positive nor negative
+ ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0;
}
sub is_negative
@@ -1374,7 +1375,7 @@ sub is_negative
# return true when arg (BINT or num_str) is negative (< 0)
my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
- $x->{sign} =~ /^-/ ? 1 : 0; # -inf is also negative, but NaN not
+ $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not
}
sub is_int
@@ -1427,8 +1428,7 @@ sub bmul
$x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math
$x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- $x;
+ $x->round(@r);
}
sub _div_inf
@@ -1510,7 +1510,7 @@ sub bdiv
$x->{sign} = '+' if $CALC->_is_zero($x->{value});
$rem->{_a} = $x->{_a};
$rem->{_p} = $x->{_p};
- $x->round(@r) if !exists $x->{_f} || ($x->{_f} & MB_NEVER_ROUND) == 0;
+ $x->round(@r);
if (! $CALC->_is_zero($rem->{value}))
{
$rem->{sign} = $y->{sign};
@@ -1520,15 +1520,14 @@ sub bdiv
{
$rem->{sign} = '+'; # dont leave -0
}
- $rem->round(@r) if !exists $rem->{_f} || ($rem->{_f} & MB_NEVER_ROUND) == 0;
+ $rem->round(@r);
return ($x,$rem);
}
$x->{value} = $CALC->_div($x->{value},$y->{value});
$x->{sign} = '+' if $CALC->_is_zero($x->{value});
- $x->round(@r) if !exists $x->{_f} || ($x->{_f} & MB_NEVER_ROUND) == 0;
- $x;
+ $x->round(@r);
}
###############################################################################
@@ -1561,20 +1560,15 @@ sub bmod
$x->{value} = $CALC->_mod($x->{value},$y->{value});
if (!$CALC->_is_zero($x->{value}))
{
- my $xsign = $x->{sign};
+ $x->{value} = $CALC->_sub($y->{value},$x->{value},1) # $y-$x
+ if ($x->{sign} ne $y->{sign});
$x->{sign} = $y->{sign};
- if ($xsign ne $y->{sign})
- {
- my $t = $CALC->_copy($x->{value}); # copy $x
- $x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x
- }
}
else
{
$x->{sign} = '+'; # dont leave -0
}
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- $x;
+ $x->round(@r);
}
sub bmodinv
@@ -1585,7 +1579,7 @@ sub bmodinv
# (i.e. their gcd is not one) then NaN is returned.
# set up parameters
- my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ my ($self,$x,$y,@r) = (undef,@_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
@@ -1648,12 +1642,10 @@ sub bfac
{
# (BINT or num_str, BINT or num_str) return BINT
# compute factorial number from $x, modify $x in place
- my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
- return $x if $x->modify('bfac');
-
- return $x if $x->{sign} eq '+inf'; # inf => inf
- return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
+ return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf
+ return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN
$x->{value} = $CALC->_fac($x->{value});
$x->round(@r);
@@ -1746,8 +1738,7 @@ sub bpow
$x->{value} = $CALC->_pow($x->{value},$y->{value});
$x->{sign} = $new_sign;
$x->{sign} = '+' if $CALC->_is_zero($y->{value});
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
- $x;
+ $x->round(@r);
}
sub blsft
@@ -1983,7 +1974,7 @@ sub _trailing_zeros
sub bsqrt
{
# calculate square root of $x
- my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
return $x if $x->modify('bsqrt');
@@ -2075,7 +2066,7 @@ sub bfround
# $n == 0 || $n == 1 => round to integer
my $x = shift; my $self = ref($x) || $x; $x = $self->new($x) unless ref $x;
- my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_);
+ my ($scale,$mode) = $x->_scale_p(@_);
return $x if !defined $scale || $x->modify('bfround'); # no-op
@@ -2104,7 +2095,7 @@ sub fround
{
# Exists to make life easier for switch between MBF and MBI (should we
# autoload fxxx() like MBF does for bxxx()?)
- my $x = shift;
+ my $x = shift; $x = $class->new($x) unless ref $x;
$x->bround(@_);
}
@@ -2117,9 +2108,8 @@ sub bround
# do not return $x->bnorm(), but $x
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');
+ my ($scale,$mode) = $x->_scale_a(@_);
+ return $x if !defined $scale || $x->modify('bround'); # no-op
if ($x->is_zero() || $scale == 0)
{
@@ -2361,6 +2351,18 @@ sub objectify
@a;
}
+sub _register_callback
+ {
+ my ($class,$callback) = @_;
+
+ if (ref($callback) ne 'CODE')
+ {
+ require Carp;
+ Carp::croak ("$callback is not a coderef");
+ }
+ $CALLBACKS{$class} = $callback;
+ }
+
sub import
{
my $self = shift;
@@ -2394,12 +2396,20 @@ sub import
}
}
# any non :constant stuff is handled by our parent, Exporter
- # even if @_ is empty, to give it a chance
- $self->SUPER::import(@a); # need it for subclasses
- $self->export_to_level(1,$self,@a); # need it for MBF
+ if (@a > 0)
+ {
+ require Exporter;
+
+ $self->SUPER::import(@a); # need it for subclasses
+ $self->export_to_level(1,$self,@a); # need it for MBF
+ }
# try to load core math lib
my @c = split /\s*,\s*/,$CALC;
+ foreach (@c)
+ {
+ $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
+ }
push @c,'Calc'; # if all fail, try this
$CALC = ''; # signal error
foreach my $lib (@c)
@@ -2409,8 +2419,8 @@ sub import
$lib =~ s/\.pm$//;
if ($] < 5.006)
{
- # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
- # used in the same script, or eval inside import().
+ # Perl < 5.6.0 dies with "out of memory!" when eval("") and ':constant' is
+ # used in the same script, or eval("") inside import().
my @parts = split /::/, $lib; # Math::BigInt => Math BigInt
my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
require File::Spec;
@@ -2474,22 +2484,28 @@ sub import
require Carp;
Carp::croak ("Couldn't load any math lib, not even 'Calc.pm'");
}
- _fill_can_cache(); # for emulating lower math lib functions
- }
-sub _fill_can_cache
- {
- # fill $CAN with the results of $CALC->can(...)
+ # notify callbacks
+ foreach my $class (keys %CALLBACKS)
+ {
+ &{$CALLBACKS{$class}}($CALC);
+ }
+
+ # Fill $CAN with the results of $CALC->can(...) for emulating lower math lib
+ # functions
%CAN = ();
- for my $method (qw/ signed_and or signed_or xor signed_xor /)
+ for my $method (qw/ signed_and signed_or signed_xor /)
{
$CAN{$method} = $CALC->can("_$method") ? 1 : 0;
}
+
+ # import done
}
sub __from_hex
{
+ # internal
# convert a (ref to) big hex string to BigInt, return undef for error
my $hs = shift;
@@ -2511,6 +2527,7 @@ sub __from_hex
sub __from_bin
{
+ # internal
# convert a (ref to) big binary string to BigInt, return undef for error
my $bs = shift;
@@ -2530,10 +2547,11 @@ sub __from_bin
sub _split
{
- # (ref to num_str) return num_str
- # internal, take apart a string and return the pieces
- # strip leading/trailing whitespace, leading zeros, underscore and reject
- # invalid input
+ # input: num_str; output: undef for invalid or
+ # (\$mantissa_sign,\$mantissa_value,\$mantissa_fraction,\$exp_sign,\$exp_value)
+ # Internal, take apart a string and return the pieces.
+ # Strip leading/trailing whitespace, leading zeros, underscore and reject
+ # invalid input.
my $x = shift;
# strip white space at front, also extranous leading zeros
@@ -2601,13 +2619,15 @@ sub __lcm
# does modify first argument
# LCM
- my $x = shift; my $ty = shift;
+ my ($x,$ty) = @_;
return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan);
- $x * $ty / bgcd($x,$ty);
+ my $method = ref($x) . '::bgcd';
+ no strict 'refs';
+ $x * $ty / &$method($x,$ty);
}
###############################################################################
-# this method return 0 if the object can be modified, or 1 for not
+# this method returns 0 if the object can be modified, or 1 if not.
# We use a fast constant sub() here, to avoid costly calls. Subclasses
# may override it with special code (f.i. Math::BigInt::Constant does so)
@@ -2727,7 +2747,7 @@ Math::BigInt - Arbitrary size integer math package
$x->length(); # return number of digits in number
($xl,$f) = $x->length(); # length of number and length of fraction part,
- # latter is always 0 digits long for BigInt's
+ # latter is always 0 digits long for BigInts
$x->exponent(); # return exponent as BigInt
$x->mantissa(); # return (signed) mantissa as BigInt
@@ -2737,8 +2757,8 @@ Math::BigInt - Arbitrary size integer math package
$x->numify(); # return as scalar (might overflow!)
# conversation to string (do not modify their argument)
- $x->bstr(); # normalized string
- $x->bsstr(); # normalized string in scientific notation
+ $x->bstr(); # normalized string (e.g. '3')
+ $x->bsstr(); # norm. string in scientific notation (e.g. '3E0')
$x->as_hex(); # as signed hexadecimal string with prefixed 0x
$x->as_bin(); # as signed binary string with prefixed 0b
@@ -2750,9 +2770,11 @@ Math::BigInt - Arbitrary size integer math package
$x->accuracy($n); # set A $x to $n
# Global methods
- Math::BigInt->precision(); # get/set global P for all BigInt objects
- Math::BigInt->accuracy(); # get/set global A for all BigInt objects
- Math::BigInt->config(); # return hash containing configuration
+ Math::BigInt->precision(); # get/set global P for all BigInt objects
+ Math::BigInt->accuracy(); # get/set global A for all BigInt objects
+ Math::BigInt->round_mode(); # get/set global round mode, one of
+ # 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
+ Math::BigInt->config(); # return hash containing configuration
=head1 DESCRIPTION
@@ -2796,19 +2818,20 @@ object from the input.
=item Output
-Output values are BigInt objects (normalized), except for bstr(), which
-returns a string in normalized form.
+Output values are BigInt objects (normalized), except for the methods which
+return a string (see L<SYNOPSIS>).
+
Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>,
-C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
-return either undef, <0, 0 or >0 and are suited for sort.
+C<is_nan()>, etc.) return true or false, while others (C<bcmp()>, C<bacmp()>)
+return either undef (if NaN is involved), <0, 0 or >0 and are suited for sort.
=back
=head1 METHODS
Each of the methods below (except config(), accuracy() and precision())
-accepts three additional parameters. These arguments $A, $P and $R are
-accuracy, precision and round_mode. Please see the section about
+accepts three additional parameters. These arguments C<$A>, C<$P> and C<$R>
+are C<accuracy>, C<precision> and C<round_mode>. Please see the section about
L<ACCURACY and PRECISION> for more information.
=head2 config
@@ -3022,12 +3045,12 @@ like:
=head2 is_pos()/is_neg()
- $x->is_pos(); # true if >= 0
- $x->is_neg(); # true if < 0
+ $x->is_pos(); # true if > 0
+ $x->is_neg(); # true if < 0
The methods return true if the argument is positive or negative, respectively.
C<NaN> is neither positive nor negative, while C<+inf> counts as positive, and
-C<-inf> is negative. A C<zero> is positive.
+C<-inf> is negative. A C<zero> is neither positive nor negative.
These methods are only testing the sign, and not the value.
@@ -3066,6 +3089,14 @@ Compares $x with $y while ignoring their. Returns -1, 0, 1 or undef.
Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN.
+If you want $x to have a certain sign, use one of the following methods:
+
+ $x->babs(); # '+'
+ $x->babs()->bneg(); # '-'
+ $x->bnan(); # 'NaN'
+ $x->binf(); # '+inf'
+ $x->binf('-'); # '-inf'
+
=head2 digit
$x->digit($n); # return the nth digit, counting from right
@@ -3645,12 +3676,58 @@ This is how it works now:
=back
+=head1 Infinity and Not a Number
+
+While BigInt has extensive handling of inf and NaN, certain quirks remain.
+
+=over 2
+
+=item oct()/hex()
+
+These perl routines currently (as of Perl v.5.8.6) cannot handle passed
+inf.
+
+ te@linux:~> perl -wle 'print 2 ** 3333'
+ inf
+ te@linux:~> perl -wle 'print 2 ** 3333 == 2 ** 3333'
+ 1
+ te@linux:~> perl -wle 'print oct(2 ** 3333)'
+ 0
+ te@linux:~> perl -wle 'print hex(2 ** 3333)'
+ Illegal hexadecimal digit 'i' ignored at -e line 1.
+ 0
+
+The same problems occur if you pass them Math::BigInt->binf() objects. Since
+overloading these routines is not possible, this cannot be fixed from BigInt.
+
+=item ==, !=, <, >, <=, >= with NaNs
+
+BigInt's bcmp() routine currently returns undef to signal that a NaN was
+involved in a comparisation. However, the overload code turns that into
+either 1 or '' and thus operations like C<< NaN != NaN >> might return
+wrong values.
+
+=item log(-inf)
+
+C<< log(-inf) >> is highly weird. Since log(-x)=pi*i+log(x), then
+log(-inf)=pi*i+inf. However, since the imaginary part is finite, the real
+infinity "overshadows" it, so the number might as well just be infinity.
+However, the result is a complex number, and since BigInt/BigFloat can only
+have real numbers as results, the result is NaN.
+
+=item exp(), cos(), sin(), atan2()
+
+These all might have problems handling infinity right.
+
+=back
+
=head1 INTERNALS
The actual numbers are stored as unsigned big integers (with seperate sign).
+
You should neither care about nor depend on the internal representation; it
-might change without notice. Use only method calls like C<< $x->sign(); >>
-instead relying on the internal hash keys like in C<< $x->{sign}; >>.
+might change without notice. Use B<ONLY> method calls like C<< $x->sign(); >>
+instead relying on the internal representation.
=head2 MATH LIBRARY
@@ -3669,20 +3746,21 @@ Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc:
use Math::BigInt lib => 'Foo,Math::BigInt::Bar';
Since Math::BigInt::GMP is in almost all cases faster than Calc (especially in
-cases involving really big numbers, where it is B<much> faster), and there is
+math involving really big numbers, where it is B<much> faster), and there is
no penalty if Math::BigInt::GMP is not installed, it is a good idea to always
use the following:
use Math::BigInt lib => 'GMP';
Different low-level libraries use different formats to store the
-numbers. You should not depend on the number having a specific format.
+numbers. You should B<NOT> depend on the number having a specific format
+internally.
See the respective math library module documentation for further details.
=head2 SIGN
-The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately.
+The sign is either '+', '-', 'NaN', '+inf' or '-inf'.
A sign of 'NaN' is used to represent the result when input arguments are not
numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively
@@ -4042,6 +4120,9 @@ Alternatively, simple use C<< <=> >> for comparisations, this will get it
always right. There is not yet a way to get a number automatically represented
as a string that matches exactly the way Perl represents it.
+See also the section about L<Infinity and Not a Number> for problems in
+comparing NaNs.
+
=item int()
C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a
@@ -4052,15 +4133,26 @@ Perl scalar:
$x = Math::BigFloat->new(123.45);
$y = int($x); # BigInt 123
-In all Perl versions you can use C<as_number()> for the same effect:
+In all Perl versions you can use C<as_number()> or C<as_int> for the same
+effect:
$x = Math::BigFloat->new(123.45);
$y = $x->as_number(); # BigInt 123
+ $y = $x->as_int(); # ditto
This also works for other subclasses, like Math::String.
It is yet unlcear whether overloaded int() should return a scalar or a BigInt.
+If you want a real Perl scalar, use C<numify()>:
+
+ $y = $x->numify(); # 123 as scalar
+
+This is seldom necessary, though, because this is done automatically, like
+when you access an array:
+
+ $z = $array[$x]; # does work automatically
+
=item length
The following will probably not do what you expect:
@@ -4213,9 +4305,6 @@ since overload calls C<sub($x,0,1);> instead of C<neg($x)>. The first variant
needs to preserve $x since it does not know that it later will get overwritten.
This makes a copy of $x and takes O(N), but $x->bneg() is O(1).
-With Copy-On-Write, this issue would be gone, but C-o-W is not implemented
-since it is slower for all other things.
-
=item Mixing different object types
In Perl you will get a floating point value if you do one of the following:
@@ -4320,8 +4409,8 @@ subclass files and benchmarks.
=head1 AUTHORS
Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
-Completely rewritten by Tels http://bloodgate.com in late 2000, 2001 - 2003
-and still at it in 2004.
+Completely rewritten by Tels http://bloodgate.com in late 2000, 2001 - 2004
+and still at it in 2005.
Many people contributed in one or more ways to the final beast, see the file
CREDITS for an (uncomplete) list. If you miss your name, please drop me a
diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm
index 3d53b0c414..41183f5e7c 100644
--- a/lib/Math/BigInt/Calc.pm
+++ b/lib/Math/BigInt/Calc.pm
@@ -6,7 +6,7 @@ use strict;
use vars qw/$VERSION/;
-$VERSION = '0.43';
+$VERSION = '0.44';
# Package to store unsigned big integers in decimal and do math with them
@@ -36,7 +36,6 @@ $VERSION = '0.43';
sub api_version () { 1; }
# constants for easier life
-my $nan = 'NaN';
my ($MBASE,$BASE,$RBASE,$BASE_LEN,$MAX_VAL,$BASE_LEN_SMALL);
my ($AND_BITS,$XOR_BITS,$OR_BITS);
my ($AND_MASK,$XOR_MASK,$OR_MASK);
@@ -71,7 +70,9 @@ sub _base_len
$MBASE = int("1e".$BASE_LEN_SMALL);
$RBASE = abs('1e-'.$BASE_LEN_SMALL); # see USE_MUL
$MAX_VAL = $MBASE-1;
-
+
+ # avoid redefinitions
+
undef &_mul;
undef &_div;
@@ -132,13 +133,9 @@ BEGIN
$e = 7 if $e > 7; # cap, for VMS, OS/390 and other 64 bit systems
# 8 fails inside random testsuite, so take 7
- # determine how many digits fit into an integer and can be safely added
- # together plus carry w/o causing an overflow
-
- use integer;
-
__PACKAGE__->_base_len($e); # set and store
+ use integer;
# find out how many bits _and, _or and _xor can take (old default = 16)
# I don't think anybody has yet 128 bit scalars, so let's play safe.
local $^W = 0; # don't warn about 'nonportable number'
@@ -221,11 +218,15 @@ sub _str
# Convert number from internal base 100000 format to string format.
# internal format is always normalized (no leading zeros, "-0" => "+0")
my $ar = $_[1];
- my $ret = "";
- my $l = scalar @$ar; # number of parts
- return $nan if $l < 1; # should not happen
+ my $l = scalar @$ar; # number of parts
+ if ($l < 1) # should not happen
+ {
+ require Carp;
+ Carp::croak("$_[1] has no elements");
+ }
+ my $ret = "";
# handle first one different to strip leading zeros from it (there are no
# leading zero parts in internal representation)
$l --; $ret .= int($ar->[$l]); $l--;
@@ -572,8 +573,19 @@ sub _div_use_mul
# now calculate $x / $yorg
if (length(int($yorg->[-1])) == length(int($x->[-1])))
{
- # same length, so make full compare, and if equal, return 1
- # hm, same lengths, but same contents? So we need to check all parts:
+
+ # We take a shortcut here, because the result must be
+ # between 1 and MAX_VAL (e.g. one element) and rem is not wanted.
+ if (!wantarray)
+ {
+ $x->[0] = int($x->[-1] / $yorg->[-1]);
+ splice(@$x,1); # keep single element
+ return $x;
+ }
+
+ # wantarray: return (x,rem)
+ # same length, so make full compare
+
my $a = 0; my $j = scalar @$x - 1;
# manual way (abort if unequal, good for early ne)
while ($j >= 0)
@@ -581,25 +593,17 @@ sub _div_use_mul
last if ($a = $x->[$j] - $yorg->[$j]); $j--;
}
# $a contains the result of the compare between X and Y
- # a < 0: x < y, a == 0 => x == y, a > 0: x > y
+ # a < 0: x < y, a == 0: x == y, a > 0: x > y
if ($a <= 0)
{
- if (wantarray)
- {
- $rem = [ 0 ]; # a = 0 => x == y => rem 1
- $rem = [@$x] if $a != 0; # a < 0 => x < y => rem = x
- }
- splice(@$x,1); # keep single element
- $x->[0] = 0; # if $a < 0
- if ($a == 0)
- {
- # $x == $y
- $x->[0] = 1;
- }
- return ($x,$rem) if wantarray;
- return $x;
+ $rem = [ 0 ]; # a = 0 => x == y => rem 0
+ $rem = [@$x] if $a != 0; # a < 0 => x < y => rem = x
+ splice(@$x,1); # keep single element
+ $x->[0] = 0; # if $a < 0
+ $x->[0] = 1 if $a == 0; # $x == $y
+ return ($x,$rem);
}
- # $x >= $y, proceed normally
+ # $x >= $y, so proceed normally
}
}
@@ -766,8 +770,19 @@ sub _div_use_div
if (length(int($yorg->[-1])) == length(int($x->[-1])))
{
- # same length, so make full compare, and if equal, return 1
- # hm, same lengths, but same contents? So we need to check all parts:
+
+ # We take a shortcut here, because the result must be
+ # between 1 and MAX_VAL (e.g. one element) and rem is not wanted.
+ if (!wantarray)
+ {
+ $x->[0] = int($x->[-1] / $yorg->[-1]);
+ splice(@$x,1); # keep single element
+ return $x;
+ }
+
+ # wantarray: return (x,rem)
+ # same length, so make full compare
+
my $a = 0; my $j = scalar @$x - 1;
# manual way (abort if unequal, good for early ne)
while ($j >= 0)
@@ -775,25 +790,18 @@ sub _div_use_div
last if ($a = $x->[$j] - $yorg->[$j]); $j--;
}
# $a contains the result of the compare between X and Y
- # a < 0: x < y, a == 0 => x == y, a > 0: x > y
+ # a < 0: x < y, a == 0: x == y, a > 0: x > y
if ($a <= 0)
{
- if (wantarray)
- {
- $rem = [ 0 ]; # a = 0 => x == y => rem 1
- $rem = [@$x] if $a != 0; # a < 0 => x < y => rem = x
- }
+ $rem = [ 0 ]; # a = 0 => x == y => rem 0
+ $rem = [@$x] if $a != 0; # a < 0 => x < y => rem = x
splice(@$x,1); # keep single element
$x->[0] = 0; # if $a < 0
- if ($a == 0)
- {
- # $x == $y
- $x->[0] = 1;
- }
- return ($x,$rem) if wantarray;
- return $x;
+ $x->[0] = 1 if $a == 0; # $x == $y
+ return ($x,$rem);
}
# $x >= $y, so proceed normally
+
}
}
@@ -1928,7 +1936,7 @@ sub _gcd
# greatest common divisor
my ($c,$x,$y) = @_;
- while (! _is_zero($c,$y))
+ while ( (scalar @$y != 1) || ($y->[0] != 0) ) # while ($y != 0)
{
my $t = _copy($c,$y);
$y = _mod($c, $x, $y);
@@ -2103,8 +2111,8 @@ the same terms as Perl itself.
Original math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/>
in late 2000.
Seperated from BigInt and shaped API with the help of John Peacock.
-Fixed, sped-up and enhanced by Tels http://bloodgate.com 2001-2003.
-Further streamlining (api_version 1) by Tels 2004.
+
+Fixed, speed-up, streamlined and enhanced by Tels 2001 - 2005.
=head1 SEE ALSO
diff --git a/lib/Math/BigInt/CalcEmu.pm b/lib/Math/BigInt/CalcEmu.pm
index 9f7fd16434..f56b51a3b9 100644
--- a/lib/Math/BigInt/CalcEmu.pm
+++ b/lib/Math/BigInt/CalcEmu.pm
@@ -5,7 +5,7 @@ use strict;
# use warnings; # dont use warnings for older Perls
use vars qw/$VERSION/;
-$VERSION = '0.04';
+$VERSION = '0.05';
package Math::BigInt;
@@ -16,6 +16,8 @@ my $CALC_EMU;
BEGIN
{
$CALC_EMU = Math::BigInt->config()->{'lib'};
+ # register us with MBI to get notified of future lib changes
+ Math::BigInt::_register_callback( __PACKAGE__, sub { $CALC_EMU = $_[0]; } );
}
sub __emu_band
@@ -288,19 +290,27 @@ Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
=head1 SYNOPSIS
+ use Math::BigInt::CalcEmu;
+
+=head1 DESCRIPTION
+
Contains routines that emulate low-level math functions in BigInt, e.g.
optional routines the low-level math package does not provide on it's own.
-Will be loaded on demand and automatically by BigInt.
-
-Stuff here is really low-priority to optimize,
-since it is far better to implement the operation in the low-level math
-libary directly, possible even using a call to the native lib.
+Will be loaded on demand and called automatically by BigInt.
-=head1 DESCRIPTION
+Stuff here is really low-priority to optimize, since it is far better to
+implement the operation in the low-level math libary directly, possible even
+using a call to the native lib.
=head1 METHODS
+=head2 __emu_bxor
+
+=head2 __emu_band
+
+=head2 __emu_bior
+
=head1 LICENSE
This program is free software; you may redistribute it and/or modify it under
diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t
index a79dff1bb3..9a12572e14 100644
--- a/lib/Math/BigInt/t/bare_mbf.t
+++ b/lib/Math/BigInt/t/bare_mbf.t
@@ -27,7 +27,7 @@ BEGIN
}
print "# INC = @INC\n";
- plan tests => 1924;
+ plan tests => 1992;
}
use Math::BigFloat lib => 'BareCalc';
diff --git a/lib/Math/BigInt/t/bare_mbi.t b/lib/Math/BigInt/t/bare_mbi.t
index 6695492521..bf08a90f34 100644
--- a/lib/Math/BigInt/t/bare_mbi.t
+++ b/lib/Math/BigInt/t/bare_mbi.t
@@ -26,7 +26,7 @@ BEGIN
}
print "# INC = @INC\n";
- plan tests => 2952;
+ plan tests => 3012;
}
use Math::BigInt lib => 'BareCalc';
diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc
index 131e4531b9..5f27a8b8cb 100644
--- a/lib/Math/BigInt/t/bigfltpm.inc
+++ b/lib/Math/BigInt/t/bigfltpm.inc
@@ -4,6 +4,8 @@ ok ($class->config()->{lib},$CL);
use strict;
+my $z;
+
while (<DATA>)
{
chomp;
@@ -87,7 +89,27 @@ while (<DATA>)
else
{
$try .= "\$y = $class->new(\"$args[1]\");";
- if ($f eq "fcmp") {
+
+ if ($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 "fcmp") {
$try .= '$x <=> $y;';
} elsif ($f eq "facmp") {
$try .= '$x->facmp($y);';
@@ -115,6 +137,7 @@ while (<DATA>)
}
# print "# Trying: '$try'\n";
$ans1 = eval $try;
+ print "# Error: $@\n" if $@;
if ($ans =~ m|^/(.*)$|)
{
my $pat = $1;
@@ -337,6 +360,42 @@ sub ok_undef
}
__DATA__
+&bgcd
+inf:12:NaN
+-inf:12:NaN
+12:inf:NaN
+12:-inf:NaN
+inf:inf:NaN
+inf:-inf:NaN
+-inf:-inf:NaN
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:0
++0:+1:1
++1:+0:1
++1:+1:1
++2:+3:1
++3:+2:1
+-3:+2:1
+-3:-2:1
+-144:-60:12
+144:-60:12
+144:60:12
+100:625:25
+4096:81:1
+1034:804:2
+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
$div_scale = 40;
&flog
0::NaN
@@ -1479,7 +1538,7 @@ abc:0
1200:1
-1200:1
&is_positive
-0:1
+0:0
1:1
-1:0
-123:0
diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t
index 238a23fced..5cc9ddbbda 100755
--- a/lib/Math/BigInt/t/bigfltpm.t
+++ b/lib/Math/BigInt/t/bigfltpm.t
@@ -26,7 +26,7 @@ BEGIN
}
print "# INC = @INC\n";
- plan tests => 1924
+ plan tests => 1992
+ 2; # own tests
}
diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc
index 6453879048..2a2bfe11e9 100644
--- a/lib/Math/BigInt/t/bigintpm.inc
+++ b/lib/Math/BigInt/t/bigintpm.inc
@@ -778,7 +778,7 @@ inf:inf:NaN
-inf:1
NaNneg:0
&is_positive
-0:1
+0:0
-1:0
1:1
+inf:1
@@ -1497,6 +1497,27 @@ inf:0:inf,inf
1234567890999999999:9876543210:124999998,9503086419
1234567890000000000:9876543210:124999998,8503086420
96969696969696969696969696969678787878626262626262626262626262:484848484848484848484848486666666666666689898989898989898989:199,484848484848484848484848123012121211954972727272727272727451
+# excercise shortcut for numbers of the same length in div
+999999999999999999999999999999999:999999999999999999999999999999999:1,0
+999999999999999999999999999999999:888888888888888888888888888888888:1,111111111111111111111111111111111
+999999999999999999999999999999999:777777777777777777777777777777777:1,222222222222222222222222222222222
+999999999999999999999999999999999:666666666666666666666666666666666:1,333333333333333333333333333333333
+999999999999999999999999999999999:555555555555555555555555555555555:1,444444444444444444444444444444444
+999999999999999999999999999999999:444444444444444444444444444444444:2,111111111111111111111111111111111
+999999999999999999999999999999999:333333333333333333333333333333333:3,0
+999999999999999999999999999999999:222222222222222222222222222222222:4,111111111111111111111111111111111
+999999999999999999999999999999999:111111111111111111111111111111111:9,0
+9999999_9999999_9999999_9999999:3333333_3333333_3333333_3333333:3,0
+9999999_9999999_9999999_9999999:3333333_0000000_0000000_0000000:3,999999999999999999999
+9999999_9999999_9999999_9999999:3000000_0000000_0000000_0000000:3,999999999999999999999999999
+9999999_9999999_9999999_9999999:2000000_0000000_0000000_0000000:4,1999999999999999999999999999
+9999999_9999999_9999999_9999999:1000000_0000000_0000000_0000000:9,999999999999999999999999999
+9999999_9999999_9999999_9999999:100000_0000000_0000000_0000000:99,99999999999999999999999999
+9999999_9999999_9999999_9999999:10000_0000000_0000000_0000000:999,9999999999999999999999999
+9999999_9999999_9999999_9999999:1000_0000000_0000000_0000000:9999,999999999999999999999999
+9999999_9999999_9999999_9999999:100_0000000_0000000_0000000:99999,99999999999999999999999
+9999999_9999999_9999999_9999999:10_0000000_0000000_0000000:999999,9999999999999999999999
+9999999_9999999_9999999_9999999:1_0000000_0000000_0000000:9999999,999999999999999999999
&bdiv
abc:abc:NaN
abc:1:NaN
@@ -1591,6 +1612,27 @@ inf:0:inf
84696969696969696943434343434871161616161616161452525252486813131313131313143230042929292929292930:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6449999999999999998
84696969696969696969696969697497424242424242424242424242385803030303030303030300750000000000000000:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6450000000000000000
84696969696969696930303030303558030303030303030057575757537318181818181818199694689393939393939395:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6449999999999999997
+# excercise shortcut for numbers of the same length in div
+999999999999999999999999999999999:999999999999999999999999999999999:1
+999999999999999999999999999999999:888888888888888888888888888888888:1
+999999999999999999999999999999999:777777777777777777777777777777777:1
+999999999999999999999999999999999:666666666666666666666666666666666:1
+999999999999999999999999999999999:555555555555555555555555555555555:1
+999999999999999999999999999999999:444444444444444444444444444444444:2
+999999999999999999999999999999999:333333333333333333333333333333333:3
+999999999999999999999999999999999:222222222222222222222222222222222:4
+999999999999999999999999999999999:111111111111111111111111111111111:9
+9999999_9999999_9999999_9999999:3333333_3333333_3333333_3333333:3
+9999999_9999999_9999999_9999999:3333333_0000000_0000000_0000000:3
+9999999_9999999_9999999_9999999:3000000_0000000_0000000_0000000:3
+9999999_9999999_9999999_9999999:2000000_0000000_0000000_0000000:4
+9999999_9999999_9999999_9999999:1000000_0000000_0000000_0000000:9
+9999999_9999999_9999999_9999999:100000_0000000_0000000_0000000:99
+9999999_9999999_9999999_9999999:10000_0000000_0000000_0000000:999
+9999999_9999999_9999999_9999999:1000_0000000_0000000_0000000:9999
+9999999_9999999_9999999_9999999:100_0000000_0000000_0000000:99999
+9999999_9999999_9999999_9999999:10_0000000_0000000_0000000:999999
+9999999_9999999_9999999_9999999:1_0000000_0000000_0000000:9999999
&bmodinv
# format: number:modulus:result
# bmodinv Data errors
diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t
index 6cd19f9b6f..16f4d32a30 100755
--- a/lib/Math/BigInt/t/bigintpm.t
+++ b/lib/Math/BigInt/t/bigintpm.t
@@ -10,7 +10,7 @@ BEGIN
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 2952;
+ plan tests => 3012;
}
use Math::BigInt;
diff --git a/lib/Math/BigInt/t/inf_nan.t b/lib/Math/BigInt/t/inf_nan.t
index 852ffed7bd..0e5294fe44 100644
--- a/lib/Math/BigInt/t/inf_nan.t
+++ b/lib/Math/BigInt/t/inf_nan.t
@@ -3,16 +3,11 @@
# test inf/NaN handling all in one place
# Thanx to Jarkko for the excellent explanations and the tables
-use Test;
+use Test::More;
use strict;
BEGIN
{
- chdir 't' if -d 't';
- unshift @INC, '../lib';
- }
-BEGIN
- {
$| = 1;
# to locate the testing files
my $location = $0; $location =~ s/inf_nan.t//i;
@@ -35,7 +30,9 @@ BEGIN
# values groups operators classes tests
plan tests => 7 * 6 * 5 * 4 * 2 +
- 7 * 6 * 2 * 4 * 1; # bmod
+ 7 * 6 * 2 * 4 * 1 # bmod
+;
+# see bottom: + 4 * 10; # 4 classes * 10 NaN == NaN tests
}
use Math::BigInt;
@@ -109,10 +106,8 @@ foreach (qw/
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
my $r = $x->badd($y);
- print "# x $class $args[0] + $args[1] should be $args[2] but is $x\n",
- if !ok ($x->bstr(),$args[2]);
- print "# r $class $args[0] + $args[1] should be $args[2] but is $r\n",
- if !ok ($x->bstr(),$args[2]);
+ is($x->bstr(),$args[2],"x $class $args[0] + $args[1]");
+ is($x->bstr(),$args[2],"r $class $args[0] + $args[1]");
}
}
@@ -175,10 +170,8 @@ foreach (qw/
$args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0
my $r = $x->bsub($y);
- print "# x $class $args[0] - $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bstr(),$args[2]);
- print "# r $class $args[0] - $args[1] should be $args[2] but is $r\n"
- if !ok ($r->bstr(),$args[2]);
+ is($x->bstr(),$args[2],"x $class $args[0] - $args[1]");
+ is($r->bstr(),$args[2],"r $class $args[0] - $args[1]");
}
}
@@ -242,10 +235,8 @@ foreach (qw/
$args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0
my $r = $x->bmul($y);
- print "# x $class $args[0] * $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bstr(),$args[2]);
- print "# r $class $args[0] * $args[1] should be $args[2] but is $r\n"
- if !ok ($r->bstr(),$args[2]);
+ is($x->bstr(),$args[2],"x $class $args[0] * $args[1]");
+ is($r->bstr(),$args[2],"r $class $args[0] * $args[1]");
}
}
@@ -312,30 +303,53 @@ foreach (qw/
# bdiv in scalar context
my $r = $x->bdiv($y);
- print "# x $class $args[0] / $args[1] should be $args[2] but is $x\n"
- if !ok ($x->bstr(),$args[2]);
- print "# r $class $args[0] / $args[1] should be $args[2] but is $r\n"
- if !ok ($r->bstr(),$args[2]);
+ is($x->bstr(),$args[2],"x $class $args[0] / $args[1]");
+ is($r->bstr(),$args[2],"r $class $args[0] / $args[1]");
# bmod and bdiv in list context
my ($d,$rem) = $t->bdiv($y);
# bdiv in list context
- print "# t $class $args[0] / $args[1] should be $args[2] but is $t\n"
- if !ok ($t->bstr(),$args[2]);
- print "# d $class $args[0] / $args[1] should be $args[2] but is $d\n"
- if !ok ($d->bstr(),$args[2]);
+ is($t->bstr(),$args[2],"t $class $args[0] / $args[1]");
+ is($d->bstr(),$args[2],"d $class $args[0] / $args[1]");
# bmod
my $m = $tmod->bmod($y);
# bmod() agrees with bdiv?
- print "# m $class $args[0] % $args[1] should be $rem but is $m\n"
- if !ok ($m->bstr(),$rem->bstr());
+ is($m->bstr(),$rem->bstr(),"m $class $args[0] % $args[1]");
# bmod() return agrees with set value?
- print "# o $class $args[0] % $args[1] should be $m ($rem) but is $tmod\n"
- if !ok ($tmod->bstr(),$m->bstr());
+ is($tmod->bstr(),$m->bstr(),"o $class $args[0] % $args[1]");
}
}
+#############################################################################
+# overloaded comparisations
+
+# these are disabled for now, since Perl itself can't seem to make up it's
+# mind what NaN actually is, see [perl #33106].
+
+#
+#foreach my $c (@classes)
+# {
+# my $x = $c->bnan();
+# my $y = $c->bnan(); # test with two different objects, too
+# my $a = $c->bzero();
+#
+# is ($x == $y, undef, 'NaN == NaN: undef');
+# is ($x != $y, 1, 'NaN != NaN: 1');
+#
+# is ($x == $x, undef, 'NaN == NaN: undef');
+# is ($x != $x, 1, 'NaN != NaN: 1');
+#
+# is ($a != $x, 1, '0 != NaN: 1');
+# is ($a == $x, undef, '0 == NaN: undef');
+#
+# is ($a < $x, undef, '0 < NaN: undef');
+# is ($a <= $x, undef, '0 <= NaN: undef');
+# is ($a >= $x, undef, '0 >= NaN: undef');
+# is ($a > $x, undef, '0 > NaN: undef');
+# }
+
+# All done.
diff --git a/lib/Math/BigInt/t/lib_load.t b/lib/Math/BigInt/t/lib_load.t
new file mode 100644
index 0000000000..3aff7c4037
--- /dev/null
+++ b/lib/Math/BigInt/t/lib_load.t
@@ -0,0 +1,45 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/sub_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 => 2;
+ }
+
+# first load BigInt with Calc
+use Math::BigInt lib => 'Calc';
+
+# BigFloat will remember that we loaded Calc
+require Math::BigFloat;
+is (Math::BigFloat::config()->{lib}, 'Math::BigInt::Calc', 'BigFloat got Calc');
+
+# now load BigInt again with a different lib
+Math::BigInt->import( lib => 'BareCalc' );
+
+# and finally test that BigFloat knows about BareCalc
+
+is (Math::BigFloat::config()->{lib}, 'Math::BigInt::BareCalc', 'BigFloat was notified');
+
diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t
index e9209b70c4..73d7fc0e21 100755
--- a/lib/Math/BigInt/t/sub_mbf.t
+++ b/lib/Math/BigInt/t/sub_mbf.t
@@ -26,7 +26,7 @@ BEGIN
}
print "# INC = @INC\n";
- plan tests => 1924
+ plan tests => 1992
+ 6; # + our own tests
}
diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t
index ee48b81234..4d4fc4eada 100755
--- a/lib/Math/BigInt/t/sub_mbi.t
+++ b/lib/Math/BigInt/t/sub_mbi.t
@@ -26,7 +26,7 @@ BEGIN
}
print "# INC = @INC\n";
- plan tests => 2952
+ plan tests => 3012
+ 5; # +5 own tests
}
diff --git a/lib/Math/BigInt/t/upgrade.inc b/lib/Math/BigInt/t/upgrade.inc
index aac4a055eb..6545edb6e4 100644
--- a/lib/Math/BigInt/t/upgrade.inc
+++ b/lib/Math/BigInt/t/upgrade.inc
@@ -295,7 +295,7 @@ __DATA__
-inf:1
NaNneg:0
&is_positive
-0:1
+0:0
-1:0
1:1
+inf:1
diff --git a/lib/Math/BigInt/t/with_sub.t b/lib/Math/BigInt/t/with_sub.t
index 8611e45b12..0ed85a4f4c 100644
--- a/lib/Math/BigInt/t/with_sub.t
+++ b/lib/Math/BigInt/t/with_sub.t
@@ -28,7 +28,7 @@ BEGIN
}
print "# INC = @INC\n";
- plan tests => 1924
+ plan tests => 1992
+ 1;
}
diff --git a/lib/Math/BigRat.pm b/lib/Math/BigRat.pm
index 6053c99b80..523088a273 100644
--- a/lib/Math/BigRat.pm
+++ b/lib/Math/BigRat.pm
@@ -9,7 +9,6 @@
# _n : numeraotr (value = _n/_d)
# _a : accuracy
# _p : precision
-# _f : flags, used by MBR to flag parts of a rational as untouchable
# You should not look at the innards of a BigRat - use the methods for this.
package Math::BigRat;
@@ -24,7 +23,7 @@ use vars qw($VERSION @ISA $upgrade $downgrade
@ISA = qw(Exporter Math::BigFloat);
-$VERSION = '0.13';
+$VERSION = '0.14';
use overload; # inherit overload from Math::BigFloat
@@ -37,6 +36,9 @@ BEGIN
# Math::BigInt::config->('lib'); (there is always only one library loaded)
*_e_add = \&Math::BigFloat::_e_add;
*_e_sub = \&Math::BigFloat::_e_sub;
+ *as_int = \&as_number;
+ *is_pos = \&is_positive;
+ *is_neg = \&is_negative;
}
##############################################################################
@@ -101,12 +103,11 @@ sub new
# create a Math::BigRat
my $class = shift;
- my ($n,$d) = shift;
+ my ($n,$d) = @_;
my $self = { }; bless $self,$class;
- # input like (BigInt,BigInt) or (BigFloat,BigFloat) not handled yet
-
+ # input like (BigInt) or (BigFloat):
if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
{
if ($n->isa('Math::BigFloat'))
@@ -116,7 +117,7 @@ sub new
if ($n->isa('Math::BigInt'))
{
# TODO: trap NaN, inf
- $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = $n
+ $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N
$self->{_d} = $MBI->_one(); # d => 1
$self->{sign} = $n->{sign};
}
@@ -124,11 +125,56 @@ sub new
{
# TODO: trap NaN, inf
$self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
- $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = $n
+ $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = N
$self->{_d} = $MBI->_one(); # d => 1
}
return $self->bnorm(); # normalize (120/1 => 12/10)
}
+
+ # input like (BigInt,BigInt) or (BigLite,BigLite):
+ if (ref($d) && ref($n))
+ {
+ # do N first (for $self->{sign}):
+ if ($n->isa('Math::BigInt'))
+ {
+ # TODO: trap NaN, inf
+ $self->{_n} = $MBI->_copy($n->{value}); # "mantissa" = N
+ $self->{sign} = $n->{sign};
+ }
+ elsif ($n->isa('Math::BigInt::Lite'))
+ {
+ # TODO: trap NaN, inf
+ $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
+ $self->{_n} = $MBI->_new(abs($$n)); # "mantissa" = $n
+ }
+ else
+ {
+ require Carp;
+ Carp::croak(ref($n) . " is not a recognized object format for Math::BigRat->new");
+ }
+ # now D:
+ if ($d->isa('Math::BigInt'))
+ {
+ # TODO: trap NaN, inf
+ $self->{_d} = $MBI->_copy($d->{value}); # "mantissa" = D
+ # +/+ or -/- => +, +/- or -/+ => -
+ $self->{sign} = $d->{sign} ne $self->{sign} ? '-' : '+';
+ }
+ elsif ($d->isa('Math::BigInt::Lite'))
+ {
+ # TODO: trap NaN, inf
+ $self->{_d} = $MBI->_new(abs($$d)); # "mantissa" = D
+ my $ds = '+'; $ds = '-' if $$d < 0;
+ # +/+ or -/- => +, +/- or -/+ => -
+ $self->{sign} = $ds ne $self->{sign} ? '-' : '+';
+ }
+ else
+ {
+ require Carp;
+ Carp::croak(ref($d) . " is not a recognized object format for Math::BigRat->new");
+ }
+ return $self->bnorm(); # normalize (120/1 => 12/10)
+ }
return $n->copy() if ref $n; # already a BigRat
if (!defined $n)
@@ -266,15 +312,12 @@ sub new
sub copy
{
- my ($c,$x);
- if (@_ > 1)
- {
- # if two arguments, the first one is the class to "swallow" subclasses
- ($c,$x) = @_;
- }
- else
+ # if two arguments, the first one is the class to "swallow" subclasses
+ my ($c,$x) = @_;
+
+ if (scalar @_ == 1)
{
- $x = shift;
+ $x = $_[0];
$c = ref($x);
}
return unless ref($x); # only for objects
@@ -294,7 +337,7 @@ sub copy
sub config
{
# return (later set?) configuration data as hash ref
- my $class = shift || 'Math::BigFloat';
+ my $class = shift || 'Math::BigRat';
my $cfg = $class->SUPER::config(@_);
@@ -324,7 +367,7 @@ sub bstr
sub bsstr
{
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
if ($x->{sign} !~ /^[+-]$/) # inf, NaN etc
{
@@ -339,7 +382,7 @@ sub bsstr
sub bnorm
{
# reduce the number to the shortest form
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
# Both parts must be objects of whatever we are using today.
# Second check because Calc.pm has ARRAY res as unblessed objects.
@@ -378,6 +421,22 @@ sub bnorm
}
##############################################################################
+# sign manipulation
+
+sub bneg
+ {
+ # (BRAT or num_str) return BRAT
+ # negate number or make a negated number from string
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
+
+ return $x if $x->modify('bneg');
+
+ # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
+ $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_n}));
+ $x;
+ }
+
+##############################################################################
# special values
sub _bnan
@@ -1195,16 +1254,15 @@ sub bacmp
sub numify
{
# convert 17/8 => float (aka 2.125)
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, NaN, etc
# N/1 => N
- return $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d});
+ my $neg = ''; $neg = '-' if $x->{sign} eq '-';
+ return $neg . $MBI->_num($x->{_n}) if $MBI->_is_one($x->{_d});
- # N/D
- my $neg = 1; $neg = -1 if $x->{sign} ne '+';
- $neg * $MBI->_num($x->{_n}) / $MBI->_num($x->{_d}); # return sign * N/D
+ $x->_as_float()->numify() + 0.0;
}
sub as_number
@@ -1239,6 +1297,9 @@ sub as_hex
$s . $MBI->_as_hex($x->{_n});
}
+##############################################################################
+# import
+
sub import
{
my $self = shift;
@@ -1248,33 +1309,31 @@ sub import
for ( my $i = 0; $i < $l ; $i++)
{
-# print "at $_[$i] (",$_[$i+1]||'undef',")\n";
if ( $_[$i] eq ':constant' )
{
# this rest causes overlord er load to step in
- # print "overload @_\n";
overload::constant float => sub { $self->new(shift); };
}
# elsif ($_[$i] eq 'upgrade')
# {
# # this causes upgrading
-# $upgrade = $_[$i+1]; # or undef to disable
+# $upgrade = $_[$i+1]; # or undef to disable
# $i++;
# }
elsif ($_[$i] eq 'downgrade')
{
# this causes downgrading
- $downgrade = $_[$i+1]; # or undef to disable
+ $downgrade = $_[$i+1]; # or undef to disable
$i++;
}
elsif ($_[$i] eq 'lib')
{
- $lib = $_[$i+1] || ''; # default Calc
+ $lib = $_[$i+1] || ''; # default Calc
$i++;
}
elsif ($_[$i] eq 'with')
{
- $MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt
+ $MBI = $_[$i+1] || 'Math::BigInt::Calc'; # default Math::BigInt::Calc
$i++;
}
else
@@ -1282,39 +1341,24 @@ sub import
push @a, $_[$i];
}
}
- # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still work
- my $mbilib = eval { Math::BigInt->config()->{lib} };
- if ((defined $mbilib) && ($MBI eq 'Math::BigInt'))
- {
- # MBI already loaded
- $MBI->import('lib',"$lib,$mbilib", 'objectify');
- }
- else
- {
- # MBI not loaded, or not with "Math::BigInt"
- $lib .= ",$mbilib" if defined $mbilib;
+ require Math::BigInt;
- if ($] < 5.006)
- {
- # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
- # used in the same script, or eval inside import().
- my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt
- my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm
- $file = File::Spec->catfile (@parts, $file);
- eval { require $file; $MBI->import( lib => '$lib', 'objectify' ); }
- }
- else
+ # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still have GMP
+ if ($lib ne '')
+ {
+ my @c = split /\s*,\s*/, $lib;
+ foreach (@c)
{
- my $rc = "use $MBI lib => '$lib', 'objectify';";
- eval $rc;
+ $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters
}
- }
- if ($@)
- {
- require Carp; Carp::croak ("Couldn't load $MBI: $! $@");
+ # MBI already loaded, so feed it our lib arguments
+ $MBI->import('lib' => $lib . join(",",@c), 'objectify');
}
$MBI = Math::BigFloat->config()->{lib};
+
+ # register us with MBI to get notified of future lib changes
+ Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } );
# any non :constant stuff is handled by our parent, Exporter
# even if @_ is empty, to give it a chance
@@ -1328,7 +1372,7 @@ __END__
=head1 NAME
-Math::BigRat - arbitrarily big rational numbers
+Math::BigRat - Arbitrary big rational numbers
=head1 SYNOPSIS
@@ -1347,7 +1391,7 @@ Math::BigRat - arbitrarily big rational numbers
=head1 DESCRIPTION
Math::BigRat complements Math::BigInt and Math::BigFloat by providing support
-for arbitrarily big rational numbers.
+for arbitrary big rational numbers.
=head2 MATH LIBRARY
@@ -1401,6 +1445,12 @@ Create a new Math::BigRat object. Input can come in various forms:
$x = Math::BigRat->new(Math::BigFloat->new('3.1')); # BigFloat
$x = Math::BigRat->new(Math::BigInt::Lite->new('2')); # BigLite
+ # You can also give D and N as different objects:
+ $x = Math::BigRat->new(
+ Math::BigInt->new(-123),
+ Math::BigInt->new(7),
+ ); # => -123/7
+
=head2 numerator()
$n = $x->numerator();
@@ -1420,12 +1470,28 @@ Returns a copy of the denominator (the part under the line) as positive BigInt.
Return a list consisting of (signed) numerator and (unsigned) denominator as
BigInts.
-=head2 as_number()
+=head2 as_int()
$x = Math::BigRat->new('13/7');
- print $x->as_number(),"\n"; # '1'
+ print $x->as_int(),"\n"; # '1'
+
+Returns a copy of the object as BigInt, truncated to an integer.
-Returns a copy of the object as BigInt trunced it to integer.
+C<as_number()> is an alias for C<as_int()>.
+
+=head2 as_hex()
+
+ $x = Math::BigRat->new('13');
+ print $x->as_hex(),"\n"; # '0xd'
+
+Returns the BigRat as hexadecimal string. Works only for integers.
+
+=head2 as_bin()
+
+ $x = Math::BigRat->new('13');
+ print $x->as_bin(),"\n"; # '0x1101'
+
+Returns the BigRat as binary string. Works only for integers.
=head2 bfac()
@@ -1467,20 +1533,24 @@ Return true if $x is exactly one, otherwise false.
Return true if $x is exactly zero, otherwise false.
-=head2 is_positive()
+=head2 is_pos()
print "$x is >= 0\n" if $x->is_positive();
Return true if $x is positive (greater than or equal to zero), otherwise
false. Please note that '+inf' is also positive, while 'NaN' and '-inf' aren't.
-=head2 is_negative()
+C<is_positive()> is an alias for C<is_pos()>.
+
+=head2 is_neg()
print "$x is < 0\n" if $x->is_negative();
Return true if $x is negative (smaller than zero), otherwise false. Please
note that '-inf' is also negative, while 'NaN' and '+inf' aren't.
+C<is_negative()> is an alias for C<is_neg()>.
+
=head2 is_int()
print "$x is an integer\n" if $x->is_int();
@@ -1598,6 +1668,6 @@ may contain more documentation and examples as well as testcases.
=head1 AUTHORS
-(C) by Tels L<http://bloodgate.com/> 2001, 2002, 2003, 2004.
+(C) by Tels L<http://bloodgate.com/> 2001 - 2005.
=cut
diff --git a/lib/Math/BigRat/t/bigrat.t b/lib/Math/BigRat/t/bigrat.t
index df9186dd10..8310325dc1 100755
--- a/lib/Math/BigRat/t/bigrat.t
+++ b/lib/Math/BigRat/t/bigrat.t
@@ -8,7 +8,7 @@ BEGIN
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 180;
+ plan tests => 185;
}
# basic testing of Math::BigRat
@@ -94,6 +94,14 @@ ok ($cr->new('+inf'),'inf');
ok ($cr->new('-inf'),'-inf');
##############################################################################
+# two Bigints
+
+ok ($cr->new($mbi->new(3),$mbi->new(7))->badd(1),'10/7');
+ok ($cr->new($mbi->new(-13),$mbi->new(7)),'-13/7');
+ok ($cr->new($mbi->new(13),$mbi->new(-7)),'-13/7');
+ok ($cr->new($mbi->new(-13),$mbi->new(-7)),'13/7');
+
+##############################################################################
# mixed arguments
ok ($cr->new('3/7')->badd(1),'10/7');
@@ -231,6 +239,7 @@ $x = $cr->new('16/8'); ok ($array[$x],3);
$x = $cr->new('17/8'); ok ($array[$x],3);
$x = $cr->new('33/8'); ok ($array[$x],5);
$x = $cr->new('-33/8'); ok ($array[$x],6);
+$x = $cr->new('-8/1'); ok ($array[$x],2); # -8 => 2
$x = $cr->new('33/8'); ok ($x->numify() * 1000, 4125);
$x = $cr->new('-33/8'); ok ($x->numify() * 1000, -4125);
diff --git a/lib/Math/BigRat/t/bigratpm.inc b/lib/Math/BigRat/t/bigratpm.inc
index fe5b8e1f7c..3a9b851f84 100644
--- a/lib/Math/BigRat/t/bigratpm.inc
+++ b/lib/Math/BigRat/t/bigratpm.inc
@@ -60,10 +60,10 @@ while (<DATA>)
} elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) {
$try .= "\$x->b$1();";
# some is_xxx test function
- } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) {
+ } elsif ($f =~ /^is_(zero|one|pos|neg|negative|positive|odd|even|nan|int)\z/) {
$try .= "\$x->$f();";
- } elsif ($f eq "as_number") {
- $try .= '$x->as_number();';
+ } elsif ($f =~ /^(as_number|as_int)\z/){
+ $try .= "\$x->$1();";
} elsif ($f eq "finc") {
$try .= '++$x;';
} elsif ($f eq "fdec") {
@@ -218,6 +218,17 @@ inf:5:NaN
5:-inf:NaN
&as_number
144/7:20
+12/1:12
+-12/1:-12
+-12/3:-4
+NaN:NaN
++inf:inf
+-inf:-inf
+&as_int
+144/7:20
+12/1:12
+-12/1:-12
+-12/3:-4
NaN:NaN
+inf:inf
-inf:-inf
@@ -408,6 +419,9 @@ fnegNaN:NaN
-123456789:123456789
+123.456789:-123456789/1000000
-123456.789:123456789/1000
+123/7:-123/7
+-123/7:123/7
+123/-7:123/7
&fabs
fabsNaN:NaN
+inf:inf
@@ -687,14 +701,30 @@ abc:0
120:1
1200:1
-1200:1
+&is_pos
+0:0
+1:1
+-1:0
+-123:0
+NaN:0
+-inf:0
++inf:1
&is_positive
-0:1
+0:0
1:1
-1:0
-123:0
NaN:0
-inf:0
+inf:1
+&is_neg
+0:0
+1:0
+-1:1
+-123:1
+NaN:0
+-inf:1
++inf:0
&is_negative
0:0
1:0
diff --git a/lib/Math/BigRat/t/bigratpm.t b/lib/Math/BigRat/t/bigratpm.t
index fcc129e65a..510bccd58b 100755
--- a/lib/Math/BigRat/t/bigratpm.t
+++ b/lib/Math/BigRat/t/bigratpm.t
@@ -26,7 +26,7 @@ BEGIN
}
print "# INC = @INC\n";
- plan tests => 659;
+ plan tests => 686;
}
use Math::BigRat;