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
# _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;
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);
|| $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;
}
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;
}
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;
}
# }
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);
}
}
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
}
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
=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<NaN>' is
returned unless C<$num> is relatively prime to C<$mod>, i.e. unless
=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<bmodpow> is far superior to
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
undef &_mul;
undef &_div;
+
if ($caught & 1 != 0)
{
# must USE_MUL
# 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++;
sub _two
{
- # create a two (for _pow)
+ # create a two (used internally for shifting)
[ 2 ];
}
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;
}
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
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
##############################################################################
# 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
$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;
}
print "# INC = @INC\n";
- plan tests => 2361;
+ plan tests => 2368;
}
use Math::BigInt lib => 'BareCalc';
## 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
-0:0b0
1:0b1
0b1010111101010101010110110110110110101:0b1010111101010101010110110110110110101
+0x123456789123456789:0b100100011010001010110011110001001000100100011010001010110011110001001
+inf:inf
-inf:-inf
NaNas_bin:NaN
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;
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
}
print "# INC = @INC\n";
- plan tests => 2361
+ plan tests => 2368
+ 5; # +5 own tests
}
--- /dev/null
+#!/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
projects / p5sagit/p5-mst-13.2.git / commitdiff