From: Tels Date: Sat, 6 Dec 2003 20:19:44 +0000 (+0100) Subject: Math::BigInt v1.67 (pre-release) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=091c87b15dfb1c6df2cfc68045c100bbfda9d509;p=p5sagit%2Fp5-mst-13.2.git Math::BigInt v1.67 (pre-release) Message-Id: <200312062016.50484@bloodgate.com> p4raw-id: //depot/perl@21861 --- diff --git a/MANIFEST b/MANIFEST index 6219755..38ee65e 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1338,7 +1338,9 @@ lib/Math/BigInt/t/biglog.t Test the log function lib/Math/BigInt/t/calling.t Test calling conventions lib/Math/BigInt/t/config.t Test Math::BigInt->config() lib/Math/BigInt/t/constant.t Test Math::BigInt/BigFloat under :constant +lib/Math/BigInt/t/const_mbf.t Test Math::BigInt lib/Math/BigInt/t/downgrade.t Test if use Math::BigInt(); under downgrade works +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/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 059e157..dfb2671 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.40'; +$VERSION = '1.41'; require 5.005; use Exporter; @ISA = qw(Exporter Math::BigInt); @@ -335,14 +335,13 @@ sub bsstr # 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 $x = shift; my $class = ref($x) || $x; - #$x = $class->new(shift) unless ref($x); if ($x->{sign} !~ /^[+-]$/) { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } + # do $esign, because we need '1e+1', since $x->{_e}->bstr() misses the + my $esign = $x->{_e}->{sign}; $esign = '' if $esign eq '-'; my $sep = 'e'.$esign; my $sign = $x->{sign}; $sign = '' if $sign eq '+'; @@ -537,20 +536,17 @@ sub badd # take lower of the two e's and adapt m1 to it to match m2 my $e = $y->{_e}; - $e = $MBI->bzero() if !defined $e; # if no BFLOAT ? - $e = $e->copy(); # make copy (didn't do it yet) - $e->bsub($x->{_e}); + $e = $MBI->bzero() if !defined $e; # if no BFLOAT ? + $e = $e->copy(); # make copy (didn't do it yet) + $e->bsub($x->{_e}); # Ye - Xe my $add = $y->{_m}->copy(); - if ($e->{sign} eq '-') # < 0 + if ($e->{sign} eq '-') # < 0 { - my $e1 = $e->copy()->babs(); - #$x->{_m} *= (10 ** $e1); - $x->{_m}->blsft($e1,10); - $x->{_e} += $e; # need the sign of e + $x->{_e} += $e; # need the sign of e + $x->{_m}->blsft($e->babs(),10); # destroys copy of _e } - elsif (!$e->is_zero()) # > 0 + elsif (!$e->is_zero()) # > 0 { - #$add *= (10 ** $e); $add->blsft($e,10); } # else: both e are the same, so just leave them @@ -560,7 +556,7 @@ sub badd $x->{sign} = $x->{_m}->{sign}; # re-adjust signs $x->{_m}->{sign} = '+'; # mantissa always positiv # delete trailing zeros, then round - return $x->bnorm()->round($a,$p,$r,$y); + $x->bnorm()->round($a,$p,$r,$y); } sub bsub @@ -576,14 +572,16 @@ sub bsub ($self,$x,$y,$a,$p,$r) = objectify(2,@_); } + # XXX TODO: remove? if ($y->is_zero()) # still round for not adding zero { return $x->round($a,$p,$r); } - - $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN + + # $x - $y = -$x + $y + $y->{sign} =~ tr/+-/-+/; # does nothing for NaN $x->badd($y,$a,$p,$r); # badd does not leave internal zeros - $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN) + $y->{sign} =~ tr/+-/-+/; # refix $y (does nothing for NaN) $x; # already rounded by badd() } @@ -615,7 +613,7 @@ sub binc return $x->bnorm()->bround($a,$p,$r); } # inf, nan handling etc - $x->badd($self->__one(),$a,$p,$r); # does round + $x->badd($self->bone(),$a,$p,$r); # does round } sub bdec @@ -669,7 +667,7 @@ sub blog # also takes care of the "error in _find_round_parameters?" case return $x->bnan() if $x->{sign} ne '+' || $x->is_zero(); - + # no rounding at all, so must use fallback if (scalar @params == 0) { @@ -691,12 +689,13 @@ sub blog # base not defined => base == Euler's constant e if (defined $base) { - # make object, since we don't feed it trough objectify() to still get the + # make object, since we don't feed it through objectify() to still get the # case of $base == undef $base = $self->new($base) unless ref($base); # $base > 0; $base != 1 return $x->bnan() if $base->is_zero() || $base->is_one() || $base->{sign} ne '+'; + # if $x == $base, we know the result must be 1.0 return $x->bone('+',@params) if $x->bcmp($base) == 0; } @@ -725,11 +724,11 @@ sub blog if (defined $base) { $base = Math::BigFloat->new($base) unless $base->isa('Math::BigFloat'); - # not ln, but some other base + # not ln, but some other base (don't modify $base) $x->bdiv( $base->copy()->blog(undef,$scale), $scale ); } - # shortcut to not run trough _find_round_parameters again + # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly @@ -751,10 +750,13 @@ sub blog sub _log { - # internal log function to calculate log based on Taylor. + # internal log function to calculate ln() based on Taylor series. # Modifies $x in place. my ($self,$x,$scale) = @_; + # in case of $x == 1, result is 0 + return $x->bzero() if $x->is_one(); + # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log # u = x-1, v = x+1 @@ -770,8 +772,6 @@ sub _log # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 1/2 # |_ x 2 x^2 3 x^3 _| - # "normal" log algorithmn - my ($limit,$v,$u,$below,$factor,$two,$next,$over,$f); $v = $x->copy(); $v->binc(); # v = x+1 @@ -800,10 +800,9 @@ sub _log # (not with log(1.2345), but try log (123**123) to see what I mean. This # can introduce a rounding error if the division result would be f.i. # 0.1234500000001 and we round it to 5 digits it would become 0.12346, but - # if we truncated the $over and $below we might get 0.12345. Does this - # matter for the end result? So we give over and below 4 more digits to be - # on the safe side (unscientific error handling as usual...) - # Makes blog(1.23) *slightly* slower, but try blog(123*123) w/o it :o) + # if we truncated $over and $below we might get 0.12345. Does this matter + # for the end result? So we give $over and $below 4 more digits to be + # on the safe side (unscientific error handling as usual... :+D $next = $over->copy->bround($scale+4)->bdiv( $below->copy->bmul($factor)->bround($scale+4), @@ -830,7 +829,8 @@ sub _log sub _log_10 { - # internal log function based on reducing input to the range of 0.1 .. 9.99 + # Internal log function based on reducing input to the range of 0.1 .. 9.99 + # and then "correcting" the result to the proper one. Modifies $x in place. my ($self,$x,$scale) = @_; # taking blog() from numbers greater than 10 takes a *very long* time, so we @@ -865,21 +865,23 @@ sub _log_10 $calc = 0; # no need to calc, but round } } - # disable the shortcut for 2, since we maybe have it cached - my $two = $self->new(2); # also used later on - if ($x->{_e}->is_zero() && $x->{_m}->bcmp($two) == 0) + else { - $dbd = 0; # disable shortcut - # we can use the cached value in these cases - if ($scale <= $LOG_2_A) + # disable the shortcut for 2, since we maybe have it cached + if ($x->{_e}->is_zero() && $x->{_m}->bcmp(2) == 0) { - $x->bzero(); $x->badd($LOG_2); - $calc = 0; # no need to calc, but round + $dbd = 0; # disable shortcut + # we can use the cached value in these cases + if ($scale <= $LOG_2_A) + { + $x->bzero(); $x->badd($LOG_2); + $calc = 0; # no need to calc, but round + } } } # if $x = 0.1, we know the result must be 0-log(10) - if ($x->{_e}->is_one('-') && $x->{_m}->is_one()) + if ($calc != 0 && $x->{_e}->is_one('-') && $x->{_m}->is_one()) { $dbd = 0; # disable shortcut # we can use the cached value in these cases @@ -890,6 +892,8 @@ sub _log_10 } } + return if $calc == 0; # already have the result + # default: these correction factors are undef and thus not used my $l_10; # value of ln(10) to A of $scale my $l_2; # value of ln(2) to A of $scale @@ -942,55 +946,43 @@ sub _log_10 ### Since $x in the range 0.5 .. 1.5 is MUCH faster, we do a repeated div ### or mul by 2 (maximum times 3, since x < 10 and x > 0.1) - if ($calc != 0) + my $half = $self->new('0.5'); + my $twos = 0; # default: none (0 times) + my $two = $self->new(2); + while ($x->bacmp($half) <= 0) { - my $half = $self->new('0.5'); - my $twos = 0; # default: none (0 times) - while ($x->bacmp($half) < 0) - { - #print "$x\n"; - $twos--; $x->bmul($two); - } - while ($x->bacmp($two) > 0) + $twos--; $x->bmul($two); + } + while ($x->bacmp($two) >= 0) + { + $twos++; $x->bdiv($two,$scale+4); # keep all digits + } + #print "$twos\n"; + # $twos > 0 => did mul 2, < 0 => did div 2 (never both) + # calculate correction factor based on ln(2) + if ($twos != 0) + { + $LOG_2 = $self->new($LOG_2,undef,undef) unless ref $LOG_2; + if ($scale <= $LOG_2_A) { - #print "$x\n"; - $twos++; $x->bdiv($two,$scale+4); # keep all digits + # use cached value + #print "using cached value for l_10\n"; + $l_2 = $LOG_2->copy(); # copy for mul } - #print "$twos\n"; - # $twos > 0 => did mul 2, < 0 => did div 2 (never both) - # calculate correction factor based on ln(2) - if ($twos != 0) + else { - $LOG_2 = $self->new($LOG_2,undef,undef) unless ref $LOG_2; - if ($scale <= $LOG_2_A) - { - # use cached value - #print "using cached value for l_10\n"; - $l_2 = $LOG_2->copy(); # copy for mul - } - else - { - # else: slower, compute it (but don't cache it, because it could be big) - # also disable downgrade for this code path - local $Math::BigFloat::downgrade = undef; - #print "calculating value for l_2, scale $scale\n"; - $l_2 = $two->blog(undef,$scale); # scale+4, actually - } - #print "$l_2 => \n"; - $l_2->bmul($twos); # * -2 => subtract, * 2 => add - #print "$l_2\n"; + # else: slower, compute it (but don't cache it, because it could be big) + # also disable downgrade for this code path + local $Math::BigFloat::downgrade = undef; + #print "calculating value for l_2, scale $scale\n"; + $l_2 = $two->blog(undef,$scale); # scale+4, actually } + $l_2->bmul($twos); # * -2 => subtract, * 2 => add } - if ($calc != 0) - { - $self->_log($x,$scale); # need to do the "normal" way - #print "log(x) = $x\n"; - $x->badd($l_10) if defined $l_10; # correct it by ln(10) - #print "result = $x\n"; - $x->badd($l_2) if defined $l_2; # and maybe by ln(2) - #print "result = $x\n"; - } + $self->_log($x,$scale); # need to do the "normal" way + $x->badd($l_10) if defined $l_10; # correct it by ln(10) + $x->badd($l_2) if defined $l_2; # and maybe by ln(2) # all done, $x contains now the result } @@ -1021,10 +1013,19 @@ sub bgcd ############################################################################### # is_foo methods (is_negative, is_positive are inherited from BigInt) +sub _is_zero_or_one + { + # internal, return true if BigInt arg is zero or one, saving the + # two calls to is_zero() and is_one() + my $x = $_[0]; + + $x->{sign} eq '+' && ($x->is_zero() || $x->is_one()); + } + sub is_int { # return true if arg (BFLOAT or num_str) is an integer - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't $x->{_e}->{sign} eq '+'; # 1e-1 => no integer @@ -1034,7 +1035,7 @@ sub is_int sub is_zero { # return true if arg (BFLOAT or num_str) is zero - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero(); 0; @@ -1043,7 +1044,7 @@ sub is_zero sub is_one { # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given - my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $sign = '+' if !defined $sign || $sign ne '-'; return 1 @@ -1054,7 +1055,7 @@ sub is_one sub is_odd { # return true if arg (BFLOAT or num_str) is odd or false if even - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't ($x->{_e}->is_zero() && $x->{_m}->is_odd()); @@ -1064,7 +1065,7 @@ sub is_odd sub is_even { # return true if arg (BINT or num_str) is even or false if odd - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't return 1 if ($x->{_e}->{sign} eq '+' # 123.45 is never @@ -1189,7 +1190,7 @@ sub bdiv $x->bnorm(); # remove trailing 0's } - # shortcut to not run trough _find_round_parameters again + # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->{_a} = undef; # clear before round @@ -1381,7 +1382,7 @@ sub broot } $x->bneg() if $sign == 1; - # shortcut to not run trough _find_round_parameters again + # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly @@ -1452,7 +1453,7 @@ sub bsqrt { # exact result $x->{_m} = $gs; $x->{_e} = $MBI->bzero(); $x->bnorm(); - # shortcut to not run trough _find_round_parameters again + # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly @@ -1516,7 +1517,7 @@ sub bsqrt $x->{_m} = $y1; - # shortcut to not run trough _find_round_parameters again + # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly @@ -1538,21 +1539,23 @@ sub bsqrt sub bfac { # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT - # compute factorial numbers - # modifies first argument + # compute factorial number, modifies first argument my ($self,$x,@r) = objectify(1,@_); return $x->bnan() if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN ($x->{_e}->{sign} ne '+')); # digits after dot? - return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1 - # use BigInt's bfac() for faster calc + if (! _is_zero_or_one($x->{_e})) + { + $x->{_m}->blsft($x->{_e},10); # unnorm + $x->{_e}->bzero(); # norm again + } $x->{_m}->blsft($x->{_e},10); # un-norm m - $x->{_e}->bzero(); # norm $x again - $x->{_m}->bfac(); # factorial - $x->bnorm()->round(@r); + $x->{_e}->bzero(); # norm again + $x->{_m}->bfac(); # calculate factorial + $x->bnorm()->round(@r); # norm again and round result } sub _pow @@ -1633,7 +1636,7 @@ sub _pow #$steps++; } - # shortcut to not run trough _find_round_parameters again + # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly @@ -2036,7 +2039,8 @@ sub import { if ( $_[$i] eq ':constant' ) { - # this rest causes overlord er load to step in + # This causes overlord er load to step in. 'binary' and 'integer' + # are handled by BigInt. overload::constant float => sub { $self->new(shift); }; } elsif ($_[$i] eq 'upgrade') diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index c193b8b..0e4ae68 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -18,10 +18,10 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.66'; +$VERSION = '1.67'; use Exporter; @ISA = qw( Exporter ); -@EXPORT_OK = qw( objectify _swap bgcd blcm); +@EXPORT_OK = qw( objectify bgcd blcm); use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/; use vars qw/$upgrade $downgrade/; # the following are internal and should never be accessed from the outside @@ -29,10 +29,9 @@ use vars qw/$_trap_nan $_trap_inf/; use strict; # Inside overload, the first arg is always an object. If the original code had -# it reversed (like $x = 2 * $y), then the third paramater indicates this -# swapping. To make it work, we use a helper routine which not only reswaps the -# params, but also makes a new object in this case. See _swap() for details, -# especially the cases of operators with different classes. +# it reversed (like $x = 2 * $y), then the third paramater is true. +# In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes +# no difference, but in some cases it does. # For overloaded ops with only one argument we simple use $_[0]->copy() to # preserve the argument. @@ -43,14 +42,6 @@ use strict; use overload '=' => sub { $_[0]->copy(); }, -# '+' and '-' do not use _swap, since it is a triffle slower. If you want to -# override _swap (if ever), then override overload of '+' and '-', too! -# for sub it is a bit tricky to keep b: b-a => -a+b -'-' => sub { my $c = $_[0]->copy; $_[2] ? - $c->bneg()->badd($_[1]) : - $c->bsub( $_[1]) }, -'+' => sub { $_[0]->copy()->badd($_[1]); }, - # some shortcuts for speed (assumes that reversed order of arguments is routed # to normal '+' and we thus can always modify first arg. If this is changed, # this breaks and must be adjusted.) @@ -75,33 +66,65 @@ use overload "$_[1]" cmp $_[0]->bstr() : $_[0]->bstr() cmp "$_[1]" }, -'log' => sub { $_[0]->copy()->blog(); }, +#'cos' => sub { +# require Math::Big; +# return Math::Big::cos($_[0], ref($_[0])->accuracy()); +# }, + +# make cos()/sin()/exp() "work" with BigInt's or subclasses +'cos' => sub { cos($_[0]->numify()) }, +'sin' => sub { sin($_[0]->numify()) }, +'exp' => sub { exp($_[0]->numify()) }, +'atan2' => sub { atan2($_[0]->numify(),$_[1]) }, + +'log' => sub { $_[0]->copy()->blog($_[1]); }, 'int' => sub { $_[0]->copy(); }, 'neg' => sub { $_[0]->copy()->bneg(); }, 'abs' => sub { $_[0]->copy()->babs(); }, 'sqrt' => sub { $_[0]->copy()->bsqrt(); }, '~' => sub { $_[0]->copy()->bnot(); }, -'*' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmul($a[1]); }, -'/' => sub { my @a = ref($_[0])->_swap(@_);scalar $a[0]->bdiv($a[1]);}, -'%' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bmod($a[1]); }, -'**' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bpow($a[1]); }, -'<<' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->blsft($a[1]); }, -'>>' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->brsft($a[1]); }, - -'&' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->band($a[1]); }, -'|' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bior($a[1]); }, -'^' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bxor($a[1]); }, - -# can modify arg of ++ and --, so avoid a new-copy for speed, but don't -# use $_[0]->__one(), it modifies $_[0] to be 1! +# for sub it is a bit tricky to keep b: b-a => -a+b +'-' => sub { my $c = $_[0]->copy; $_[2] ? + $c->bneg()->badd($_[1]) : + $c->bsub( $_[1]) }, +'+' => sub { $_[0]->copy()->badd($_[1]); }, +'*' => sub { $_[0]->copy()->bmul($_[1]); }, + +'/' => sub { + $_[2] ? ref($_[0])->new($_[1])->bdiv($_[0]) : $_[0]->copy->bdiv($_[1]); + }, +'%' => sub { + $_[2] ? ref($_[0])->new($_[1])->bmod($_[0]) : $_[0]->copy->bmod($_[1]); + }, +'**' => sub { + $_[2] ? ref($_[0])->new($_[1])->bpow($_[0]) : $_[0]->copy->bpow($_[1]); + }, +'<<' => sub { + $_[2] ? ref($_[0])->new($_[1])->blsft($_[0]) : $_[0]->copy->blsft($_[1]); + }, +'>>' => sub { + $_[2] ? ref($_[0])->new($_[1])->brsft($_[0]) : $_[0]->copy->brsft($_[1]); + }, +'&' => sub { + $_[2] ? ref($_[0])->new($_[1])->band($_[0]) : $_[0]->copy->band($_[1]); + }, +'|' => sub { + $_[2] ? ref($_[0])->new($_[1])->bior($_[0]) : $_[0]->copy->bior($_[1]); + }, +'^' => sub { + $_[2] ? ref($_[0])->new($_[1])->bxor($_[0]) : $_[0]->copy->bxor($_[1]); + }, + +# can modify arg of ++ and --, so avoid a copy() for speed, but don't +# use $_[0]->bone(), it would modify $_[0] to be 1! '++' => sub { $_[0]->binc() }, '--' => sub { $_[0]->bdec() }, # if overloaded, O(1) instead of O(N) and twice as fast for small numbers 'bool' => sub { # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/ - # v5.6.1 dumps on that: return !$_[0]->is_zero() || undef; :-( + # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-( my $t = !$_[0]->is_zero(); undef $t if $t == 0; $t; @@ -136,6 +159,8 @@ $_trap_inf = 0; # are infs ok? set w/ config() my $nan = 'NaN'; # constants for easier life my $CALC = 'Math::BigInt::Calc'; # module to do the low level math + # default is Calc.pm +my %CAN; # cache for $CALC->can(...) my $IMPORT = 0; # was import() called yet? # used to make require work @@ -746,6 +771,7 @@ sub bone } else { + # call like: $x->bone($sign,$a,$p,$r); $self->{_a} = $_[0] if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a})); $self->{_p} = $_[1] @@ -1068,7 +1094,7 @@ sub badd } return $x if $x->modify('badd'); - return $upgrade->badd($x,$y,@r) if defined $upgrade && + return $upgrade->badd($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); $r[3] = $y; # no push! @@ -1102,20 +1128,17 @@ sub badd my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare if ($a > 0) { - #print "swapped sub (a=$a)\n"; $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap $x->{sign} = $sy; } elsif ($a == 0) { # speedup, if equal, set result to 0 - #print "equal sub, result = 0\n"; $x->{value} = $CALC->_zero(); $x->{sign} = '+'; } else # a < 0 { - #print "unswapped sub (a=$a)\n"; $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub $x->{sign} = $sx; } @@ -1126,7 +1149,7 @@ sub badd sub bsub { - # (BINT or num_str, BINT or num_str) return num_str + # (BINT or num_str, BINT or num_str) return BINT # subtract second arg from first, modify first # set up parameters @@ -1175,7 +1198,7 @@ sub binc return $x; } # inf, nan handling etc - $x->badd($self->__one(),$a,$p,$r); # badd does round + $x->badd($self->bone(),$a,$p,$r); # badd does round } sub bdec @@ -1202,19 +1225,59 @@ sub bdec return $x; } # inf, nan handling etc - $x->badd($self->__one('-'),$a,$p,$r); # badd does round + $x->badd($self->bone('-'),$a,$p,$r); # badd does round } sub blog { - # not implemented yet - my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + # calculate $x = $a ** $base + $b and return $a (e.g. the log() to base + # $base of $x) + + # set up parameters + my ($self,$x,$base,@r) = (ref($_[0]),@_); + # objectify is costly, so avoid it + if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) + { + ($self,$x,$base,@r) = objectify(2,@_); + } + + # inf, -inf, NaN, <0 => NaN + return $x->bnan() + if $x->{sign} ne '+' || $base->{sign} ne '+'; + + return $upgrade->blog($upgrade->new($x),$base,@r) if + defined $upgrade && (ref($x) ne $upgrade || ref($base) ne $upgrade); + + if ($CAN{log_int}) + { + my $rc = $CALC->_log_int($x->{value},$base->{value}); + return $x->bnan() unless defined $rc; + $x->{value} = $rc; + return $x->round(@r); + } + + return $x->bnan() if $x->is_zero() || $base->is_zero() || $base->is_one(); + + my $acmp = $x->bacmp($base); + return $x->bone('+',@r) if $acmp == 0; + return $x->bzero(@r) if $acmp < 0 || $x->is_one(); - return $upgrade->blog($upgrade->new($x),$base,$a,$p,$r) if defined $upgrade; + # blog($x,$base) ** $base + $y = $x - return $x->bnan(); + # this trial multiplication is very fast, even for large counts (like for + # 2 ** 1024, since this still requires only 1024 very fast steps + # (multiplication of a large number by a very small number is very fast)) + # See Calc for an even faster algorightmn + my $x_org = $x->copy(); # preserve orgx + $x->bzero(); # keep ref to $x + my $trial = $base->copy(); + while ($trial->bacmp($x_org) <= 0) + { + $trial->bmul($base); $x->binc(); + } + $x->round(@r); } - + sub blcm { # (BINT or num_str, BINT or num_str) return BINT @@ -1244,7 +1307,7 @@ sub bgcd $y = __PACKAGE__->new($y) if !ref($y); my $self = ref($y); my $x = $y->copy(); # keep arguments - if ($CALC->can('_gcd')) + if ($CAN{gcd}) { while (@_) { @@ -1273,15 +1336,16 @@ sub bnot my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); return $x if $x->modify('bnot'); - $x->bneg()->bdec(); # bdec already does round + $x->binc()->bneg(); # binc already does round } +############################################################################## # is_foo test routines +# we don't need $self, so undef instead of ref($_[0]) make it slightly faster sub is_zero { # return true if arg (BINT or num_str) is zero (array '+', '0') - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't @@ -1291,36 +1355,28 @@ sub is_zero sub is_nan { # return true if arg (BINT or num_str) is NaN - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - return 1 if $x->{sign} eq $nan; - 0; + $x->{sign} eq $nan ? 1 : 0; } sub is_inf { # return true if arg (BINT or num_str) is +-inf - my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); - - $sign = '' if !defined $sign; - return 1 if $sign eq $x->{sign}; # match ("+inf" eq "+inf") - return 0 if $sign !~ /^([+-]|)$/; + my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); - if ($sign eq '') + if (defined $sign) { - return 1 if ($x->{sign} =~ /^[+-]inf$/); - return 0; + $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf + $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-' + return $x->{sign} =~ /^$sign$/ ? 1 : 0; } - $sign = quotemeta($sign.'inf'); - return 1 if ($x->{sign} =~ /^$sign$/); - 0; + $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity } sub is_one { - # return true if arg (BINT or num_str) is +1 - # or -1 if sign is given - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + # return true if arg (BINT or num_str) is +1, or -1 if sign is given my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $sign = '+' if !defined $sign || $sign ne '-'; @@ -1332,7 +1388,6 @@ sub is_one sub is_odd { # return true when arg (BINT or num_str) is odd, false for even - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't @@ -1342,7 +1397,6 @@ sub is_odd sub is_even { # return true when arg (BINT or num_str) is even, false for odd - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't @@ -1352,28 +1406,23 @@ sub is_even sub is_positive { # return true when arg (BINT or num_str) is positive (>= 0) - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - return 1 if $x->{sign} =~ /^\+/; - 0; + $x->{sign} =~ /^\+/ ? 1 : 0; # +inf is also positive, but NaN not } sub is_negative { # return true when arg (BINT or num_str) is negative (< 0) - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - return 1 if ($x->{sign} =~ /^-/); - 0; + $x->{sign} =~ /^-/ ? 1 : 0; # -inf is also negative, but NaN not } sub is_int { # return true when arg (BINT or num_str) is an integer - # always true for BigInt, but different for Floats - # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + # always true for BigInt, but different for BigFloats my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't @@ -1550,7 +1599,7 @@ sub bmod return $x->round(@r); } - if ($CALC->can('_mod')) + if ($CAN{mod}) { # calc new sign and in case $y == +/- 1, return $x $x->{value} = $CALC->_mod($x->{value},$y->{value}); @@ -1561,7 +1610,6 @@ sub bmod if ($xsign ne $y->{sign}) { my $t = $CALC->_copy($x->{value}); # copy $x - $x->{value} = $CALC->_copy($y->{value}); # copy $y to $x $x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x } } @@ -1572,6 +1620,8 @@ sub bmod $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; return $x; } + # disable upgrade temporarily, otherwise endless loop due to bdiv() + local $upgrade = undef; my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds) # modify in place foreach (qw/value sign _a _p/) @@ -1607,7 +1657,7 @@ sub bmodinv # put least residue into $x if $x was negative, and thus make it positive $x->bmod($y) if $x->{sign} eq '-'; - if ($CALC->can('_modinv')) + if ($CAN{modinv}) { my $sign; ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value}); @@ -1685,7 +1735,7 @@ sub bmodpow # 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')) + if ($CAN{modpow}) { # $mod is positive, sign on $exp is ignored, result also positive $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value}); @@ -1705,10 +1755,7 @@ sub bmodpow my $len = CORE::length($expbin); while (--$len >= 0) { - if( substr($expbin,$len,1) eq '1') - { - $num->bmul($acc)->bmod($mod); - } + $num->bmul($acc)->bmod($mod) if substr($expbin,$len,1) eq '1'; $acc->bmul($acc)->bmod($mod); } @@ -1720,21 +1767,21 @@ sub bmodpow sub bfac { # (BINT or num_str, BINT or num_str) return BINT - # compute factorial numbers - # modifies first argument + # compute factorial number from $x, modify $x in place my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bfac'); return $x->bnan() if $x->{sign} ne '+'; # inf, NnN, <0 etc => NaN - return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1 - if ($CALC->can('_fac')) + if ($CAN{fac}) { $x->{value} = $CALC->_fac($x->{value}); return $x->round(@r); } + return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1 + my $n = $x->copy(); $x->bone(); # seems we need not to temp. clear A/P of $x since the result is the same @@ -1781,7 +1828,7 @@ sub bpow return $x->bnan() if $y->{sign} eq '-'; return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0) - if ($CALC->can('_pow')) + if ($CAN{pow}) { $x->{value} = $CALC->_pow($x->{value},$y->{value}); $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; @@ -1805,7 +1852,7 @@ sub bpow # return $x->round(@r); # } - my $pow2 = $self->__one(); + my $pow2 = $self->bone(); my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//; my $len = CORE::length($y_bin); while (--$len > 0) @@ -1837,7 +1884,7 @@ sub blsft $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; - my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft'); + my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CAN{lsft}; if (defined $t) { $x->{value} = $t; return $x->round(@r); @@ -1902,7 +1949,7 @@ sub brsft $x->bdec(); # n == 2, but $y == 1: this fixes it } - my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft'); + my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CAN{rsft}; if (defined $t) { $x->{value} = $t; @@ -1932,36 +1979,106 @@ sub band local $Math::BigInt::upgrade = undef; return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); - return $x->bzero(@r) if $y->is_zero() || $x->is_zero(); - my $sign = 0; # sign of result - $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-'); my $sx = 1; $sx = -1 if $x->{sign} eq '-'; my $sy = 1; $sy = -1 if $y->{sign} eq '-'; - if ($CALC->can('_and') && $sx == 1 && $sy == 1) + if ($CAN{and} && $sx == 1 && $sy == 1) { $x->{value} = $CALC->_and($x->{value},$y->{value}); return $x->round(@r); } + + if ($CAN{signed_and}) + { + $x->{value} = $CALC->_signed_and($x->{value},$y->{value},$sx,$sy); + return $x->round(@r); + } + + return $x->bzero(@r) if $y->is_zero() || $x->is_zero(); + + my $sign = 0; # sign of result + $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-'); + + my ($bx,$by); + + if ($sx == -1) # if x is negative + { + # two's complement: inc and flip all "bits" in $bx + $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc + $bx =~ s/-?0x//; + $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + else + { + $bx = $x->as_hex(); # get binary representation + $bx =~ s/-?0x//; + $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + if ($sy == -1) # if y is negative + { + # two's complement: inc and flip all "bits" in $by + $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc + $by =~ s/-?0x//; + $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + else + { + $by = $y->as_hex(); # get binary representation + $by =~ s/-?0x//; + $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + # now we have bit-strings from X and Y, reverse them for padding + $bx = reverse $bx; + $by = reverse $by; + + # cut the longer string to the length of the shorter one (the result would + # be 0 due to AND anyway) + my $diff = CORE::length($bx) - CORE::length($by); + if ($diff > 0) + { + $bx = substr($bx,0,CORE::length($by)); + } + elsif ($diff < 0) + { + $by = substr($by,0,CORE::length($bx)); + } + + # and the strings together + my $r = $bx & $by; + + # and reverse the result again + $bx = reverse $r; + + # one of $x or $y was negative, so need to flip bits in the result + # in both cases (one or two of them negative, or both positive) we need + # to get the characters back. + if ($sign == 1) + { + $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; + } + else + { + $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; + } - my $m = $self->bone(); my ($xr,$yr); - my $x10000 = $self->new (0x1000); - my $y1 = copy(ref($x),$y); # make copy - $y1->babs(); # and positive - my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! - use integer; # need this for negative bools - while (!$x1->is_zero() && !$y1->is_zero()) + $bx = '0x' . $bx; + if ($CAN{from_hex}) { - ($x1, $xr) = bdiv($x1, $x10000); - ($y1, $yr) = bdiv($y1, $x10000); - # make both op's numbers! - $x->badd( bmul( $class->new( - abs($sx*int($xr->numify()) & $sy*int($yr->numify()))), - $m)); - $m->bmul($x10000); + $x->{value} = $CALC->_from_hex( \$bx ); } - $x->bneg() if $sign; + else + { + $r = $self->new($bx); + $x->{value} = $r->{value}; + } + + # calculate sign of result + $x->{sign} = '+'; + $x->{sign} = '-' if $sx == $sy && $sx == -1 && !$x->is_zero(); + + $x->bdec() if $sign == 1; + $x->round(@r); } @@ -1984,37 +2101,108 @@ sub bior local $Math::BigInt::upgrade = undef; return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); - return $x->round(@r) if $y->is_zero(); - my $sign = 0; # sign of result - $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-'); my $sx = 1; $sx = -1 if $x->{sign} eq '-'; my $sy = 1; $sy = -1 if $y->{sign} eq '-'; + # the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior() + # don't use lib for negative values - if ($CALC->can('_or') && $sx == 1 && $sy == 1) + if ($CAN{or} && $sx == 1 && $sy == 1) { $x->{value} = $CALC->_or($x->{value},$y->{value}); return $x->round(@r); } - my $m = $self->bone(); my ($xr,$yr); - my $x10000 = $self->new(0x10000); - my $y1 = copy(ref($x),$y); # make copy - $y1->babs(); # and positive - my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! - use integer; # need this for negative bools - while (!$x1->is_zero() || !$y1->is_zero()) + # if lib can do negatvie values, so use it + if ($CAN{signed_or}) + { + $x->{value} = $CALC->_signed_or($x->{value},$y->{value},$sx,$sy); + return $x->round(@r); + } + + return $x->round(@r) if $y->is_zero(); + + my $sign = 0; # sign of result + $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-'); + + my ($bx,$by); + + if ($sx == -1) # if x is negative + { + # two's complement: inc and flip all "bits" in $bx + $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc + $bx =~ s/-?0x//; + $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + else + { + $bx = $x->as_hex(); # get binary representation + $bx =~ s/-?0x//; + $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + if ($sy == -1) # if y is negative + { + # two's complement: inc and flip all "bits" in $by + $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc + $by =~ s/-?0x//; + $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + else + { + $by = $y->as_hex(); # get binary representation + $by =~ s/-?0x//; + $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + # now we have bit-strings from X and Y, reverse them for padding + $bx = reverse $bx; + $by = reverse $by; + + # padd the shorter string + my $xx = "\x00"; $xx = "\x0f" if $sx == -1; + my $yy = "\x00"; $yy = "\x0f" if $sy == -1; + my $diff = CORE::length($bx) - CORE::length($by); + if ($diff > 0) { - ($x1, $xr) = bdiv($x1,$x10000); - ($y1, $yr) = bdiv($y1,$x10000); - # make both op's numbers! - $x->badd( bmul( $class->new( - abs($sx*int($xr->numify()) | $sy*int($yr->numify()))), - $m)); - $m->bmul($x10000); + $by .= $yy x $diff; } - $x->bneg() if $sign; + elsif ($diff < 0) + { + $bx .= $xx x abs($diff); + } + + # or the strings together + my $r = $bx | $by; + + # and reverse the result again + $bx = reverse $r; + + # one of $x or $y was negative, so need to flip bits in the result + # in both cases (one or two of them negative, or both positive) we need + # to get the characters back. + if ($sign == 1) + { + $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; + } + else + { + $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; + } + + $bx = '0x' . $bx; + if ($CAN{from_hex}) + { + $x->{value} = $CALC->_from_hex( \$bx ); + } + else + { + $r = $self->new($bx); + $x->{value} = $r->{value}; + } + + # if one of X or Y was negative, we need to decrement result + $x->bdec() if $sign == 1; + $x->round(@r); } @@ -2037,37 +2225,109 @@ sub bxor local $Math::BigInt::upgrade = undef; return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); - return $x->round(@r) if $y->is_zero(); - my $sign = 0; # sign of result - $sign = 1 if $x->{sign} ne $y->{sign}; my $sx = 1; $sx = -1 if $x->{sign} eq '-'; my $sy = 1; $sy = -1 if $y->{sign} eq '-'; # don't use lib for negative values - if ($CALC->can('_xor') && $sx == 1 && $sy == 1) + if ($CAN{xor} && $sx == 1 && $sy == 1) { $x->{value} = $CALC->_xor($x->{value},$y->{value}); return $x->round(@r); } + + # if lib can do negatvie values, so use it + if ($CAN{signed_xor}) + { + $x->{value} = $CALC->_signed_xor($x->{value},$y->{value},$sx,$sy); + return $x->round(@r); + } - my $m = $self->bone(); my ($xr,$yr); - my $x10000 = $self->new(0x10000); - my $y1 = copy(ref($x),$y); # make copy - $y1->babs(); # and positive - my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! - use integer; # need this for negative bools - while (!$x1->is_zero() || !$y1->is_zero()) + return $x->round(@r) if $y->is_zero(); + + my $sign = 0; # sign of result + $sign = 1 if $x->{sign} ne $y->{sign}; + + my ($bx,$by); + + if ($sx == -1) # if x is negative + { + # two's complement: inc and flip all "bits" in $bx + $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc + $bx =~ s/-?0x//; + $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + else + { + $bx = $x->as_hex(); # get binary representation + $bx =~ s/-?0x//; + $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + if ($sy == -1) # if y is negative + { + # two's complement: inc and flip all "bits" in $by + $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc + $by =~ s/-?0x//; + $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + else + { + $by = $y->as_hex(); # get binary representation + $by =~ s/-?0x//; + $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; + } + # now we have bit-strings from X and Y, reverse them for padding + $bx = reverse $bx; + $by = reverse $by; + + # padd the shorter string + my $xx = "\x00"; $xx = "\x0f" if $sx == -1; + my $yy = "\x00"; $yy = "\x0f" if $sy == -1; + my $diff = CORE::length($bx) - CORE::length($by); + if ($diff > 0) + { + $by .= $yy x $diff; + } + elsif ($diff < 0) + { + $bx .= $xx x abs($diff); + } + + # xor the strings together + my $r = $bx ^ $by; + + # and reverse the result again + $bx = reverse $r; + + # one of $x or $y was negative, so need to flip bits in the result + # in both cases (one or two of them negative, or both positive) we need + # to get the characters back. + if ($sign == 1) + { + $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; + } + else + { + $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; + } + + $bx = '0x' . $bx; + if ($CAN{from_hex}) + { + $x->{value} = $CALC->_from_hex( \$bx ); + } + else { - ($x1, $xr) = bdiv($x1, $x10000); - ($y1, $yr) = bdiv($y1, $x10000); - # make both op's numbers! - $x->badd( bmul( $class->new( - abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))), - $m)); - $m->bmul($x10000); + $r = $self->new($bx); + $x->{value} = $r->{value}; } - $x->bneg() if $sign; + + # calculate sign of result + $x->{sign} = '+'; + $x->{sign} = '-' if $sx != $sy && !$x->is_zero(); + + $x->bdec() if $sign == 1; + $x->round(@r); } @@ -2076,7 +2336,7 @@ sub length my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); my $e = $CALC->_len($x->{value}); - return wantarray ? ($e,0) : $e; + wantarray ? ($e,0) : $e; } sub digit @@ -2095,7 +2355,7 @@ sub _trailing_zeros return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/; - return $CALC->_zeros($x->{value}) if $CALC->can('_zeros'); + return $CALC->_zeros($x->{value}) if $CAN{zeros}; # if not: since we do not know underlying internal representation: my $es = "$x"; $es =~ /([0]*)$/; @@ -2112,17 +2372,19 @@ sub bsqrt return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf - return $x->round(@r) if $x->is_zero() || $x->is_one(); # 0,1 => 0,1 return $upgrade->bsqrt($x,@r) if defined $upgrade; - if ($CALC->can('_sqrt')) + if ($CAN{sqrt}) { $x->{value} = $CALC->_sqrt($x->{value}); return $x->round(@r); } - return $x->bone('+',@r) if $x < 4; # 2,3 => 1 + # this is slow: + return $x->round(@r) if $x->is_zero(); # 0,1 => 0,1 + + return $x->bone('+',@r) if $x < 4; # 1,2,3 => 1 my $y = $x->copy(); my $l = int($x->length()/2); @@ -2169,7 +2431,7 @@ sub broot return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade; - if ($CALC->can('_root')) + if ($CAN{root}) { $x->{value} = $CALC->_root($x->{value},$y->{value}); return $x->round(@r); @@ -2254,9 +2516,9 @@ sub mantissa sub parts { # return a copy of both the exponent and the mantissa - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - return ($x->mantissa(),$x->exponent()); + ($x->mantissa(),$x->exponent()); } ############################################################################## @@ -2286,6 +2548,7 @@ sub bfround sub _scan_for_nonzero { + # internal, used by bround() my $x = shift; my $pad = shift; my $xs = shift; @@ -2296,18 +2559,16 @@ sub _scan_for_nonzero return 0 if $follow > $len || $follow < 1; # since we do not know underlying represention of $x, use decimal string - #my $r = substr ($$xs,-$follow); my $r = substr ("$x",-$follow); - return 1 if $r =~ /[^0]/; - 0; + $r =~ /[^0]/ ? 1 : 0; } sub fround { - # to make life easier for switch between MBF and MBI (autoload fxxx() - # like MBF does for bxxx()?) + # Exists to make life easier for switch between MBF and MBI (should we + # autoload fxxx() like MBF does for bxxx()?) my $x = shift; - return $x->bround(@_); + $x->bround(@_); } sub bround @@ -2418,61 +2679,106 @@ sub bround sub bfloor { - # return integer less or equal then number, since it is already integer, - # always returns $self - my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + # return integer less or equal then number; no-op since it's already integer + my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $x->round(@r); } sub bceil { - # return integer greater or equal then number, since it is already integer, - # always returns $self - my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); + # return integer greater or equal then number; no-op since it's already int + my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $x->round(@r); } -############################################################################## -# private stuff (internal use only) +sub as_number + { + # An object might be asked to return itself as bigint on certain overloaded + # operations, this does exactly this, so that sub classes can simple inherit + # it or override with their own integer conversion routine. + $_[0]->copy(); + } -sub __one +sub as_hex { - # internal speedup, set argument to 1, or create a +/- 1 - my $self = shift; - my $x = $self->bone(); # $x->{value} = $CALC->_one(); - $x->{sign} = shift || '+'; - $x; + # 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 + + my $es = ''; my $s = ''; + $s = $x->{sign} if $x->{sign} eq '-'; + if ($CAN{as_hex}) + { + $es = ${$CALC->_as_hex($x->{value})}; + } + else + { + return '0x0' if $x->is_zero(); + + 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($h,pack('v',$xr->numify())); + } + $es = reverse $es; + $es =~ s/^[0]+//; # strip leading zeros + $s .= '0x'; + } + $s . $es; } -sub _swap +sub as_bin { - # Overload will swap params if first one is no object ref so that the first - # one is always an object ref. In this case, third param is true. - # This routine is to overcome the effect of scalar,$object creating an object - # of the class of this package, instead of the second param $object. This - # happens inside overload, when the overload section of this package is - # inherited by sub classes. - # For overload cases (and this is used only there), we need to preserve the - # args, hence the copy(). - # You can override this method in a subclass, the overload section will call - # $object->_swap() to make sure it arrives at the proper subclass, with some - # exceptions like '+' and '-'. To make '+' and '-' work, you also need to - # specify your own overload for them. - - # object, (object|scalar) => preserve first and make copy - # scalar, object => swapped, re-swap and create new from first - # (using class of second object, not $class!!) - my $self = shift; # for override in subclass - if ($_[2]) - { - my $c = ref ($_[0]) || $class; # fallback $class should not happen - return ( $c->new($_[1]), $_[0] ); - } - return ( $_[0]->copy(), $_[1] ); + # 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 + + my $es = ''; my $s = ''; + $s = $x->{sign} if $x->{sign} eq '-'; + if ($CAN{as_bin}) + { + $es = ${$CALC->_as_bin($x->{value})}; + } + else + { + return '0b0' if $x->is_zero(); + 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($b,pack('v',$xr->numify())); + } + $es = reverse $es; + $es =~ s/^[0]+//; # strip leading zeros + $s .= '0b'; + } + $s . $es; } +############################################################################## +# private stuff (internal use only) + sub objectify { # check for strings, if yes, return objects instead @@ -2574,15 +2880,16 @@ sub import { my $self = shift; - $IMPORT++; + $IMPORT++; # remember we did import() my @a; my $l = scalar @_; for ( my $i = 0; $i < $l ; $i++ ) { if ($_[$i] eq ':constant') { # this causes overlord er load to step in - overload::constant integer => sub { $self->new(shift) }; - overload::constant binary => sub { $self->new(shift) }; + overload::constant + integer => sub { $self->new(shift) }, + binary => sub { $self->new(shift) }; } elsif ($_[$i] eq 'upgrade') { @@ -2634,7 +2941,23 @@ sub import if ($CALC eq '') { require Carp; - Carp::croak ("Couldn't load any math lib, not even the default"); + Carp::croak ("Couldn't load any math lib, not even 'Calc.pm'"); + } + _fill_can_cache(); + } + +sub _fill_can_cache + { + # fill $CAN with the results of $CALC->can(...) + + %CAN = (); + for my $method (qw/gcd mod modinv modpow fac pow lsft rsft + and signed_and or signed_or xor signed_xor + from_hex as_hex from_bin as_bin + zeros sqrt root log_int log + /) + { + $CAN{$method} = $CALC->can("_$method") ? 1 : 0; } } @@ -2654,7 +2977,7 @@ sub __from_hex my $sign = '+'; $sign = '-' if ($$hs =~ /^-/); $$hs =~ s/^[+-]//; # strip sign - if ($CALC->can('_from_hex')) + if ($CAN{'_from_hex'}) { $x->{value} = $CALC->_from_hex($hs); } @@ -2693,7 +3016,7 @@ sub __from_bin my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/); $$bs =~ s/^[+-]//; # strip sign - if ($CALC->can('_from_bin')) + if ($CAN{'_from_bin'}) { $x->{value} = $CALC->_from_bin($bs); } @@ -2787,91 +3110,6 @@ sub _split return; # NaN, not a number } -sub as_number - { - # an object might be asked to return itself as bigint on certain overloaded - # operations, this does exactly this, so that sub classes can simple inherit - # it or override with their own integer conversion routine - my $self = shift; - - $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 - - my $es = ''; my $s = ''; - $s = $x->{sign} if $x->{sign} eq '-'; - if ($CALC->can('_as_hex')) - { - $es = ${$CALC->_as_hex($x->{value})}; - } - else - { - return '0x0' if $x->is_zero(); - - 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($h,pack('v',$xr->numify())); - } - $es = reverse $es; - $es =~ s/^[0]+//; # strip leading zeros - $s .= '0x'; - } - $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 - - my $es = ''; my $s = ''; - $s = $x->{sign} if $x->{sign} eq '-'; - if ($CALC->can('_as_bin')) - { - $es = ${$CALC->_as_bin($x->{value})}; - } - else - { - return '0b0' if $x->is_zero(); - 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($b,pack('v',$xr->numify())); - } - $es = reverse $es; - $es =~ s/^[0]+//; # strip leading zeros - $s .= '0b'; - } - $s . $es; - } - ############################################################################## # internal calculation routines (others are in Math::BigInt::Calc etc) @@ -3061,7 +3299,7 @@ and results in an integer, including hexadecimal and binary numbers. Scalars holding numbers may also be passed, but note that non-integer numbers may already have lost precision due to the conversation to float. Quote -your input if you want BigInt to see all the digits. +your input if you want BigInt to see all the digits: $x = Math::BigInt->new(12345678890123456789); # bad $x = Math::BigInt->new('12345678901234567890'); # good @@ -3072,10 +3310,14 @@ This means integer values like 1.01E2 or even 1000E-2 are also accepted. Non-integer values result in NaN. Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('') -results in 'NaN'. +results in 'NaN'. This might change in the future, so use always the following +explicit forms to get a zero or NaN: + + $zero = Math::BigInt->bzero(); + $nan = Math::BigInt->bnan(); C on a BigInt object is now effectively a no-op, since the numbers -are always stored in normalized form. On a string, it creates a BigInt +are always stored in normalized form. If passed a string, creates a BigInt object from the input. =item Output @@ -3109,15 +3351,15 @@ appropriate information. key Description Example ============================================================ - lib Name of the Math library + lib Name of the low-level math library Math::BigInt::Calc - lib_version Version of 'lib' + lib_version Version of low-level math library (see 'lib') 0.30 - class The class of config you just called + class The class name of config() you just called Math::BigInt - upgrade To which class numbers are upgraded + upgrade To which class math operations might be upgraded Math::BigFloat - downgrade To which class numbers are downgraded + downgrade To which class math operations might be downgraded undef precision Global precision undef @@ -3129,6 +3371,10 @@ appropriate information. 1.61 div_scale Fallback acccuracy for div 40 + trap_nan If true, traps creation of NaN via croak() + 1 + trap_inf If true, traps creation of +inf/-inf via croak() + 1 The following values can be set by passing C a reference to a hash: @@ -3341,9 +3587,11 @@ 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. -=head2 bcmp +=head2 digit + + $x->digit($n); # return the nth digit, counting from right - $x->digit($n); # return the nth digit, counting from right +If C<$n> is negative, returns the digit counting from left. =head2 bneg @@ -3366,7 +3614,13 @@ numbers. =head2 bnot - $x->bnot(); # two's complement (bit wise not) + $x->bnot(); + +Two's complement (bit wise not). This is equivalent to + + $x->binc()->bneg(); + +but faster. =head2 binc @@ -3416,7 +3670,7 @@ writing $num ** $exp % $mod -because C is much faster--it reduces internal variables into +because it is much faster - it reduces internal variables into the modulus whenever possible, so it operates on smaller numbers. C also supports negative exponents. @@ -3555,7 +3809,7 @@ Return the signed mantissa of $x as BigInt. Since version v1.33, Math::BigInt and Math::BigFloat have full support for accuracy and precision based rounding, both automatically after every -operation as well as manually. +operation, as well as manually. This section describes the accuracy/precision handling in Math::Big* as it used to be and as it is now, complete with an explanation of all terms and @@ -3713,7 +3967,7 @@ versions <= 5.7.2) is like this: Actually, the 'difference' added to the scale is calculated from the number of "significant digits" in dividend and divisor, which is derived by looking at the length of the mantissa. Which is wrong, since it includes - the + sign (oups) and actually gets 2 for '+100' and 4 for '+101'. Oups + the + sign (oops) and actually gets 2 for '+100' and 4 for '+101'. Oops again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange assumption that 124 has 3 significant digits, while 120/7 will get you '17', not '17.1' since 120 is thought to have 2 significant digits. @@ -3730,23 +3984,26 @@ This is how it works now: =item Setting/Accessing - * You can set the A global via Math::BigInt->accuracy() or - Math::BigFloat->accuracy() or whatever class you are using. - * You can also set P globally by using Math::SomeClass->precision() likewise. + * You can set the A global via C<< Math::BigInt->accuracy() >> or + C<< Math::BigFloat->accuracy() >> or whatever class you are using. + * You can also set P globally by using C<< Math::SomeClass->precision() >> + likewise. * Globals are classwide, and not inherited by subclasses. - * to undefine A, use Math::SomeCLass->accuracy(undef); - * to undefine P, use Math::SomeClass->precision(undef); - * Setting Math::SomeClass->accuracy() clears automatically - Math::SomeClass->precision(), and vice versa. + * to undefine A, use C<< Math::SomeCLass->accuracy(undef); >> + * to undefine P, use C<< Math::SomeClass->precision(undef); >> + * Setting C<< Math::SomeClass->accuracy() >> clears automatically + C<< Math::SomeClass->precision() >>, and vice versa. * To be valid, A must be > 0, P can have any value. * If P is negative, this means round to the P'th place to the right of the decimal point; positive values mean to the left of the decimal point. P of 0 means round to integer. - * to find out the current global A, take Math::SomeClass->accuracy() - * to find out the current global P, take Math::SomeClass->precision() - * use $x->accuracy() respective $x->precision() for the local setting of $x. - * Please note that $x->accuracy() respecive $x->precision() fall back to the - defined globals, when $x's A or P is not set. + * to find out the current global A, use C<< Math::SomeClass->accuracy() >> + * to find out the current global P, use C<< Math::SomeClass->precision() >> + * use C<< $x->accuracy() >> respective C<< $x->precision() >> for the local + setting of C<< $x >>. + * Please note that C<< $x->accuracy() >> respecive C<< $x->precision() >> + return eventually defined global A or P, when C<< $x >>'s A or P is not + set. =item Creating numbers @@ -3761,7 +4018,7 @@ This is how it works now: B be used. This is used by subclasses to create numbers without suffering rounding in the parent. Thus a subclass is able to have it's own globals enforced upon creation of a number by using - $x = Math::BigInt->new($number,undef,undef): + C<< $x = Math::BigInt->new($number,undef,undef) >>: use Math::BigInt::SomeSubclass; use Math::BigInt; @@ -3779,22 +4036,21 @@ This is how it works now: operation according to the rules below * Negative P is ignored in Math::BigInt, since BigInts never have digits after the decimal point - * Math::BigFloat uses Math::BigInts internally, but setting A or P inside - Math::BigInt as globals should not tamper with the parts of a BigFloat. - Thus a flag is used to mark all Math::BigFloat numbers as 'never round' + * Math::BigFloat uses Math::BigInt internally, but setting A or P inside + Math::BigInt as globals does not tamper with the parts of a BigFloat. + A flag is used to mark all Math::BigFloat numbers as 'never round'. =item Precedence * It only makes sense that a number has only one of A or P at a time. - Since you can set/get both A and P, there is a rule that will practically - enforce only A or P to be in effect at a time, even if both are set. - This is called precedence. + If you set either A or P on one object, or globally, the other one will + be automatically cleared. * If two objects are involved in an operation, and one of them has A in effect, and the other P, this results in an error (NaN). - * A takes precendence over P (Hint: A comes before P). If A is defined, it - is used, otherwise P is used. If neither of them is defined, nothing is - used, i.e. the result will have as many digits as it can (with an - exception for fdiv/fsqrt) and will not be rounded. + * A takes precendence over P (Hint: A comes before P). + If neither of them is defined, nothing is used, i.e. the result will have + as many digits as it can (with an exception for fdiv/fsqrt) and will not + be rounded. * There is another setting for fdiv() (and thus for fsqrt()). If neither of A or P is defined, fdiv() will use a fallback (F) of $div_scale digits. If either the dividend's or the divisor's mantissa has more digits than @@ -3805,7 +4061,7 @@ This is how it works now: A, P or F), and, if F is not used, round the result (this will still fail in the case of a result like 0.12345000000001 with A or P of 5, but this can not be helped - or can it?) - * Thus you can have the math done by on Math::Big* class in three modes: + * Thus you can have the math done by on Math::Big* class in two modi: + never round (this is the default): This is done by setting A and P to undef. No math operation will round the result, with fdiv() and fsqrt() as exceptions to guard @@ -3854,10 +4110,11 @@ This is how it works now: =item Local settings - * You can set A and P locally by using $x->accuracy() and $x->precision() + * You can set A or P locally by using C<< $x->accuracy() >> or + C<< $x->precision() >> and thus force different A and P for different objects/numbers. * Setting A or P this way immediately rounds $x to the new value. - * $x->accuracy() clears $x->precision(), and vice versa. + * C<< $x->accuracy() >> clears C<< $x->precision() >>, and vice versa. =item Rounding @@ -3867,12 +4124,12 @@ This is how it works now: * the two rounding functions take as the second parameter one of the following rounding modes (R): 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' - * you can set and get the global R by using Math::SomeClass->round_mode() - or by setting $Math::SomeClass::round_mode - * after each operation, $result->round() is called, and the result may + * you can set/get the global R by using C<< Math::SomeClass->round_mode() >> + or by setting C<< $Math::SomeClass::round_mode >> + * after each operation, C<< $result->round() >> is called, and the result may eventually be rounded (that is, if A or P were set either locally, globally or as parameter to the operation) - * to manually round a number, call $x->round($A,$P,$round_mode); + * to manually round a number, call C<< $x->round($A,$P,$round_mode); >> this will round the number by using the appropriate rounding function and then normalize it. * rounding modifies the local settings of the number: @@ -3911,7 +4168,7 @@ instead relying on the internal hash keys like in C<< $x->{sign}; >>. =head2 MATH LIBRARY Math with the numbers is done (by default) by a module called -Math::BigInt::Calc. This is equivalent to saying: +C. This is equivalent to saying: use Math::BigInt lib => 'Calc'; @@ -3924,11 +4181,17 @@ Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: use Math::BigInt lib => 'Foo,Math::BigInt::Bar'; -Calc.pm uses as internal format an array of elements of some decimal base -(usually 1e5 or 1e7) with the least significant digit first, while BitVect.pm -uses a bit vector of base 2, most significant bit first. Other modules might -use even different means of representing the numbers. See the respective -module documentation for further details. +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 +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. + +See the respective math library module documentation for further details. =head2 SIGN @@ -3952,14 +4215,13 @@ that: C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them in one go. Both the returned mantissa and exponent have a sign. -Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf, -where it will be NaN; and for $x == 0, where it will be 1 -(to be compatible with Math::BigFloat's internal representation of a zero as -C<0E1>). +Currently, for BigInts C<$e> is always 0, except for NaN, +inf and -inf, +where it is C; and for C<$x == 0>, where it is C<1> (to be compatible +with Math::BigFloat's internal representation of a zero as C<0E1>). -C<$m> will always be a copy of the original number. The relation between $e -and $m might change in the future, but will always be equivalent in a -numerical sense, e.g. $m might get minimized. +C<$m> is currently just a copy of the original number. The relation between +C<$e> and C<$m> will stay always the same, though their real values might +change. =head1 EXAMPLES @@ -4068,18 +4330,19 @@ more time then the actual addition. With a technique called copy-on-write, the cost of copying with overload could be minimized or even completely avoided. A test implementation of COW did show performance gains for overloaded math, but introduced a performance loss due -to a constant overhead for all other operatons. +to a constant overhead for all other operatons. So Math::BigInt does currently +not COW. -The rewritten version of this module is slower on certain operations, like -new(), bstr() and numify(). The reason are that it does now more work and -handles more cases. The time spent in these operations is usually gained in -the other operations so that programs on the average should get faster. If -they don't, please contect the author. +The rewritten version of this module (vs. v0.01) is slower on certain +operations, like C, C and C. The reason are that it +does now more work and handles much more cases. The time spent in these +operations is usually gained in the other math operations so that code on +the average should get (much) faster. If they don't, please contact the author. Some operations may be slower for small numbers, but are significantly faster -for big numbers. Other operations are now constant (O(1), like bneg(), babs() -etc), instead of O(N) and thus nearly always take much less time. These -optimizations were done on purpose. +for big numbers. Other operations are now constant (O(1), like C, +C etc), instead of O(N) and thus nearly always take much less time. +These optimizations were done on purpose. If you find the Calc module to slow, try to install any of the replacement modules and see if they help you. @@ -4236,14 +4499,16 @@ known to be troublesome: =over 1 -=item stringify, bstr(), bsstr() and 'cmp' +=item bstr(), bsstr() and 'cmp' -Both stringify and bstr() now drop the leading '+'. The old code would return -'+3', the new returns '3'. This is to be consistent with Perl and to make -cmp (especially with overloading) to work as you expect. It also solves -problems with Test.pm, it's ok() uses 'eq' internally. +Both C and C as well as automated stringify via overload now +drop the leading '+'. The old code would return '+3', the new returns '3'. +This is to be consistent with Perl and to make C (especially with +overloading) to work as you expect. It also solves problems with C, +because it's C uses 'eq' internally. -Mark said, when asked about to drop the '+' altogether, or make only cmp work: +Mark Biggar said, when asked about to drop the '+' altogether, or make only +C work: I agree (with the first alternative), don't add the '+' on positive numbers. It's not as important anymore with the new internal @@ -4273,7 +4538,8 @@ Additionally, the following still works: There is now a C method to get the string in scientific notation aka C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr() for comparisation, but Perl will represent some numbers as 100 and others -as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq: +as 1e+308. If in doubt, convert both arguments to Math::BigInt before +comparing them as strings: use Test; BEGIN { plan tests => 3 } @@ -4285,9 +4551,9 @@ as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq: $y = Math::BigInt->new($y); ok ($x,$y); # okay -Alternatively, simple use <=> for comparisations, that 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. +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. =item int() diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index 694bdd5..6db1a62 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.36'; +$VERSION = '0.37'; # Package to store unsigned big integers in decimal and do math with them @@ -226,6 +226,7 @@ sub _two sub _copy { + # make a true copy [ @{$_[1]} ]; } @@ -250,7 +251,7 @@ sub _str # leading zero parts in internal representation) $l --; $ret .= int($ar->[$l]); $l--; # Interestingly, the pre-padd method uses more time - # the old grep variant takes longer (14 to 10 sec) + # the old grep variant takes longer (14 vs. 10 sec) my $z = '0' x ($BASE_LEN-1); while ($l >= 0) { @@ -296,8 +297,7 @@ sub _add # for each in Y, add Y to X and carry. If after that, something is left in # X, foreach in X add carry to X and then return X, carry - # Trades one "$j++" for having to shift arrays, $j could be made integer - # but this would impose a limit to number-length of 2**32. + # Trades one "$j++" for having to shift arrays my $i; my $car = 0; my $j = 0; for $i (@$y) { @@ -314,8 +314,7 @@ sub _add sub _inc { # (ref to int_num_array, ref to int_num_array) - # routine to add 1 to a base 1eX numbers - # This routine modifies array x + # Add 1 to $x, modify $x in place my ($c,$x) = @_; for my $i (@$x) @@ -330,17 +329,16 @@ sub _inc sub _dec { # (ref to int_num_array, ref to int_num_array) - # routine to add 1 to a base 1eX numbers - # This routine modifies array x + # Sub 1 from $x, modify $x in place my ($c,$x) = @_; my $MAX = $BASE-1; # since MAX_VAL based on MBASE for my $i (@$x) { last if (($i -= 1) >= 0); # early out - $i = $MAX; # overflow, next + $i = $MAX; # underflow, next } - pop @$x if $x->[-1] == 0 && @$x > 1; # last overflowed (but leave 0) + pop @$x if $x->[-1] == 0 && @$x > 1; # last underflowed (but leave 0) $x; } @@ -787,6 +785,7 @@ sub _div_use_div return $x; } # now calculate $x / $yorg + if (length(int($yorg->[-1])) == length(int($x->[-1]))) { # same length, so make full compare, and if equal, return 1 @@ -916,31 +915,28 @@ sub _acmp # internal absolute post-normalized compare (ignore signs) # ref to array, ref to array, return <0, 0, >0 # arrays must have at least one entry; this is not checked for - my ($c,$cx,$cy) = @_; + + # shortcut for short numbers + return (($cx->[0] <=> $cy->[0]) <=> 0) + if scalar @$cx == scalar @$cy && scalar @$cx == 1; # fast comp based on number of array elements (aka pseudo-length) - my $lxy = scalar @$cx - scalar @$cy; + my $lxy = (scalar @$cx - scalar @$cy) + # or length of first element if same number of elements (aka difference 0) + || + # need int() here because sometimes the last element is '00018' vs '18' + (length(int($cx->[-1])) - length(int($cy->[-1]))); return -1 if $lxy < 0; # already differs, ret return 1 if $lxy > 0; # ditto - # now calculate length based on digits, not parts - # we need only the length of the last element, since both array have the - # same number of parts - $lxy = length(int($cx->[-1])) - length(int($cy->[-1])); - return -1 if $lxy < 0; - return 1 if $lxy > 0; - - # hm, same lengths, but same contents? So we need to check all parts: - my $a; my $j = scalar @$cx - 1; # manual way (abort if unequal, good for early ne) - while ($j >= 0) + my $a; my $j = scalar @$cx; + while (--$j >= 0) { - last if ($a = $cx->[$j] - $cy->[$j]); $j--; + last if ($a = $cx->[$j] - $cy->[$j]); } - return 1 if $a > 0; - return -1 if $a < 0; - 0; # numbers are equal + $a <=> 0; } sub _len @@ -1149,7 +1145,7 @@ sub _mod $r = 0 if $r == $y; $x->[0] = $r; } - splice (@$x,1); + splice (@$x,1); # keep one element of $x $x; } @@ -1266,63 +1262,127 @@ sub _fac if ((@$cx == 1) && ($cx->[0] <= 2)) { - $cx->[0] = 1 * ($cx->[0]||1); # 0,1 => 1, 2 => 2 + $cx->[0] ||= 1; # 0 => 1, 1 => 1, 2 => 2 return $cx; } # go forward until $base is exceeded - # limit is either $x or $base (x == 100 means as result too high) + # limit is either $x steps (steps == 100 means a result always too high) or + # $base. my $steps = 100; $steps = $cx->[0] if @$cx == 1; - my $r = 2; my $cf = 3; my $step = 1; my $last = $r; - while ($r < $BASE && $step < $steps) + my $r = 2; my $cf = 3; my $step = 2; my $last = $r; + while ($r*$cf < $BASE && $step < $steps) { $last = $r; $r *= $cf++; $step++; } - if ((@$cx == 1) && ($step == $cx->[0])) + if ((@$cx == 1) && $step == $cx->[0]) { - # completely done - $cx = [$last]; + # completely done, so keep reference to $x and return + $cx->[0] = $r; return $cx; } + # now we must do the left over steps + my $n; # steps still to do + if (scalar @$cx == 1) + { + $n = $cx->[0]; + } + else + { + $n = _copy($c,$cx); + } - # do so as long as n has more than one element - my $n = $cx->[0]; - # as soon as the last element of $cx is 0, we split it up and remember how - # many zeors we got so far. The reason is that n! will accumulate zeros at - # the end rather fast. + $cx->[0] = $last; splice (@$cx,1); # keep ref to $x my $zero_elements = 0; - $cx = [$last]; - if (scalar @$cx == 1) + + # do left-over steps fit into a scalar? + if (ref $n eq 'ARRAY') { - my $n = _copy($c,$cx); - # no need to test for $steps, since $steps is a scalar and we stop before - while (scalar @$n != 1) + # No, so use slower inc() & cmp() + $step = [$step]; + while (_acmp($step,$n) <= 0) { + # as soon as the last element of $cx is 0, we split it up and remember + # how many zeors we got so far. The reason is that n! will accumulate + # zeros at the end rather fast. if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } - _mul($c,$cx,$n); _dec($c,$n); + _mul($c,$cx,$step); _inc($c,$step); } - $n = $n->[0]; # "convert" to scalar } - - # the left over steps will fit into a scalar, so we can speed it up - while ($n != $step) + else { - if ($cx->[0] == 0) + # Yes, so we can speed it up slightly + while ($step <= $n) { - $zero_elements ++; shift @$cx; + # When the last element of $cx is 0, we split it up and remember + # how many we got so far. The reason is that n! will accumulate + # zeros at the end rather fast. + if ($cx->[0] == 0) + { + $zero_elements ++; shift @$cx; + } + _mul($c,$cx,[$step]); $step++; } - _mul($c,$cx,[$n]); $n--; } # multiply in the zeros again while ($zero_elements-- > 0) { unshift @$cx, 0; } - $cx; + $cx; # return result + } + +sub _log_int + { + # calculate integer log of $x to base $base + # ref to array, ref to array - return ref to array + my ($c,$x,$base) = @_; + + # X == 0 => NaN + return if (scalar @$x == 1 && $x->[0] == 0); + # BASE 0 or 1 => NaN + return if (scalar @$base == 1 && $base->[0] < 2); + my $cmp = _acmp($c,$x,$base); + # X == BASE => 1 + if ($cmp == 0) + { + splice (@$x,1); $x->[0] = 1; + return $x; + } + # X < BASE + if ($cmp < 0) + { + splice (@$x,1); $x->[0] = 0; + return $x; + } + + # this trial multiplication is very fast, even for large counts (like for + # 2 ** 1024, since this still requires only 1024 very fast steps + # (multiplication of a large number by a very small number is very fast)) + my $x_org = _copy($c,$x); # preserve x + splice(@$x,1); $x->[0] = 0; # keep ref to $x + + # use a loop that keeps $x as scalar as long as possible (this is faster) + my $trial = _copy($c,$base); my $count = 0; my $a; + while (($a = _acmp($x,$trial,$x_org) <= 0) && $count < $BASE) + { + _mul($c,$trial,$base); $count++; + } + if ($a <= 0) + { + # not done yet? + $x->[0] = $count; + while (_acmp($x,$trial,$x_org) <= 0) + { + _mul($c,$trial,$base); _inc($c,$x); + } + } + + $x; # return result } # for debugging: @@ -1423,7 +1483,11 @@ sub _root else { # fit's into one Perl scalar, so result can be computed directly - $x->[0] = int( $x->[0] ** (1 / $n->[0]) ); + # cannot use int() here, because it rounds wrongly (try + # (81 ** 3) ** (1/3) to see what I mean) + #$x->[0] = int( $x->[0] ** (1 / $n->[0]) ); + # round to 8 digits, then truncate result to integer + $x->[0] = int ( sprintf ("%.8f", $x->[0] ** (1 / $n->[0]) ) ); } return $x; } @@ -1453,10 +1517,45 @@ sub _root } else { - # Should compute a guess of the result (by rule of thumb), then improve it - # via Newton's method or something similiar. - # XXX TODO - warn ('_root() not fully implemented in Calc.'); + # trial computation by starting with 2,4,8,16 etc until we overstep + + my $step = _two(); + my $trial = _two(); + + _mul($c, $trial, $step) + while (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) < 0); + + # hit exactly? + if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) == 0) + { + @$x = @$trial; # make copy while preserving ref to $x + return $x; + } + # overstepped, so go back on step + _div($c, $trial, $step); + + # add two, because $trial cannot be exactly the result (otherwise we would + # alrady have found it) + _add($c, $trial, $step); + + # and now add more and more (2,4,6,8, etc) + _add($c, $trial, $step) + while (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) < 0); + + # hit not exactly? (overstepped) + # 80 too small, 81 slightly too big, 82 too big + if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) > 0) + { + _dec($c,$trial); + } + # 80 too small, 81 slightly too big + if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) > 0) + { + _dec($c,$trial); + } + + @$x = @$trial; # make copy while preserving ref to $x + return $x; } $x; } @@ -1579,10 +1678,10 @@ sub _as_hex # convert a decimal number to hex (ref to array, return ref to string) my ($c,$x) = @_; - # fit's into one element + # fit's into one element (handle also 0x0 case) if (@$x == 1) { - my $t = '0x' . sprintf("%x",$x->[0]); + my $t = sprintf("0x%x",$x->[0]); return \$t; } @@ -1598,10 +1697,11 @@ sub _as_hex { $x10000 = [ 0x1000 ]; $h = 'h3'; } - while (! _is_zero($c,$x1)) + # while (! _is_zero($c,$x1)) + while (@$x1 != 1 || $x1->[0] != 0) # _is_zero() { ($x1, $xr) = _div($c,$x1,$x10000); - $es .= unpack($h,pack('v',$xr->[0])); + $es .= unpack($h,pack('v',$xr->[0])); # XXX TODO: why pack('v',...)? } $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros @@ -1614,10 +1714,15 @@ sub _as_bin # convert a decimal number to bin (ref to array, return ref to string) my ($c,$x) = @_; - # fit's into one element - if (@$x == 1) + # fit's into one element (and Perl recent enough), handle also 0b0 case + # handle zero case for older Perls + if ($] <= 5.005 && @$x == 1 && $x->[0] == 0) + { + my $t = '0b0'; return \$t; + } + if (@$x == 1 && $] >= 5.006) { - my $t = '0b' . sprintf("%b",$x->[0]); + my $t = sprintf("0b%b",$x->[0]); return \$t; } my $x1 = _copy($c,$x); @@ -1632,10 +1737,12 @@ sub _as_bin { $x10000 = [ 0x1000 ]; $b = 'b12'; } - while (! _is_zero($c,$x1)) + # while (! _is_zero($c,$x1)) + while (!(@$x1 == 1 && $x1->[0] == 0)) # _is_zero() { ($x1, $xr) = _div($c,$x1,$x10000); - $es .= unpack($b,pack('v',$xr->[0])); + $es .= unpack($b,pack('v',$xr->[0])); # XXX TODO: why pack('v',...)? + # $es .= unpack($b,$xr->[0]); } $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros @@ -1672,7 +1779,7 @@ 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 + # instead of converting X (8) bit at a time, it is faster to "convert" the # number to hex, and then call _from_hex. my $hs = $$bs; @@ -1680,27 +1787,8 @@ sub _from_bin 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(); - - my $len = length($$bs)-2; - $len = int($len/8); # 4-digit parts, w/o '0x' - my $val; my $i = -8; - while ($len >= 0) - { - $val = substr($$bs,$i,8); - $val =~ s/^[+-]?0b// if $len == 0; # for last part only - - $val = ord(pack('B8',substr('00000000'.$val,-8,8))); - - $i -= 8; $len --; - _add ($c, $x, _mul ($c, [ $val ], $mul ) ) if $val != 0; - _mul ($c, $mul, $m ) if $len >= 0; # skip last mul - } - $x; + + $c->_from_hex(\('0x'.$h)); } ############################################################################## @@ -1787,8 +1875,8 @@ Math::BigInt::Calc - Pure Perl module to support Math::BigInt =head1 SYNOPSIS Provides support for big integer calculations. Not intended to be used by other -modules (except Math::BigInt::Cached). Other modules which sport the same -functions can also be used to support Math::BigInt, like Math::BigInt::Pari. +modules. Other modules which sport the same functions can also be used to support +Math::BigInt, like Math::BigInt::GMP or Math::BigInt::Pari. =head1 DESCRIPTION @@ -1874,6 +1962,10 @@ slow) fallback routines to emulate these: _and(obj1,obj2) AND (bit-wise) object 1 with object 2 _or(obj1,obj2) OR (bit-wise) object 1 with object 2 + _signed_or + _signed_and + _signed_xor + _mod(obj,obj) Return remainder of div of the 1st by the 2nd object _sqrt(obj) return the square root of object (truncated to int) _root(obj) return the n'th (n >= 3) root of obj (truncated to int) @@ -1884,6 +1976,8 @@ slow) fallback routines to emulate these: _zeros(obj) return number of trailing decimal zeros _modinv return inverse modulus _modpow return modulus of power ($x ** $y) % $z + _log_int(X,N) calculate integer log() of X in base N + X >= 0, N >= 0 (return undef for NaN) Input strings come in as unsigned but with prefix (i.e. as '123', '0xabc' or '0b1101'). @@ -1931,7 +2025,7 @@ 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/enhanced by Tels 2001-2002. +Fixed, sped-up and enhanced by Tels http://bloodgate.com 2001-2003. =head1 SEE ALSO diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t index 1c4a97a..08ac4c2 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 => 1768; + plan tests => 1772; } use Math::BigFloat lib => 'BareCalc'; diff --git a/lib/Math/BigInt/t/bare_mbi.t b/lib/Math/BigInt/t/bare_mbi.t index ceebc03..6bcc6bd 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 => 2684; + plan tests => 2728; } use Math::BigInt lib => 'BareCalc'; diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc index 712caa6..60a8f08 100644 --- a/lib/Math/BigInt/t/bigfltpm.inc +++ b/lib/Math/BigInt/t/bigfltpm.inc @@ -1201,6 +1201,8 @@ abc:1:abc:NaN &ffac Nanfac:NaN -1:NaN ++inf:NaN +-inf:NaN 0:1 1:1 2:2 diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index 0d73a7d..84741ba 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 => 1768 + plan tests => 1772 + 2; # own tests } diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t index fe3b7c4..8d352eb 100644 --- a/lib/Math/BigInt/t/bigintc.t +++ b/lib/Math/BigInt/t/bigintc.t @@ -14,9 +14,18 @@ use Math::BigInt::Calc; BEGIN { - plan tests => 258; + plan tests => 296; } +my ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL) = + Math::BigInt::Calc->_base_len(); + +print "# BASE_LEN = $BASE_LEN\n"; +print "# MAX_VAL = $MAX_VAL\n"; +print "# AND_BITS = $AND_BITS\n"; +print "# XOR_BITS = $XOR_BITS\n"; +print "# IOR_BITS = $OR_BITS\n"; + # testing of Math::BigInt::Calc my $C = 'Math::BigInt::Calc'; # pass classname to sub's @@ -156,6 +165,16 @@ ok ($C->_acmp($x,$y),-1); ok ($C->_acmp($y,$x),1); ok ($C->_acmp($x,$x),0); ok ($C->_acmp($y,$y),0); +$x = $C->_new(\"12"); +$y = $C->_new(\"12"); +ok ($C->_acmp($x,$y),0); +$x = $C->_new(\"21"); +ok ($C->_acmp($x,$y),1); +ok ($C->_acmp($y,$x),-1); +$x = $C->_new(\"123456789"); +$y = $C->_new(\"1987654321"); +ok ($C->_acmp($x,$y),-1); +ok ($C->_acmp($y,$x),+1); $x = $C->_new(\"1234567890123456789"); $y = $C->_new(\"987654321012345678"); @@ -204,6 +223,55 @@ ok (${$C->_str($C->_root($x,$n))},'4'); # 4.xx => 4.0 $x = $C->_new(\"81"); $n = $C->_new(\"4"); # 3*3*3*3 == 81 ok (${$C->_str($C->_root($x,$n))},'3'); +# _pow (and _root) +$x = $C->_new(\"81"); $n = $C->_new(\"3"); # 81 ** 3 == 531441 +ok (${$C->_str($C->_pow($x,$n))},81 ** 3); + +ok (${$C->_str($C->_root($x,$n))},81); + +$x = $C->_new(\"81"); +ok (${$C->_str($C->_pow($x,$n))},81 ** 3); +ok (${$C->_str($C->_pow($x,$n))},'150094635296999121'); # 531441 ** 3 == + +ok (${$C->_str($C->_root($x,$n))},'531441'); +ok (${$C->_str($C->_root($x,$n))},'81'); + +$x = $C->_new(\"81"); $n = $C->_new(\"14"); +ok (${$C->_str($C->_pow($x,$n))},'523347633027360537213511521'); +ok (${$C->_str($C->_root($x,$n))},'81'); + +$x = $C->_new(\"523347633027360537213511520"); +ok (${$C->_str($C->_root($x,$n))},'80'); + +$x = $C->_new(\"523347633027360537213511522"); +ok (${$C->_str($C->_root($x,$n))},'81'); + +my $res = [ qw/ 9 31 99 316 999 3162 9999/ ]; + +# 99 ** 2 = 9801, 999 ** 2 = 998001 etc +for my $i (2 .. 9) + { + $x = '9' x $i; $x = $C->_new(\$x); + $n = $C->_new(\"2"); + my $rc = '9' x ($i-1). '8' . '0' x ($i-1) . '1'; + print "# _pow( ", '9' x $i, ", 2) \n" unless + ok (${$C->_str($C->_pow($x,$n))},$rc); + + if ($i <= 7) + { + $x = '9' x $i; $x = $C->_new(\$x); + $n = '9' x $i; $n = $C->_new(\$n); + print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless + ok (${$C->_str($C->_root($x,$n))},'1'); + + $x = '9' x $i; $x = $C->_new(\$x); + $n = $C->_new(\"2"); + print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless + ok (${$C->_str($C->_root($x,$n))}, $res->[$i-2]); + } + } + +############################################################################## # _fac $x = $C->_new(\"0"); ok (${$C->_str($C->_fac($x))},'1'); $x = $C->_new(\"1"); ok (${$C->_str($C->_fac($x))},'1'); @@ -214,6 +282,11 @@ $x = $C->_new(\"5"); ok (${$C->_str($C->_fac($x))},'120'); $x = $C->_new(\"10"); ok (${$C->_str($C->_fac($x))},'3628800'); $x = $C->_new(\"11"); ok (${$C->_str($C->_fac($x))},'39916800'); $x = $C->_new(\"12"); ok (${$C->_str($C->_fac($x))},'479001600'); +$x = $C->_new(\"13"); ok (${$C->_str($C->_fac($x))},'6227020800'); + +# test that _fac modifes $x in place for small arguments +$x = $C->_new(\"3"); $C->_fac($x); ok (${$C->_str($x)},'6'); +$x = $C->_new(\"13"); $C->_fac($x); ok (${$C->_str($x)},'6227020800'); ############################################################################## # _inc and _dec diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc index b4e9250..332f575 100644 --- a/lib/Math/BigInt/t/bigintpm.inc +++ b/lib/Math/BigInt/t/bigintpm.inc @@ -156,6 +156,8 @@ while () } }elsif ($f eq "broot"){ $try .= "\$x->broot(\$y);"; + }elsif ($f eq "blog"){ + $try .= "\$x->blog(\$y);"; }elsif ($f eq "band"){ $try .= "\$x & \$y;"; }elsif ($f eq "bior"){ @@ -693,6 +695,35 @@ __DATA__ 5:7:5 &^= 5:7:2 +&blog +NaNlog:2:NaN +122:NaNlog:NaN +NaNlog1:NaNlog:NaN +122:inf:NaN +inf:122:NaN +122:-inf:NaN +-inf:122:NaN +-inf:-inf:NaN +inf:inf:NaN +0:4:NaN +-21:4:NaN +21:-21:NaN +# normal results +1024:2:10 +81:3:4 +# 3.01.. truncate +82:3:4 +# 3.9... truncate +80:3:3 +15625:5:6 +15626:5:6 +15624:5:5 +# $x == $base => result 1 +3:3:1 +# $x < $base => result 0 ($base ** 0 <= $x) +3:4:0 +# $x == 1 => result 0 +1:5:0 &is_negative 0:0 -1:1 diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index 53de9b7..b541aae 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 => 2684; + plan tests => 2728; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/bigints.t b/lib/Math/BigInt/t/bigints.t index e7972fb..6b21a75 100644 --- a/lib/Math/BigInt/t/bigints.t +++ b/lib/Math/BigInt/t/bigints.t @@ -28,8 +28,8 @@ BEGIN plan tests => 51; } -# testing of Math::BigInt::BitVect, primarily for interface/api and not for the -# math functionality +# testing of Math::BigInt:Scalar (used by the testsuite), +# primarily for interface/api and not for the math functionality use Math::BigInt::Scalar; diff --git a/lib/Math/BigInt/t/biglog.t b/lib/Math/BigInt/t/biglog.t index c7c07c1..9ed9c2a 100644 --- a/lib/Math/BigInt/t/biglog.t +++ b/lib/Math/BigInt/t/biglog.t @@ -68,6 +68,7 @@ ok ($cl->new(0.0001)->blog(), -$ten * 4); # also cached ok ($cl->new(2)->blog(), '0.6931471805599453094172321214581765680755'); +ok ($cl->new(4)->blog(), $cl->new(2)->blog * 2); # These are still slow, so do them only to 10 digits @@ -97,7 +98,6 @@ ok ($cl->new('10')->bpow('0.6',10), '3.981071706'); # blog should handle bigint input ok (Math::BigFloat::blog(Math::BigInt->new(100),10), 2); -ok (Math::BigInt->new(100)->blog(10), 'NaN'); # test for bug in bsqrt() not taking negative _e into account test_bpow ('200','0.5',10, '14.14213562'); diff --git a/lib/Math/BigInt/t/const_mbf.t b/lib/Math/BigInt/t/const_mbf.t new file mode 100644 index 0000000..be86407 --- /dev/null +++ b/lib/Math/BigInt/t/const_mbf.t @@ -0,0 +1,45 @@ +#!/usr/bin/perl -w + +# test BigFloat constants alone (w/o BigInt loading) + +use strict; +use Test; + +BEGIN + { + $| = 1; + # to locate the testing files + my $location = $0; $location =~ s/const_mbf.t//i; + if ($ENV{PERL_CORE}) + { + # testing with the core distribution + @INC = qw(../t/lib); + } + unshift @INC, qw(../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; + if ($] < 5.006) + { + for (1..2) { skip (1,'Not supported on older Perls'); } + exit; + } + } + +use Math::BigFloat ':constant'; + +ok (1.0 / 3.0, '0.3333333333333333333333333333333333333333'); + +# BigInt was not loadede with ':constant', so only floats are handled +ok (ref(2 ** 2),''); + diff --git a/lib/Math/BigInt/t/constant.t b/lib/Math/BigInt/t/constant.t index 4e5a17e..8df7283 100644 --- a/lib/Math/BigInt/t/constant.t +++ b/lib/Math/BigInt/t/constant.t @@ -6,8 +6,26 @@ use Test; BEGIN { $| = 1; - chdir 't' if -d 't'; - unshift @INC, '../lib'; # for running manually + # to locate the testing files + my $location = $0; $location =~ s/constant.t//i; + if ($ENV{PERL_CORE}) + { + # testing with the core distribution + @INC = qw(../t/lib); + } + unshift @INC, qw(../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 => 7; if ($] < 5.006) { diff --git a/lib/Math/BigInt/t/fallback.t b/lib/Math/BigInt/t/fallback.t new file mode 100644 index 0000000..c09a201 --- /dev/null +++ b/lib/Math/BigInt/t/fallback.t @@ -0,0 +1,51 @@ +#!/usr/bin/perl -w + +# test 'fallback' for overload cos/sin/atan2/exp + +use Test; +use strict; + +BEGIN + { + $| = 1; + # to locate the testing files + my $location = $0; $location =~ s/fallback.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 => 8; + } + + +use Math::BigInt; +use Math::BigFloat; + +my $bi = Math::BigInt->new(1); + +ok (cos($bi), cos(1)); +ok (sin($bi), sin(1)); +ok (exp($bi), exp(1)); +ok (atan2($bi,$bi), atan2(1,1)); + +my $bf = Math::BigInt->new(1); + +ok (cos($bf), cos(1)); +ok (sin($bf), sin(1)); +ok (exp($bf), exp(1)); +ok (atan2($bf,$bf), atan2(1,1)); + diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t index d2c19c2..91fda97 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 => 1768 + plan tests => 1772 + 6; # + our own tests } diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t index 1e6cbf8..65c6d0b 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 => 2684 + plan tests => 2728 + 5; # +5 own tests } diff --git a/lib/Math/BigInt/t/with_sub.t b/lib/Math/BigInt/t/with_sub.t index c4319aa..a3af404 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 => 1768 + plan tests => 1772 + 1; }