From: Tels Date: Sat, 1 Jan 2005 18:59:51 +0000 (+0100) Subject: Math::BigInt v1.74, Math::BigRat v0.14, bignum v0.16 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b68b7ab1e328997a801e104fc190aa117fc75775;p=p5sagit%2Fp5-mst-13.2.git Math::BigInt v1.74, Math::BigRat v0.14, bignum v0.16 Message-Id: <200501011859.52858@bloodgate.com> p4raw-id: //depot/perl@23739 --- diff --git a/MANIFEST b/MANIFEST index 5a22852..841d99a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1122,18 +1122,19 @@ lib/bigint.pl An arbitrary precision integer arithmetic package lib/bigintpl.t See if bigint.pl works lib/bigint.pm bignum lib/bignum.pm bignum -lib/bignum/t/bigint.t See if bignum works +lib/bignum/t/bigint.t See if bigint works lib/bignum/t/bignum.t See if bignum works -lib/bignum/t/bigrat.t See if bignum works +lib/bignum/t/bigrat.t See if bigrat works lib/bignum/t/biinfnan.t See if bignum works lib/bignum/t/bninfnan.t See if bignum works -lib/bignum/t/bn_lite.t See if bignum works +lib/bignum/t/bn_lite.t See if bignum with Math::BigInt::Lite works lib/bignum/t/brinfnan.t See if bignum works -lib/bignum/t/br_lite.t See if bignum works +lib/bignum/t/br_lite.t See if bigrat with Math::BigInt::Lite works lib/bignum/t/infnan.inc See if bignum works -lib/bignum/t/option_a.t See if bignum works -lib/bignum/t/option_l.t See if bignum works -lib/bignum/t/option_p.t See if bignum works +lib/bignum/t/option_a.t See if bignum a => X works +lib/bignum/t/option_l.t See if bignum l => X works +lib/bignum/t/option_p.t See if bignum p => X works +lib/bignum/t/ratopt_a.t See if bigrat a => X works lib/bigrat.pl An arbitrary precision rational arithmetic package lib/bigrat.pm bignum lib/blib.pm For "use blib" @@ -1509,6 +1510,7 @@ lib/Math/BigInt/t/_e_math.t Helper routine in BigFloat for _e math lib/Math/BigInt/t/fallback.t Test Math::BigInt lib/Math/BigInt/t/inf_nan.t Special tests for inf and NaN handling lib/Math/BigInt/t/isa.t Test for Math::BigInt inheritance +lib/Math/BigInt/t/lib_load.t Test sane lib names lib/Math/BigInt/t/mbf_ali.t Tests for BigFloat lib/Math/BigInt/t/mbi_ali.t Tests for BigInt lib/Math/BigInt/t/mbimbf.inc Actual BigInt/BigFloat accuracy, precision and fallback, round_mode tests diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index fbe0cf6..7466472 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 in 2001 - 2004, and still +at it in 2005. =cut diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index 5417535..f7ff612 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). + Some routines (C, C, C, C, -C) return true or false, while others (C, C) -return either undef, <0, 0 or >0 and are suited for sort. +C, etc.) return true or false, while others (C, C) +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, C and C. Please see the section about L 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 is neither positive nor negative, while C<+inf> counts as positive, and -C<-inf> is negative. A C is positive. +C<-inf> is negative. A C 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 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 faster), and there is +math involving really big numbers, where it is B 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 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 for problems in +comparing NaNs. + =item int() C 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 for the same effect: +In all Perl versions you can use C or C 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: + + $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 instead of C. 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 3d53b0c..41183f5 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 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 9f7fd16..f56b51a 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 a79dff1..9a12572 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 6695492..bf08a90 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 131e453..5f27a8b 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 () { chomp; @@ -87,7 +89,27 @@ while () 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 () } # 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 238a23f..5cc9ddb 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 6453879..2a2bfe1 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 6cd19f9..16f4d32 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 852ffed..0e5294f 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 0000000..3aff7c4 --- /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 e9209b7..73d7fc0 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 ee48b81..4d4fc4e 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 aac4a05..6545edb 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 8611e45..0ed85a4 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 6053c99..523088a 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 is an alias for C. + +=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 an alias for C. + +=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 an alias for C. + =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 2001, 2002, 2003, 2004. +(C) by Tels L 2001 - 2005. =cut diff --git a/lib/Math/BigRat/t/bigrat.t b/lib/Math/BigRat/t/bigrat.t index df9186d..8310325 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 fe5b8e1..3a9b851 100644 --- a/lib/Math/BigRat/t/bigratpm.inc +++ b/lib/Math/BigRat/t/bigratpm.inc @@ -60,10 +60,10 @@ while () } 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 fcc129e..510bccd 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; diff --git a/lib/bigint.pm b/lib/bigint.pm index 69f80a2..695b4c4 100644 --- a/lib/bigint.pm +++ b/lib/bigint.pm @@ -1,7 +1,7 @@ package bigint; require 5.005; -$VERSION = '0.05'; +$VERSION = '0.06'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( ); @@ -212,7 +212,7 @@ constants are created as proper BigInts. Floating point constants are truncated to integer. All results are also truncated. -=head2 OPTIONS +=head2 Options bigint recognizes some options that can be passed while loading it via use. The options can (currently) be either a single letter form, or the long form. @@ -257,9 +257,9 @@ line. This will be hopefully fixed soon ;) This prints out the name and version of all modules used and then exits. - perl -Mbigint=v -e '' + perl -Mbigint=v -=head2 MATH LIBRARY +=head2 Math Library Math with the numbers is done (by default) by a module called Math::BigInt::Calc. This is equivalent to saying: @@ -277,7 +277,7 @@ Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: Please see respective module documentation for further details. -=head2 INTERNAL FORMAT +=head2 Internal Format The numbers are stored as objects, and their internals might change at anytime, especially between math operations. The objects also might belong to different @@ -289,9 +289,9 @@ accessor methods. E.g. looking at $x->{sign} is not a good idea since there is no guaranty that the object in question has such a hash key, nor is a hash underneath at all. -=head2 SIGN +=head2 Sign -The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately. +The sign is either '+', '-', 'NaN', '+inf' or '-inf'. You can access it with the sign() method. A sign of 'NaN' is used to represent the result when input arguments are not @@ -299,13 +299,13 @@ numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively minus infinity. You will get '+inf' when dividing a positive number by 0, and '-inf' when dividing any negative number by 0. -=head2 METHODS +=head2 Methods Since all numbers are now objects, you can use all functions that are part of the BigInt API. You can only use the bxxx() notation, and not the fxxx() notation, though. -=head2 CAVEAT +=head2 Caveat But a warning is in order. When using the following to make a copy of a number, only a shallow copy will be made. @@ -379,6 +379,6 @@ as L, L and L. =head1 AUTHORS -(C) by Tels L in early 2002, 2003. +(C) by Tels L in early 2002 - 2005. =cut diff --git a/lib/bignum.pm b/lib/bignum.pm index 1902d58..db03d98 100644 --- a/lib/bignum.pm +++ b/lib/bignum.pm @@ -1,7 +1,7 @@ package bignum; require 5.005; -$VERSION = '0.15'; +$VERSION = '0.16'; use Exporter; @EXPORT_OK = qw( ); @EXPORT = qw( inf NaN ); @@ -291,7 +291,7 @@ overloading of '..' is not yet possible in Perl (as of v5.8.0): perl -Mbignum -le 'for (1..2) { print ref($_); }' -=head2 OPTIONS +=head2 Options bignum recognizes some options that can be passed while loading it via use. The options can (currently) be either a single letter form, or the long form. @@ -333,9 +333,9 @@ line. This will be hopefully fixed soon ;) This prints out the name and version of all modules used and then exits. - perl -Mbignum=v -e '' + perl -Mbignum=v -=head2 METHODS +=head2 Methods Beside import() and AUTOLOAD() there are only a few other methods. @@ -344,7 +344,7 @@ the BigInt or BigFloat API. It is wise to use only the bxxx() notation, and not the fxxx() notation, though. This makes it possible that the underlying object might morph into a different class than BigFloat. -=head2 CAVEAT +=head2 Caveat But a warning is in order. When using the following to make a copy of a number, only a shallow copy will be made. @@ -352,6 +352,10 @@ only a shallow copy will be made. $x = 9; $y = $x; $x = $y = 7; +If you want to make a real copy, use the following: + + $y = $x->copy(); + Using the copy or the original with overloaded math is okay, e.g. the following work: diff --git a/lib/bignum/t/option_a.t b/lib/bignum/t/option_a.t index 2ab00bb..2086f9a 100755 --- a/lib/bignum/t/option_a.t +++ b/lib/bignum/t/option_a.t @@ -2,7 +2,7 @@ ############################################################################### -use Test; +use Test::More; use strict; BEGIN @@ -15,11 +15,17 @@ BEGIN use bignum a => '12'; -ok (Math::BigInt->accuracy(),12); -ok (Math::BigFloat->accuracy(),12); +my @C = qw/Math::BigInt Math::BigFloat/; + +foreach my $c (@C) + { + is ($c->accuracy(),12, "$c accuracy = 12"); + } bignum->import( accuracy => '23'); -ok (Math::BigInt->accuracy(),23); -ok (Math::BigFloat->accuracy(),23); +foreach my $c (@C) + { + is ($c->accuracy(), 23, "$c accuracy = 23"); + } diff --git a/lib/bignum/t/option_l.t b/lib/bignum/t/option_l.t index 134dd7c..f534183 100755 --- a/lib/bignum/t/option_l.t +++ b/lib/bignum/t/option_l.t @@ -1,8 +1,6 @@ #!/usr/bin/perl -w -############################################################################### - -use Test; +use Test::More; use strict; BEGIN @@ -16,18 +14,18 @@ BEGIN use bignum; my $rc = eval ('bignum->import( "l" => "foo" );'); -ok ($@,''); # shouldn't die +is ($@,''); # shouldn't die $rc = eval ('bignum->import( "lib" => "foo" );'); -ok ($@,''); # ditto +is ($@,''); # ditto $rc = eval ('bignum->import( "foo" => "bar" );'); -ok ($@ =~ /^Unknown option foo/i,1); # should die +like ($@, qr/^Unknown option foo/i, 'died'); # should die # test that options are only lowercase (don't see a reason why allow UPPER) foreach (qw/L LIB Lib T Trace TRACE V Version VERSION/) { $rc = eval ('bignum->import( "$_" => "bar" );'); - ok ($@ =~ /^Unknown option $_/i,1); # should die + like ($@, qr/^Unknown option $_/i, 'died'); # should die } diff --git a/lib/bignum/t/option_p.t b/lib/bignum/t/option_p.t index c6df4ad..b84883b 100755 --- a/lib/bignum/t/option_p.t +++ b/lib/bignum/t/option_p.t @@ -1,8 +1,6 @@ #!/usr/bin/perl -w -############################################################################### - -use Test; +use Test::More; use strict; BEGIN @@ -10,11 +8,22 @@ BEGIN $| = 1; chdir 't' if -d 't'; unshift @INC, '../lib'; - plan tests => 2; + plan tests => 4; } +my @C = qw/Math::BigInt Math::BigFloat/; + use bignum p => '12'; -ok (Math::BigInt->precision(),12); -ok (Math::BigFloat->precision(),12); +foreach my $c (@C) + { + is ($c->precision(),12, "$c precision = 12"); + } + +bignum->import( p => '42' ); + +foreach my $c (@C) + { + is ($c->precision(),42, "$c precision = 42"); + } diff --git a/lib/bignum/t/ratopt_a.t b/lib/bignum/t/ratopt_a.t new file mode 100644 index 0000000..f004afe --- /dev/null +++ b/lib/bignum/t/ratopt_a.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl -w + +############################################################################### + +use Test::More; +use strict; + +BEGIN + { + $| = 1; + chdir 't' if -d 't'; + unshift @INC, '../lib'; + plan tests => 7; + } + +my @C = qw/Math::BigInt Math::BigFloat Math::BigRat/; + +# bigrat (bug until v0.15) +use bigrat a => 2; + +foreach my $c (@C) + { + is ($c->accuracy(), 2, "$c accuracy = 2"); + } + +eval { bigrat->import( accuracy => '42') }; + +is ($@, '', 'no error'); + +foreach my $c (@C) + { + is ($c->accuracy(), 42, "$c accuracy = 42"); + } + diff --git a/lib/bigrat.pm b/lib/bigrat.pm index 45dfed4..b2a26d6 100644 --- a/lib/bigrat.pm +++ b/lib/bigrat.pm @@ -1,8 +1,8 @@ package bigrat; require 5.005; -$VERSION = '0.06'; -use Exporter; +$VERSION = '0.07'; +require Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( ); @EXPORT = qw( inf NaN ); @@ -86,7 +86,19 @@ sub import # this causes a different low lib to take care... $lib = $_[$i+1] || ''; my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." - splice @a, $j, $s; $j -= $s; + splice @a, $j, $s; $j -= $s; $i++; + } + elsif ($_[$i] =~ /^(a|accuracy)$/) + { + $a = $_[$i+1]; + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; $i++; + } + elsif ($_[$i] =~ /^(p|precision)$/) + { + $p = $_[$i+1]; + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." + splice @a, $j, $s; $j -= $s; $i++; } elsif ($_[$i] =~ /^(v|version)$/) { @@ -132,6 +144,9 @@ sub import require Math::BigFloat; Math::BigFloat->import( upgrade => 'Math::BigRat', ':constant' ); require Math::BigRat; + + bigrat->accuracy($a) if defined $a; + bigrat->precision($p) if defined $p; if ($ver) { print "bigrat\t\t\t v$VERSION\n"; @@ -173,7 +188,7 @@ respectively. Other than L, this module upgrades to Math::BigRat, meaning that instead of 2.5 you will get 2+1/2 as output. -=head2 MODULES USED +=head2 Modules Used C is just a thin wrapper around various modules of the Math::BigInt family. Think of it as the head of the family, who runs the shop, and orders @@ -186,7 +201,7 @@ The following modules are currently used by bignum: Math::BigFloat Math::BigRat -=head2 MATH LIBRARY +=head2 Math Library Math with the numbers is done (by default) by a module called Math::BigInt::Calc. This is equivalent to saying: @@ -204,23 +219,23 @@ Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: Please see respective module documentation for further details. -=head2 SIGN +=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 minus infinity. You will get '+inf' when dividing a positive number by 0, and '-inf' when dividing any negative number by 0. -=head2 METHODS +=head2 Methods Since all numbers are not objects, you can use all functions that are part of the BigInt or BigFloat API. It is wise to use only the bxxx() notation, and not the fxxx() notation, though. This makes you independed on the fact that the underlying object might morph into a different class than BigFloat. -=head2 CAVEAT +=head2 Cavaet But a warning is in order. When using the following to make a copy of a number, only a shallow copy will be made. @@ -228,6 +243,10 @@ only a shallow copy will be made. $x = 9; $y = $x; $x = $y = 7; +If you want to make a real copy, use the following: + + $y = $x->copy(); + Using the copy or the original with overloaded math is okay, e.g. the following work: @@ -254,6 +273,50 @@ Using methods that do not modify, but testthe contents works: See the documentation about the copy constructor and C<=> in overload, as well as the documentation in BigInt for further details. +=head2 Options + +bignum recognizes some options that can be passed while loading it via use. +The options can (currently) be either a single letter form, or the long form. +The following options exist: + +=over 2 + +=item a or accuracy + +This sets the accuracy for all math operations. The argument must be greater +than or equal to zero. See Math::BigInt's bround() function for details. + + perl -Mbigrat=a,50 -le 'print sqrt(20)' + +=item p or precision + +This sets the precision for all math operations. The argument can be any +integer. Negative values mean a fixed number of digits after the dot, while +a positive value rounds to this digit left from the dot. 0 or 1 mean round to +integer. See Math::BigInt's bfround() function for details. + + perl -Mbigrat=p,-50 -le 'print sqrt(20)' + +=item t or trace + +This enables a trace mode and is primarily for debugging bignum or +Math::BigInt/Math::BigFloat. + +=item l or lib + +Load a different math lib, see L. + + perl -Mbigrat=l,GMP -e 'print 2 ** 512' + +Currently there is no way to specify more than one library on the command +line. This will be hopefully fixed soon ;) + +=item v or version + +This prints out the name and version of all modules used and then exits. + + perl -Mbigrat=v + =head1 EXAMPLES perl -Mbigrat -le 'print sqrt(33)' @@ -276,6 +339,6 @@ as L, L and L. =head1 AUTHORS -(C) by Tels L in early 2002. +(C) by Tels L in early 2002 - 2005. =cut diff --git a/t/lib/Math/BigFloat/Subclass.pm b/t/lib/Math/BigFloat/Subclass.pm index 2ec948e..94d3f2a 100644 --- a/t/lib/Math/BigFloat/Subclass.pm +++ b/t/lib/Math/BigFloat/Subclass.pm @@ -1,5 +1,7 @@ #!/usr/bin/perl -w +# for testing subclassing Math::BigFloat + package Math::BigFloat::Subclass; require 5.005_02; @@ -12,7 +14,7 @@ use vars qw($VERSION @ISA $PACKAGE @ISA = qw(Exporter Math::BigFloat); -$VERSION = 0.04; +$VERSION = 0.05; use overload; # inherit overload from BigInt @@ -39,6 +41,9 @@ sub new BEGIN { *objectify = \&Math::BigInt::objectify; + # to allow Math::BigFloat::Subclass::bgcd( ... ) style calls + *bgcd = \&Math::BigFloat::bgcd; + *blcm = \&Math::BigFloat::blcm; } 1;