From: Jarkko Hietaniemi Date: Mon, 3 Sep 2001 18:15:16 +0000 (+0000) Subject: Upgrade to Math::BigInt 1.42. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bd05a4614e0221fd12dd8001c037ca98c84c75a0;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Math::BigInt 1.42. p4raw-id: //depot/perl@11849 --- diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index 32f0a21..dfd722c 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -11,7 +11,7 @@ package Math::BigFloat; -$VERSION = '1.20'; +$VERSION = '1.21'; require 5.005; use Exporter; use Math::BigInt qw/objectify/; @@ -33,10 +33,9 @@ use vars qw/$AUTOLOAD $accuracy $precision $div_scale $rnd_mode/; my $class = "Math::BigFloat"; use overload -'<=>' => sub { - $_[2] ? - $class->bcmp($_[1],$_[0]) : - $class->bcmp($_[0],$_[1])}, +'<=>' => sub { $_[2] ? + ref($_[0])->bcmp($_[1],$_[0]) : + ref($_[0])->bcmp($_[0],$_[1])}, 'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint ; @@ -345,18 +344,31 @@ sub bcmp return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0 # adjust so that exponents are equal - my $lx = $x->{_m}->length() + $x->{_e}; - my $ly = $y->{_m}->length() + $y->{_e}; + my $lxm = $x->{_m}->length(); + my $lym = $y->{_m}->length(); + my $lx = $lxm + $x->{_e}; + my $ly = $lym + $y->{_e}; # print "x $x y $y lx $lx ly $ly\n"; my $l = $lx - $ly; $l = -$l if $x->{sign} eq '-'; # print "$l $x->{sign}\n"; - return $l if $l != 0; + return $l <=> 0 if $l != 0; - # lengths are equal, so compare mantissa, if equal, compare exponents - # this assumes normalized numbers (no trailing zeros etc!) - my $rc = $x->{_m} <=> $y->{_m} || $x->{_e} <=> $y->{_e}; + # lengths (corrected by exponent) are equal + # so make mantissa euqal length by padding with zero (shift left) + my $diff = $lxm - $lym; + my $xm = $x->{_m}; # not yet copy it + my $ym = $y->{_m}; + if ($diff > 0) + { + $ym = $y->{_m}->copy()->blsft($diff,10); + } + elsif ($diff < 0) + { + $xm = $x->{_m}->copy()->blsft(-$diff,10); + } + my $rc = $xm->bcmp($ym); $rc = -$rc if $x->{sign} eq '-'; # -124 < -123 - return $rc; + return $rc <=> 0; } sub bacmp diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index 8a0d47f..df7881c 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -19,7 +19,7 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.41'; +$VERSION = '1.42'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub @@ -69,8 +69,8 @@ use overload '**=' => sub { $_[0]->bpow($_[1]); }, '<=>' => sub { $_[2] ? - $class->bcmp($_[1],$_[0]) : - $class->bcmp($_[0],$_[1])}, + ref($_[0])->bcmp($_[1],$_[0]) : + ref($_[0])->bcmp($_[0],$_[1])}, 'cmp' => sub { $_[2] ? $_[1] cmp $_[0]->bstr() : @@ -1224,6 +1224,7 @@ sub _trailing_zeros my $x = shift; $x = $class->new($x) unless ref $x; + #return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/; return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/; return $CALC->_zeros($x->{value}) if $CALC->can('_zeros'); @@ -1638,13 +1639,13 @@ sub import # used in the same script, or eval inside import(). (my $mod = $lib . '.pm') =~ s!::!/!g; # require does not automatically :: => /, so portability problems arise - eval { require $mod; $lib->import(); } + eval { require $mod; $lib->import( @c ); } } else { - eval "use $lib;"; + eval "use $lib @c;"; } - $CALC = $lib, last if $@ eq ''; + $CALC = $lib, last if $@ eq ''; # no error in loading lib? } } @@ -1799,6 +1800,66 @@ sub as_number $self->copy(); } +sub as_hex + { + # return as hex string, with prefixed 0x + my $x = shift; $x = $class->new($x) if !ref($x); + + return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + return '0x0' if $x->is_zero(); + + my $es = ''; my $s = ''; + $s = $x->{sign} if $x->{sign} eq '-'; + $s .= '0x'; + if ($CALC->can('_as_hex')) + { + $es = $CALC->_as_hex($x->{value}); + } + else + { + my $x1 = $x->copy()->babs(); my $xr; + my $x100 = Math::BigInt->new (0x100); + while (!$x1->is_zero()) + { + ($x1, $xr) = bdiv($x1,$x100); + $es .= unpack('h2',pack('C',$xr->numify())); + } + $es = reverse $es; + $es =~ s/^[0]+//; # strip leading zeros + } + $s . $es; + } + +sub as_bin + { + # return as binary string, with prefixed 0b + my $x = shift; $x = $class->new($x) if !ref($x); + + return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + return '0b0' if $x->is_zero(); + + my $es = ''; my $s = ''; + $s = $x->{sign} if $x->{sign} eq '-'; + $s .= '0b'; + if ($CALC->can('_as_bin')) + { + $es = $CALC->_as_bin($x->{value}); + } + else + { + my $x1 = $x->copy()->babs(); my $xr; + my $x100 = Math::BigInt->new (0x100); + while (!$x1->is_zero()) + { + ($x1, $xr) = bdiv($x1,$x100); + $es .= unpack('b8',pack('C',$xr->numify())); + } + $es = reverse $es; + $es =~ s/^[0]+//; # strip leading zeros + } + $s . $es; + } + ############################################################################## # internal calculation routines (others are in Math::BigInt::Calc etc) @@ -1941,17 +2002,23 @@ Math::BigInt - Arbitrary size integer math package bgcd(@values); # greatest common divisor blcm(@values); # lowest common multiplicator - - $x->bstr(); # normalized string - $x->bsstr(); # normalized string in scientific notation + $x->length(); # return number of digits in number - ($x,$f) = $x->length(); # length of number and length of fraction part + ($x,$f) = $x->length(); # length of number and length of fraction part, + # latter is always 0 digits long for BigInt's $x->exponent(); # return exponent as BigInt $x->mantissa(); # return mantissa as BigInt $x->parts(); # return (mantissa,exponent) as BigInt $x->copy(); # make a true copy of $x (unlike $y = $x;) $x->as_number(); # return as BigInt (in BigInt: same as copy()) + + # conversation to string + $x->bstr(); # normalized string + $x->bsstr(); # normalized string in scientific notation + $x->as_hex(); # as signed hexadecimal string with prefixed 0x + $x->as_bin(); # as signed binary string with prefixed 0b + =head1 DESCRIPTION @@ -2440,6 +2507,11 @@ Examples for rounding: print $x->copy()->bnorm(),"\n"; # 123.46 print $x->copy()->fround(),"\n"; # 123.46 +Examples for converting: + + my $x = Math::BigInt->new('0b1'.'01' x 123); + print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n"; + =head1 Autocreating constants After C all the B decimal constants @@ -2609,6 +2681,18 @@ It is yet unlcear whether overloaded int() should return a scalar or a BigInt. The following will probably not do what you expect: + $c = Math::BigInt->new(123); + print $c->length(),"\n"; # prints 30 + +It prints both the number of digits in the number and in the fraction part +since print calls C in list context. Use something like: + + print scalar $c->length(),"\n"; # prints 3 + +=item bdiv + +The following will probably not do what you expect: + print $c->bdiv(10000),"\n"; It prints both quotient and reminder since print calls C in list diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index c42fc40..ebaf5a1 100644 --- a/lib/Math/BigInt/Calc.pm +++ b/lib/Math/BigInt/Calc.pm @@ -5,21 +5,10 @@ use strict; # use warnings; # dont use warnings for older Perls require Exporter; - -use vars qw/ @ISA @EXPORT $VERSION/; +use vars qw/@ISA $VERSION/; @ISA = qw(Exporter); -@EXPORT = qw( - _add _mul _div _mod _sub - _new - _str _num _acmp _len - _digit - _is_zero _is_one - _is_even _is_odd - _check _zero _one _copy _zeros - _rsft _lsft -); -$VERSION = '0.09'; +$VERSION = '0.10'; # Package to store unsigned big integers in decimal and do math with them @@ -28,12 +17,11 @@ $VERSION = '0.09'; # todo: # - fully remove funky $# stuff (maybe) -# - use integer; vs 1e7 as base # USE_MUL: due to problems on certain os (os390, posix-bc) "* 1e-5" is used -# instead of "/ 1e5" at some places, (marked with USE_MUL). But instead of -# using the reverse only on problematic machines, I used it everytime to avoid -# the costly comparisons. This _should_ work everywhere. Thanx Peter Prymmer +# instead of "/ 1e5" at some places, (marked with USE_MUL). +# The BEGIN block is used to determine which of the two variants gives the +# correct result. ############################################################################## # global constants, flags and accessory @@ -47,13 +35,14 @@ my $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL BEGIN { - # Daniel Pfeiffer: determine largest group of digits that is precisely + # from Daniel Pfeiffer: determine largest group of digits that is precisely # multipliable with itself plus carry my ($e, $num) = 4; - do { - $num = ('9' x ++$e) + 0; + do + { + $num = ('9' x ++$e) + 0; $num *= $num + 1; - } until ($num == $num - 1 or $num - 1 == $num - 2); + } until ($num == $num - 1 or $num - 1 == $num - 2); $BASE_LEN = $e-1; $BASE = int("1e".$BASE_LEN); $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL @@ -105,6 +94,9 @@ sub _copy return [ @{$_[1]} ]; } +# catch and throw away +sub import { } + ############################################################################## # convert back to string and number @@ -589,7 +581,7 @@ sub __strip_zeros sub _check { - # no checks yet, pull it out from the test suite + # used by the test suite my $x = $_[1]; return "$x is not a reference" if !ref($x); @@ -637,7 +629,7 @@ using the following call: =head1 EXPORT -The following functions MUST be exported in order to support +The following functions MUST be defined in order to support the use by Math::BigInt: _new(string) return ref to new object from ref to decimal string @@ -677,9 +669,9 @@ the use by Math::BigInt: _check(obj) check whether internal representation is still intact return 0 for ok, otherwise error message as string -The following functions are optional, and can be exported if the underlying lib +The following functions are optional, and can be defined if the underlying lib has a fast way to do them. If not defined, Math::BigInt will use a pure, but -slow, Perl function as fallback to emulate these: +slow, Perl way as fallback to emulate these: _from_hex(str) return ref to new object from ref to hexadecimal string _from_bin(str) return ref to new object from ref to binary string @@ -710,7 +702,7 @@ zero or similar cases. The first parameter can be modified, that includes the possibility that you return a reference to a completely different object instead. Although keeping -the reference the same is prefered. +the reference is prefered over creating and returning a different one. Return values are always references to objects or strings. Exceptions are C<_lsft()> and C<_rsft()>, which return undef if they can not shift the @@ -722,11 +714,11 @@ to BigInt, which will use some generic code to calculate the result. If you want to port your own favourite c-lib for big numbers to the Math::BigInt interface, you can take any of the already existing modules as a rough guideline. You should really wrap up the latest BigInt and BigFloat -testsuites with your module, and replace the following line: +testsuites with your module, and replace in them any of the following: use Math::BigInt; -by +by this: use Math::BigInt lib => 'yourlib'; diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index a30563d..0ee6ff3 100755 --- a/lib/Math/BigInt/t/bigfltpm.t +++ b/lib/Math/BigInt/t/bigfltpm.t @@ -8,7 +8,7 @@ BEGIN $| = 1; unshift @INC, '../lib'; # for running manually # chdir 't' if -d 't'; - plan tests => 1158; + plan tests => 1162; } use Math::BigInt; @@ -538,11 +538,15 @@ fcmpNaN:+0: 0.0005:0.0001:1 0.005:0.0001:1 0.001:0.0005:1 -0.000001:0.0005:-2 # <0, but can't test this -0.00000123:0.0005:-2 # <0, but can't test this +0.000001:0.0005:-1 +0.00000123:0.0005:-1 0.00512:0.0001:1 0.005:0.000112:1 0.00123:0.0005:1 +1.5:2:-1 +2:1.5:1 +1.54321:234:-1 +234:1.54321:1 # infinity -inf:5432112345:-1 +inf:5432112345:1 diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t index 9c82d65..1f36cf7 100644 --- a/lib/Math/BigInt/t/bigintc.t +++ b/lib/Math/BigInt/t/bigintc.t @@ -19,61 +19,61 @@ use Math::BigInt::Calc; my $C = 'Math::BigInt::Calc'; # pass classname to sub's # _new and _str -my $x = _new($C,\"123"); my $y = _new($C,\"321"); -ok (ref($x),'ARRAY'); ok (${_str($C,$x)},123); ok (${_str($C,$y)},321); +my $x = $C->_new(\"123"); my $y = $C->_new(\"321"); +ok (ref($x),'ARRAY'); ok (${$C->_str($x)},123); ok (${$C->_str($y)},321); # _add, _sub, _mul, _div -ok (${_str($C,_add($C,$x,$y))},444); -ok (${_str($C,_sub($C,$x,$y))},123); -ok (${_str($C,_mul($C,$x,$y))},39483); -ok (${_str($C,_div($C,$x,$y))},123); +ok (${$C->_str($C->_add($x,$y))},444); +ok (${$C->_str($C->_sub($x,$y))},123); +ok (${$C->_str($C->_mul($x,$y))},39483); +ok (${$C->_str($C->_div($x,$y))},123); -ok (${_str($C,_mul($C,$x,$y))},39483); -ok (${_str($C,$x)},39483); -ok (${_str($C,$y)},321); -my $z = _new($C,\"2"); -ok (${_str($C,_add($C,$x,$z))},39485); -my ($re,$rr) = _div($C,$x,$y); +ok (${$C->_str($C->_mul($x,$y))},39483); +ok (${$C->_str($x)},39483); +ok (${$C->_str($y)},321); +my $z = $C->_new(\"2"); +ok (${$C->_str($C->_add($x,$z))},39485); +my ($re,$rr) = $C->_div($x,$y); -ok (${_str($C,$re)},123); ok (${_str($C,$rr)},2); +ok (${$C->_str($re)},123); ok (${$C->_str($rr)},2); # is_zero, _is_one, _one, _zero -ok (_is_zero($C,$x),0); -ok (_is_one($C,$x),0); +ok ($C->_is_zero($x),0); +ok ($C->_is_one($x),0); -ok (_is_one($C,_one()),1); ok (_is_one($C,_zero()),0); -ok (_is_zero($C,_zero()),1); ok (_is_zero($C,_one()),0); +ok ($C->_is_one($C->_one()),1); ok ($C->_is_one($C->_zero()),0); +ok ($C->_is_zero($C->_zero()),1); ok ($C->_is_zero($C->_one()),0); # is_odd, is_even -ok (_is_odd($C,_one()),1); ok (_is_odd($C,_zero()),0); -ok (_is_even($C,_one()),0); ok (_is_even($C,_zero()),1); +ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero()),0); +ok ($C->_is_even($C->_one()),0); ok ($C->_is_even($C->_zero()),1); # _digit -$x = _new($C,\"123456789"); -ok (_digit($C,$x,0),9); -ok (_digit($C,$x,1),8); -ok (_digit($C,$x,2),7); -ok (_digit($C,$x,-1),1); -ok (_digit($C,$x,-2),2); -ok (_digit($C,$x,-3),3); +$x = $C->_new(\"123456789"); +ok ($C->_digit($x,0),9); +ok ($C->_digit($x,1),8); +ok ($C->_digit($x,2),7); +ok ($C->_digit($x,-1),1); +ok ($C->_digit($x,-2),2); +ok ($C->_digit($x,-3),3); # _copy -$x = _new($C,\"12356"); -ok (${_str($C,_copy($C,$x))},12356); +$x = $C->_new(\"12356"); +ok (${$C->_str($C->_copy($x))},12356); # _zeros -$x = _new($C,\"1256000000"); ok (_zeros($C,$x),6); -$x = _new($C,\"152"); ok (_zeros($C,$x),0); -$x = _new($C,\"123000"); ok (_zeros($C,$x),3); +$x = $C->_new(\"1256000000"); ok ($C->_zeros($x),6); +$x = $C->_new(\"152"); ok ($C->_zeros($x),0); +$x = $C->_new(\"123000"); ok ($C->_zeros($x),3); # _lsft, _rsft -$x = _new($C,\"10"); $y = _new($C,\"3"); -ok (${_str($C,_lsft($C,$x,$y,10))},10000); -$x = _new($C,\"20"); $y = _new($C,\"3"); -ok (${_str($C,_lsft($C,$x,$y,10))},20000); -$x = _new($C,\"128"); $y = _new($C,\"4"); -if (!defined _lsft($C,$x,$y,2)) +$x = $C->_new(\"10"); $y = $C->_new(\"3"); +ok (${$C->_str($C->_lsft($x,$y,10))},10000); +$x = $C->_new(\"20"); $y = $C->_new(\"3"); +ok (${$C->_str($C->_lsft($x,$y,10))},20000); +$x = $C->_new(\"128"); $y = $C->_new(\"4"); +if (!defined $C->_lsft($x,$y,2)) { ok (1,1) } @@ -81,12 +81,12 @@ else { ok ('_lsft','undef'); } -$x = _new($C,\"1000"); $y = _new($C,\"3"); -ok (${_str($C,_rsft($C,$x,$y,10))},1); -$x = _new($C,\"20000"); $y = _new($C,\"3"); -ok (${_str($C,_rsft($C,$x,$y,10))},20); -$x = _new($C,\"256"); $y = _new($C,\"4"); -if (!defined _rsft($C,$x,$y,2)) +$x = $C->_new(\"1000"); $y = $C->_new(\"3"); +ok (${$C->_str($C->_rsft($x,$y,10))},1); +$x = $C->_new(\"20000"); $y = $C->_new(\"3"); +ok (${$C->_str($C->_rsft($x,$y,10))},20); +$x = $C->_new(\"256"); $y = $C->_new(\"4"); +if (!defined $C->_rsft($x,$y,2)) { ok (1,1) } @@ -96,31 +96,31 @@ else } # _acmp -$x = _new($C,\"123456789"); -$y = _new($C,\"987654321"); -ok (_acmp($C,$x,$y),-1); -ok (_acmp($C,$y,$x),1); -ok (_acmp($C,$x,$x),0); -ok (_acmp($C,$y,$y),0); +$x = $C->_new(\"123456789"); +$y = $C->_new(\"987654321"); +ok ($C->_acmp($x,$y),-1); +ok ($C->_acmp($y,$x),1); +ok ($C->_acmp($x,$x),0); +ok ($C->_acmp($y,$y),0); # _div -$x = _new($C,\"3333"); $y = _new($C,\"1111"); -ok (${_str($C, scalar _div($C,$x,$y))},3); -$x = _new($C,\"33333"); $y = _new($C,\"1111"); ($x,$y) = _div($C,$x,$y); -ok (${_str($C,$x)},30); ok (${_str($C,$y)},3); -$x = _new($C,\"123"); $y = _new($C,\"1111"); -($x,$y) = _div($C,$x,$y); ok (${_str($C,$x)},0); ok (${_str($C,$y)},123); +$x = $C->_new(\"3333"); $y = $C->_new(\"1111"); +ok (${$C->_str(scalar $C->_div($x,$y))},3); +$x = $C->_new(\"33333"); $y = $C->_new(\"1111"); ($x,$y) = $C->_div($x,$y); +ok (${$C->_str($x)},30); ok (${$C->_str($y)},3); +$x = $C->_new(\"123"); $y = $C->_new(\"1111"); +($x,$y) = $C->_div($x,$y); ok (${$C->_str($x)},0); ok (${$C->_str($y)},123); # _num -$x = _new($C,\"12345"); $x = _num($C,$x); ok (ref($x)||'',''); ok ($x,12345); +$x = $C->_new(\"12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345); # should not happen: -# $x = _new($C,\"-2"); $y = _new($C,\"4"); ok (_acmp($C,$x,$y),-1); +# $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1); # _check -$x = _new($C,\"123456789"); -ok (_check($C,$x),0); -ok (_check($C,123),'123 is not a reference'); +$x = $C->_new(\"123456789"); +ok ($C->_check($x),0); +ok ($C->_check(123),'123 is not a reference'); # done diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index b815aad..e33e028 100755 --- a/lib/Math/BigInt/t/bigintpm.t +++ b/lib/Math/BigInt/t/bigintpm.t @@ -8,9 +8,9 @@ BEGIN $| = 1; # chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 1424; + plan tests => 1447; } -my $version = '1.40'; # for $VERSION tests, match current release (by hand!) +my $version = '1.42'; # for $VERSION tests, match current release (by hand!) ############################################################################## # for testing inheritance of _swap @@ -85,6 +85,10 @@ while () $try .= '$x->is_negative()+0;'; } elsif ($f eq "is_positive") { $try .= '$x->is_positive()+0;'; + } elsif ($f eq "as_hex") { + $try .= '$x->as_hex();'; + } elsif ($f eq "as_bin") { + $try .= '$x->as_bin();'; } elsif ($f eq "is_inf") { $try .= "\$x->is_inf('$args[1]')+0;"; } elsif ($f eq "binf") { @@ -496,6 +500,14 @@ ok ($x->length(),length "20988936657440586486151264256610222593863921"); $x = Math::BigInt->new(2); $x **= 127; $x--; ok ($x,"170141183460469231731687303715884105727"); +$x = Math::BigInt->new('215960156869840440586892398248'); +($x,$y) = $x->length(); +ok ($x,30); ok ($y,0); + +$x = Math::BigInt->new('1_000_000_000_000'); +($x,$y) = $x->length(); +ok ($x,13); ok ($y,0); + # I am afraid the following is not yet possible due to slowness # Also, testing for 2 meg output is a bit hard ;) #$x = new Math::BigInt(2); $x **= 6972593; $x--; @@ -1266,6 +1278,7 @@ abc:12:NaN 12345:5 10000000000000000:17 -123:3 +215960156869840440586892398248:30 &bsqrt 144:12 16:4 @@ -1397,3 +1410,23 @@ NaNceil:NaN 2:2 3:3 abc:NaN +&as_hex +128:0x80 +-128:-0x80 +0:0x0 +-0:0x0 +1:0x1 +0x123456789123456789:0x123456789123456789 ++inf:inf +-inf:-inf +NaNas_hex:NaN +&as_bin +128:0b10000000 +-128:-0b10000000 +0:0b0 +-0:0b0 +1:0b1 +0b1010111101010101010110110110110110101:0b1010111101010101010110110110110110101 ++inf:inf +-inf:-inf +NaNas_bin:NaN