From: Jarkko Hietaniemi Date: Mon, 10 Jun 2002 20:55:00 +0000 (+0000) Subject: Upgrade to Math::BigInt 1.59. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1ddff52a1281532cbd0c62e75300cd5f2fb50094;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Math::BigInt 1.59. p4raw-id: //depot/perl@17174 --- diff --git a/MANIFEST b/MANIFEST index 29b2e9d..bead6e1 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1233,6 +1233,7 @@ lib/Math/BigInt/t/sub_mbi.t Empty subclass test of BigInt lib/Math/BigInt/t/sub_mif.t Test A & P with subclasses using mbimbf.inc lib/Math/BigInt/t/upgrade.inc Actual tests for upgrade.t lib/Math/BigInt/t/upgrade.t Test if use Math::BigInt(); under upgrade works +lib/Math/BigInt/t/upgradef.t Test if use Math::BigFloat(); under upgrade works lib/Math/BigInt/t/use.t Test if use Math::BigInt(); works lib/Math/BigInt/t/use_lib1.t Test combinations of Math::BigInt and BigFloat lib/Math/BigInt/t/use_lib2.t Test combinations of Math::BigInt and BigFloat diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index c9624ba..fb59ae3 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -12,7 +12,7 @@ package Math::BigFloat; # _p: precision # _f: flags, used to signal MBI not to touch our private parts -$VERSION = '1.33'; +$VERSION = '1.34'; require 5.005; use Exporter; use File::Spec; diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index 77f3343..591973e 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -18,7 +18,7 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.58'; +$VERSION = '1.59'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( objectify _swap bgcd blcm); @@ -1419,38 +1419,41 @@ sub bmodinv || $num->is_zero() # or num == 0 || $num->{sign} !~ /^[+-]$/ # or num NaN, inf, -inf ); - return $num # i.e., NaN or some kind of infinity, - if ($num->{sign} !~ /^[+-]$/); + + # put least residue into $num if $num was negative, and thus make it positive + $num->bmod($mod) if $num->{sign} eq '-'; if ($CALC->can('_modinv')) { - $num->{value} = $CALC->_modinv($mod->{value}); + $num->{value} = $CALC->_modinv($num->{value},$mod->{value}); + $num->bnan() if !defined $num->{value} ; # in case there was no return $num; } - # the remaining case, nonpositive case, $num < 0, is addressed below. - my ($u, $u1) = ($self->bzero(), $self->bone()); my ($a, $b) = ($mod->copy(), $num->copy()); - # put least residue into $b if $num was negative - $b->bmod($mod) if $b->{sign} eq '-'; - + # first step need always be done since $num (and thus $b) is never 0 + # Note that the loop is aligned so that the check occurs between #2 and #1 + # thus saving us one step #2 at the loop end. Typical loop count is 1. Even + # a case with 28 loops still gains about 3% with this layout. + my $q; + ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 # Euclid's Algorithm while (!$b->is_zero()) { - ($a, my $q, $b) = ($b, $a->copy()->bdiv($b)); - ($u, $u1) = ($u1, $u - $u1 * $q); + ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2 + ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 again } # if the gcd is not 1, then return NaN! It would be pointless to - # have called bgcd first, because we would then be performing the - # same Euclidean Algorithm *twice* + # have called bgcd to check this first, because we would then be performing + # the same Euclidean Algorithm *twice* return $num->bnan() unless $a->is_one(); - $u->bmod($mod); - $num->{value} = $u->{value}; - $num->{sign} = $u->{sign}; + $u1->bmod($mod); + $num->{value} = $u1->{value}; + $num->{sign} = $u1->{sign}; $num; } @@ -1474,20 +1477,14 @@ sub bmodpow return $num->bnan(); } - my $exp1 = $exp->copy(); - if ($exp->{sign} eq '-') - { - $exp1->babs(); - $num->bmodinv ($mod); - # return $num if $num->{sign} !~ /^[+-]/; # see next check - } + $num->bmodinv ($mod) if ($exp->{sign} eq '-'); - # check num for valid values (also NaN if there was no inverse) + # check num for valid values (also NaN if there was no inverse but $exp < 0) return $num->bnan() if $num->{sign} !~ /^[+-]$/; if ($CALC->can('_modpow')) { - # $exp and $mod are positive, result is also positive + # $mod is positive, sign on $exp is ignored, result also positive $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value}); return $num; } @@ -1496,18 +1493,22 @@ sub bmodpow return $num->bzero() if $mod->is_one(); return $num->bone() if $num->is_zero() or $num->is_one(); - $num->bmod($mod); # if $x is large, make it smaller first - my $acc = $num->copy(); $num->bone(); # keep ref to $num + # $num->bmod($mod); # if $x is large, make it smaller first + my $acc = $num->copy(); # but this is not really faster... - while( !$exp1->is_zero() ) + $num->bone(); # keep ref to $num + + my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix + my $len = length($expbin); + while (--$len >= 0) { - if( $exp1->is_odd() ) + if( substr($expbin,$len,1) eq '1') { $num->bmul($acc)->bmod($mod); } $acc->bmul($acc)->bmod($mod); - $exp1->brsft( 1, 2); # remove last (binary) digit } + $num; } @@ -1594,15 +1595,14 @@ sub bpow # } my $pow2 = $self->__one(); - my $y1 = $class->new($y); - my $two = $self->new(2); - while (!$y1->is_one()) + my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//; + my $len = length($y_bin); + while (--$len > 0) { - $pow2->bmul($x) if $y1->is_odd(); - $y1->bdiv($two); + $pow2->bmul($x) if substr($y_bin,$len,1) eq '1'; # is odd? $x->bmul($x); } - $x->bmul($pow2) unless $pow2->is_one(); + $x->bmul($pow2); $x->round(@r); } @@ -2494,12 +2494,19 @@ sub as_hex } else { - my $x1 = $x->copy()->babs(); my $xr; - my $x10000 = Math::BigInt->new (0x10000); + my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h); + if ($] >= 5.006) + { + $x10000 = Math::BigInt->new (0x10000); $h = 'h4'; + } + else + { + $x10000 = Math::BigInt->new (0x1000); $h = 'h3'; + } while (!$x1->is_zero()) { ($x1, $xr) = bdiv($x1,$x10000); - $es .= unpack('h4',pack('v',$xr->numify())); + $es .= unpack($h,pack('v',$xr->numify())); } $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros @@ -2524,12 +2531,19 @@ sub as_bin } else { - my $x1 = $x->copy()->babs(); my $xr; - my $x10000 = Math::BigInt->new (0x10000); + my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b); + if ($] >= 5.006) + { + $x10000 = Math::BigInt->new (0x10000); $b = 'b16'; + } + else + { + $x10000 = Math::BigInt->new (0x1000); $b = 'b12'; + } while (!$x1->is_zero()) { ($x1, $xr) = bdiv($x1,$x10000); - $es .= unpack('b16',pack('v',$xr->numify())); + $es .= unpack($b,pack('v',$xr->numify())); } $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros @@ -2962,7 +2976,7 @@ numbers. =head2 bmodinv - bmodinv($num,$mod); # modular inverse (no OO style) + $num->bmodinv($mod); # modular inverse Returns the inverse of C<$num> in the given modulus C<$mod>. 'C' is returned unless C<$num> is relatively prime to C<$mod>, i.e. unless @@ -2970,7 +2984,7 @@ C. =head2 bmodpow - bmodpow($num,$exp,$mod); # modular exponentation ($num**$exp % $mod) + $num->bmodpow($exp,$mod); # modular exponentation ($num**$exp % $mod) Returns the value of C<$num> taken to the power C<$exp> in the modulus C<$mod> using binary exponentation. C is far superior to diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index 717361d..4adb1d5 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.29'; +$VERSION = '0.30'; # Package to store unsigned big integers in decimal and do math with them @@ -74,6 +74,7 @@ sub _base_len undef &_mul; undef &_div; + if ($caught & 1 != 0) { # must USE_MUL @@ -144,6 +145,10 @@ BEGIN # to make _and etc simpler (and faster for smaller, slower for large numbers) my $max = 16; while (2 ** $max < $BASE) { $max++; } + { + no integer; + $max = 16 if $] < 5.006; # older Perls might not take >16 too well + } my ($x,$y,$z); do { $AND_BITS++; @@ -268,7 +273,7 @@ sub _one sub _two { - # create a two (for _pow) + # create a two (used internally for shifting) [ 2 ]; } @@ -1229,15 +1234,16 @@ sub _pow my ($c,$cx,$cy) = @_; my $pow2 = _one(); - my $two = _two(); - my $y1 = _copy($c,$cy); - while (!_is_one($c,$y1)) + + my $y_bin = ${_as_bin($c,$cy)}; $y_bin =~ s/^0b//; + my $len = length($y_bin); + while (--$len > 0) { - _mul($c,$pow2,$cx) if _is_odd($c,$y1); - _div($c,$y1,$two); + _mul($c,$pow2,$cx) if substr($y_bin,$len,1) eq '1'; # is odd? _mul($c,$cx,$cx); } - _mul($c,$cx,$pow2) unless _is_one($c,$pow2); + + _mul($c,$cx,$pow2); $cx; } @@ -1483,12 +1489,19 @@ sub _as_hex my $x1 = _copy($c,$x); my $es = ''; - my $xr; - my $x10000 = [ 0x10000 ]; + my ($xr, $h, $x10000); + if ($] >= 5.006) + { + $x10000 = [ 0x10000 ]; $h = 'h4'; + } + else + { + $x10000 = [ 0x1000 ]; $h = 'h3'; + } while (! _is_zero($c,$x1)) { ($x1, $xr) = _div($c,$x1,$x10000); - $es .= unpack('h4',pack('v',$xr->[0])); + $es .= unpack($h,pack('v',$xr->[0])); } $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros @@ -1504,12 +1517,19 @@ sub _as_bin my $x1 = _copy($c,$x); my $es = ''; - my $xr; - my $x10000 = [ 0x10000 ]; + my ($xr, $b, $x10000); + if ($] >= 5.006) + { + $x10000 = [ 0x10000 ]; $b = 'b16'; + } + else + { + $x10000 = [ 0x1000 ]; $b = 'b12'; + } while (! _is_zero($c,$x1)) { ($x1, $xr) = _div($c,$x1,$x10000); - $es .= unpack('b16',pack('v',$xr->[0])); + $es .= unpack($b,pack('v',$xr->[0])); } $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros @@ -1580,9 +1600,38 @@ sub _from_bin ############################################################################## # special modulus functions +# not ready yet, since it would need to deal with unsigned numbers sub _modinv1 { # inverse modulus + my ($c,$num,$mod) = @_; + + my $u = _zero(); my $u1 = _one(); + my $a = _copy($c,$mod); my $b = _copy($c,$num); + + # Euclid's Algorithm for bgcd(), only that we calc bgcd() ($a) and the + # result ($u) at the same time + while (!_is_zero($c,$b)) + { +# print ${_str($c,$a)}, " ", ${_str($c,$b)}, " ", ${_str($c,$u)}, " ", +# ${_str($c,$u1)}, "\n"; + ($a, my $q, $b) = ($b, _div($c,$a,$b)); +# print ${_str($c,$a)}, " ", ${_str($c,$q)}, " ", ${_str($c,$b)}, "\n"; + # original: ($u,$u1) = ($u1, $u - $u1 * $q); + my $t = _copy($c,$u); + $u = _copy($c,$u1); + _mul($c,$u1,$q); + $u1 = _sub($t,$u1); +# print ${_str($c,$a)}, " ", ${_str($c,$b)}, " ", ${_str($c,$u)}, " ", +# ${_str($c,$u1)}, "\n"; + } + + # if the gcd is not 1, then return NaN + return undef unless _is_one($c,$a); + + $num = _mod($c,$u,$mod); +# print ${_str($c,$num)},"\n"; + $num; } sub _modpow @@ -1601,27 +1650,22 @@ sub _modpow $num->[0] = 1; return $num; } - -# $num = _mod($c,$num,$mod); + +# $num = _mod($c,$num,$mod); # this does not make it faster my $acc = _copy($c,$num); my $t = _one(); - my $two = _two(); - my $exp1 = _copy($c,$exp); # keep arguments - while (!_is_zero($c,$exp1)) + my $expbin = ${_as_bin($c,$exp)}; $expbin =~ s/^0b//; + my $len = length($expbin); + while (--$len >= 0) { - if (_is_odd($c,$exp1)) + if ( substr($expbin,$len,1) eq '1') # is_odd { _mul($c,$t,$acc); $t = _mod($c,$t,$mod); } _mul($c,$acc,$acc); $acc = _mod($c,$acc,$mod); - _div($c,$exp1,$two); -# print "exp ",${_str($c,$exp1)},"\n"; -# print "acc ",${_str($c,$acc)},"\n"; -# print "num ",${_str($c,$num)},"\n"; -# print "mod ",${_str($c,$mod)},"\n"; } @$num = @$t; $num; diff --git a/lib/Math/BigInt/t/bare_mbi.t b/lib/Math/BigInt/t/bare_mbi.t index 9a01dc6..e81a4ba 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 => 2361; + plan tests => 2368; } use Math::BigInt lib => 'BareCalc'; diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc index 795e388..01b77b8 100644 --- a/lib/Math/BigInt/t/bigintpm.inc +++ b/lib/Math/BigInt/t/bigintpm.inc @@ -1387,6 +1387,9 @@ abc:5:NaN ## bmodinv Error cases / useless use of function 3:-5:NaN inf:5:NaN +5:inf:NaN +-inf:5:NaN +5:-inf:NaN &bmodpow # format: number:exponent:modulus:result # bmodpow Data errors @@ -1956,6 +1959,7 @@ NaNas_hex:NaN -0:0b0 1:0b1 0b1010111101010101010110110110110110101:0b1010111101010101010110110110110110101 +0x123456789123456789:0b100100011010001010110011110001001000100100011010001010110011110001001 +inf:inf -inf:-inf NaNas_bin:NaN diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index 9bc0341..ae4026f 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 => 2361; + plan tests => 2368; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/mbi_rand.t b/lib/Math/BigInt/t/mbi_rand.t index 11c59cc..1aeb685 100644 --- a/lib/Math/BigInt/t/mbi_rand.t +++ b/lib/Math/BigInt/t/mbi_rand.t @@ -8,6 +8,7 @@ my $count; BEGIN { $| = 1; + if ($^O eq 'os390') { print "1..0\n"; exit(0) } # test takes too long there unshift @INC, '../lib'; # for running manually my $location = $0; $location =~ s/mbi_rand.t//; unshift @INC, $location; # to locate the testing files diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t index dcd8645..99d5971 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 => 2361 + plan tests => 2368 + 5; # +5 own tests } diff --git a/lib/Math/BigInt/t/upgradef.t b/lib/Math/BigInt/t/upgradef.t new file mode 100644 index 0000000..437268d --- /dev/null +++ b/lib/Math/BigInt/t/upgradef.t @@ -0,0 +1,84 @@ +#!/usr/bin/perl -w + +use Test; +use strict; + +BEGIN + { + $| = 1; + # to locate the testing files + my $location = $0; $location =~ s/upgradef.t//i; + if ($ENV{PERL_CORE}) + { + # testing with the core distribution + @INC = qw(../t/lib); + } + unshift @INC, qw(../lib); # to locate the modules + 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 => 0 + + 6; # our own tests + } + +############################################################################### +package Math::BigFloat::Test; + +use Math::BigFloat; +require Exporter; +use vars qw/@ISA/; +@ISA = qw/Exporter Math::BigFloat/; + +use overload; + +sub isa + { + my ($self,$class) = @_; + return if $class =~ /^Math::Big(Int|Float)/; # we aren't one of these + UNIVERSAL::isa($self,$class); + } + +sub bmul + { + return __PACKAGE__->new(123); + } + +sub badd + { + return __PACKAGE__->new(321); + } + +############################################################################### +package main; + +# use Math::BigInt upgrade => 'Math::BigFloat'; +use Math::BigFloat upgrade => 'Math::BigFloat::Test'; + +use vars qw ($scale $class $try $x $y $z $f @args $ans $ans1 $ans1_str $setup + $ECL $CL); +$class = "Math::BigFloat"; +$CL = "Math::BigInt::Calc"; +$ECL = "Math::BigFloat::Test"; + +ok (Math::BigFloat->upgrade(),$ECL); +ok (Math::BigFloat->downgrade()||'',''); + +$x = $class->new(123); $y = $ECL->new(123); $z = $x->bmul($y); +ok (ref($z),$ECL); ok ($z,123); + +$x = $class->new(123); $y = $ECL->new(123); $z = $x->badd($y); +ok (ref($z),$ECL); ok ($z,321); + + + +# not yet: +# require 'upgrade.inc'; # all tests here for sharing