# _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);
# 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 '+';
# 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
$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
($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()
}
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
# 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)
{
# 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;
}
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
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
# 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
# (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),
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
$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
}
}
+ 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
### 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
}
###############################################################################
# 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
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;
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
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());
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
$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
}
$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
{
# 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
$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
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
#$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
{
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')
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
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.
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.)
"$_[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;
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
}
else
{
+ # call like: $x->bone($sign,$a,$p,$r);
$self->{_a} = $_[0]
if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a}));
$self->{_p} = $_[1]
}
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!
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;
}
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
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
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
$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 (@_)
{
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
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 '-';
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
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
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
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});
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
}
}
$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/)
# 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});
# 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});
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);
}
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
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;
# 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)
$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);
$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;
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);
}
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);
}
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);
}
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
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]*)$/;
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);
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);
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());
}
##############################################################################
sub _scan_for_nonzero
{
+ # internal, used by bround()
my $x = shift;
my $pad = shift;
my $xs = shift;
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
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
{
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')
{
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;
}
}
my $sign = '+'; $sign = '-' if ($$hs =~ /^-/);
$$hs =~ s/^[+-]//; # strip sign
- if ($CALC->can('_from_hex'))
+ if ($CAN{'_from_hex'})
{
$x->{value} = $CALC->_from_hex($hs);
}
my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/);
$$bs =~ s/^[+-]//; # strip sign
- if ($CALC->can('_from_bin'))
+ if ($CAN{'_from_bin'})
{
$x->{value} = $CALC->_from_bin($bs);
}
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)
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
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<bnorm()> 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
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
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<config()> a reference to a hash:
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
=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
$num ** $exp % $mod
-because C<bmodpow> 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<bmodpow> also supports negative exponents.
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
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.
=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
B<not> 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;
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
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
=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
* 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:
=head2 MATH LIBRARY
Math with the numbers is done (by default) by a module called
-Math::BigInt::Calc. This is equivalent to saying:
+C<Math::BigInt::Calc>. This is equivalent to saying:
use Math::BigInt lib => '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<much> 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
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<NaN>; 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
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<new()>, C<bstr()> and C<numify()>. 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<bneg()>,
+C<babs()> 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.
=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<bstr()> and C<bsstr()> 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<cmp> (especially with
+overloading) to work as you expect. It also solves problems with C<Test.pm>,
+because it's C<ok()> 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<cmp> work:
I agree (with the first alternative), don't add the '+' on positive
numbers. It's not as important anymore with the new internal
There is now a C<bsstr()> 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 }
$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()
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
sub _copy
{
+ # make a true copy
[ @{$_[1]} ];
}
# 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)
{
# 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)
{
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)
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;
}
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
# 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
$r = 0 if $r == $y;
$x->[0] = $r;
}
- splice (@$x,1);
+ splice (@$x,1); # keep one element of $x
$x;
}
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:
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;
}
}
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;
}
# 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;
}
{
$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
# 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);
{
$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
# 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;
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));
}
##############################################################################
=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
_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)
_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').
Original math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/>
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
projects / platform / upstream / perl.git / commitdiff