From: Jarkko Hietaniemi Date: Mon, 25 Feb 2002 13:49:32 +0000 (+0000) Subject: Upgrade to Math::BigInt 1.52. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=13a12e00ae4e5ba31d47ed0f689b4c75806007d3;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Math::BigInt 1.52. p4raw-id: //depot/perl@14863 --- diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index 2b7faae..2111d72 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -1,3 +1,9 @@ +package Math::BigFloat; + +# +# Mike grinned. 'Two down, infinity to go' - Mike Nostrus in Before and After +# + # The following hash values are internally used: # _e: exponent (BigInt) # _m: mantissa (absolute BigInt) @@ -6,9 +12,7 @@ # _p: precision # _f: flags, used to signal MBI not to touch our private parts -package Math::BigFloat; - -$VERSION = '1.28'; +$VERSION = '1.29'; require 5.005; use Exporter; use Math::BigInt qw/objectify/; @@ -24,7 +28,6 @@ use overload ref($_[0])->bcmp($_[1],$_[0]) : ref($_[0])->bcmp($_[0],$_[1])}, 'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint -'log' => sub { $_[0]->blog() }, ; ############################################################################## @@ -72,6 +75,8 @@ BEGIN { tie $rnd_mode, 'Math::BigFloat'; } my %hand_ups = map { $_ => 1 } qw / is_nan is_inf is_negative is_positive accuracy precision div_scale round_mode fneg fabs babs fnot + objectify + bone binf bnan bzero /; sub method_alias { return exists $methods{$_[0]||''}; } @@ -137,84 +142,36 @@ sub new $self->bnorm()->round(@r); # first normalize, then round } -sub bnan +sub _bnan { - # create a bigfloat 'NaN', if given a BigFloat, set it to 'NaN' + # used by parent class bone() to initialize number to 1 my $self = shift; - $self = $class if !defined $self; - if (!ref($self)) - { - my $c = $self; $self = {}; bless $self, $c; - } $self->{_m} = Math::BigInt->bzero(); $self->{_e} = Math::BigInt->bzero(); - $self->{sign} = $nan; - $self->{_a} = undef; $self->{_p} = undef; - $self; } -sub binf +sub _binf { - # create a bigfloat '+-inf', if given a BigFloat, set it to '+-inf' + # used by parent class bone() to initialize number to 1 my $self = shift; - my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-'; - - $self = $class if !defined $self; - if (!ref($self)) - { - my $c = $self; $self = {}; bless $self, $c; - } $self->{_m} = Math::BigInt->bzero(); $self->{_e} = Math::BigInt->bzero(); - $self->{sign} = $sign.'inf'; - $self->{_a} = undef; $self->{_p} = undef; - $self; } -sub bone +sub _bone { - # create a bigfloat '+-1', if given a BigFloat, set it to '+-1' + # used by parent class bone() to initialize number to 1 my $self = shift; - my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-'; - - $self = $class if !defined $self; - if (!ref($self)) - { - my $c = $self; $self = {}; bless $self, $c; - } $self->{_m} = Math::BigInt->bone(); $self->{_e} = Math::BigInt->bzero(); - $self->{sign} = $sign; - if (@_ > 0) - { - $self->{_a} = $_[0] - if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a}); - $self->{_p} = $_[1] - if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p}); - } - return $self; } -sub bzero +sub _bzero { - # create a bigfloat '+0', if given a BigFloat, set it to 0 + # used by parent class bone() to initialize number to 1 my $self = shift; - $self = $class if !defined $self; - if (!ref($self)) - { - my $c = $self; $self = {}; bless $self, $c; - } $self->{_m} = Math::BigInt->bzero(); $self->{_e} = Math::BigInt->bone(); - $self->{sign} = '+'; - if (@_ > 0) - { - $self->{_a} = $_[0] - if (defined $self->{_a} && defined $_[0] && $_[0] > $self->{_a}); - $self->{_p} = $_[1] - if (defined $self->{_p} && defined $_[1] && $_[1] < $self->{_p}); - } - return $self; } ############################################################################## @@ -439,12 +396,12 @@ sub badd { # NaN first return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - # inf handline + # inf handling if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) { - # + and + => +, - and - => -, + and - => 0, - and + => 0 - return $x->bzero() if $x->{sign} ne $y->{sign}; - return $x; + # +inf++inf or -inf+-inf => same, rest is NaN + return $x if $x->{sign} eq $y->{sign}; + return $x->bnan(); } # +-inf + something => +inf # something +-inf => +-inf @@ -735,7 +692,6 @@ sub is_even my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't -# return 1 if $x->{_m}->is_zero(); # 0e1 is even return 1 if ($x->{_e}->{sign} eq '+' # 123.45 is never && $x->{_m}->is_even()); # but 1200 is 0; @@ -747,14 +703,12 @@ sub bmul # (BINT or num_str, BINT or num_str) return BINT my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); - # print "mbf bmul $x->{_m}e$x->{_e} $y->{_m}e$y->{_e}\n"; return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - # handle result = 0 - return $x->bzero() if $x->is_zero() || $y->is_zero(); # inf handling if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { + return $x->bnan() if $x->is_zero() || $y->is_zero(); # result will always be +-inf: # +inf * +/+inf => +inf, -inf * -/-inf => +inf # +inf * -/-inf => -inf, -inf * +/+inf => -inf @@ -762,6 +716,8 @@ sub bmul return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); return $x->binf('-'); } + # handle result = 0 + return $x->bzero() if $x->is_zero() || $y->is_zero(); # aEb * cEd = (a*c)E(b+d) $x->{_m}->bmul($y->{_m}); @@ -777,23 +733,15 @@ sub bdiv # (BFLOAT,BFLOAT) (quo,rem) or BINT (only rem) my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); - # x / +-inf => 0, reminder x - return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero() - if $y->{sign} =~ /^[+-]inf$/; + return $self->_div_inf($x,$y) + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); - # NaN if x == NaN or y == NaN or x==y==0 - return wantarray ? ($x->bnan(),bnan()) : $x->bnan() - if (($x->is_nan() || $y->is_nan()) || - ($x->is_zero() && $y->is_zero())); - - # 5 / 0 => +inf, -6 / 0 => -inf - return wantarray - ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign}) - if ($x->{sign} =~ /^[+-]$/ && $y->is_zero()); - - # x== 0 or y == 1 or y == -1 + # x== 0 # also: or y == 1 or y == -1 return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); + # upgrade + return $upgrade->bdiv($x,$y,$a,$p,$r) if defined $upgrade; + # we need to limit the accuracy to protect against overflow my $fallback = 0; my $scale = 0; diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index c36014a..cb19916 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -1,3 +1,10 @@ +package Math::BigInt; + +# +# "Mike had an infinite amount to do and a negative amount of time in which +# to do it." - Before and After +# + # The following hash values are used: # value: unsigned int with actual value (as a Math::BigInt::Calc or similiar) # sign : +,-,NaN,+inf,-inf @@ -8,11 +15,10 @@ # Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since # underlying lib might change the reference! -package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.51'; +$VERSION = '1.52'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( objectify _swap bgcd blcm); @@ -468,6 +474,17 @@ sub bnan } $self->import() if $IMPORT == 0; # make require work return if $self->modify('bnan'); + my $c = ref($self); + if ($self->can('_bnan')) + { + # use subclass to initialize + $self->_bnan(); + } + else + { + # otherwise do our own thing + $self->{value} = $CALC->_zero(); + } $self->{value} = $CALC->_zero(); $self->{sign} = $nan; delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly @@ -487,7 +504,17 @@ sub binf } $self->import() if $IMPORT == 0; # make require work return if $self->modify('binf'); - $self->{value} = $CALC->_zero(); + my $c = ref($self); + if ($self->can('_binf')) + { + # use subclass to initialize + $self->_binf(); + } + else + { + # otherwise do our own thing + $self->{value} = $CALC->_zero(); + } $self->{sign} = $sign.'inf'; ($self->{_a},$self->{_p}) = @_; # take over requested rounding return $self; @@ -505,7 +532,17 @@ sub bzero } $self->import() if $IMPORT == 0; # make require work return if $self->modify('bzero'); - $self->{value} = $CALC->_zero(); + + if ($self->can('_bzero')) + { + # use subclass to initialize + $self->_bzero(); + } + else + { + # otherwise do our own thing + $self->{value} = $CALC->_zero(); + } $self->{sign} = '+'; if (@_ > 0) { @@ -531,7 +568,17 @@ sub bone } $self->import() if $IMPORT == 0; # make require work return if $self->modify('bone'); - $self->{value} = $CALC->_one(); + + if ($self->can('_bone')) + { + # use subclass to initialize + $self->_bone(); + } + else + { + # otherwise do our own thing + $self->{value} = $CALC->_one(); + } $self->{sign} = $sign; if (@_ > 0) { @@ -830,8 +877,8 @@ sub badd { # NaN first return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - # inf handline - if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) + # inf handling + if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) { # +inf++inf or -inf+-inf => same, rest is NaN return $x if $x->{sign} eq $y->{sign}; @@ -1238,7 +1285,6 @@ sub bdiv return wantarray ? ($x->round(@r),$self->bzero(@r)) : $x->round(@r); } - my $rem; if (wantarray) { my $rem = $self->bzero(); @@ -1261,7 +1307,6 @@ sub bdiv $x->{value} = $CALC->_div($x->{value},$y->{value}); $x->{sign} = '+' if $CALC->_is_zero($x->{value}); $x->round(@r); - $x; } sub bmod @@ -2137,8 +2182,8 @@ sub __from_hex $mul *= $x65536 if $len >= 0; # skip last mul } } - $x->{sign} = $sign if !$x->is_zero(); # no '-0' - return $x; + $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0' + $x; } sub __from_bin @@ -2152,9 +2197,6 @@ sub __from_bin $$bs =~ s/([01])_([01])/$1$2/g; return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/; - my $mul = Math::BigInt->bzero(); $mul++; - my $x256 = Math::BigInt->new(256); - my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/); $$bs =~ s/^[+-]//; # strip sign if ($CALC->can('_from_bin')) @@ -2163,6 +2205,8 @@ sub __from_bin } else { + my $mul = Math::BigInt->bzero(); $mul++; + my $x256 = Math::BigInt->new(256); my $len = CORE::length($$bs)-2; $len = int($len/8); # 8-digit parts, w/o '0b' my $val; my $i = -8; @@ -2179,8 +2223,8 @@ sub __from_bin $mul *= $x256 if $len >= 0; # skip last mul } } - $x->{sign} = $sign if !$x->is_zero(); - return $x; + $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0' + $x; } sub _split @@ -2510,6 +2554,34 @@ Each of the methods below accepts three additional parameters. These arguments $A, $P and $R are accuracy, precision and round_mode. Please see more in the section about ACCURACY and ROUNDIND. +=head2 accuracy + + $x->accuracy(5); # local for $x + $class->accuracy(5); # global for all members of $class + +Set or get the global or local accuracy, aka how many significant digits the +results have. Please see the section about L for +further details. + +Value must be greater than zero. Pass an undef value to disable it: + + $x->accuracy(undef); + Math::BigInt->accuracy(undef); + +Returns the current accuracy. For C<$x->accuracy()> it will return either the +local accuracy, or if not defined, the global. This means the return value +represents the accuracy that will be in effect for $x: + + $y = Math::BigInt->new(1234567); # unrounded + print Math::BigInt->accuracy(4),"\n"; # set 4, print 4 + $x = Math::BigInt->new(123456); # will be automatically rounded + print "$x $y\n"; # '123500 1234567' + print $x->accuracy(),"\n"; # will be 4 + print $y->accuracy(),"\n"; # also 4, since global is 4 + print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5 + print $x->accuracy(),"\n"; # still 4 + print $y->accuracy(),"\n"; # 5, since global is 5 + =head2 brsft $x->brsft($y,$n); diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index d76aa09..3d09670 100644 --- a/lib/Math/BigInt/Calc.pm +++ b/lib/Math/BigInt/Calc.pm @@ -8,7 +8,7 @@ require Exporter; use vars qw/@ISA $VERSION/; @ISA = qw(Exporter); -$VERSION = '0.22'; +$VERSION = '0.23'; # Package to store unsigned big integers in decimal and do math with them @@ -564,7 +564,7 @@ sub _div_use_mul if (@$x == 1 && @$yorg == 1) { - # shortcut, $y is smaller than $x + # shortcut, $yorg and $x are two small numbers if (wantarray) { my $r = [ $x->[0] % $yorg->[0] ]; @@ -577,6 +577,12 @@ sub _div_use_mul return $x; } } + #if (@$yorg == 1) + # { + # # shortcut, $y is < $BASE + # + # } + my $y = [ @$yorg ]; if ($LEN_CONVERT != 0) @@ -686,7 +692,7 @@ sub _div_use_div if (@$x == 1 && @$yorg == 1) { - # shortcut, $y is smaller than $x + # shortcut, $yorg and $x are two small numbers if (wantarray) { my $r = [ $x->[0] % $yorg->[0] ]; @@ -699,6 +705,11 @@ sub _div_use_div return $x; } } +# if (@$yorg == 1) +# { +# # shortcut, $y is < $BASE +# +# } my $y = [ @$yorg ]; if ($LEN_CONVERT != 0) @@ -1450,6 +1461,16 @@ sub _from_bin # convert a hex number to decimal (ref to string, return ref to array) my ($c,$bs) = @_; + # instead of converting 8 bit at a time, it is faster to convert the + # number to hex, and then call _from_hex. + + my $hs = $$bs; + $hs =~ s/^[+-]?0b//; # remove sign and 0b + my $l = length($hs); # bits + $hs = '0' x (8-($l % 8)) . $hs if ($l % 8) != 0; # padd left side w/ 0 + my $h = unpack('H*', pack ('B*', $hs)); # repack as hex + return $c->_from_hex(\('0x'.$h)); + my $mul = _one(); my $m = [ 0x100 ]; # 8 bit at a time my $x = _zero(); diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t index 2e669f8..78668c3 100644 --- a/lib/Math/BigInt/t/bare_mbf.t +++ b/lib/Math/BigInt/t/bare_mbf.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1585; + plan tests => 1586; } use Math::BigInt lib => 'BareCalc'; diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc index e7860d3..17a6783 100644 --- a/lib/Math/BigInt/t/bigfltpm.inc +++ b/lib/Math/BigInt/t/bigfltpm.inc @@ -174,6 +174,13 @@ $class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46'); $class->accuracy(undef); $class->precision(undef); # reset for further tests +############################################################################### +# can we call objectify (broken until v1.52) + +$try = '@args' . " = $class" . "::objectify(2,$class,4,5);".'join(" ",@args);'; +$ans = eval $try; +ok ($ans,"$class 4 5"); + 1; # all done ############################################################################### @@ -752,8 +759,8 @@ fincNaN:NaN abc:abc:NaN abc:+0:NaN +0:abc:NaN -+inf:-inf:0 --inf:+inf:0 ++inf:-inf:NaN +-inf:+inf:NaN +inf:+inf:inf -inf:-inf:-inf baddNaN:+inf:NaN @@ -801,8 +808,8 @@ abc:+0:NaN +0:abc:NaN +inf:-inf:inf -inf:+inf:-inf -+inf:+inf:0 --inf:-inf:0 ++inf:+inf:NaN +-inf:-inf:NaN baddNaN:+inf:NaN baddNaN:+inf:NaN +inf:baddNaN:NaN diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index 0ed5c4a..28ae2b3 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 => 1585; + plan tests => 1586; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/config.t b/lib/Math/BigInt/t/config.t index 5c660a7..4ff46de 100644 --- a/lib/Math/BigInt/t/config.t +++ b/lib/Math/BigInt/t/config.t @@ -22,7 +22,7 @@ my $cfg = Math::BigInt->config(); ok (ref($cfg),'HASH'); ok ($cfg->{lib},'Math::BigInt::Calc'); -ok ($cfg->{lib_version},'0.22'); +ok ($cfg->{lib_version},'0.23'); ok ($cfg->{class},'Math::BigInt'); ok ($cfg->{upgrade}||'',''); ok ($cfg->{div_scale},40); diff --git a/lib/Math/BigInt/t/inf_nan.t b/lib/Math/BigInt/t/inf_nan.t index 38ebe03..b62ae1c 100644 --- a/lib/Math/BigInt/t/inf_nan.t +++ b/lib/Math/BigInt/t/inf_nan.t @@ -1,17 +1,21 @@ #!/usr/bin/perl -w +# test inf/NaN handling all in one place +# Thanx to Jarkko for the excellent explanations and the tables + use Test; use strict; BEGIN { - $| = 1; - plan tests => 7*6*4; + $| = 1; # 7 values 6 groups 4 oprators 2 classes + plan tests => 7 * 6 * 4 * 2; chdir 't' if -d 't'; unshift @INC, '../lib'; } use Math::BigInt; +use Math::BigFloat; my (@args,$x,$y,$z); @@ -67,11 +71,14 @@ foreach (qw/ /) { @args = split /:/,$_; - $x = Math::BigInt->new($args[0]); - $y = Math::BigInt->new($args[1]); - $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0 - print "# $args[0] + $args[1] should be $args[2] but is ",$x->bstr(),"\n" - if !ok ($x->badd($y)->bstr(),$args[2]); + for my $class (qw/Math::BigInt Math::BigFloat/) + { + $x = $class->new($args[0]); + $y = $class->new($args[1]); + $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0 + print "# $class $args[0] + $args[1] should be $args[2] but is $x\n", + if !ok ($x->badd($y)->bstr(),$args[2]); + } } # - @@ -126,11 +133,14 @@ foreach (qw/ /) { @args = split /:/,$_; - $x = Math::BigInt->new($args[0]); - $y = Math::BigInt->new($args[1]); - $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0 - print "# $args[0] - $args[1] should be $args[2] but is $x\n" - if !ok ($x->bsub($y)->bstr(),$args[2]); + for my $class (qw/Math::BigInt Math::BigFloat/) + { + $x = $class->new($args[0]); + $y = $class->new($args[1]); + $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0 + print "# $class $args[0] - $args[1] should be $args[2] but is $x\n" + if !ok ($x->bsub($y)->bstr(),$args[2]); + } } # * @@ -185,11 +195,15 @@ foreach (qw/ /) { @args = split /:/,$_; - $x = Math::BigInt->new($args[0]); - $y = Math::BigInt->new($args[1]); - $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0 - print "# $args[0] * $args[1] should be $args[2] but is $x\n" - if !ok ($x->bmul($y)->bstr(),$args[2]); + for my $class (qw/Math::BigInt Math::BigFloat/) + { + $x = $class->new($args[0]); + $y = $class->new($args[1]); + $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0 + $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0 + print "# $class $args[0] * $args[1] should be $args[2] but is $x\n" + if !ok ($x->bmul($y)->bstr(),$args[2]); + } } # / @@ -244,12 +258,13 @@ foreach (qw/ /) { @args = split /:/,$_; - $x = Math::BigInt->new($args[0]); - $y = Math::BigInt->new($args[1]); - $args[2] = '0' if $args[2] eq '-0'; # BigInt hasn't got -0 - print "# $args[0] / $args[1] should be $args[2] but is $x\n" - if !ok ($x->bdiv($y)->bstr(),$args[2]); - + for my $class (qw/Math::BigInt Math::BigFloat/) + { + $x = $class->new($args[0]); + $y = $class->new($args[1]); + $args[2] = '0' if $args[2] eq '-0'; # BigInt/Float hasn't got -0 + print "# $class $args[0] / $args[1] should be $args[2] but is $x\n" + if !ok ($x->bdiv($y)->bstr(),$args[2]); + } } - diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t index 417bbce..2035035 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 => 1585 + plan tests => 1586 + 4; # + 4 own tests } diff --git a/t/lib/Math/BigFloat/Subclass.pm b/t/lib/Math/BigFloat/Subclass.pm index db8ccb7..82ad7e6 100644 --- a/t/lib/Math/BigFloat/Subclass.pm +++ b/t/lib/Math/BigFloat/Subclass.pm @@ -36,4 +36,9 @@ sub new return $self; } +BEGIN + { + *objectify = \&Math::BigInt::objectify; + } + 1;