and bignum v0.14.
p4raw-id: //depot/perl@20000
lib/Math/BigInt/t/bigintpm.inc Shared tests for bigintpm.t and sub_mbi.t
lib/Math/BigInt/t/bigintpm.t See if BigInt.pm works
lib/Math/BigInt/t/bigints.t See if BigInt.pm works
+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/mbimbf.inc Actual BigInt/BigFloat accuracy, precision and fallback, round_mode tests
lib/Math/BigInt/t/mbimbf.t BigInt/BigFloat accuracy, precision and fallback, round_mode
lib/Math/BigInt/t/mbi_rand.t Test Math::BigInt randomly
+lib/Math/BigInt/t/req_mbf0.t test: require Math::BigFloat; ->bzero();
+lib/Math/BigInt/t/req_mbf1.t test: require Math::BigFloat; ->bone();
+lib/Math/BigInt/t/req_mbfa.t test: require Math::BigFloat; ->bnan();
+lib/Math/BigInt/t/req_mbfi.t test: require Math::BigFloat; ->binf();
+lib/Math/BigInt/t/req_mbfn.t test: require Math::BigFloat; ->new();
+lib/Math/BigInt/t/req_mbfw.t require Math::BigFloat; import ( with => );
lib/Math/BigInt/t/require.t Test if require Math::BigInt works
lib/Math/BigInt/t/sub_mbf.t Empty subclass test of BigFloat
lib/Math/BigInt/t/sub_mbi.t Empty subclass test of BigInt
lib/Math/BigInt/t/sub_mif.t Test A & P with subclasses using mbimbf.inc
+lib/Math/BigInt/t/trap.t Test whether trap_nan and trap_inf work
+lib/Math/BigInt/t/upgradef.t Test if use Math::BigFloat(); under upgrade works
lib/Math/BigInt/t/upgrade.inc Actual tests for upgrade.t
lib/Math/BigInt/t/upgrade.t Test if use Math::BigInt(); under upgrade works
-lib/Math/BigInt/t/upgradef.t Test if use Math::BigFloat(); under upgrade works
-lib/Math/BigInt/t/use.t Test if use Math::BigInt(); works
lib/Math/BigInt/t/use_lib1.t Test combinations of Math::BigInt and BigFloat
lib/Math/BigInt/t/use_lib2.t Test combinations of Math::BigInt and BigFloat
lib/Math/BigInt/t/use_lib3.t Test combinations of Math::BigInt and BigFloat
lib/Math/BigInt/t/use_lib4.t Test combinations of Math::BigInt and BigFloat
+lib/Math/BigInt/t/use_mbfw.t use BigFloat w/ with and lib at the same time
+lib/Math/BigInt/t/use.t Test if use Math::BigInt(); works
lib/Math/BigInt/t/with_sub.t Test use Math::BigFloat with => package
lib/Math/BigInt/Trace.pm bignum tracing
+lib/Math/BigRat/t/bigratup.t test under $Math::BigInt::upgrade
+lib/Math/BigRat/t/requirer.t see if require works properly
+lib/Math/BigRat/t/trap.t see if trap_nan and trap_inf work
lib/Math/BigRat.pm Math::BigRat
lib/Math/BigRat/t/bigfltpm.inc Math::BigRat test
lib/Math/BigRat/t/bigfltrt.t Math::BigRat test
# The following hash values are internally used:
# _e: exponent (BigInt)
# _m: mantissa (absolute BigInt)
-# sign: +,-,"NaN" if not a number
+# sign: +,-,+inf,-inf, or "NaN" if not a number
# _a: accuracy
# _p: precision
# _f: flags, used to signal MBI not to touch our private parts
-$VERSION = '1.38';
+$VERSION = '1.39';
require 5.005;
use Exporter;
@ISA = qw(Exporter Math::BigInt);
use strict;
use vars qw/$AUTOLOAD $accuracy $precision $div_scale $round_mode $rnd_mode/;
use vars qw/$upgrade $downgrade/;
+# the following are internal and should never be accessed from the outside
+use vars qw/$_trap_nan $_trap_inf/;
my $class = "Math::BigFloat";
use overload
;
##############################################################################
-# global constants, flags and accessory
+# global constants, flags and assorted stuff
-use constant MB_NEVER_ROUND => 0x0001;
-
-# are NaNs ok?
-my $NaNOK=1;
-# constant for easier life
-my $nan = 'NaN';
+# the following are public, but their usage is not recommended. Use the
+# accessor methods instead.
# class constants, use Class->constant_name() to access
$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
my $MBI = 'Math::BigInt'; # the package we are using for our private parts
# changable by use Math::BigFloat with => 'package'
+# the following are private and not to be used from the outside:
+
+use constant MB_NEVER_ROUND => 0x0001;
+
+# are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config()
+$_trap_nan = 0;
+# the same for infs
+$_trap_inf = 0;
+
+# constant for easier life
+my $nan = 'NaN';
+
+my $IMPORT = 0; # was import() called yet?
+ # used to make require work
+
+# some digits of accuracy for blog(undef,10); which we use in blog() for speed
+my $LOG_10 =
+ '2.3025850929940456840179914546843642076011014886287729760333279009675726097';
+my $LOG_10_A = length($LOG_10)-1;
+# ditto for log(2)
+my $LOG_2 =
+ '0.6931471805599453094172321214581765680755001343602552541206800094933936220';
+my $LOG_2_A = length($LOG_2)-1;
+
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); }
BEGIN
- {
- $rnd_mode = 'even';
- tie $rnd_mode, 'Math::BigFloat';
+ {
+ # when someone set's $rnd_mode, we catch this and check the value to see
+ # whether it is valid or not.
+ $rnd_mode = 'even'; tie $rnd_mode, 'Math::BigFloat';
}
##############################################################################
my %methods = map { $_ => 1 }
qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
fint facmp fcmp fzero fnan finf finc fdec flog ffac
- fceil ffloor frsft flsft fone flog
+ fceil ffloor frsft flsft fone flog froot
/;
# valid method's that can be hand-ed up (for AUTOLOAD)
my %hand_ups = map { $_ => 1 }
qw / is_nan is_inf is_negative is_positive
- accuracy precision div_scale round_mode fneg fabs babs fnot
+ accuracy precision div_scale round_mode fneg fabs fnot
objectify upgrade downgrade
bone binf bnan bzero
/;
return $class->bzero() if !defined $wanted; # default to 0
return $wanted->copy() if UNIVERSAL::isa($wanted,'Math::BigFloat');
+ $class->import() if $IMPORT == 0; # make require work
+
my $self = {}; bless $self, $class;
# shortcut for bigints and its subclasses
if ((ref($wanted)) && (ref($wanted) ne $class))
my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split(\$wanted);
if (!ref $mis)
{
- die "$wanted is not a number initialized to $class" if !$NaNOK;
+ if ($_trap_nan)
+ {
+ require Carp;
+ Carp::croak ("$wanted is not a number initialized to $class");
+ }
return $downgrade->bnan() if $downgrade;
if ($downgrade && $self->{_e}->{sign} eq '+')
{
-# print "downgrading $$miv$$mfv"."E$$es$$ev";
+ #print "downgrading $$miv$$mfv"."E$$es$$ev";
if ($self->{_e}->is_zero())
{
$self->{_m}->{sign} = $$mis; # negative if wanted
}
return $downgrade->new("$$mis$$miv$$mfv"."E$$es$$ev");
}
- # print "mbf new $self->{sign} $self->{_m} e $self->{_e} ",ref($self),"\n";
- $self->bnorm()->round(@r); # first normalize, then round
+ #print "mbf new $self->{sign} $self->{_m} e $self->{_e} ",ref($self),"\n";
+ $self->bnorm()->round(@r); # first normalize, then round
}
sub _bnan
{
- # used by parent class bone() to initialize number to 1
+ # used by parent class bone() to initialize number to NaN
my $self = shift;
+
+ if ($_trap_nan)
+ {
+ require Carp;
+ my $class = ref($self);
+ Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
+ }
+
+ $IMPORT=1; # call our import only once
$self->{_m} = $MBI->bzero();
$self->{_e} = $MBI->bzero();
}
sub _binf
{
- # used by parent class bone() to initialize number to 1
+ # used by parent class bone() to initialize number to +-inf
my $self = shift;
+
+ if ($_trap_inf)
+ {
+ require Carp;
+ my $class = ref($self);
+ Carp::croak ("Tried to set $self to +-inf in $class\::_binf()");
+ }
+
+ $IMPORT=1; # call our import only once
$self->{_m} = $MBI->bzero();
$self->{_e} = $MBI->bzero();
}
{
# used by parent class bone() to initialize number to 1
my $self = shift;
+ $IMPORT=1; # call our import only once
$self->{_m} = $MBI->bone();
$self->{_e} = $MBI->bzero();
}
sub _bzero
{
- # used by parent class bone() to initialize number to 1
+ # used by parent class bone() to initialize number to 0
my $self = shift;
+ $IMPORT=1; # call our import only once
$self->{_m} = $MBI->bzero();
$self->{_e} = $MBI->bone();
}
# return (later set?) configuration data as hash ref
my $class = shift || 'Math::BigFloat';
- my $cfg = $MBI->config();
+ my $cfg = $class->SUPER::config(@_);
- no strict 'refs';
+ # now we need only to override the ones that are different from our parent
$cfg->{class} = $class;
$cfg->{with} = $MBI;
- foreach (
- qw/upgrade downgrade precision accuracy round_mode VERSION div_scale/)
- {
- $cfg->{lc($_)} = ${"${class}::$_"};
- };
$cfg;
}
#my $x = shift; my $class = ref($x) || $x;
#$x = $class->new(shift) unless ref($x);
- #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
- #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
if ($x->{sign} !~ /^[+-]$/)
{
return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
$dot = '';
if ($x->{_e} <= -$len)
{
- # print "style: 0.xxxx\n";
+ #print "style: 0.xxxx\n";
my $r = $x->{_e}->copy(); $r->babs()->bsub( CORE::length($es) );
$es = '0.'. ('0' x $r) . $es; $cad = -($len+$r);
}
else
{
- # print "insert '.' at $x->{_e} in '$es'\n";
+ #print "insert '.' at $x->{_e} in '$es'\n";
substr($es,$x->{_e},0) = '.'; $cad = $x->{_e};
}
}
#my $x = shift; my $class = ref($x) || $x;
#$x = $class->new(shift) unless ref($x);
- #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan;
- #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan;
if ($x->{sign} !~ /^[+-]$/)
{
return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
$x->badd($self->bone('-'),$a,$p,$r); # does round
}
+sub DEBUG () { 0; }
+
sub blog
{
- my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(2,@_);
-
- # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log
+ my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- # u = x-1, v = x+1
- # _ _
- # Taylor: | u 1 u^3 1 u^5 |
- # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 0
- # |_ v 3 v^3 5 v^5 _|
-
- # This takes much more steps to calculate the result:
- # u = x-1
- # _ _
- # Taylor: | u 1 u^2 1 u^3 |
- # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 1/2
- # |_ x 2 x^2 3 x^3 _|
+ # $base > 0, $base != 1; if $base == undef default to $base == e
+ # $x >= 0
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
- my $scale = 0;
- my @params = $x->_find_round_parameters($a,$p,$r);
+ my ($scale,@params);
+ ($x,@params) = $x->_find_round_parameters($a,$p,$r);
+ # 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 == 1)
+ if (scalar @params == 0)
{
# simulate old behaviour
- $params[1] = $self->div_scale(); # and round to it as accuracy
- $params[0] = undef;
- $scale = $params[1]+4; # at least four more for proper round
- $params[3] = $r; # round mode by caller or undef
+ $params[0] = $self->div_scale(); # and round to it as accuracy
+ $params[1] = undef; # P = undef
+ $scale = $params[0]+4; # at least four more for proper round
+ $params[2] = $r; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
}
else
{
# the 4 below is empirical, and there might be cases where it is not
# enough...
- $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined
+ $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
}
return $x->bzero(@params) if $x->is_one();
- return $x->bnan() if $x->{sign} ne '+' || $x->is_zero();
- return $x->bone('+',@params) if $x->bcmp($base) == 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
+ # 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 '+';
+ return $x->bone('+',@params) if $x->bcmp($base) == 0;
+ }
# when user set globals, they would interfere with our calculation, so
# disable them and later re-enable them
delete $x->{_a}; delete $x->{_p};
# need to disable $upgrade in BigInt, to avoid deep recursion
local $Math::BigInt::upgrade = undef;
+
+ # upgrade $x if $x is not a BigFloat (handle BigInt input)
+ if (!$x->isa('Math::BigFloat'))
+ {
+ $x = Math::BigFloat->new($x);
+ $self = ref($x);
+ }
+ # first calculate the log to base e (using reduction by 10 (and probably 2))
+ $self->_log_10($x,$scale);
- my ($case,$limit,$v,$u,$below,$factor,$two,$next,$over,$f);
-
- if (3 < 5)
- #if ($x <= Math::BigFloat->new("0.5"))
- {
- $case = 0;
- # print "case $case $x < 0.5\n";
- $v = $x->copy(); $v->binc(); # v = x+1
- $x->bdec(); $u = $x->copy(); # u = x-1; x = x-1
- $x->bdiv($v,$scale); # first term: u/v
- $below = $v->copy();
- $over = $u->copy();
- $u *= $u; $v *= $v; # u^2, v^2
- $below->bmul($v); # u^3, v^3
- $over->bmul($u);
- $factor = $self->new(3); $f = $self->new(2);
- }
- #else
- # {
- # $case = 1;
- # print "case 1 $x > 0.5\n";
- # $v = $x->copy(); # v = x
- # $u = $x->copy(); $u->bdec(); # u = x-1;
- # $x->bdec(); $x->bdiv($v,$scale); # first term: x-1/x
- # $below = $v->copy();
- # $over = $u->copy();
- # $below->bmul($v); # u^2, v^2
- # $over->bmul($u);
- # $factor = $self->new(2); $f = $self->bone();
- # }
- $limit = $self->new("1E-". ($scale-1));
- #my $steps = 0;
- while (3 < 5)
+ # and if a different base was requested, convert it
+ if (defined $base)
{
- # we calculate the next term, and add it to the last
- # when the next term is below our limit, it won't affect the outcome
- # anymore, so we stop
- $next = $over->copy()->bdiv($below->copy()->bmul($factor),$scale);
- last if $next->bcmp($limit) <= 0;
- $x->badd($next);
- # print "step $x\n";
- # calculate things for the next term
- $over *= $u; $below *= $v; $factor->badd($f);
- #$steps++;
+ # not ln, but some other base
+ $x->bdiv( $base->copy()->blog(undef,$scale), $scale );
}
- $x->bmul(2) if $case == 0;
- #print "took $steps steps\n";
-
+
# shortcut to not run trough _find_round_parameters again
- if (defined $params[1])
+ if (defined $params[0])
{
- $x->bround($params[1],$params[3]); # then round accordingly
+ $x->bround($params[0],$params[2]); # then round accordingly
}
else
{
- $x->bfround($params[2],$params[3]); # then round accordingly
+ $x->bfround($params[1],$params[2]); # then round accordingly
}
if ($fallback)
{
$x;
}
+sub _log
+ {
+ # internal log function to calculate log based on Taylor.
+ # Modifies $x in place.
+ my ($self,$x,$scale) = @_;
+
+ # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log
+
+ # u = x-1, v = x+1
+ # _ _
+ # Taylor: | u 1 u^3 1 u^5 |
+ # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 0
+ # |_ v 3 v^3 5 v^5 _|
+
+ # This takes much more steps to calculate the result and is thus not used
+ # u = x-1
+ # _ _
+ # Taylor: | u 1 u^2 1 u^3 |
+ # 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
+ $x->bdec(); $u = $x->copy(); # u = x-1; x = x-1
+ $x->bdiv($v,$scale); # first term: u/v
+ $below = $v->copy();
+ $over = $u->copy();
+ $u *= $u; $v *= $v; # u^2, v^2
+ $below->bmul($v); # u^3, v^3
+ $over->bmul($u);
+ $factor = $self->new(3); $f = $self->new(2);
+
+ my $steps = 0 if DEBUG;
+ $limit = $self->new("1E-". ($scale-1));
+ while (3 < 5)
+ {
+ # we calculate the next term, and add it to the last
+ # when the next term is below our limit, it won't affect the outcome
+ # anymore, so we stop
+
+ # calculating the next term simple from over/below will result in quite
+ # a time hog if the input has many digits, since over and below will
+ # accumulate more and more digits, and the result will also have many
+ # digits, but in the end it is rounded to $scale digits anyway. So if we
+ # round $over and $below first, we save a lot of time for the division
+ # (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)
+
+ $next = $over->copy->bround($scale+4)->bdiv(
+ $below->copy->bmul($factor)->bround($scale+4),
+ $scale);
+
+## old version:
+## $next = $over->copy()->bdiv($below->copy()->bmul($factor),$scale);
+
+ last if $next->bacmp($limit) <= 0;
+
+ delete $next->{_a}; delete $next->{_p};
+ $x->badd($next);
+ #print "step $x\n ($next - $limit = ",$next - $limit,")\n";
+ # calculate things for the next term
+ $over *= $u; $below *= $v; $factor->badd($f);
+ if (DEBUG)
+ {
+ $steps++; print "step $steps = $x\n" if $steps % 10 == 0;
+ }
+ }
+ $x->bmul($f); # $x *= 2
+ print "took $steps steps\n" if DEBUG;
+ }
+
+sub _log_10
+ {
+ # internal log function based on reducing input to the range of 0.1 .. 9.99
+ my ($self,$x,$scale) = @_;
+
+ # taking blog() from numbers greater than 10 takes a *very long* time, so we
+ # break the computation down into parts based on the observation that:
+ # blog(x*y) = blog(x) + blog(y)
+ # We set $y here to multiples of 10 so that $x is below 1 (the smaller $x is
+ # the faster it get's, especially because 2*$x takes about 10 times as long,
+ # so by dividing $x by 10 we make it at least factor 100 faster...)
+
+ # The same observation is valid for numbers smaller than 0.1 (e.g. computing
+ # log(1) is fastest, and the farther away we get from 1, the longer it takes)
+ # so we also 'break' this down by multiplying $x with 10 and subtract the
+ # log(10) afterwards to get the correct result.
+
+ # calculate nr of digits before dot
+ my $dbd = $x->{_m}->length() + $x->{_e}->numify();
+
+ # more than one digit (e.g. at least 10), but *not* exactly 10 to avoid
+ # infinite recursion
+
+ my $calc = 1; # do some calculation?
+
+ # disable the shortcut for 10, since we need log(10) and this would recurse
+ # infinitely deep
+ if ($x->{_e}->is_one() && $x->{_m}->is_one())
+ {
+ $dbd = 0; # disable shortcut
+ # we can use the cached value in these cases
+ if ($scale <= $LOG_10_A)
+ {
+ $x->bzero(); $x->badd($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)
+ {
+ $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())
+ {
+ $dbd = 0; # disable shortcut
+ # we can use the cached value in these cases
+ if ($scale <= $LOG_10_A)
+ {
+ $x->bzero(); $x->bsub($LOG_10);
+ $calc = 0; # no need to calc, but round
+ }
+ }
+
+ # 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
+
+ # $x == 2 => 1, $x == 13 => 2, $x == 0.1 => 0, $x == 0.01 => -1
+ # so don't do this shortcut for 1 or 0
+ if (($dbd > 1) || ($dbd < 0))
+ {
+ # convert our cached value to an object if not already (avoid doing this
+ # at import() time, since not everybody needs this)
+ $LOG_10 = $self->new($LOG_10,undef,undef) unless ref $LOG_10;
+
+ #print "x = $x, dbd = $dbd, calc = $calc\n";
+ # got more than one digit before the dot, or more than one zero after the
+ # dot, so do:
+ # log(123) == log(1.23) + log(10) * 2
+ # log(0.0123) == log(1.23) - log(10) * 2
+
+ if ($scale <= $LOG_10_A)
+ {
+ # use cached value
+ #print "using cached value for l_10\n";
+ $l_10 = $LOG_10->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 "l_10 = $l_10 (self = $self',
+ # ", ref(l_10) = ",ref($l_10)," scale $scale)\n";
+ #print "calculating value for l_10, scale $scale\n";
+ $l_10 = $self->new(10)->blog(undef,$scale); # scale+4, actually
+ }
+ $dbd-- if ($dbd > 1); # 20 => dbd=2, so make it dbd=1
+ # make object
+ $dbd = $self->new($dbd);
+ #print "dbd $dbd\n";
+ $l_10->bmul($dbd); # log(10) * (digits_before_dot-1)
+ #print "l_10 = $l_10\n";
+ #print "x = $x";
+ $x->{_e}->bsub($dbd); # 123 => 1.23
+ #print " => $x\n";
+ #print "calculating log($x) with scale=$scale\n";
+
+ }
+
+ # Now: 0.1 <= $x < 10 (and possible correction in l_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)
+ while ($x->bacmp($half) < 0)
+ {
+ #print "$x\n";
+ $twos--; $x->bmul($two);
+ }
+ while ($x->bacmp($two) > 0)
+ {
+ #print "$x\n";
+ $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)
+ {
+ # 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";
+ }
+ }
+
+ 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";
+ }
+ # all done, $x contains now the result
+ }
+
sub blcm
{
# (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
sub is_one
{
# return true if arg (BFLOAT or num_str) is +1 or -1 if signis given
- my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- my $sign = shift || ''; $sign = '+' if $sign ne '-';
+ $sign = '+' if !defined $sign || $sign ne '-';
return 1
if ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one());
0;
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
- my $scale = 0;
- my @params = $x->_find_round_parameters($a,$p,$r,$y);
+ my (@params,$scale);
+ ($x,@params) = $x->_find_round_parameters($a,$p,$r,$y);
+
+ return $x if $x->is_nan(); # error in _find_round_parameters?
# no rounding at all, so must use fallback
- if (scalar @params == 1)
+ if (scalar @params == 0)
{
# simulate old behaviour
- $params[1] = $self->div_scale(); # and round to it as accuracy
- $scale = $params[1]+4; # at least four more for proper round
- $params[3] = $r; # round mode by caller or undef
+ $params[0] = $self->div_scale(); # and round to it as accuracy
+ $scale = $params[0]+4; # at least four more for proper round
+ $params[2] = $r; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
}
else
{
# the 4 below is empirical, and there might be cases where it is not
# enough...
- $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined
+ $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
}
my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length();
$scale = $lx if $lx > $scale;
}
# shortcut to not run trough _find_round_parameters again
- if (defined $params[1])
+ if (defined $params[0])
{
$x->{_a} = undef; # clear before round
- $x->bround($params[1],$params[3]); # then round accordingly
+ $x->bround($params[0],$params[2]); # then round accordingly
}
else
{
$x->{_p} = undef; # clear before round
- $x->bfround($params[2],$params[3]); # then round accordingly
+ $x->bfround($params[1],$params[2]); # then round accordingly
}
if ($fallback)
{
{
if (!$y->is_one())
{
- $rem->bmod($y,$params[1],$params[2],$params[3]); # copy already done
+ $rem->bmod($y,@params); # copy already done
}
else
{
$x->round($a,$p,$r,$y); # round and return
}
+sub broot
+ {
+ # calculate $y'th root of $x
+ my ($self,$x,$y,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(2,@_);
+
+ # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
+ return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
+ $y->{sign} !~ /^\+$/;
+
+ return $x if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
+
+ # we need to limit the accuracy to protect against overflow
+ my $fallback = 0;
+ my (@params,$scale);
+ ($x,@params) = $x->_find_round_parameters($a,$p,$r);
+
+ return $x if $x->is_nan(); # error in _find_round_parameters?
+
+ # no rounding at all, so must use fallback
+ if (scalar @params == 0)
+ {
+ # simulate old behaviour
+ $params[0] = $self->div_scale(); # and round to it as accuracy
+ $scale = $params[0]+4; # at least four more for proper round
+ $params[2] = $r; # round mode by caller or undef
+ $fallback = 1; # to clear a/p afterwards
+ }
+ else
+ {
+ # the 4 below is empirical, and there might be cases where it is not
+ # enough...
+ $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
+ }
+
+ # when user set globals, they would interfere with our calculation, so
+ # disable them and later re-enable them
+ no strict 'refs';
+ my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
+ my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
+ # we also need to disable any set A or P on $x (_find_round_parameters took
+ # them already into account), since these would interfere, too
+ delete $x->{_a}; delete $x->{_p};
+ # need to disable $upgrade in BigInt, to avoid deep recursion
+ local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI
+
+ # remember sign and make $x positive, since -4 ** (1/2) => -2
+ my $sign = 0; $sign = 1 if $x->is_negative(); $x->babs();
+
+ if ($y->bcmp(2) == 0) # normal square root
+ {
+ $x->bsqrt($scale+4);
+ }
+ elsif ($y->is_one('-'))
+ {
+ # $x ** -1 => 1/$x
+ my $u = $self->bone()->bdiv($x,$scale);
+ # copy private parts over
+ $x->{_m} = $u->{_m};
+ $x->{_e} = $u->{_e};
+ }
+ else
+ {
+ my $u = $self->bone()->bdiv($y,$scale+4);
+ delete $u->{_a}; delete $u->{_p}; # otherwise it conflicts
+ $x->bpow($u,$scale+4); # el cheapo
+ }
+ $x->bneg() if $sign == 1;
+
+ # shortcut to not run trough _find_round_parameters again
+ if (defined $params[0])
+ {
+ $x->bround($params[0],$params[2]); # then round accordingly
+ }
+ else
+ {
+ $x->bfround($params[1],$params[2]); # then round accordingly
+ }
+ if ($fallback)
+ {
+ # clear a/p after round, since user did not request it
+ $x->{_a} = undef; $x->{_p} = undef;
+ }
+ # restore globals
+ $$abr = $ab; $$pbr = $pb;
+ $x;
+ }
+
sub bsqrt
{
- # calculate square root; this should probably
- # use a different test to see whether the accuracy we want is...
+ # calculate square root
my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- return $x->bnan() if $x->{sign} eq 'NaN' || $x->{sign} =~ /^-/; # <0, NaN
- return $x if $x->{sign} eq '+inf'; # +inf
- return $x if $x->is_zero() || $x->is_one();
+ return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
+ return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
+ return $x->round($a,$p,$r) if $x->is_zero() || $x->is_one();
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
- my $scale = 0;
- my @params = $x->_find_round_parameters($a,$p,$r);
+ my (@params,$scale);
+ ($x,@params) = $x->_find_round_parameters($a,$p,$r);
+
+ return $x if $x->is_nan(); # error in _find_round_parameters?
# no rounding at all, so must use fallback
- if ((scalar @params == 1) ||
- (!defined($params[1] || $params[2])))
+ if (scalar @params == 0)
{
# simulate old behaviour
- $params[1] = $self->div_scale(); # and round to it as accuracy
- $scale = $params[1]+4; # at least four more for proper round
- $params[3] = $r; # round mode by caller or undef
+ $params[0] = $self->div_scale(); # and round to it as accuracy
+ $scale = $params[0]+4; # at least four more for proper round
+ $params[2] = $r; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
}
else
{
# the 4 below is empirical, and there might be cases where it is not
# enough...
- $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined
+ $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
}
# when user set globals, they would interfere with our calculation, so
# exact result
$x->{_m} = $gs; $x->{_e} = $MBI->bzero(); $x->bnorm();
# shortcut to not run trough _find_round_parameters again
- if (defined $params[1])
+ if (defined $params[0])
{
- $x->bround($params[1],$params[3]); # then round accordingly
+ $x->bround($params[0],$params[2]); # then round accordingly
}
else
{
- $x->bfround($params[2],$params[3]); # then round accordingly
+ $x->bfround($params[1],$params[2]); # then round accordingly
}
if ($fallback)
{
# steps of 10. The length of $x does not count, since an even or odd number
# of digits before the dot is not changed by adding an even number of digits
# after the dot (the result is still odd or even digits long).
+ my $length = $y1->length();
$y1->bmul(10) if $x->{_e}->is_odd();
# now calculate how many digits the result of sqrt(y1) would have
- my $digits = int($y1->length() / 2);
+ my $digits = int($length / 2);
# but we need at least $scale digits, so calculate how many are missing
my $shift = $scale - $digits;
# that should never happen (we take care of integer guesses above)
$y1->bsqrt();
# By "shifting" $y1 right (by creating a negative _e) we calculate the final
# result, which is than later rounded to the desired scale.
+
+ # calculate how many zeros $x had after the '.' (or before it, depending
+ # on sign of $dat, the result should have half as many:
+ my $dat = $length + $x->{_e}->numify();
+
+ if ($dat > 0)
+ {
+ # no zeros after the dot (e.g. 1.23, 0.49 etc)
+ # preserve half as many digits before the dot than the input had
+ # (but round this "up")
+ $dat = int(($dat+1)/2);
+ }
+ else
+ {
+ $dat = int(($dat)/2);
+ }
+ $x->{_e}= $MBI->new( $dat - $y1->length() );
+
$x->{_m} = $y1;
- # gs->length() is the number of digits before the dot. Since gs is always
- # truncated (9.99 => 9), it is always right (if gs was rounded, it would be
- # '10' and thus gs->length() == 2, which would be wrong).
- $x->{_e} = $MBI->new(- $y1->length() + $gs->length());
# shortcut to not run trough _find_round_parameters again
- if (defined $params[1])
+ if (defined $params[0])
{
- $x->bround($params[1],$params[3]); # then round accordingly
+ $x->bround($params[0],$params[2]); # then round accordingly
}
else
{
- $x->bfround($params[2],$params[3]); # then round accordingly
+ $x->bfround($params[1],$params[2]); # then round accordingly
}
if ($fallback)
{
$x->bnorm()->round(@r);
}
-sub _pow2
- {
- # Calculate a power where $y is a non-integer, like 2 ** 0.5
- my ($x,$y,$a,$p,$r) = @_;
- my $self = ref($x);
-
- # we need to limit the accuracy to protect against overflow
- my $fallback = 0;
- my $scale = 0;
- my @params = $x->_find_round_parameters($a,$p,$r);
-
- # no rounding at all, so must use fallback
- if (scalar @params == 1)
- {
- # simulate old behaviour
- $params[1] = $self->div_scale(); # and round to it as accuracy
- $scale = $params[1]+4; # at least four more for proper round
- $params[3] = $r; # round mode by caller or undef
- $fallback = 1; # to clear a/p afterwards
- }
- else
- {
- # the 4 below is empirical, and there might be cases where it is not
- # enough...
- $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined
- }
-
- # when user set globals, they would interfere with our calculation, so
- # disable them and later re-enable them
- no strict 'refs';
- my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef;
- my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef;
- # we also need to disable any set A or P on $x (_find_round_parameters took
- # them already into account), since these would interfere, too
- delete $x->{_a}; delete $x->{_p};
- # need to disable $upgrade in BigInt, to avoid deep recursion
- local $Math::BigInt::upgrade = undef;
-
- # split the second argument into its integer and fraction part
- # we calculate the result then from these two parts, like in
- # 2 ** 2.4 == (2 ** 2) * (2 ** 0.4)
- my $c = $self->new($y->as_number()); # integer part
- my $d = $y-$c; # fractional part
- my $xc = $x->copy(); # a temp. copy
-
- # now calculate binary fraction from the decimal fraction on the fly
- # f.i. 0.654:
- # 0.654 * 2 = 1.308 > 1 => 0.1 ( 1.308 - 1 = 0.308)
- # 0.308 * 2 = 0.616 < 1 => 0.10
- # 0.616 * 2 = 1.232 > 1 => 0.101 ( 1.232 - 1 = 0.232)
- # and so on...
- # The process stops when the result is exactly one, or when we have
- # enough accuracy
-
- # From the binary fraction we calculate the result as follows:
- # we assume the fraction ends in 1, and we remove this one first.
- # For each digit after the dot, assume 1 eq R and 0 eq XR, where R means
- # take square root and X multiply with the original X.
-
- my $i = 0;
- while ($i++ < 50)
- {
- $d->badd($d); # * 2
- last if $d->is_one(); # == 1
- $x->bsqrt(); # 0
- if ($d > 1)
- {
- $x->bsqrt(); $x->bmul($xc); $d->bdec(); # 1
- }
- }
- # assume fraction ends in 1
- $x->bsqrt(); # 1
- if (!$c->is_one())
- {
- $x->bmul( $xc->bpow($c) );
- }
- elsif (!$c->is_zero())
- {
- $x->bmul( $xc );
- }
- # done
-
- # shortcut to not run trough _find_round_parameters again
- if (defined $params[1])
- {
- $x->bround($params[1],$params[3]); # then round accordingly
- }
- else
- {
- $x->bfround($params[2],$params[3]); # then round accordingly
- }
- if ($fallback)
- {
- # clear a/p after round, since user did not request it
- $x->{_a} = undef; $x->{_p} = undef;
- }
- # restore globals
- $$abr = $ab; $$pbr = $pb;
- $x;
- }
-
sub _pow
{
# Calculate a power where $y is a non-integer, like 2 ** 0.5
# if $y == 0.5, it is sqrt($x)
return $x->bsqrt($a,$p,$r,$y) if $y->bcmp('0.5') == 0;
+ # Using:
+ # a ** x == e ** (x * ln a)
+
# u = y * ln x
- # _ _
- # Taylor: | u u^2 u^3 |
- # x ** y = 1 + | --- + --- + * ----- + ... |
- # |_ 1 1*2 1*2*3 _|
+ # _ _
+ # Taylor: | u u^2 u^3 |
+ # x ** y = 1 + | --- + --- + ----- + ... |
+ # |_ 1 1*2 1*2*3 _|
# we need to limit the accuracy to protect against overflow
my $fallback = 0;
- my $scale = 0;
- my @params = $x->_find_round_parameters($a,$p,$r);
+ my ($scale,@params);
+ ($x,@params) = $x->_find_round_parameters($a,$p,$r);
+
+ return $x if $x->is_nan(); # error in _find_round_parameters?
# no rounding at all, so must use fallback
- if (scalar @params == 1)
+ if (scalar @params == 0)
{
# simulate old behaviour
- $params[1] = $self->div_scale(); # and round to it as accuracy
- $scale = $params[1]+4; # at least four more for proper round
- $params[3] = $r; # round mode by caller or undef
+ $params[0] = $self->div_scale(); # and round to it as accuracy
+ $params[1] = undef; # disable P
+ $scale = $params[0]+4; # at least four more for proper round
+ $params[2] = $r; # round mode by caller or undef
$fallback = 1; # to clear a/p afterwards
}
else
{
# the 4 below is empirical, and there might be cases where it is not
# enough...
- $scale = abs($params[1] || $params[2]) + 4; # take whatever is defined
+ $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
}
# when user set globals, they would interfere with our calculation, so
my ($limit,$v,$u,$below,$factor,$next,$over);
- $u = $x->copy()->blog($scale)->bmul($y);
+ $u = $x->copy()->blog(undef,$scale)->bmul($y);
$v = $self->bone(); # 1
$factor = $self->new(2); # 2
$x->bone(); # first term: 1
# when the next term is below our limit, it won't affect the outcome
# anymore, so we stop
$next = $over->copy()->bdiv($below,$scale);
- last if $next->bcmp($limit) <= 0;
+ last if $next->bacmp($limit) <= 0;
$x->badd($next);
-# print "at $x\n";
# calculate things for the next term
$over *= $u; $below *= $factor; $factor->binc();
#$steps++;
}
# shortcut to not run trough _find_round_parameters again
- if (defined $params[1])
+ if (defined $params[0])
{
- $x->bround($params[1],$params[3]); # then round accordingly
+ $x->bround($params[0],$params[2]); # then round accordingly
}
else
{
- $x->bfround($params[2],$params[3]); # then round accordingly
+ $x->bfround($params[1],$params[2]); # then round accordingly
}
if ($fallback)
{
# accuracy: preserve $N digits, and overwrite the rest with 0's
my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x);
- die ('bround() needs positive accuracy') if ($_[0] || 0) < 0;
+ if (($_[0] || 0) < 0)
+ {
+ require Carp; Carp::croak ('bround() needs positive accuracy');
+ }
my ($scale,$mode) = $x->_scale_a($self->accuracy(),$self->round_mode(),@_);
return $x if !defined $scale; # no-op
$name =~ s/.*:://; # split package
no strict 'refs';
+ $class->import() if $IMPORT == 0;
if (!method_alias($name))
{
if (!defined $name)
my $self = shift;
my $l = scalar @_;
my $lib = ''; my @a;
+ $IMPORT=1;
for ( my $i = 0; $i < $l ; $i++)
{
if ( $_[$i] eq ':constant' )
{
# this rest causes overlord er load to step in
- # print "overload @_\n";
overload::constant float => sub { $self->new(shift); };
}
elsif ($_[$i] eq 'upgrade')
}
elsif ($_[$i] eq 'lib')
{
+ # alternative library
$lib = $_[$i+1] || ''; # default Calc
$i++;
}
elsif ($_[$i] eq 'with')
{
+ # alternative class for our private parts()
$MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt
$i++;
}
# MBI not loaded, or with ne "Math::BigInt"
$lib .= ",$mbilib" if defined $mbilib;
$lib =~ s/^,//; # don't leave empty
+ # replacement library can handle lib statement, but also could ignore it
if ($] < 5.006)
{
# Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is
eval $rc;
}
}
- die ("Couldn't load $MBI: $! $@") if $@;
+ if ($@)
+ {
+ require Carp; Carp::croak ("Couldn't load $MBI: $! $@");
+ }
# any non :constant stuff is handled by our parent, Exporter
# even if @_ is empty, to give it a chance
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
return '0x0' if $x->is_zero();
- return 'NaN' if $x->{_e}->{sign} ne '+'; # how to do 1e-1 in hex!?
+ return $nan if $x->{_e}->{sign} ne '+'; # how to do 1e-1 in hex!?
my $z = $x->{_m}->copy();
if (!$x->{_e}->is_zero()) # > 0
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
return '0b0' if $x->is_zero();
- return 'NaN' if $x->{_e}->{sign} ne '+'; # how to do 1e-1 in hex!?
+ return $nan if $x->{_e}->{sign} ne '+'; # how to do 1e-1 in hex!?
my $z = $x->{_m}->copy();
if (!$x->{_e}->is_zero()) # > 0
$x->digit($n); # return the nth digit, counting from right
$x->digit(-$n); # return the nth digit, counting from left
- # The following all modify their first argument:
-
+ # The following all modify their first argument. If you want to preserve
+ # $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for why this is
+ # neccessary when mixing $a = $b assigments with non-overloaded math.
+
# set
$x->bzero(); # set $i to 0
$x->bnan(); # set $i to NaN
$x->badd($y); # addition (add $y to $x)
$x->bsub($y); # subtraction (subtract $y from $x)
$x->bmul($y); # multiplication (multiply $x by $y)
- $x->bdiv($y); # divide, set $i to quotient
+ $x->bdiv($y); # divide, set $x to quotient
# return (quo,rem) or quo if scalar
- $x->bmod($y); # modulus
- $x->bpow($y); # power of arguments (a**b)
+ $x->bmod($y); # modulus ($x % $y)
+ $x->bpow($y); # power of arguments ($x ** $y)
$x->blsft($y); # left shift
$x->brsft($y); # right shift
# return (quo,rem) or quo if scalar
- $x->blog($base); # logarithm of $x, base defaults to e
- # (other bases than e not supported yet)
+ $x->blog(); # logarithm of $x to base e (Euler's number)
+ $x->blog($base); # logarithm of $x to base $base (f.i. 2)
$x->band($y); # bit-wise and
$x->bior($y); # bit-wise inclusive or
$x->bnot(); # bit-wise not (two's complement)
$x->bsqrt(); # calculate square-root
+ $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root)
$x->bfac(); # factorial of $x (1*2*3*4*..$x)
- $x->bround($N); # accuracy: preserver $N digits
+ $x->bround($N); # accuracy: preserve $N digits
$x->bfround($N); # precision: round to the $Nth digit
+ $x->bfloor(); # return integer less or equal than $x
+ $x->bceil(); # return integer greater or equal than $x
+
# The following do not modify their arguments:
+
bgcd(@values); # greatest common divisor
blcm(@values); # lowest common multiplicator
$x->bstr(); # return string
$x->bsstr(); # return string in scientific notation
- $x->bfloor(); # return integer less or equal than $x
- $x->bceil(); # return integer greater or equal than $x
-
$x->exponent(); # return exponent as BigInt
$x->mantissa(); # return mantissa as BigInt
$x->parts(); # return (mantissa,exponent) as BigInt
$x->accuracy(); # return A of $x (or global, if A of $x undef)
$x->accuracy($n); # set A $x to $n
- Math::BigFloat->precision(); # get/set global P for all BigFloat objects
- Math::BigFloat->accuracy(); # get/set global A for all BigFloat objects
+ # these get/set the appropriate global value for all BigFloat objects
+ Math::BigFloat->precision(); # Precision
+ Math::BigFloat->accuracy(); # Accuracy
+ Math::BigFloat->round_mode(); # rounding mode
=head1 DESCRIPTION
The string output will always have leading and trailing zeros stripped and drop
a plus sign. C<bstr()> will give you always the form with a decimal point,
-while C<bsstr()> (for scientific) gives you the scientific notation.
+while C<bsstr()> (s for scientific) gives you the scientific notation.
Input bstr() bsstr()
'-0' '0' '0E1'
C<is_nan()>) return true or false, while others (C<bcmp()>, C<bacmp()>)
return either undef, <0, 0 or >0 and are suited for sort.
-Actual math is done by using BigInts to represent the mantissa and exponent.
+Actual math is done by using the class defined with C<with => Class;> (which
+defaults to BigInts) to represent the mantissa and exponent.
+
The sign C</^[+-]$/> is stored separately. The string 'NaN' is used to
represent the result when input arguments are not numbers, as well as
the result of dividing by zero.
Since things like sqrt(2) or 1/3 must presented with a limited precision lest
a operation consumes all resources, each operation produces no more than
-C<Math::BigFloat::precision()> digits.
+the requested number of digits.
+
+Please refer to BigInt's documentation for the precedence rules of which
+accuracy/precision setting will be used.
+
+If there is no gloabl precision set, B<and> the operation inquestion was not
+called with a requested precision or accuracy, B<and> the input $x has no
+accuracy or precision set, then a fallback parameter will be used. For
+historical reasons, it is called C<div_scale> and can be accessed via:
+
+ $d = Math::BigFloat->div_scale(); # query
+ Math::BigFloat->div_scale($n); # set to $n digits
+
+The default value is 40 digits.
In case the result of one operation has more precision than specified,
it is rounded. The rounding mode taken is either the default mode, or the one
supplied to the operation after the I<scale>:
$x = Math::BigFloat->new(2);
- Math::BigFloat::precision(5); # 5 digits max
+ Math::BigFloat->precision(5); # 5 digits max
$y = $x->copy()->bdiv(3); # will give 0.66666
$y = $x->copy()->bdiv(3,6); # will give 0.666666
$y = $x->copy()->bdiv(3,6,'odd'); # will give 0.666667
- Math::BigFloat::round_mode('zero');
+ Math::BigFloat->round_mode('zero');
$y = $x->copy()->bdiv(3,6); # will give 0.666666
=head2 Rounding
=item fround ( -$scale ) and fround ( 0 )
-These are effetively no-ops.
+These are effectively no-ops.
=back
the following: 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'.
The default rounding mode is 'even'. By using
-C<< Math::BigFloat::round_mode($round_mode); >> you can get and set the default
+C<< Math::BigFloat->round_mode($round_mode); >> you can get and set the default
mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is
no longer supported.
The second parameter to the round functions then overrides the default
temporarily.
-The C<< as_number() >> function returns a BigInt from a Math::BigFloat. It uses
+The C<as_number()> function returns a BigInt from a Math::BigFloat. It uses
'trunc' as rounding mode to make it equivalent to:
$x = 2.5;
use Math::BigFloat lib => 'GMP';
-Use the lib, Luke! And see L<Using Math::BigInt::Lite> for more details.
+It is also possible to just require Math::BigFloat:
+
+ require Math::BigFloat;
+
+This will load the neccessary things (like BigInt) when they are needed, and
+automatically.
+
+Use the lib, Luke! And see L<Using Math::BigInt::Lite> for more details than
+you ever wanted to know about loading a different library.
=head2 Using Math::BigInt::Lite
# 3
use Math::BigFloat with => 'Math::BigInt::Lite', lib => 'GMP,Pari';
-If you want to use Math::BigInt's, too, simple add a Math::BigInt B<before>:
+There is no need for a "use Math::BigInt;" statement, even if you want to
+use Math::BigInt's, since Math::BigFloat will needs Math::BigInt and thus
+always loads it. But if you add it, add it B<before>:
# 4
use Math::BigInt;
That would try to load Foo, Bar, Baz and Calc (in that order). Or in other
words, Math::BigFloat will try to retain previously loaded libs when you
-don't specify it one.
+don't specify it onem but if you specify one, it will try to load them.
Actually, the lib loading order would be "Bar,Baz,Calc", and then
"Foo,Bar,Baz,Calc", but independend of which lib exists, the result is the
-same as trying the latter load alone, except for the fact that Bar or Baz
-might be loaded needlessly in an intermidiate step
+same as trying the latter load alone, except for the fact that one of Bar or
+Baz might be loaded needlessly in an intermidiate step (and thus hang around
+and waste memory). If neither Bar nor Baz exist (or don't work/compile), they
+will still be tried to be loaded, but this is not as time/memory consuming as
+actually loading one of them. Still, this type of usage is not recommended due
+to these issues.
-The old way still works though:
+The old way (loading the lib only in BigInt) still works though:
# 6
use Math::BigInt lib => 'Bar,Baz';
use Math::BigFloat;
-But B<examples #3 and #4 are recommended> for usage.
+You can even load Math::BigInt afterwards:
-=head1 BUGS
+ # 7
+ use Math::BigFloat;
+ use Math::BigInt lib => 'Bar,Baz';
-=over 2
+But this has the same problems like #5, it will first load Calc
+(Math::BigFloat needs Math::BigInt and thus loads it) and then later Bar or
+Baz, depending on which of them works and is usable/loadable. Since this
+loads Calc unnecc., it is not recommended.
-=item *
+Since it also possible to just require Math::BigFloat, this poses the question
+about what libary this will use:
-The following does not work yet:
+ require Math::BigFloat;
+ my $x = Math::BigFloat->new(123); $x += 123;
- $m = $x->mantissa();
- $e = $x->exponent();
- $y = $m * ( 10 ** $e );
- print "ok\n" if $x == $y;
+It will use Calc. Please note that the call to import() is still done, but
+only when you use for the first time some Math::BigFloat math (it is triggered
+via any constructor, so the first time you create a Math::BigFloat, the load
+will happen in the background). This means:
-=item *
+ require Math::BigFloat;
+ Math::BigFloat->import ( lib => 'Foo,Bar' );
-There is no fmod() function yet.
+would be the same as:
-=back
+ use Math::BigFloat lib => 'Foo, Bar';
+
+But don't try to be clever to insert some operations in between:
+
+ require Math::BigFloat;
+ my $x = Math::BigFloat->bone() + 4; # load BigInt and Calc
+ Math::BigFloat->import( lib => 'Pari' ); # load Pari, too
+ $x = Math::BigFloat->bone()+4; # now use Pari
+
+While this works, it loads Calc needlessly. But maybe you just wanted that?
+
+B<Examples #3 is highly recommended> for daily usage.
+
+=head1 BUGS
+
+Please see the file BUGS in the CPAN distribution Math::BigInt for known bugs.
-=head1 CAVEAT
+=head1 CAVEATS
=over 1
It will not do what you think, e.g. making a copy of $x. Instead it just makes
a second reference to the B<same> object and stores it in $y. Thus anything
-that modifies $x will modify $y, and vice versa.
-
- $x->bmul(2);
- print "$x, $y\n"; # prints '10, 10'
-
-If you want a true copy of $x, use:
-
- $y = $x->copy();
-
-See also the documentation in L<overload> regarding C<=>.
+that modifies $x will modify $y (except overloaded math operators), and vice
+versa. See L<Math::BigInt> for details and how to avoid that.
=item bpow
=back
+=head1 SEE ALSO
+
+L<Math::BigInt>, L<Math::BigRat> and L<Math::Big> as well as
+L<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
+
+The pragmas L<bignum>, L<bigint> and L<bigrat> might also be of interest
+because they solve the autoupgrading/downgrading issue, at least partly.
+
+The package at
+L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> contains
+more documentation including a full version history, testcases, empty
+subclass files and benchmarks.
+
=head1 LICENSE
This program is free software; you may redistribute it and/or modify it under
=head1 AUTHORS
Mark Biggar, overloaded interface by Ilya Zakharevich.
-Completely rewritten by Tels http://bloodgate.com in 2001.
+Completely rewritten by Tels http://bloodgate.com in 2001, 2002, and still
+at it in 2003.
=cut
my $class = "Math::BigInt";
require 5.005;
-$VERSION = '1.64_01';
-$VERSION = eval $VERSION;
+$VERSION = '1.65';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( objectify _swap 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 vars qw/$_trap_nan $_trap_inf/;
use strict;
# Inside overload, the first arg is always an object. If the original code had
##############################################################################
# global constants, flags and accessory
-use constant MB_NEVER_ROUND => 0x0001;
-
-my $NaNOK=1; # are NaNs ok?
-my $nan = 'NaN'; # constants for easier life
-
-my $CALC = 'Math::BigInt::Calc'; # module to do low level math
-my $IMPORT = 0; # did import() yet?
+# these are public, but their usage is not recommended, use the accessor
+# methods instead
$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'
$accuracy = undef;
$upgrade = undef; # default is no upgrade
$downgrade = undef; # default is no downgrade
+# these are internally, and not to be used from the outside
+
+use constant MB_NEVER_ROUND => 0x0001;
+
+$_trap_nan = 0; # are NaNs ok? set w/ config()
+$_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
+my $IMPORT = 0; # was import() called yet?
+ # used to make require work
+
##############################################################################
# the old code had $rnd_mode, so we need to support it, too
if (defined $_[0])
{
my $m = shift;
- die "Unknown round mode $m"
- if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
+ if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/)
+ {
+ require Carp; Carp::croak ("Unknown round mode '$m'");
+ }
return ${"${class}::round_mode"} = $m;
}
- return ${"${class}::round_mode"};
+ ${"${class}::round_mode"};
}
sub upgrade
my $u = shift;
return ${"${class}::upgrade"} = $u;
}
- return ${"${class}::upgrade"};
+ ${"${class}::upgrade"};
}
sub downgrade
my $u = shift;
return ${"${class}::downgrade"} = $u;
}
- return ${"${class}::downgrade"};
+ ${"${class}::downgrade"};
}
sub div_scale
{
no strict 'refs';
- # make Class->round_mode() work
+ # make Class->div_scale() work
my $self = shift;
my $class = ref($self) || $self || __PACKAGE__;
if (defined $_[0])
{
- die ('div_scale must be greater than zero') if $_[0] < 0;
+ if ($_[0] < 0)
+ {
+ require Carp; Carp::croak ('div_scale must be greater than zero');
+ }
${"${class}::div_scale"} = shift;
}
- return ${"${class}::div_scale"};
+ ${"${class}::div_scale"};
}
sub accuracy
if (@_ > 0)
{
my $a = shift;
- die ('accuracy must not be zero') if defined $a && $a == 0;
+ # convert objects to scalars to avoid deep recursion. If object doesn't
+ # have numify(), then hopefully it will have overloading for int() and
+ # boolean test without wandering into a deep recursion path...
+ $a = $a->numify() if ref($a) && $a->can('numify');
+
+ if (defined $a)
+ {
+ # also croak on non-numerical
+ if (!$a || $a <= 0)
+ {
+ require Carp;
+ Carp::croak ('Argument to accuracy must be greater than zero');
+ }
+ if (int($a) != $a)
+ {
+ require Carp; Carp::croak ('Argument to accuracy must be an integer');
+ }
+ }
if (ref($x))
{
# $object->accuracy() or fallback to global
- $x->bround($a) if defined $a;
- $x->{_a} = $a; # set/overwrite, even if not rounded
- $x->{_p} = undef; # clear P
+ $x->bround($a) if $a; # not for undef, 0
+ $x->{_a} = $a; # set/overwrite, even if not rounded
+ $x->{_p} = undef; # clear P
+ $a = ${"${class}::accuracy"} unless defined $a; # proper return value
}
else
{
# set global
${"${class}::accuracy"} = $a;
- ${"${class}::precision"} = undef; # clear P
+ ${"${class}::precision"} = undef; # clear P
}
- return $a; # shortcut
+ return $a; # shortcut
}
my $r;
# but don't return global undef, when $x's accuracy is 0!
$r = ${"${class}::accuracy"} if !defined $r;
$r;
- }
+ }
sub precision
{
my $class = ref($x) || $x || __PACKAGE__;
no strict 'refs';
- # need to set new value?
if (@_ > 0)
{
my $p = shift;
+ # convert objects to scalars to avoid deep recursion. If object doesn't
+ # have numify(), then hopefully it will have overloading for int() and
+ # boolean test without wandering into a deep recursion path...
+ $p = $p->numify() if ref($p) && $p->can('numify');
+ if ((defined $p) && (int($p) != $p))
+ {
+ require Carp; Carp::croak ('Argument to precision must be an integer');
+ }
if (ref($x))
{
# $object->precision() or fallback to global
- $x->bfround($p) if defined $p;
- $x->{_p} = $p; # set/overwrite, even if not rounded
- $x->{_a} = undef; # clear A
+ $x->bfround($p) if $p; # not for undef, 0
+ $x->{_p} = $p; # set/overwrite, even if not rounded
+ $x->{_a} = undef; # clear A
+ $p = ${"${class}::precision"} unless defined $p; # proper return value
}
else
{
# set global
${"${class}::precision"} = $p;
- ${"${class}::accuracy"} = undef; # clear A
+ ${"${class}::accuracy"} = undef; # clear A
}
- return $p; # shortcut
+ return $p; # shortcut
}
my $r;
# but don't return global undef, when $x's precision is 0!
$r = ${"${class}::precision"} if !defined $r;
$r;
- }
+ }
sub config
{
- # return (later set?) configuration data as hash ref
+ # return (or set) configuration data as hash ref
my $class = shift || 'Math::BigInt';
no strict 'refs';
- my $lib = $CALC;
+ if (@_ > 0)
+ {
+ # try to set given options as arguments from hash
+
+ my $args = $_[0];
+ if (ref($args) ne 'HASH')
+ {
+ $args = { @_ };
+ }
+ # these values can be "set"
+ my $set_args = {};
+ foreach my $key (
+ qw/trap_inf trap_nan
+ upgrade downgrade precision accuracy round_mode div_scale/
+ )
+ {
+ $set_args->{$key} = $args->{$key} if exists $args->{$key};
+ delete $args->{$key};
+ }
+ if (keys %$args > 0)
+ {
+ require Carp;
+ Carp::croak ("Illegal key(s) '",
+ join("','",keys %$args),"' passed to $class\->config()");
+ }
+ foreach my $key (keys %$set_args)
+ {
+ if ($key =~ /^trap_(inf|nan)\z/)
+ {
+ ${"${class}::_trap_$1"} = ($set_args->{"trap_$1"} ? 1 : 0);
+ next;
+ }
+ # use a call instead of just setting the $variable to check argument
+ $class->$key($set_args->{$key});
+ }
+ }
+
+ # now return actual configuration
+
my $cfg = {
- lib => $lib,
- lib_version => ${"${lib}::VERSION"},
+ lib => $CALC,
+ lib_version => ${"${CALC}::VERSION"},
class => $class,
+ trap_nan => ${"${class}::_trap_nan"},
+ trap_inf => ${"${class}::_trap_inf"},
+ version => ${"${class}::VERSION"},
};
- foreach (
- qw/upgrade downgrade precision accuracy round_mode VERSION div_scale/)
+ foreach my $key (qw/
+ upgrade downgrade precision accuracy round_mode div_scale
+ /)
{
- $cfg->{lc($_)} = ${"${class}::$_"};
+ $cfg->{$key} = ${"${class}::$key"};
};
$cfg;
}
# remove sign without touching wanted to make it work with constants
my $t = $wanted; $t =~ s/^[+-]//; $ref = \$t;
}
+ # force to string version (otherwise Pari is unhappy about overflowed
+ # constants, for instance)
+ # not good, BigInt shouldn't need to know about alternative libs:
+ # $ref = \"$$ref" if $CALC eq 'Math::BigInt::Pari';
$self->{value} = $CALC->_new($ref);
no strict 'refs';
if ( (defined $a) || (defined $p)
my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted);
if (!ref $mis)
{
- die "$wanted is not a number initialized to $class" if !$NaNOK;
- #print "NaN 1\n";
+ if ($_trap_nan)
+ {
+ require Carp; Carp::croak("$wanted is not a number in $class");
+ }
$self->{value} = $CALC->_zero();
$self->{sign} = $nan;
return $self;
my $diff = $e - CORE::length($$mfv);
if ($diff < 0) # Not integer
{
+ if ($_trap_nan)
+ {
+ require Carp; Carp::croak("$wanted not an integer in $class");
+ }
#print "NOI 1\n";
return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
$self->{sign} = $nan;
else # diff >= 0
{
# adjust fraction and add it to value
- # print "diff > 0 $$miv\n";
+ #print "diff > 0 $$miv\n";
$$miv = $$miv . ($$mfv . '0' x $diff);
}
}
if ($$mfv ne '') # e <= 0
{
# fraction and negative/zero E => NOI
+ if ($_trap_nan)
+ {
+ require Carp; Carp::croak("$wanted not an integer in $class");
+ }
#print "NOI 2 \$\$mfv '$$mfv'\n";
return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
$self->{sign} = $nan;
$e = abs($e);
if ($$miv !~ s/0{$e}$//) # can strip so many zero's?
{
+ if ($_trap_nan)
+ {
+ require Carp; Carp::croak("$wanted not an integer in $class");
+ }
#print "NOI 3\n";
return $upgrade->new($wanted,$a,$p,$r) if defined $upgrade;
$self->{sign} = $nan;
{
my $c = $self; $self = {}; bless $self, $c;
}
+ no strict 'refs';
+ if (${"${class}::_trap_nan"})
+ {
+ require Carp;
+ Carp::croak ("Tried to set $self to NaN in $class\::bnan()");
+ }
$self->import() if $IMPORT == 0; # make require work
return if $self->modify('bnan');
- my $c = ref($self);
if ($self->can('_bnan'))
{
# use subclass to initialize
{
my $c = $self; $self = {}; bless $self, $c;
}
+ no strict 'refs';
+ if (${"${class}::_trap_inf"})
+ {
+ require Carp;
+ Carp::croak ("Tried to set $self to +-inf in $class\::binfn()");
+ }
$self->import() if $IMPORT == 0; # make require work
return if $self->modify('binf');
- my $c = ref($self);
if ($self->can('_binf'))
{
# use subclass to initialize
}
$self->import() if $IMPORT == 0; # make require work
return if $self->modify('bzero');
-
+
if ($self->can('_bzero'))
{
# use subclass to initialize
my $self = shift;
my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-';
$self = $class if !defined $self;
-
+
if (!ref($self))
{
my $c = $self; $self = {}; bless $self, $c;
# After any operation or when calling round(), the result is rounded by
# regarding the A & P from arguments, local parameters, or globals.
+ # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!!
+
# This procedure finds the round parameters, but it is for speed reasons
# duplicated in round. Otherwise, it is tested by the testsuite and used
# by fdiv().
+
+ # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P
+ # were requested/defined (locally or globally or both)
my ($self,$a,$p,$r,@args) = @_;
# $a accuracy, if given by caller
# @args all 'other' arguments (0 for unary, 1 for binary ops)
# leave bigfloat parts alone
- return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
+ return ($self) if exists $self->{_f} && ($self->{_f} & MB_NEVER_ROUND) != 0;
my $c = ref($self); # find out class of argument(s)
no strict 'refs';
# if still none defined, use globals (#2)
$a = ${"$c\::accuracy"} unless defined $a;
$p = ${"$c\::precision"} unless defined $p;
+
+ # A == 0 is useless, so undef it to signal no rounding
+ $a = undef if defined $a && $a == 0;
# no rounding today?
return ($self) unless defined $a || defined $p; # early out
# set A and set P is an fatal error
- return ($self->bnan()) if defined $a && defined $p;
+ return ($self->bnan()) if defined $a && defined $p; # error
$r = ${"$c\::round_mode"} unless defined $r;
- die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
-
- return ($self,$a,$p,$r);
+ if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/)
+ {
+ require Carp; Carp::croak ("Unknown round mode '$r'");
+ }
+
+ ($self,$a,$p,$r);
}
sub round
# @args all 'other' arguments (0 for unary, 1 for binary ops)
# leave bigfloat parts alone
- return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0;
+ return ($self) if exists $self->{_f} && ($self->{_f} & MB_NEVER_ROUND) != 0;
my $c = ref($self); # find out class of argument(s)
no strict 'refs';
$a = ${"$c\::accuracy"} unless defined $a;
$p = ${"$c\::precision"} unless defined $p;
+ # A == 0 is useless, so undef it to signal no rounding
+ $a = undef if defined $a && $a == 0;
+
# no rounding today?
return $self unless defined $a || defined $p; # early out
return $self->bnan() if defined $a && defined $p;
$r = ${"$c\::round_mode"} unless defined $r;
- die "Unknown round mode '$r'" if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/;
+ if ($r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/)
+ {
+
+ }
# now round, by calling either fround or ffround:
if (defined $a)
# not implemented yet
my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
- return $upgrade->blog($x,$base,$a,$p,$r) if defined $upgrade;
+ return $upgrade->blog($upgrade->new($x),$base,$a,$p,$r) if defined $upgrade;
return $x->bnan();
}
# we don't need $self, so undef instead of ref($_[0]) make it slightly faster
my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_);
- $sign = '' if !defined $sign; $sign = '+' if $sign ne '-';
+ $sign = '+' if !defined $sign || $sign ne '-';
return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either
$CALC->_is_one($x->{value});
return $self->_div_inf($x,$y)
if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
- return $upgrade->bdiv($upgrade->new($x),$y,@r)
- if defined $upgrade && !$y->isa($self);
-
- $r[3] = $y; # no push!
-
- # 0 / something
- return
- wantarray ? ($x->round(@r),$self->bzero(@r)):$x->round(@r) if $x->is_zero();
-
- # Is $x in the interval [0, $y) (aka $x <= $y) ?
- my $cmp = $CALC->_acmp($x->{value},$y->{value});
- if (($cmp < 0) and (($x->{sign} eq $y->{sign}) or !wantarray))
- {
- return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
- if defined $upgrade;
-
- return $x->bzero()->round(@r) unless wantarray;
- my $t = $x->copy(); # make copy first, because $x->bzero() clobbers $x
- return ($x->bzero()->round(@r),$t);
- }
- elsif ($cmp == 0)
- {
- # shortcut, both are the same, so set to +/- 1
- $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') );
- return $x unless wantarray;
- return ($x->round(@r),$self->bzero(@r));
- }
return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r)
if defined $upgrade;
+ $r[3] = $y; # no push!
+
# calc new sign and in case $y == +/- 1, return $x
my $xsign = $x->{sign}; # keep
$x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+');
- # check for / +-1 (cant use $y->is_one due to '-'
- if ($CALC->_is_one($y->{value}))
- {
- return wantarray ? ($x->round(@r),$self->bzero(@r)) : $x->round(@r);
- }
if (wantarray)
{
$x->{sign} = '+' if $CALC->_is_zero($x->{value});
$rem->{_a} = $x->{_a};
$rem->{_p} = $x->{_p};
- $x->round(@r);
+ $x->round(@r) if !exists $x->{_f} || ($x->{_f} & MB_NEVER_ROUND) == 0;
if (! $CALC->_is_zero($rem->{value}))
{
$rem->{sign} = $y->{sign};
- $rem = $y-$rem if $xsign ne $y->{sign}; # one of them '-'
+ $rem = $y->copy()->bsub($rem) if $xsign ne $y->{sign}; # one of them '-'
}
else
{
$rem->{sign} = '+'; # dont leave -0
}
- return ($x,$rem->round(@r));
+ $rem->round(@r) if !exists $rem->{_f} || ($rem->{_f} & MB_NEVER_ROUND) == 0;
+ return ($x,$rem);
}
$x->{value} = $CALC->_div($x->{value},$y->{value});
$x->{sign} = '+' if $CALC->_is_zero($x->{value});
- $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
+ $x->round(@r) if !exists $x->{_f} || ($x->{_f} & MB_NEVER_ROUND) == 0;
$x;
}
$num->bone(); # keep ref to $num
my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix
- my $len = length($expbin);
+ my $len = CORE::length($expbin);
while (--$len >= 0)
{
if( substr($expbin,$len,1) eq '1')
my $pow2 = $self->__one();
my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//;
- my $len = length($y_bin);
+ my $len = CORE::length($y_bin);
while (--$len > 0)
{
$pow2->bmul($x) if substr($y_bin,$len,1) eq '1'; # is odd?
sub bsqrt
{
+ # calculate square root of $x
my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
return $x if $x->modify('bsqrt');
- return $x->bnan() if $x->{sign} ne '+'; # -x or inf or NaN => NaN
- return $x->bzero(@r) if $x->is_zero(); # 0 => 0
- return $x->round(@r) if $x->is_one(); # 1 => 1
+ 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;
my $l = int($x->length()/2);
$x->bone(); # keep ref($x), but modify it
- $x->blsft($l,10);
+ $x->blsft($l,10) if $l != 0; # first guess: 1.('0' x (l/2))
my $last = $self->bzero();
my $two = $self->new(2);
- my $lastlast = $x+$two;
+ my $lastlast = $self->bzero();
+ #my $lastlast = $x+$two;
while ($last != $x && $lastlast != $x)
{
$lastlast = $last; $last = $x->copy();
$x->round(@r);
}
+sub broot
+ {
+ # calculate $y'th root of $x
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
+
+ return $x if $x->modify('broot');
+
+ # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
+ return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
+ $y->{sign} !~ /^\+$/;
+
+ return $x->round(@r)
+ if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();
+
+ return $upgrade->broot($x,@r) if defined $upgrade;
+
+ if ($CALC->can('_root'))
+ {
+ $x->{value} = $CALC->_root($x->{value},$y->{value});
+ return $x->round(@r);
+ }
+
+ return $x->bsqrt() if $y->bacmp(2) == 0; # 2 => square root
+
+ # since we take at least a cubic root, and only 8 ** 1/3 >= 2 (==2):
+ return $x->bone('+',@r) if $x < 8; # $x=2..7 => 1
+
+ my $org = $x->copy();
+ my $l = int($x->length()/$y->numify());
+
+ $x->bone(); # keep ref($x), but modify it
+ $x->blsft($l,10) if $l != 0; # first guess: 1.('0' x (l/$y))
+
+ my $last = $self->bzero();
+ my $lastlast = $self->bzero();
+ #my $lastlast = $x+$y;
+ my $divider = $self->new(2);
+ my $up = $y-1;
+ print "start $org divider $divider up $up\n";
+ while ($last != $x && $lastlast != $x)
+ {
+ print "at $x ($last $lastlast)\n";
+ $lastlast = $last; $last = $x->copy();
+ print "at $x ($last ",($org / ($x ** $up)),"\n";
+ $x->badd($org / ($x ** 2));
+ $x->bdiv($divider);
+ }
+ print $x ** $y," org ",$org,"\n";
+ # correct overshot
+ while ($x ** $y < $org)
+ {
+ print "correcting $x to ";
+ $x->binc();
+ print "$x ( $x ** $y == ",$x ** $y,")\n";
+ }
+ $x->round(@r);
+ }
+
sub exponent
{
# return a copy of the exponent (here always 0, NaN or 1 for $m == 0)
}
my $up = ${"$a[0]::upgrade"};
- # print "Now in objectify, my class is today $a[0]\n";
+ #print "Now in objectify, my class is today $a[0]\n";
if ($count == 0)
{
while (@_)
}
push @a,@_; # return other params, too
}
- die "$class objectify needs list context" unless wantarray;
+ if (! wantarray)
+ {
+ require Carp; Carp::croak ("$class objectify needs list context");
+ }
${"$a[0]::downgrade"} = $d;
@a;
}
}
$CALC = $lib, last if $@ eq ''; # no error in loading lib?
}
- die "Couldn't load any math lib, not even the default" if $CALC eq '';
+ if ($CALC eq '')
+ {
+ require Carp;
+ Carp::croak ("Couldn't load any math lib, not even the default");
+ }
}
sub __from_hex
my $x = shift; $x = $class->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- return '0x0' if $x->is_zero();
my $es = ''; my $s = '';
$s = $x->{sign} if $x->{sign} eq '-';
}
else
{
+ return '0x0' if $x->is_zero();
+
my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h);
if ($] >= 5.006)
{
my $x = shift; $x = $class->new($x) if !ref($x);
return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
- return '0b0' if $x->is_zero();
my $es = ''; my $s = '';
$s = $x->{sign} if $x->{sign} eq '-';
}
else
{
+ return '0b0' if $x->is_zero();
my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b);
if ($] >= 5.006)
{
use Math::BigInt;
+ # or make it faster: install (optional) Math::BigInt::GMP
+ # and always use (it will fall back to pure Perl if the
+ # GMP library is not installed):
+
+ use Math::BigInt lib => 'GMP';
+
# Number creation
$x = Math::BigInt->new($str); # defaults to 0
$nan = Math::BigInt->bnan(); # create a NotANumber
$x->digit($n); # return the nth digit, counting from right
$x->digit(-$n); # return the nth digit, counting from left
- # The following all modify their first argument:
+ # The following all modify their first argument. If you want to preserve
+ # $x, use $z = $x->copy()->bXXX($y); See under L<CAVEATS> for why this is
+ # neccessary when mixing $a = $b assigments with non-overloaded math.
$x->bzero(); # set $x to 0
$x->bnan(); # set $x to NaN
$x->bnot(); # bitwise not (two's complement)
$x->bsqrt(); # calculate square-root
+ $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root)
$x->bfac(); # factorial of $x (1*2*3*4*..$x)
- $x->round($A,$P,$mode); # round to accuracy or precision using mode $r
+ $x->round($A,$P,$mode); # round to accuracy or precision using mode $mode
$x->bround($N); # accuracy: preserve $N digits
$x->bfround($N); # round to $Nth digit, no-op for BigInts
- # The following do not modify their arguments in BigInt,
+ # The following do not modify their arguments in BigInt (are no-ops),
# but do so in BigFloat:
$x->bfloor(); # return integer less or equal than $x
globals enforced upon creation of a number by using
$x = Math::BigInt->new($number,undef,undef):
- use Math::Bigint::SomeSubclass;
+ use Math::BigInt::SomeSubclass;
use Math::BigInt;
Math::BigInt->accuracy(2);
$x = Math::BigInt->bstr("1234") # string "1234"
$x = "$x"; # same as bstr()
- $x = Math::BigInt->bneg("1234"); # Bigint "-1234"
- $x = Math::BigInt->babs("-12345"); # Bigint "12345"
+ $x = Math::BigInt->bneg("1234"); # BigInt "-1234"
+ $x = Math::BigInt->babs("-12345"); # BigInt "12345"
$x = Math::BigInt->bnorm("-0 00"); # BigInt "0"
$x = bint(1) + bint(2); # BigInt "3"
$x = bint(1) + "2"; # ditto (auto-BigIntify of "2")
do not work. You need an explicit Math::BigInt->new() around one of the
operands. You should also quote large constants to protect loss of precision:
- use Math::Bigint;
+ use Math::BigInt;
$x = Math::BigInt->new('1234567889123456789123456789123456789');
=over 2
+=item broot() does not work
+
+The broot() function in BigInt may only work for small values. This will be
+fixed in a later version.
+
=item Out of Memory!
Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and
This section also applies to other overloaded math packages, like Math::String.
-One solution to you problem might be L<autoupgrading|upgrading>.
+One solution to you problem might be autoupgrading|upgrading. See the
+pragmas L<bignum>, L<bigint> and L<bigrat> for an easy way to do this.
=item bsqrt()
C<bsqrt()> works only good if the result is a big integer, e.g. the square
root of 144 is 12, but from 12 the square root is 3, regardless of rounding
-mode.
+mode. The reason is that the result is always truncated to an integer.
If you want a better approximation of the square root, then use:
=head1 SEE ALSO
-L<Math::BigFloat> and L<Math::Big> as well as L<Math::BigInt::BitVect>,
-L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
+L<Math::BigFloat>, L<Math::BigRat> and L<Math::Big> as well as
+L<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and L<Math::BigInt::GMP>.
+
+The pragmas L<bignum>, L<bigint> and L<bigrat> also might be of interest
+because they solve the autoupgrading/downgrading issue, at least partly.
The package at
L<http://search.cpan.org/search?mode=module&query=Math%3A%3ABigInt> contains
=head1 AUTHORS
Original code by Mark Biggar, overloaded interface by Ilya Zakharevich.
-Completely rewritten by Tels http://bloodgate.com in late 2000, 2001.
+Completely rewritten by Tels http://bloodgate.com in late 2000, 2001, 2002
+and still at it in 2003.
+
+Many people contributed in one or more ways to the final beast, see the file
+CREDITS for an (uncomplete) list. If you miss your name, please drop me a
+mail. Thank you!
=cut
use vars qw/@ISA $VERSION/;
@ISA = qw(Exporter);
-$VERSION = '0.32';
+$VERSION = '0.34';
# Package to store unsigned big integers in decimal and do math with them
# The BEGIN block is used to determine which of the two variants gives the
# correct result.
+# Beware of things like:
+# $i = $i * $y + $car; $car = int($i / $MBASE); $i = $i % $MBASE;
+# This works on x86, but fails on ARM (SA1100, iPAQ) due to whoeknows what
+# reasons. So, use this instead (slower, but correct):
+# $i = $i * $y + $car; $car = int($i / $MBASE); $i -= $MBASE * $car;
+
##############################################################################
# global constants, flags and accessory
my ($MBASE,$BASE,$RBASE,$BASE_LEN,$MAX_VAL,$BASE_LEN2,$BASE_LEN_SMALL);
my ($AND_BITS,$XOR_BITS,$OR_BITS);
my ($AND_MASK,$XOR_MASK,$OR_MASK);
-my ($LEN_CONVERT);
sub _base_len
{
$MBASE = int("1e".$BASE_LEN_SMALL);
$RBASE = abs('1e-'.$BASE_LEN_SMALL); # see USE_MUL
$MAX_VAL = $MBASE-1;
- $LEN_CONVERT = 0;
- $LEN_CONVERT = 1 if $BASE_LEN_SMALL != $BASE_LEN;
-
+
#print "BASE_LEN: $BASE_LEN MAX_VAL: $MAX_VAL BASE: $BASE RBASE: $RBASE ";
#print "BASE_LEN_SMALL: $BASE_LEN_SMALL MBASE: $MBASE\n";
undef &_mul;
undef &_div;
- if ($caught & 1 != 0)
+ # $caught & 1 != 0 => cannot use MUL
+ # $caught & 2 != 0 => cannot use DIV
+ # The parens around ($caught & 1) were important, indeed, if we would use
+ # & here.
+ if ($caught == 2) # 2
{
- # must USE_MUL
+ # print "# use mul\n";
+ # must USE_MUL since we cannot use DIV
*{_mul} = \&_mul_use_mul;
*{_div} = \&_div_use_mul;
}
- else # $caught must be 2, since it can't be 1 nor 3
+ else # 0 or 1
{
+ # print "# use div\n";
# can USE_DIV instead
*{_mul} = \&_mul_use_div;
*{_div} = \&_div_use_div;
}
-##############################################################################
-# convert between the "small" and the "large" representation
-
-sub _to_large
- {
- # take an array in base $BASE_LEN_SMALL and convert it in-place to $BASE_LEN
- my ($c,$x) = @_;
-
-# print "_to_large $BASE_LEN_SMALL => $BASE_LEN\n";
-
- return $x if $LEN_CONVERT == 0 || # nothing to converconvertor
- @$x == 1; # only one element => early out
-
- # 12345 67890 12345 67890 contents
- # to 3 2 1 0 index
- # 123456 7890123 4567890 contents
-
-# # faster variant
-# my @d; my $str = '';
-# my $z = '0' x $BASE_LEN_SMALL;
-# foreach (@$x)
-# {
-# # ... . 04321 . 000321
-# $str = substr($z.$_,-$BASE_LEN_SMALL,$BASE_LEN_SMALL) . $str;
-# if (length($str) > $BASE_LEN)
-# {
-# push @d, substr($str,-$BASE_LEN,$BASE_LEN); # extract one piece
-# substr($str,-$BASE_LEN,$BASE_LEN) = ''; # remove it
-# }
-# }
-# push @d, $str if $str !~ /^0*$/; # extract last piece
-# @$x = @d;
-# $x->[-1] = int($x->[-1]); # strip leading zero
-# $x;
-
- my $ret = "";
- my $l = scalar @$x; # number of parts
- $l --; $ret .= int($x->[$l]); $l--;
- my $z = '0' x ($BASE_LEN_SMALL-1);
- while ($l >= 0)
- {
- $ret .= substr($z.$x->[$l],-$BASE_LEN_SMALL);
- $l--;
- }
- my $str = _new($c,\$ret); # make array
- @$x = @$str; # clobber contents of $x
- $x->[-1] = int($x->[-1]); # strip leading zero
- }
-
-sub _to_small
- {
- # take an array in base $BASE_LEN and convert it in-place to $BASE_LEN_SMALL
- my ($c,$x) = @_;
-
- return $x if $LEN_CONVERT == 0; # nothing to do
- return $x if @$x == 1 && length(int($x->[0])) <= $BASE_LEN_SMALL;
-
- my $d = _str($c,$x);
- my $il = length($$d)-1;
- ## this leaves '00000' instead of int 0 and will be corrected after any op
- # clobber contents of $x
- @$x = reverse(unpack("a" . ($il % $BASE_LEN_SMALL+1)
- . ("a$BASE_LEN_SMALL" x ($il / $BASE_LEN_SMALL)), $$d));
-
- $x->[-1] = int($x->[-1]); # strip leading zero
- }
-
###############################################################################
sub _new
# modifies first arg, second need not be different from first
my ($c,$xv,$yv) = @_;
- # shortcut for two very short numbers (improved by Nathan Zook)
- # works also if xv and yv are the same reference
- if ((@$xv == 1) && (@$yv == 1))
+ if (@$yv == 1)
{
- if (($xv->[0] *= $yv->[0]) >= $MBASE)
- {
- $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $MBASE;
- };
- return $xv;
- }
- # shortcut for result == 0
- if ( ((@$xv == 1) && ($xv->[0] == 0)) ||
- ((@$yv == 1) && ($yv->[0] == 0)) )
- {
- @$xv = (0);
+ # shortcut for two very short numbers (improved by Nathan Zook)
+ # works also if xv and yv are the same reference, and handles also $x == 0
+ if (@$xv == 1)
+ {
+ if (($xv->[0] *= $yv->[0]) >= $MBASE)
+ {
+ $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $MBASE;
+ };
+ return $xv;
+ }
+ # $x * 0 => 0
+ if ($yv->[0] == 0)
+ {
+ @$xv = (0);
+ return $xv;
+ }
+ # multiply a large number a by a single element one, so speed up
+ my $y = $yv->[0]; my $car = 0;
+ foreach my $i (@$xv)
+ {
+ $i = $i * $y + $car; $car = int($i * $RBASE); $i -= $car * $MBASE;
+ }
+ push @$xv, $car if $car != 0;
return $xv;
}
+ # shortcut for result $x == 0 => result = 0
+ return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) );
# since multiplying $x with $x fails, make copy in this case
$yv = [@$xv] if $xv == $yv; # same references?
- if ($LEN_CONVERT != 0)
- {
- $c->_to_small($xv); $c->_to_small($yv);
- }
-
my @prod = (); my ($prod,$car,$cty,$xi,$yi);
for $xi (@$xv)
$xi = shift @prod || 0; # || 0 makes v5.005_3 happy
}
push @$xv, @prod;
- if ($LEN_CONVERT != 0)
- {
- $c->_to_large($yv);
- $c->_to_large($xv);
- }
- else
- {
- __strip_zeros($xv);
- }
+ __strip_zeros($xv);
$xv;
}
# modifies first arg, second need not be different from first
my ($c,$xv,$yv) = @_;
- # shortcut for two very short numbers (improved by Nathan Zook)
- # works also if xv and yv are the same reference
- if ((@$xv == 1) && (@$yv == 1))
+ if (@$yv == 1)
{
- if (($xv->[0] *= $yv->[0]) >= $MBASE)
- {
- $xv->[0] =
- $xv->[0] - ($xv->[1] = int($xv->[0] / $MBASE)) * $MBASE;
- };
- return $xv;
- }
- # shortcut for result == 0
- if ( ((@$xv == 1) && ($xv->[0] == 0)) ||
- ((@$yv == 1) && ($yv->[0] == 0)) )
- {
- @$xv = (0);
+ # shortcut for two small numbers, also handles $x == 0
+ if (@$xv == 1)
+ {
+ # shortcut for two very short numbers (improved by Nathan Zook)
+ # works also if xv and yv are the same reference, and handles also $x == 0
+ if (($xv->[0] *= $yv->[0]) >= $MBASE)
+ {
+ $xv->[0] =
+ $xv->[0] - ($xv->[1] = int($xv->[0] / $MBASE)) * $MBASE;
+ };
+ return $xv;
+ }
+ # $x * 0 => 0
+ if ($yv->[0] == 0)
+ {
+ @$xv = (0);
+ return $xv;
+ }
+ # multiply a large number a by a single element one, so speed up
+ my $y = $yv->[0]; my $car = 0;
+ foreach my $i (@$xv)
+ {
+ $i = $i * $y + $car; $car = int($i / $MBASE); $i -= $car * $MBASE;
+ }
+ push @$xv, $car if $car != 0;
return $xv;
}
+ # shortcut for result $x == 0 => result = 0
+ return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) );
-
# since multiplying $x with $x fails, make copy in this case
$yv = [@$xv] if $xv == $yv; # same references?
- if ($LEN_CONVERT != 0)
- {
- $c->_to_small($xv); $c->_to_small($yv);
- }
-
my @prod = (); my ($prod,$car,$cty,$xi,$yi);
for $xi (@$xv)
{
$xi = shift @prod || 0; # || 0 makes v5.005_3 happy
}
push @$xv, @prod;
- if ($LEN_CONVERT != 0)
- {
- $c->_to_large($yv);
- $c->_to_large($xv);
- }
- else
- {
- __strip_zeros($xv);
- }
+ __strip_zeros($xv);
$xv;
}
}
my $y = [ @$yorg ]; # always make copy to preserve
- if ($LEN_CONVERT != 0)
- {
- $c->_to_small($x); $c->_to_small($y);
- }
my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0);
}
@$x = @q;
my $d = \@d;
- if ($LEN_CONVERT != 0)
- {
- $c->_to_large($x); $c->_to_large($d);
- }
- else
- {
- __strip_zeros($x);
- __strip_zeros($d);
- }
+ __strip_zeros($x);
+ __strip_zeros($d);
return ($x,$d);
}
@$x = @q;
- if ($LEN_CONVERT != 0)
- {
- $c->_to_large($x);
- }
- else
- {
- __strip_zeros($x);
- }
+ __strip_zeros($x);
$x;
}
# in list context
my ($c,$x,$yorg) = @_;
+ # the general div algorithmn here is about O(N*N) and thus quite slow, so
+ # we first check for some special cases and use shortcuts to handle them.
+
+ # This works, because we store the numbers in a chunked format where each
+ # element contains 5..7 digits (depending on system).
+
+ # if both numbers have only one element:
if (@$x == 1 && @$yorg == 1)
{
# shortcut, $yorg and $x are two small numbers
return $x;
}
}
+ # if x has more than one, but y has only one element:
if (@$yorg == 1)
{
my $rem;
return ($x,$rem) if wantarray;
return $x;
}
+ # now x and y have more than one element
- my $y = [ @$yorg ]; # always make copy to preserve
- if ($LEN_CONVERT != 0)
+ # check whether y has more elements than x, if yet, the result will be 0
+ if (@$yorg > @$x)
{
- $c->_to_small($x); $c->_to_small($y);
+ my $rem;
+ $rem = [@$x] if wantarray; # make copy
+ splice (@$x,1); # keep ref to original array
+ $x->[0] = 0; # set to 0
+ return ($x,$rem) if wantarray; # including remainder?
+ return $x;
}
+ # check whether the numbers have the same number of elements, in that case
+ # the result will fit into one element and can be computed efficiently
+ if (@$yorg == @$x)
+ {
+ my $rem;
+ # if $yorg has more digits than $x (it's leading element is longer than
+ # the one from $x), the result will also be 0:
+ if (length(int($yorg->[-1])) > length(int($x->[-1])))
+ {
+ $rem = [@$x] if wantarray; # make copy
+ splice (@$x,1); # keep ref to org array
+ $x->[0] = 0; # set to 0
+ return ($x,$rem) if wantarray; # including remainder?
+ 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
+ # hm, same lengths, but same contents? So we need to check all parts:
+ my $a = 0; my $j = scalar @$x - 1;
+ # manual way (abort if unequal, good for early ne)
+ while ($j >= 0)
+ {
+ last if ($a = $x->[$j] - $yorg->[$j]); $j--;
+ }
+ # a < 0: x < y, a == 0 => x == y, a > 0: x > y
+ if ($a <= 0)
+ {
+ $rem = [@$x] if wantarray;
+ splice(@$x,1);
+ $x->[0] = 0; # if $a < 0
+ if ($a == 0)
+ {
+ # $x == $y
+ $x->[0] = 1;
+ }
+ return ($x,$rem) if wantarray;
+ return $x;
+ }
+ # $x >= $y, proceed normally
+ }
+
+ }
+
+ # all other cases:
+
+ my $y = [ @$yorg ]; # always make copy to preserve
my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0);
}
@$x = @q;
my $d = \@d;
- if ($LEN_CONVERT != 0)
- {
- $c->_to_large($x); $c->_to_large($d);
- }
- else
- {
- __strip_zeros($x);
- __strip_zeros($d);
- }
+ __strip_zeros($x);
+ __strip_zeros($d);
return ($x,$d);
}
@$x = @q;
- if ($LEN_CONVERT != 0)
- {
- $c->_to_large($x);
- }
- else
- {
- __strip_zeros($x);
- }
+ __strip_zeros($x);
$x;
}
my $dst = 0; # destination
my $src = _num($c,$y); # as normal int
my $xlen = (@$x-1)*$BASE_LEN+length(int($x->[-1])); # len of x in digits
- if ($src > $xlen)
+ if ($src > $xlen or ($src == $xlen and ! defined $x->[1]))
{
# 12345 67890 shifted right by more than 10 digits => 0
splice (@$x,1); # leave only one element
$cx = [$last];
return $cx;
}
- my $n = _copy($c,$cx);
- $cx = [$last];
+ # now we must do the left over steps
- while (!(@$n == 1 && $n->[0] == $step))
+ # 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.
+ my $zero_elements = 0;
+ $cx = [$last];
+ if (scalar @$cx == 1)
{
- _mul($c,$cx,$n); _dec($c,$n);
+ my $n = _copy($c,$cx);
+ # no need to test for $steps, since $steps is a scalar and we stop before
+ while (scalar @$n != 1)
+ {
+ if ($cx->[0] == 0)
+ {
+ $zero_elements ++; shift @$cx;
+ }
+ _mul($c,$cx,$n); _dec($c,$n);
+ }
+ $n = $n->[0]; # "convert" to scalar
+ }
+
+ # the left over steps will fit into a scalar, so we can speed it up
+ while ($n != $step)
+ {
+ if ($cx->[0] == 0)
+ {
+ $zero_elements ++; shift @$cx;
+ }
+ _mul($c,$cx,[$n]); $n--;
+ }
+ # multiply in the zeros again
+ while ($zero_elements-- > 0)
+ {
+ unshift @$cx, 0;
}
$cx;
}
sub _sqrt
{
# square-root of $x in place
- # Compute a guess of the result (rule of thumb), then improve it via
+ # Compute a guess of the result (by rule of thumb), then improve it via
# Newton's method.
my ($c,$x) = @_;
$x;
}
+sub _root
+ {
+ # take n'th root of $x in place (n >= 3)
+ # Compute a guess of the result (by rule of thumb), then improve it via
+ # Newton's method.
+ my ($c,$x,$n) = @_;
+
+ if (scalar @$x == 1)
+ {
+ if (scalar @$n > 1)
+ {
+ # result will always be smaller than 2 so trunc to 1 at once
+ $x->[0] = 1;
+ }
+ else
+ {
+ # fit's into one Perl scalar, so result can be computed directly
+ $x->[0] = int( $x->[0] ** (1 / $n->[0]) );
+ }
+ return $x;
+ }
+
+ # XXX TODO
+
+ $x;
+ }
+
##############################################################################
# binary stuff
# convert a decimal number to hex (ref to array, return ref to string)
my ($c,$x) = @_;
+ # fit's into one element
+ if (@$x == 1)
+ {
+ my $t = '0x' . sprintf("%x",$x->[0]);
+ return \$t;
+ }
+
my $x1 = _copy($c,$x);
my $es = '';
# convert a decimal number to bin (ref to array, return ref to string)
my ($c,$x) = @_;
+ # fit's into one element
+ if (@$x == 1)
+ {
+ my $t = '0b' . sprintf("%b",$x->[0]);
+ return \$t;
+ }
my $x1 = _copy($c,$x);
my $es = '';
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.
+functions can also be used to support Math::BigInt, like Math::BigInt::Pari.
=head1 DESCRIPTION
'libname' is either the long name ('Math::BigInt::Pari'), or only the short
version like 'Pari'.
-=head1 EXPORT
+=head1 STORAGE
+
+=head1 METHODS
The following functions MUST be defined in order to support the use by
Math::BigInt:
In list context, returns (result,remainder).
NOTE: this is integer math, so no
fractional part will be returned.
+ The second operand will be not be 0, so no need to
+ check for that.
_sub(obj,obj) Simple subtraction of 1 object from another
a third, optional parameter indicates that the params
are swapped. In this case, the first param needs to
_or(obj1,obj2) OR (bit-wise) object 1 with object 2
_mod(obj,obj) Return remainder of div of the 1st by the 2nd object
- _sqrt(obj) return the square root of object (truncate to int)
+ _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)
_fac(obj) return factorial of object 1 (1*2*3*4..)
_pow(obj,obj) return object 1 to the power of object 2
_gcd(obj,obj) return Greatest Common Divisor of two objects
Input strings come in as unsigned but with prefix (i.e. as '123', '0xabc'
or '0b1101').
-Testing of input parameter validity is done by the caller, so you need not
-worry about underflow (f.i. in C<_sub()>, C<_dec()>) nor about division by
-zero or similar cases.
+So the library needs only to deal with unsigned big integers. Testing of input
+parameter validity is done by the caller, so you need not worry about
+underflow (f.i. in C<_sub()>, C<_dec()>) nor about division by zero or similar
+cases.
The first parameter can be modified, that includes the possibility that you
return a reference to a completely different object instead. Although keeping
the reference and just changing it's contents is prefered over creating and
returning a different reference.
-Return values are always references to objects or strings. Exceptions are
-C<_lsft()> and C<_rsft()>, which return undef if they can not shift the
-argument. This is used to delegate shifting of bases different than the one
-you can support back to Math::BigInt, which will use some generic code to
-calculate the result.
+Return values are always references to objects, strings, or true/false for
+comparisation routines.
+
+Exceptions are C<_lsft()> and C<_rsft()>, which return undef if they can not
+shift the argument. This is used to delegate shifting of bases different than
+the one you can support back to Math::BigInt, which will use some generic code
+to calculate the result.
=head1 WRAP YOUR OWN
=head1 AUTHORS
Original math code by Mark Biggar, rewritten by Tels L<http://bloodgate.com/>
-in late 2000, 2001.
+in late 2000.
Seperated from BigInt and shaped API with the help of John Peacock.
+Fixed/enhanced by Tels 2001-2002.
=head1 SEE ALSO
L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect>,
-L<Math::BigInt::GMP>, L<Math::BigInt::Cached> and L<Math::BigInt::Pari>.
+L<Math::BigInt::GMP>, L<Math::BigInt::FastCalc> and L<Math::BigInt::Pari>.
=cut
}
print "# INC = @INC\n";
- plan tests => 1643;
+ plan tests => 1760;
}
use Math::BigFloat lib => 'BareCalc';
}
print "# INC = @INC\n";
- plan tests => 2527;
+ plan tests => 2648;
}
use Math::BigInt lib => 'BareCalc';
}
print "# INC = @INC\n";
- plan tests => 669
- + 1; # our onw tests
+ plan tests => 679
+ + 1; # our own tests
}
print "# ",Math::BigInt->config()->{lib},"\n";
{
@args = split(/:/,$_,99); $ans = pop(@args);
}
- $try = "\$x = new $class \"$args[0]\";";
+ $try = "\$x = $class->new('$args[0]');";
if ($f eq "fnorm")
{
$try .= "\$x;";
$try .= "$setup; \$x->ffround($args[1]);";
} elsif ($f eq "fsqrt") {
$try .= "$setup; \$x->fsqrt();";
- } elsif ($f eq "flog") {
- $try .= "$setup; \$x->flog();";
} elsif ($f eq "ffac") {
$try .= "$setup; \$x->ffac();";
+ } elsif ($f eq "flog") {
+ if ($args[1] ne '')
+ {
+ $try .= "\$y = $class->new($args[1]);";
+ $try .= "$setup; \$x->flog(\$y);";
+ }
+ else
+ {
+ $try .= "$setup; \$x->flog();";
+ }
}
else
{
- $try .= "\$y = new $class \"$args[1]\";";
+ $try .= "\$y = $class->new(\"$args[1]\");";
if ($f eq "fcmp") {
$try .= '$x <=> $y;';
} elsif ($f eq "facmp") {
$try .= '$x->facmp($y);';
} elsif ($f eq "fpow") {
$try .= '$x ** $y;';
+ } elsif ($f eq "froot") {
+ $try .= "$setup; \$x->froot(\$y);";
} elsif ($f eq "fadd") {
$try .= '$x + $y;';
} elsif ($f eq "fsub") {
ok ($ans,"$class 4 5");
}
+#############################################################################
+# is_one('-') (broken until v1.64)
+
+ok ($class->new(-1)->is_one(),0);
+ok ($class->new(-1)->is_one('-'),1);
+
1; # all done
###############################################################################
__DATA__
$div_scale = 40;
&flog
-0:NaN
--1:NaN
--2:NaN
-1:0
+0::NaN
+-1::NaN
+-2::NaN
+# base > 0, base != 1
+2:-1:NaN
+2:0:NaN
+2:1:NaN
+# log(1) is always 1, regardless of $base
+1::0
+1:1:0
+1:2:0
# this is too slow for the testsuite
#2:0.6931471805599453094172321214581765680755
#2.718281828:0.9999999998311266953289851340574956564911
#$div_scale = 20;
#2.718281828:0.99999999983112669533
-# too slow, too (or hangs?)
+# too slow, too
#123:4.8112184355
$div_scale = 14;
#10:0:2.302585092994
#1000:0:6.90775527898214
#100:0:4.60517018598809
-2:0:0.69314718055995
+2::0.69314718055995
#3.1415:0:1.14470039286086
+# too slow
#12345:0:9.42100640177928
#0.001:0:-6.90775527898214
# reset for further tests
$div_scale = 40;
-1:0
+1::0
&frsft
NaNfrsft:2:NaN
0:2:0
0.000000001:0
0.0000000001:0
0.00000000001:0
+0.12345:0
+0.123456:0
+0.1234567:0
+0.12345678:0
+0.123456789:0
&finf
1:+:inf
2:-:-inf
10:3628800
11:39916800
12:479001600
+&froot
+# sqrt()
++0:2:0
++1:2:1
+-1:2:NaN
+# -$x ** (1/2) => -$y, but not in froot()
+-123.456:2:NaN
++inf:2:inf
+-inf:2:NaN
+2:2:1.41421356237309504880168872420969807857
+-2:2:NaN
+4:2:2
+9:2:3
+16:2:4
+100:2:10
+123.456:2:11.11107555549866648462149404118219234119
+15241.38393:2:123.4559999756998444766131352122991626468
+1.44:2:1.2
+12:2:3.464101615137754587054892683011744733886
+0.49:2:0.7
+0.0049:2:0.07
+# invalid ones
+1:NaN:NaN
+-1:NaN:NaN
+0:NaN:NaN
+-inf:NaN:NaN
++inf:NaN:NaN
+NaN:0:NaN
+NaN:2:NaN
+NaN:inf:NaN
+NaN:inf:NaN
+12:-inf:NaN
+12:inf:NaN
++0:0:NaN
++1:0:NaN
+-1:0:NaN
+-2:0:NaN
+-123.45:0:NaN
++inf:0:NaN
+12:1:12
+-12:1:NaN
+8:-1:NaN
+-8:-1:NaN
+# cubic root
+8:3:2
+-8:3:NaN
+# fourths root
+16:4:2
+81:4:3
&fsqrt
+0:0
-1:NaN
144e20:120000000000
# proved to be an endless loop under 7-9
12:3.464101615137754587054892683011744733886
+0.49:0.7
+0.0049:0.07
&is_nan
123:0
abc:1
-51:-51
-51.2:-52
12.2:12
+0.12345:0
+0.123456:0
+0.1234567:0
+0.12345678:0
+0.123456789:0
&fceil
0:0
abc:NaN
}
print "# INC = @INC\n";
- plan tests => 1643
+ plan tests => 1760
+ 2; # own tests
}
BEGIN
{
- plan tests => 276;
+ plan tests => 258;
}
# testing of Math::BigInt::Calc
# _sqrt
$x = $C->_new(\"144"); ok (${$C->_str($C->_sqrt($x))},'12');
+$x = $C->_new(\"144000000000000"); ok (${$C->_str($C->_sqrt($x))},'12000000');
+
+# _root
+$x = $C->_new(\"81"); my $n = $C->_new(\"3"); # 4*4*4 = 64, 5*5*5 = 125
+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');
# _fac
$x = $C->_new(\"0"); ok (${$C->_str($C->_fac($x))},'1');
# _as_hex, _as_bin
ok (${$C->_str(scalar $C->_from_hex( $C->_as_hex( $C->_new(\"128"))))}, 128);
ok (${$C->_str(scalar $C->_from_bin( $C->_as_bin( $C->_new(\"128"))))}, 128);
+ok (${$C->_str(scalar $C->_from_hex( $C->_as_hex( $C->_new(\"0"))))}, 0);
+ok (${$C->_str(scalar $C->_from_bin( $C->_as_bin( $C->_new(\"0"))))}, 0);
+ok ( ${$C->_as_hex( $C->_new(\"0"))}, '0x0');
+ok ( ${$C->_as_bin( $C->_new(\"0"))}, '0b0');
+ok ( ${$C->_as_hex( $C->_new(\"12"))}, '0xc');
+ok ( ${$C->_as_bin( $C->_new(\"12"))}, '0b1100');
# _check
$x = $C->_new(\"123456789");
ok (@$x,1); ok ($x->[0],0);
}
-###############################################################################
-# _to_large and _to_small (last since they toy with BASE_LEN etc)
-
-$C->_base_len(5,7); $x = [ qw/67890 12345 67890 12345/ ]; $C->_to_large($x);
-ok (@$x,3);
-ok ($x->[0], '4567890'); ok ($x->[1], '7890123'); ok ($x->[2], '123456');
-
-$C->_base_len(5,7); $x = [ qw/54321 54321 54321 54321/ ]; $C->_to_large($x);
-ok (@$x,3);
-ok ($x->[0], '2154321'); ok ($x->[1], '4321543'); ok ($x->[2], '543215');
-
-$C->_base_len(6,7); $x = [ qw/654321 654321 654321 654321/ ];
-$C->_to_large($x); ok (@$x,4);
-ok ($x->[0], '1654321'); ok ($x->[1], '2165432');
-ok ($x->[2], '3216543'); ok ($x->[3], '654');
-
-$C->_base_len(5,7); $C->_to_small($x); ok (@$x,5);
-ok ($x->[0], '54321'); ok ($x->[1], '43216');
-ok ($x->[2], '32165'); ok ($x->[3], '21654');
-ok ($x->[4], '6543');
-
-$C->_base_len(7,10); $x = [ qw/0000000 0000000 9999990 9999999/ ];
-$C->_to_large($x); ok (@$x,3);
-ok ($x->[0], '0000000000'); ok ($x->[1], '9999900000');
-ok ($x->[2], '99999999');
-
-$C->_base_len(7,10); $x = [ qw/0000000 0000000 9999990 9999999 99/ ];
-$C->_to_large($x); ok (@$x,3);
-ok ($x->[0], '0000000000'); ok ($x->[1], '9999900000');
-ok ($x->[2], '9999999999');
-
# done
1;
{
$try .= "\$x >> \$y;";
}
+ }elsif ($f eq "broot"){
+ $try .= "\$x->broot(\$y);";
}elsif ($f eq "band"){
$try .= "\$x & \$y;";
}elsif ($f eq "bior"){
ok ($class->binf('-inf'),'-inf');
###############################################################################
+# is_one('-')
+
+ok ($class->new(1)->is_one('-'),0);
+ok ($class->new(-1)->is_one('-'),1);
+ok ($class->new(1)->is_one(),1);
+ok ($class->new(-1)->is_one(),0);
+
+###############################################################################
# all tests done
1;
-8:0:-inf,-8
-inf:0:-inf,-inf
0:0:NaN,NaN
+# test the shortcut in Calc if @$x == @$yorg
+1234567812345678:123456712345678:10,688888898
+12345671234567:1234561234567:10,58888897
+123456123456:12345123456:10,4888896
+1234512345:123412345:10,388895
+1234567890999999999:1234567890:1000000000,999999999
+1234567890000000000:1234567890:1000000000,0
+1234567890999999999:9876543210:124999998,9503086419
+1234567890000000000:9876543210:124999998,8503086420
+96969696969696969696969696969678787878626262626262626262626262:484848484848484848484848486666666666666689898989898989898989:199,484848484848484848484848123012121211954972727272727272727451
&bdiv
abc:abc:NaN
abc:1:NaN
14:3:4
# bug in Calc with '99999' vs $BASE-1
10000000000000000000000000000000000000000000000000000000000000000000000000000000000:10000000375084540248994272022843165711074:999999962491547381984643365663244474111576
+# test the shortcut in Calc if @$x == @$yorg
+1234567812345678:123456712345678:10
+12345671234567:1234561234567:10
+123456123456:12345123456:10
+1234512345:123412345:10
+1234567890999999999:1234567890:1000000000
+1234567890000000000:1234567890:1000000000
+1234567890999999999:9876543210:124999998
+1234567890000000000:9876543210:124999998
+96969696969696969696969696969678787878626262626262626262626262:484848484848484848484848486666666666666689898989898989898989:199
&bmodinv
# format: number:modulus:result
# bmodinv Data errors
4:24
5:120
6:720
+7:5040
+8:40320
+9:362880
10:3628800
11:39916800
12:479001600
10000000000000000:17
-123:3
215960156869840440586892398248:30
+&broot
+# sqrt()
++0:2:0
++1:2:1
+-1:2:NaN
+# -$x ** (1/2) => -$y, but not in froot()
+-123:2:NaN
++inf:2:inf
+-inf:2:NaN
+2:2:1
+-2:2:NaN
+4:2:2
+9:2:3
+16:2:4
+100:2:10
+123:2:11
+15241:2:123
+144:2:12
+12:2:3
+0.49:2:0
+0.0049:2:0
+# invalid ones
+1:NaN:NaN
+-1:NaN:NaN
+0:NaN:NaN
+-inf:NaN:NaN
++inf:NaN:NaN
+NaN:0:NaN
+NaN:2:NaN
+NaN:inf:NaN
+NaN:inf:NaN
+12:-inf:NaN
+12:inf:NaN
++0:0:NaN
++1:0:NaN
+-1:0:NaN
+-2:0:NaN
+-123.45:0:NaN
++inf:0:NaN
+12:1:12
+-12:1:NaN
+8:-1:NaN
+-8:-1:NaN
+# cubic root
+8:3:2
+-8:3:NaN
+# fourths root
+#16:4:2
+#81:4:3
&bsqrt
145:12
144:12
-2:NaN
-123:NaN
Nan:NaN
-+inf:NaN
++inf:inf
+-inf:NaN
&bround
$round_mode('trunc')
0:12:0
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 2527;
+ plan tests => 2648;
}
use Math::BigInt;
BEGIN
{
$| = 1;
- # chdir 't' if -d 't';
- unshift @INC, '../lib'; # for running manually
+ # to locate the testing files
+ my $location = $0; $location =~ s/bigints.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ @INC = qw(../t/lib); # testing with the core distribution
+ }
+ unshift @INC, '../lib'; # for testing manually
+ 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 => 51;
}
--- /dev/null
+#!/usr/bin/perl -w
+
+# Test blog function (and bpow, since it uses blog).
+
+# It is too slow to be simple included in bigfltpm.inc, where it would get
+# executed 3 times. One time would be under BareCalc, which shouldn't make any
+# difference since there is no CALC->_log() function, and one time under a
+# subclass, which *should* work.
+
+# But it is better to test the numerical functionality, instead of not testing
+# it at all (which did lead to wrong answers for 0 < $x < 1 in blog() in
+# versions up to v1.63, and for bsqrt($x) when $x << 1 for instance).
+
+use Test;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/biglog.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../lib);
+ }
+ unshift @INC, '../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 => 50;
+ }
+
+use Math::BigFloat;
+use Math::BigInt;
+
+my $cl = "Math::BigFloat";
+
+# these tests are now really fast, since they collapse to blog(10), basically
+# Don't attempt to run them with older versions. You are warned.
+
+# $x < 0 => NaN
+ok ($cl->new(-2)->blog(), 'NaN');
+ok ($cl->new(-1)->blog(), 'NaN');
+ok ($cl->new(-10)->blog(), 'NaN');
+ok ($cl->new(-2,2)->blog(), 'NaN');
+
+my $ten = $cl->new(10)->blog();
+
+# 10 is cached (up to 75 digits)
+ok ($cl->new(10)->blog(), '2.302585092994045684017991454684364207601');
+
+# 0.1 is using the cached value for log(10), too
+
+ok ($cl->new(0.1)->blog(), -$ten);
+ok ($cl->new(0.01)->blog(), -$ten * 2);
+ok ($cl->new(0.001)->blog(), -$ten * 3);
+ok ($cl->new(0.0001)->blog(), -$ten * 4);
+
+# also cached
+ok ($cl->new(2)->blog(), '0.6931471805599453094172321214581765680755');
+
+# These are still slow, so do them only to 10 digits
+
+ok ($cl->new('0.2')->blog(undef,10), '-1.609437912');
+ok ($cl->new('0.3')->blog(undef,10), '-1.203972804');
+ok ($cl->new('0.4')->blog(undef,10), '-0.9162907319');
+ok ($cl->new('0.5')->blog(undef,10), '-0.6931471806');
+ok ($cl->new('0.6')->blog(undef,10), '-0.5108256238');
+ok ($cl->new('0.7')->blog(undef,10), '-0.3566749439');
+ok ($cl->new('0.8')->blog(undef,10), '-0.2231435513');
+ok ($cl->new('0.9')->blog(undef,10), '-0.1053605157');
+
+ok ($cl->new('9')->blog(undef,10), '2.197224577');
+
+ok ($cl->new('10')->blog(10,10), '1.000000000');
+ok ($cl->new('20')->blog(20,10), '1.000000000');
+ok ($cl->new('100')->blog(100,10), '1.000000000');
+
+ok ($cl->new('100')->blog(10,10), '2.000000000'); # 10 ** 2 == 100
+ok ($cl->new('400')->blog(20,10), '2.000000000'); # 20 ** 2 == 400
+
+ok ($cl->new('4')->blog(2,10), '2.000000000'); # 2 ** 2 == 4
+ok ($cl->new('16')->blog(2,10), '4.000000000'); # 2 ** 4 == 16
+
+ok ($cl->new('1.2')->bpow('0.3',10), '1.056219968');
+ok ($cl->new('10')->bpow('0.6',10), '3.981071706');
+
+# blog should handle bigint input
+# TODO: should be 2
+#ok (Math::BigFloat::blog(Math::BigInt->new(100),10), 2);
+ok (Math::BigFloat::blog(Math::BigInt->new(100),10), 'NaN');
+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');
+test_bpow ('20','0.5',10, '4.472135955');
+test_bpow ('2','0.5',10, '1.414213562');
+test_bpow ('0.2','0.5',10, '0.4472135955');
+test_bpow ('0.02','0.5',10, '0.1414213562');
+test_bpow ('0.49','0.5',undef , '0.7');
+test_bpow ('0.49','0.5',10 , '0.7000000000');
+test_bpow ('0.002','0.5',10, '0.04472135955');
+test_bpow ('0.0002','0.5',10, '0.01414213562');
+test_bpow ('0.0049','0.5',undef,'0.07');
+test_bpow ('0.0049','0.5',10 , '0.07000000000');
+test_bpow ('0.000002','0.5',10, '0.001414213562');
+test_bpow ('0.021','0.5',10, '0.1449137675');
+test_bpow ('1.2','0.5',10, '1.095445115');
+test_bpow ('1.23','0.5',10, '1.109053651');
+test_bpow ('12.3','0.5',10, '3.507135583');
+
+test_bpow ('9.9','0.5',10, '3.146426545');
+test_bpow ('9.86902225','0.5',10, '3.141500000');
+test_bpow ('9.86902225','0.5',undef, '3.1415');
+
+test_bpow ('0.2','0.41',10, '0.5169187652');
+
+sub test_bpow
+ {
+ my ($x,$y,$scale,$result) = @_;
+
+ print "# Tried: $x->bpow($y,$scale);\n"
+ unless ok ($cl->new($x)->bpow($y,$scale),$result);
+ }
+
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 10;
+ plan tests => 51;
}
-# test whether Math::BigInt constant works
+# test whether Math::BigInt->config() and Math::BigFloat->config() works
use Math::BigInt;
+use Math::BigFloat;
-ok (Math::BigInt->can('config'));
+my $mbi = 'Math::BigInt'; my $mbf = 'Math::BigFloat';
-my $cfg = Math::BigInt->config();
+##############################################################################
+# BigInt
+
+ok ($mbi->can('config'));
+
+my $cfg = $mbi->config();
+
+ok (ref($cfg),'HASH');
+
+ok ($cfg->{lib},'Math::BigInt::Calc');
+ok ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION);
+ok ($cfg->{class},$mbi);
+ok ($cfg->{upgrade}||'','');
+ok ($cfg->{div_scale},40);
+
+ok ($cfg->{precision}||0,0); # should test for undef
+ok ($cfg->{accuracy}||0,0);
+
+ok ($cfg->{round_mode},'even');
+
+ok ($cfg->{trap_nan},0);
+ok ($cfg->{trap_inf},0);
+
+##############################################################################
+# BigFloat
+
+ok ($mbf->can('config'));
+
+$cfg = $mbf->config();
ok (ref($cfg),'HASH');
ok ($cfg->{lib},'Math::BigInt::Calc');
+ok ($cfg->{with},$mbi);
ok ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION);
-ok ($cfg->{class},'Math::BigInt');
+ok ($cfg->{class},$mbf);
ok ($cfg->{upgrade}||'','');
ok ($cfg->{div_scale},40);
ok ($cfg->{round_mode},'even');
+ok ($cfg->{trap_nan},0);
+ok ($cfg->{trap_inf},0);
+
+##############################################################################
+# test setting values
+
+my $test = {
+ trap_nan => 1,
+ trap_inf => 1,
+ accuracy => 2,
+ precision => 3,
+ round_mode => 'zero',
+ div_scale => '100',
+ upgrade => 'Math::BigInt::SomeClass',
+ downgrade => 'Math::BigInt::SomeClass',
+ };
+
+my $c;
+
+foreach my $key (keys %$test)
+ {
+ # see if setting in MBI works
+ eval ( "$mbi\->config( $key => '$test->{$key}' );" );
+ $c = $mbi->config(); ok ("$key = $c->{$key}", "$key = $test->{$key}");
+ $c = $mbf->config();
+ # see if setting it in MBI leaves MBF alone
+ if (($c->{$key}||0) ne $test->{$key})
+ {
+ ok (1,1);
+ }
+ else
+ {
+ ok ("$key eq $c->{$key}","$key ne $test->{$key}");
+ }
+
+ # see if setting in MBF works
+ eval ( "$mbf\->config( $key => '$test->{$key}' );" );
+ $c = $mbf->config(); ok ("$key = $c->{$key}", "$key = $test->{$key}");
+ }
+
+##############################################################################
+# test setting illegal keys (should croak)
+
+my $never_reached = 0;
+eval ("$mbi\->config( 'some_garbage' => 1 ); $never_reached = 1;");
+ok ($never_reached,0);
+
+$never_reached = 0;
+eval ("$mbf\->config( 'some_garbage' => 1 ); $never_reached = 1;");
+ok ($never_reached,0);
+
+# this does not work. Why?
+#ok (@!, "Illegal keys 'some_garbage' passed to Math::BigInt->config() at ./config.t line 104");
+
# all tests done
}
print "# INC = @INC\n";
- # values groups oprators classes tests
- plan tests => 7 * 6 * 5 * 4 * 2 +
- 7 * 6 * 2 * 4 * 1; # bmod
+ # values groups operators classes tests
+ plan tests => 7 * 6 * 5 * 4 * 2 +
+ 7 * 6 * 2 * 4 * 1; # bmod
}
use Math::BigInt;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
$count = 128;
- plan tests => $count*2;
+ plan tests => $count*4;
}
use Math::BigInt;
# print "# A $A\n# B $B\n";
if ($A->is_zero() || $B->is_zero())
{
- ok (1,1); ok (1,1); next;
+ for (1..4) { ok (1,1); } next;
}
# check that int(A/B)*B + A % B == A holds for all inputs
# $X = ($A/$B)*$B + 2 * ($A % $B) - ($A % $B);
($ADB,$AMB) = $A->copy()->bdiv($B);
- print "# ". join(' ',Math::BigInt::Calc->_base_len()),"\n"
+ print "# ". join(' ',Math::BigInt::Calc->_base_len()),"\n".
+ "# tried $ADB * $B + $two*$AMB - $AMB\n"
unless ok ($ADB*$B+$two*$AMB-$AMB,$As);
+ ok ($ADB*$B/$B,$ADB);
# swap 'em and try this, too
# $X = ($B/$A)*$A + $B % $A;
($ADB,$AMB) = $B->copy()->bdiv($A);
- print "# ". join(' ',Math::BigInt::Calc->_base_len()),"\n"
+ #print "check: $ADB $AMB";
+ print "# ". join(' ',Math::BigInt::Calc->_base_len()),"\n".
+ "# tried $ADB * $A + $two*$AMB - $AMB\n"
unless ok ($ADB*$A+$two*$AMB-$AMB,$Bs);
+ #print "$ADB * $A = ",$ADB * $A,"\n";
+ #print " +$two * $AMB = ",$ADB * $A + $two * $AMB,"\n";
+ #print " -$AMB = ",$ADB * $A + $two * $AMB - $AMB,"\n";
+ ok ($ADB*$A/$A,$ADB);
}
$mbf->round_mode('even');
$x = $mbf->new('740.7')->fdiv('6',4,undef,'zero'); ok ($x,'123.4');
+$x = $mbi->new('123456'); $y = $mbi->new('123456'); $y->{_a} = 6;
+ok ($x->bdiv($y),1); ok ($x->{_a},6); # carried over
+
+$x = $mbi->new('123456'); $y = $mbi->new('123456'); $x->{_a} = 6;
+ok ($x->bdiv($y),1); ok ($x->{_a},6); # carried over
+
+$x = $mbi->new('123456'); $y = $mbi->new('223456'); $y->{_a} = 6;
+ok ($x->bdiv($y),0); ok ($x->{_a},6); # carried over
+
+$x = $mbi->new('123456'); $y = $mbi->new('223456'); $x->{_a} = 6;
+ok ($x->bdiv($y),0); ok ($x->{_a},6); # carried over
+
###############################################################################
# test that bop(0) does the same than bop(undef)
# these should warn, since '3.17' is a NaN in BigInt and thus >= returns undef
$warn = ''; eval "\$z = 3.17 <= \$y"; ok ($z, 1);
print "# Got: '$warn'\n" unless
-ok ($warn =~ /^Use of uninitialized value in numeric le \(<=\) at/);
+ok ($warn =~ /^Use of uninitialized value (in numeric le \(<=\) |)at/);
$warn = ''; eval "\$z = \$y >= 3.17"; ok ($z, 1);
print "# Got: '$warn'\n" unless
-ok ($warn =~ /^Use of uninitialized value in numeric ge \(>=\) at/);
+ok ($warn =~ /^Use of uninitialized value (in numeric ge \(>=\) |)at/);
# XXX TODO breakage:
# $z = $y->copy()->bmul($u,2,0,'odd'); ok ($z,31000);
@params = $x->_find_round_parameters(undef,-2);
ok (scalar @params,1); # error, A and P defined
ok ($params[0],$x); # self
+ ok ($x->is_nan(),1); # and must be NaN
${"$mbi\::accuracy"} = undef;
${"$mbi\::precision"} = 1;
@params = $x->_find_round_parameters(1,undef);
ok (scalar @params,1); # error, A and P defined
ok ($params[0],$x); # self
+ ok ($x->is_nan(),1); # and must be NaN
${"$mbi\::precision"} = undef; # reset
}
}
print "# INC = @INC\n";
- plan tests => 669
- + 16; # own tests
+ plan tests => 679
+ + 22; # own tests
}
use Math::BigInt 1.63;
ok ($Math::BigFloat::rnd_mode,'even');
my $x = eval '$mbi->round_mode("huhmbi");';
-ok ($@ =~ /^Unknown round mode huhmbi at/);
+print "# Got '$@'\n" unless
+ ok ($@ =~ /^Unknown round mode 'huhmbi' at/);
$x = eval '$mbf->round_mode("huhmbf");';
-ok ($@ =~ /^Unknown round mode huhmbf at/);
+print "# Got '$@'\n" unless
+ ok ($@ =~ /^Unknown round mode 'huhmbf' at/);
# old way (now with test for validity)
$x = eval '$Math::BigInt::rnd_mode = "huhmbi";';
-ok ($@ =~ /^Unknown round mode huhmbi at/);
+print "# Got '$@'\n" unless
+ ok ($@ =~ /^Unknown round mode 'huhmbi' at/);
$x = eval '$Math::BigFloat::rnd_mode = "huhmbf";';
-ok ($@ =~ /^Unknown round mode huhmbf at/);
+print "# Got '$@'\n" unless
+ ok ($@ =~ /^Unknown round mode 'huhmbf' at/);
# see if accessor also changes old variable
$mbi->round_mode('odd'); ok ($Math::BigInt::rnd_mode,'odd');
$mbf->round_mode('odd'); ok ($Math::BigInt::rnd_mode,'odd');
ok_undef ($class->accuracy()); # and now A must be cleared
}
+foreach my $class (qw/Math::BigInt Math::BigFloat/)
+ {
+ $class->accuracy(42);
+ my $x = $class->new(123); # $x gets A of 42, too!
+ ok ($x->accuracy(),42); # really?
+ ok ($x->accuracy(undef),42); # $x has no A, but the
+ # global is still in effect for $x
+ # so the return value of that operation should
+ # be 42, not undef
+ ok ($x->accuracy(),42); # so $x should still have A = 42
+ }
--- /dev/null
+#!/usr/bin/perl -w
+
+# check that simple requiring BigFloat and then bzero() works
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/req_mbf0.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 => 1;
+ }
+
+require Math::BigFloat; my $x = Math::BigFloat->bzero(); ok ($x,0);
+
+# all tests done
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# check that simple requiring BigFloat and then bone() works
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/req_mbf1.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 => 1;
+ }
+
+require Math::BigFloat; my $x = Math::BigFloat->bone(); ok ($x,1);
+
+# all tests done
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# check that simple requiring BigFloat and then bnan() works
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/req_mbfa.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 => 1;
+ }
+
+require Math::BigFloat; my $x = Math::BigFloat->bnan(1); ok ($x,'NaN');
+
+# all tests done
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# check that simple requiring BigFloat and then binf() works
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/req_mbfi.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 => 1;
+ }
+
+require Math::BigFloat; my $x = Math::BigFloat->binf(); ok ($x,'inf');
+
+# all tests done
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# check that simple requiring BigFloat and then new() works
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/req_mbfn.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 => 1;
+ }
+
+require Math::BigFloat; my $x = Math::BigFloat->new(1); ++$x; ok ($x,2);
+
+# all tests done
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# check that requiring BigFloat and then calling import() works
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/req_mbfw.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 => 3;
+ }
+
+# normal require that calls import automatically (we thus have MBI afterwards)
+require Math::BigFloat; my $x = Math::BigFloat->new(1); ++$x; ok ($x,2);
+
+ok (Math::BigFloat->config()->{with}, 'Math::BigInt' );
+
+# now override
+Math::BigFloat->import ( with => 'Math::BigInt::Subclass' );
+
+ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Subclass' );
+
+# all tests done
+
#!/usr/bin/perl -w
+# check that simple requiring BigInt works
+
use strict;
use Test;
}
print "# INC = @INC\n";
- plan tests => 1643
+ plan tests => 1760
+ 6; # + our own tests
}
}
print "# INC = @INC\n";
- plan tests => 2527
+ plan tests => 2648
+ 5; # +5 own tests
}
}
print "# INC = @INC\n";
- plan tests => 669;
+ plan tests => 679;
}
use Math::BigInt::Subclass;
--- /dev/null
+#!/usr/bin/perl -w
+
+# test that config ( trap_nan => 1, trap_inf => 1) really works/dies
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ chdir 't' if -d 't';
+ unshift @INC, '../lib'; # for running manually
+ plan tests => 35;
+ }
+
+use Math::BigInt;
+use Math::BigFloat;
+
+my $mbi = 'Math::BigInt'; my $mbf = 'Math::BigFloat';
+my ($cfg,$x);
+
+foreach my $class ($mbi, $mbf)
+ {
+ # can do and defaults are okay?
+ ok ($class->can('config'));
+ ok ($class->config()->{trap_nan}, 0);
+ ok ($class->config()->{trap_inf}, 0);
+
+ # can set?
+ $cfg = $class->config( trap_nan => 1 ); ok ($cfg->{trap_nan},1);
+
+ # also test that new() still works normally
+ eval ("\$x = \$class->new('42'); \$x->bnan();");
+ ok ($@ =~/^Tried to set/, 1);
+ ok ($x,42); # after new() never modified
+
+ # can reset?
+ $cfg = $class->config( trap_nan => 0 ); ok ($cfg->{trap_nan},0);
+
+ # can set?
+ $cfg = $class->config( trap_inf => 1 ); ok ($cfg->{trap_inf},1);
+ eval ("\$x = \$class->new('4711'); \$x->binf();");
+ ok ($@ =~/^Tried to set/, 1);
+ ok ($x,4711); # after new() never modified
+
+ # +$x/0 => +inf
+ eval ("\$x = \$class->new('4711'); \$x->bdiv(0);");
+ ok ($@ =~/^Tried to set/, 1);
+ ok ($x,4711); # after new() never modified
+
+ # -$x/0 => -inf
+ eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);");
+ ok ($@ =~/^Tried to set/, 1);
+ ok ($x,-815); # after new() never modified
+
+ $cfg = $class->config( trap_nan => 1 );
+ # 0/0 => NaN
+ eval ("\$x = \$class->new('0'); \$x->bdiv(0);");
+ ok ($@ =~/^Tried to set/, 1);
+ ok ($x,0); # after new() never modified
+ }
+
+##############################################################################
+# BigInt
+
+$x = Math::BigInt->new(2);
+eval ("\$x = \$mbi->new('0.1');");
+ok ($x,2); # never modified since it dies
+eval ("\$x = \$mbi->new('0a.1');");
+ok ($x,2); # never modified since it dies
+
+
+##############################################################################
+# BigFloat
+
+$x = Math::BigFloat->new(2);
+eval ("\$x = \$mbf->new('0.1a');");
+ok ($x,2); # never modified since it dies
+
+# all tests done
+
-2:NaN
-123:NaN
Nan:NaN
-+inf:NaN
++inf:inf
+-inf:NaN
&bround
$round_mode('trunc')
0:12:0
}
print "# INC = @INC\n";
- plan tests => 2072
+ plan tests => 2074
+ 2; # our own tests
}
--- /dev/null
+#!/usr/bin/perl -w
+
+# check that using BigFloat with "with" and "lib" at the same time works
+# broken in versions up to v1.63
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/use_mbfw.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 => 3;
+ }
+
+
+# the replacement lib can handle the lib statement, but it could also ignore
+# it completely, for instance, when it is a 100% replacement for BigInt, but
+# doesn't know the concept of alternative libs. But it still needs to cope
+# with "lib => ". SubClass does record it, so we test here essential if
+# BigFloat hands the lib properly down, any more is outside out testing reach.
+
+use Math::BigFloat with => 'Math::BigInt::Subclass', lib => 'BareCalc';
+
+ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Subclass' );
+
+ok ($Math::BigInt::Subclass::lib, 'BareCalc' );
+
+# it never arrives here, but that is a design decision in SubClass
+ok (Math::BigInt->config->{lib}, 'Math::BigInt::Calc' );
+
+# all tests done
+
}
print "# INC = @INC\n";
- plan tests => 1643
+ plan tests => 1760
+ 1;
}
use Exporter;
use Math::BigFloat;
use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade
- $accuracy $precision $round_mode $div_scale);
+ $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);
@ISA = qw(Exporter Math::BigFloat);
@EXPORT_OK = qw();
-$VERSION = '0.09';
+$VERSION = '0.10';
-use overload; # inherit from Math::BigFloat
+use overload; # inherit from Math::BigFloat
##############################################################################
# global constants, flags and accessory
-use constant MB_NEVER_ROUND => 0x0001;
-
$accuracy = $precision = undef;
$round_mode = 'even';
$div_scale = 40;
$upgrade = undef;
$downgrade = undef;
+# these are internally, and not to be used from the outside
+
+use constant MB_NEVER_ROUND => 0x0001;
+
+$_trap_nan = 0; # are NaNs ok? set w/ config()
+$_trap_inf = 0; # are infs ok? set w/ config()
+
my $nan = 'NaN';
my $class = 'Math::BigRat';
my $MBI = 'Math::BigInt';
$self->{_n} = $f->{_m}->copy(); # mantissa
$self->{_d} = $MBI->bone();
- $self->{sign} = $f->{sign}; $self->{_n}->{sign} = '+';
+ $self->{sign} = $f->{sign} || '+'; $self->{_n}->{sign} = '+';
if ($f->{_e}->{sign} eq '-')
{
# something like Math::BigRat->new('0.1');
}
if ($n->isa('Math::BigInt'))
{
+ # TODO: trap NaN, inf
$self->{_n} = $n->copy(); # "mantissa" = $n
$self->{_d} = $MBI->bone();
$self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
}
if ($n->isa('Math::BigInt::Lite'))
{
- $self->{_n} = $MBI->new($$n,undef,undef); # "mantissa" = $n
+ # TODO: trap NaN, inf
+ $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
+ $self->{_n} = $MBI->new(abs($$n),undef,undef); # "mantissa" = $n
$self->{_d} = $MBI->bone();
- $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
return $self->bnorm();
}
}
# string input with / delimiter
if ($n =~ /\s*\/\s*/)
{
- return Math::BigRat->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
- return Math::BigRat->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid
+ return $class->bnan() if $n =~ /\/.*\//; # 1/2/3 isn't valid
+ return $class->bnan() if $n =~ /\/\s*$/; # 1/ isn't valid
($n,$d) = split (/\//,$n);
# try as BigFloats first
if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
local $Math::BigFloat::precision = undef;
local $Math::BigInt::accuracy = undef;
local $Math::BigInt::precision = undef;
- $self->_new_from_float(Math::BigFloat->new($n));
+ my $nf = Math::BigFloat->new($n);
+ $self->{sign} = '+';
+ return $self->bnan() if $nf->is_nan();
+ $self->{_n} = $nf->{_m};
# now correct $self->{_n} due to $n
my $f = Math::BigFloat->new($d,undef,undef);
- if ($f->{_e}->{sign} eq '-')
+ $self->{_d} = $f->{_m};
+ return $self->bnan() if $f->is_nan();
+ #print "n=$nf e$nf->{_e} d=$f e$f->{_e}\n";
+ # calculate the difference between nE and dE
+ my $diff_e = $nf->{_e}->copy()->bsub ( $f->{_e} );
+ if ($diff_e->is_negative())
+ {
+ # < 0: mul d with it
+ $self->{_d}->blsft($diff_e->babs(),10);
+ }
+ elsif (!$diff_e->is_zero())
{
- # 10 / 0.1 => 100/1
- $self->{_n}->blsft($f->{_e}->copy()->babs(),10);
+ # > 0: mul n with it
+ $self->{_n}->blsft($diff_e,10);
}
- else
- {
- $self->{_d}->blsft($f->{_e},10); # 1 / 1 => 10/1
- }
}
else
{
# both d and n are (big)ints
$self->{_n} = $MBI->new($n,undef,undef);
$self->{_d} = $MBI->new($d,undef,undef);
- return $self->bnan() if $self->{_n}->is_nan() || $self->{_d}->is_nan();
+ $self->{sign} = '+';
+ return $self->bnan() if $self->{_n}->{sign} eq $nan ||
+ $self->{_d}->{sign} eq $nan;
# inf handling is missing here
+ if ($self->{_n}->is_inf() || $self->{_d}->is_inf())
+ {
+ # inf/inf => NaN
+ return $self->bnan() if
+ ($self->{_n}->is_inf() && $self->{_d}->is_inf());
+ # +-inf/123 => +-inf
+ return $self->binf($self->{sign}) if $self->{_n}->is_inf();
+ # 123/inf => 0
+ return $self->bzero();
+ }
- $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
+ $self->{sign} = $self->{_n}->{sign}; $self->{_n}->babs();
# if $d is negative, flip sign
$self->{sign} =~ tr/+-/-+/ if $self->{_d}->{sign} eq '-';
- $self->{_d}->{sign} = '+'; # normalize
+ $self->{_d}->babs(); # normalize
}
+
return $self->bnorm();
}
local $Math::BigFloat::precision = undef;
local $Math::BigInt::accuracy = undef;
local $Math::BigInt::precision = undef;
+ $self->{sign} = 'NaN';
$self->_new_from_float(Math::BigFloat->new($n,undef,undef));
}
else
{
$self->{_n} = $MBI->new($n,undef,undef);
$self->{_d} = $MBI->bone();
- $self->{sign} = $self->{_n}->{sign}; $self->{_n}->{sign} = '+';
+ $self->{sign} = $self->{_n}->{sign}; $self->{_n}->babs();
return $self->bnan() if $self->{sign} eq 'NaN';
return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
}
$self->bnorm();
}
-###############################################################################
+##############################################################################
+
+sub config
+ {
+ # return (later set?) configuration data as hash ref
+ my $class = shift || 'Math::BigFloat';
+
+ my $cfg = $class->SUPER::config(@_);
+
+ # now we need only to override the ones that are different from our parent
+ $cfg->{class} = $class;
+ $cfg->{with} = $MBI;
+ $cfg;
+ }
+
+##############################################################################
sub bstr
{
# don't reduce again)
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- # both parts must be BigInt's
- die ("n is not $MBI but (".ref($x->{_n}).')')
- if ref($x->{_n}) ne $MBI;
- die ("d is not $MBI but (".ref($x->{_d}).')')
- if ref($x->{_d}) ne $MBI;
+ # both parts must be BigInt's (or whatever we are using today)
+ if (ref($x->{_n}) ne $MBI)
+ {
+ require Carp; Carp::croak ("n is not $MBI but (".ref($x->{_n}).')');
+ }
+ if (ref($x->{_d}) ne $MBI)
+ {
+ require Carp; Carp::croak ("d is not $MBI but (".ref($x->{_d}).')');
+ }
# this is to prevent automatically rounding when MBI's globals are set
$x->{_d}->{_f} = MB_NEVER_ROUND;
sub _bnan
{
- # used by parent class bone() to initialize number to 1
+ # used by parent class bnan() to initialize number to NaN
my $self = shift;
+
+ if ($_trap_nan)
+ {
+ require Carp;
+ my $class = ref($self);
+ Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
+ }
$self->{_n} = $MBI->bzero();
$self->{_d} = $MBI->bzero();
}
{
# used by parent class bone() to initialize number to +inf/-inf
my $self = shift;
+
+ if ($_trap_inf)
+ {
+ require Carp;
+ my $class = ref($self);
+ Carp::croak ("Tried to set $self to inf in $class\::_binf()");
+ }
$self->{_n} = $MBI->bzero();
$self->{_d} = $MBI->bzero();
}
sub _bzero
{
- # used by parent class bone() to initialize number to 0
+ # used by parent class bzero() to initialize number to 0
my $self = shift;
$self->{_n} = $MBI->bzero();
$self->{_d} = $MBI->bone();
($self,$x,$y,@r) = objectify(2,@_);
}
+ # TODO: $self instead or $class??
$x = $class->new($x) unless $x->isa($class);
$y = $class->new($y) unless $y->isa($class);
($self,$x,$y,@r) = objectify(2,@_);
}
+ # TODO: $self instead or $class??
$x = $class->new($x) unless $x->isa($class);
$y = $class->new($y) unless $y->isa($class);
($self,$x,$y,@r) = objectify(2,@_);
}
+ # TODO: $self instead or $class??
$x = $class->new($x) unless $x->isa($class);
$y = $class->new($y) unless $y->isa($class);
$x;
}
+sub bmod
+ {
+ # compute "remainder" (in Perl way) of $x / $y
+
+ # set up parameters
+ my ($self,$x,$y,@r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,@r) = objectify(2,@_);
+ }
+
+ # TODO: $self instead or $class??
+ $x = $class->new($x) unless $x->isa($class);
+ $y = $class->new($y) unless $y->isa($class);
+
+ return $self->_div_inf($x,$y)
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
+
+ return $self->_div_inf($x,$y)
+ if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero());
+
+ return $x if $x->is_zero(); # 0 / 7 = 0, mod 0
+
+ # compute $x - $y * floor($x/$y), keeping the sign of $x
+
+ local $Math::BigInt::upgrade = undef;
+ local $Math::BigInt::accuracy = undef;
+ local $Math::BigInt::precision = undef;
+
+ my $u = $x->copy()->babs();
+ # do a "normal" division ($x/$y)
+ $u->{_d}->bmul($y->{_n});
+ $u->{_n}->bmul($y->{_d});
+
+ # compute floor
+ if (!$u->{_d}->is_one())
+ {
+ $u->{_n}->bdiv($u->{_d}); # 22/7 => 3/1 w/ truncate
+ # no need to set $u->{_d} to 1, since later we set it to $y->{_d}
+ #$x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
+ }
+
+ # compute $y * $u
+ $u->{_d} = $y->{_d}; # 1 * $y->{_d}, see floor above
+ $u->{_n}->bmul($y->{_n});
+
+ my $xsign = $x->{sign}; $x->{sign} = '+'; # remember sign and make abs
+ # compute $x - $u
+ $x->bsub($u);
+ $x->{sign} = $xsign; # put sign back
+
+ $x->bnorm()->round(@r);
+ $x;
+ }
+
##############################################################################
# bdec/binc
return $x unless $x->{sign} =~ /^[+-]$/;
return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
+ local $Math::BigInt::upgrade = undef;
+ local $Math::BigInt::accuracy = undef;
+ local $Math::BigInt::precision = undef;
$x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
$x->{_d}->bone();
$x->{_n}->binc() if $x->{sign} eq '+'; # +22/7 => 4/1
return $x unless $x->{sign} =~ /^[+-]$/;
return $x if $x->{_d}->is_one(); # 22/1 => 22, 0/1 => 0
+ local $Math::BigInt::upgrade = undef;
+ local $Math::BigInt::accuracy = undef;
+ local $Math::BigInt::precision = undef;
$x->{_n}->bdiv($x->{_d}); # 22/7 => 3/1 w/ truncate
$x->{_d}->bone();
$x->{_n}->binc() if $x->{sign} eq '-'; # -22/7 => -4/1
sub bsqrt
{
- my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
+ my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_);
+
+ return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0
+ return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf
+ return $x->round(@r) if $x->is_zero() || $x->is_one();
+
+ local $Math::BigFloat::upgrade = undef;
+ local $Math::BigFloat::downgrade = undef;
+ local $Math::BigFloat::precision = undef;
+ local $Math::BigFloat::accuracy = undef;
+ local $Math::BigInt::upgrade = undef;
+ local $Math::BigInt::precision = undef;
+ local $Math::BigInt::accuracy = undef;
+ $x->{_d} = Math::BigFloat->new($x->{_d})->bsqrt(@r);
+ $x->{_n} = Math::BigFloat->new($x->{_n})->bsqrt(@r);
- return $x->bnan() if $x->{sign} ne '+'; # inf, NaN, -1 etc
- $x->{_d}->bsqrt($a,$p,$r);
- $x->{_n}->bsqrt($a,$p,$r);
- $x->bnorm();
+ # if sqrt(D) was not integer
+ if ($x->{_d}->{_e}->{sign} ne '+')
+ {
+ $x->{_n}->blsft($x->{_d}->{_e}->babs(),10); # 7.1/4.51 => 7.1/45.1
+ $x->{_d} = $x->{_d}->{_m}; # 7.1/45.1 => 71/45.1
+ }
+ # if sqrt(N) was not integer
+ if ($x->{_n}->{_e}->{sign} ne '+')
+ {
+ $x->{_d}->blsft($x->{_n}->{_e}->babs(),10); # 71/45.1 => 710/45.1
+ $x->{_n} = $x->{_n}->{_n}; # 710/45.1 => 710/451
+ }
+
+ # convert parts to $MBI again
+ $x->{_n} = $x->{_n}->as_number();
+ $x->{_d} = $x->{_d}->as_number();
+ $x->bnorm()->round(@r);
}
sub blsft
{
my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_);
- return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
+ return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc
+
+ # need to disable these, otherwise bdiv() gives BigRat again
+ local $Math::BigInt::upgrade = undef;
+ local $Math::BigInt::accuracy = undef;
+ local $Math::BigInt::precision = undef;
my $t = $x->{_n}->copy()->bdiv($x->{_d}); # 22/7 => 3
$t->{sign} = $x->{sign};
$t;
$x = Math::BigRat->new('13/7');
print $x->as_number(),"\n"; # '1'
-Returns a copy of the object as BigInt by truncating it to integer.
+Returns a copy of the object as BigInt trunced it to integer.
=head2 bfac()
Are not yet implemented.
+=head2 bmod()
+
+ use Math::BigRat;
+ my $x = Math::BigRat->new('7/4');
+ my $y = Math::BigRat->new('4/3');
+ print $x->bmod($y);
+
+Set $x to the remainder of the division of $x by $y.
+
=head2 is_one()
print "$x is 1\n" if $x->is_one();
Truncate $x to an integer value.
+=head2 config
+
+ use Data::Dumper;
+
+ print Dumper ( Math::BigRat->config() );
+ print Math::BigRat->config()->{lib},"\n";
+
+Returns a hash containing the configuration, e.g. the version number, lib
+loaded etc. The following hash keys are currently filled in with the
+appropriate information.
+
+ key RO/RW Description
+ Example
+ ============================================================
+ lib RO Name of the Math library
+ Math::BigInt::Calc
+ lib_version RO Version of 'lib'
+ 0.30
+ class RO The class of config you just called
+ Math::BigRat
+ version RO version number of the class you used
+ 0.10
+ upgrade RW To which class numbers are upgraded
+ undef
+ downgrade RW To which class numbers are downgraded
+ undef
+ precision RW Global precision
+ undef
+ accuracy RW Global accuracy
+ undef
+ round_mode RW Global round mode
+ even
+ div_scale RW Fallback acccuracy for div
+ 40
+ trap_nan RW Trap creation of NaN (undef = no)
+ undef
+ trap_inf RW Trap creation of +inf/-inf (undef = no)
+ undef
+
+By passing a reference to a hash you may set the configuration values. This
+works only for values that a marked with a C<RW> above, anything else is
+read-only.
+
=head1 BUGS
Some things are not yet implemented, or only implemented half-way:
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib'; # for running manually
- plan tests => 151;
+ plan tests => 159;
}
# testing of Math::BigRat
$x = $cr->$func('0.1/10'); ok ($x,'1/100');
$x = $cr->$func('0.1/0.1'); ok ($x,'1');
$x = $cr->$func('1e2/10'); ok ($x,10);
+ $x = $cr->$func('5/1e2'); ok ($x,'1/20');
$x = $cr->$func('1e2/1e1'); ok ($x,10);
$x = $cr->$func('1 / 3'); ok ($x,'1/3');
$x = $cr->$func('-1 / 3'); ok ($x,'-1/3');
# input ala '1+1/3' isn't parsed ok yet
$x = $cr->$func('1+1/3'); ok ($x,'NaN');
+
+ $x = $cr->$func('1/1.2'); ok ($x,'5/6');
+ $x = $cr->$func('1.3/1.2'); ok ($x,'13/12');
+ $x = $cr->$func('1.2/1'); ok ($x,'6/5');
############################################################################
# other classes as input
ok ($class->config()->{lib},$CL);
+$setup = '';
+
while (<DATA>)
{
chomp;
{
$try .= "\$x;";
} elsif ($f eq "finf") {
- $try .= "\$x->binf('$args[1]');";
+ my $a = $args[1] || '';
+ $try .= "\$x->binf('$a');";
} elsif ($f eq "is_inf") {
$try .= "\$x->is_inf('$args[1]');";
} elsif ($f eq "fone") {
}
__DATA__
+&as_number
+144/7:20
+NaN:NaN
++inf:inf
+-inf:-inf
+&bmod
+NaN:1:NaN
+1:NaN:NaN
+1:1:0
+2:2:0
+12:6:0
+7/4:4/14:1/28
+7/4:4/16:0
+-7/4:4/16:0
+-7/4:-4/16:0
+7/4:-4/16:0
+7/4:4/32:0
+-7/4:4/32:0
+-7/4:-4/32:0
+7/4:-4/32:0
+7/4:4/28:1/28
+-7/4:4/28:-1/28
+7/4:-4/28:1/28
+-7/4:-4/28:-1/28
+&fsqrt
+1:1
+0:0
+NaN:NaN
++inf:inf
+-inf:NaN
+144:12
+# sqrt(144) / sqrt(4) = 12/2 = 6/1
+144/4:6
+25/16:5/4
+-3:NaN
+&flog
+NaN:NaN
+0:NaN
&finf
1:+:inf
2:-:-inf
3:abc:inf
-#&numify
+&numify
#0:0e+1
#+1:1e+0
#1234:1234e+0
-#NaN:NaN
+NaN:NaN
#+inf:inf
#-inf:-inf
&fnan
}
print "# INC = @INC\n";
- plan tests => 491;
+ plan tests => 525;
}
use Math::BigRat;
--- /dev/null
+#!/usr/bin/perl -w
+
+# Test whether $Math::BigInt::upgrade is breaks out neck
+
+use Test;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+ plan tests => 5;
+ }
+
+use Math::BigInt upgrade => 'Math::BigRat';
+use Math::BigRat;
+
+my $rat = 'Math::BigRat';
+my ($x,$y,$z);
+
+##############################################################################
+# bceil/bfloor
+
+$x = $rat->new('49/4'); ok ($x->bfloor(),'12');
+$x = $rat->new('49/4'); ok ($x->bceil(),'13');
+
+##############################################################################
+# bsqrt
+
+$x = $rat->new('144'); ok ($x->bsqrt(),'12');
+$x = $rat->new('144/16'); ok ($x->bsqrt(),'3');
+$x = $rat->new('1/3'); ok ($x->bsqrt(),
+ '1000000000000000000000000000000000000000/1732050807568877293527446341505872366943');
+
+
+
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# check that simple requiring BigRat works
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/requirer.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 => 1;
+ }
+
+my ($x);
+
+require Math::BigRat; $x = Math::BigRat->new(1); ++$x;
+
+ok ($x||'undef',2);
+
+# all tests done
+
--- /dev/null
+#!/usr/bin/perl -w
+
+# test that config ( trap_nan => 1, trap_inf => 1) really works/dies
+
+use strict;
+use Test;
+
+BEGIN
+ {
+ $| = 1;
+ chdir 't' if -d 't';
+ unshift @INC, '../lib'; # for running manually
+ plan tests => 29;
+ }
+
+use Math::BigRat;
+
+my $mbi = 'Math::BigRat';
+my ($cfg,$x);
+
+foreach my $class ($mbi)
+ {
+ # can do and defaults are okay?
+ ok ($class->can('config'));
+ ok ($class->config()->{trap_nan}, 0);
+ ok ($class->config()->{trap_inf}, 0);
+
+ # can set?
+ $cfg = $class->config( trap_nan => 1 ); ok ($cfg->{trap_nan},1);
+
+ # can set via hash ref?
+ $cfg = $class->config( { trap_nan => 1 } ); ok ($cfg->{trap_nan},1);
+
+ # also test that new() still works normally
+ eval ("\$x = \$class->new('42'); \$x->bnan();");
+ ok ($@ =~/^Tried to set/, 1);
+ ok ($x,42); # after new() never modified
+
+ # can reset?
+ $cfg = $class->config( trap_nan => 0 ); ok ($cfg->{trap_nan},0);
+
+ # can set?
+ $cfg = $class->config( trap_inf => 1 ); ok ($cfg->{trap_inf},1);
+ eval ("\$x = \$class->new('4711'); \$x->binf();");
+ ok ($@ =~/^Tried to set/, 1);
+ ok ($x,4711); # after new() never modified
+
+ # +$x/0 => +inf
+ eval ("\$x = \$class->new('4711'); \$x->bdiv(0);");
+ ok ($@ =~/^Tried to set/, 1);
+ ok ($x,4711); # after new() never modified
+
+ # -$x/0 => -inf
+ eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);");
+ ok ($@ =~/^Tried to set/, 1);
+ ok ($x,-815); # after new() never modified
+
+ $cfg = $class->config( trap_nan => 1 );
+ # 0/0 => NaN
+ eval ("\$x = \$class->new('0'); \$x->bdiv(0);");
+ ok ($@ =~/^Tried to set/, 1);
+ ok ($x,0); # after new() never modified
+ }
+
+##############################################################################
+# BigRat
+
+$cfg = Math::BigRat->config( trap_nan => 1 );
+
+for my $trap (qw/0.1a +inf inf -inf/)
+ {
+ my $x = Math::BigRat->new('7/4');
+
+ eval ("\$x = \$mbi->new('$trap');");
+ print "# Got: $x\n" unless
+ ok ($x,'7/4'); # never modified since it dies
+ eval ("\$x = \$mbi->new('$trap');");
+ print "# Got: $x\n" unless
+ ok ($x,'7/4'); # never modified since it dies
+ eval ("\$x = \$mbi->new('$trap/7');");
+ print "# Got: $x\n" unless
+ ok ($x,'7/4'); # never modified since it dies
+ }
+
+# all tests done
+
package bigint;
require 5.005;
-$VERSION = '0.03';
+$VERSION = '0.04';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( );
no strict 'refs';
if (defined $_[0])
{
- Math::BigInt->$name($_[0]);
+ return Math::BigInt->$name($_[0]);
}
return Math::BigInt->$name();
};
constants are created as proper BigInts.
Floating point constants are truncated to integer. All results are also
-trunctaed.
+truncated.
=head2 OPTIONS
with normal scalars is not extraordinary, but normal and expected.
You should not depend on the internal format, all accesses must go through
-accessor methods. E.g. looking at $x->{sign} is not a bright idea since there
+accessor methods. E.g. looking at $x->{sign} is not a good idea since there
is no guaranty that the object in question has such a hash key, nor is a hash
underneath at all.
the BigInt API. You can only use the bxxx() notation, and not the fxxx()
notation, though.
+=head2 CAVEAT
+
+But a warning is in order. When using the following to make a copy of a number,
+only a shallow copy will be made.
+
+ $x = 9; $y = $x;
+ $x = $y = 7;
+
+Using the copy or the original with overloaded math is okay, e.g. the
+following work:
+
+ $x = 9; $y = $x;
+ print $x + 1, " ", $y,"\n"; # prints 10 9
+
+but calling any method that modifies the number directly will result in
+B<both> the original and the copy beeing destroyed:
+
+ $x = 9; $y = $x;
+ print $x->badd(1), " ", $y,"\n"; # prints 10 10
+
+ $x = 9; $y = $x;
+ print $x->binc(1), " ", $y,"\n"; # prints 10 10
+
+ $x = 9; $y = $x;
+ print $x->bmul(2), " ", $y,"\n"; # prints 18 18
+
+Using methods that do not modify, but testthe contents works:
+
+ $x = 9; $y = $x;
+ $z = 9 if $x->is_zero(); # works fine
+
+See the documentation about the copy constructor and C<=> in overload, as
+well as the documentation in BigInt for further details.
+
=head1 MODULES USED
C<bigint> is just a thin wrapper around various modules of the Math::BigInt
package bignum;
require 5.005;
-$VERSION = '0.13';
+$VERSION = '0.14';
use Exporter;
@EXPORT_OK = qw( );
@EXPORT = qw( inf NaN );
if (defined $_[0])
{
Math::BigInt->$name($_[0]);
- Math::BigFloat->$name($_[0]);
+ return Math::BigFloat->$name($_[0]);
}
return Math::BigInt->$name();
};
the fxxx() notation, though. This makes it possible that the underlying object
might morph into a different class than BigFloat.
+=head2 CAVEAT
+
+But a warning is in order. When using the following to make a copy of a number,
+only a shallow copy will be made.
+
+ $x = 9; $y = $x;
+ $x = $y = 7;
+
+Using the copy or the original with overloaded math is okay, e.g. the
+following work:
+
+ $x = 9; $y = $x;
+ print $x + 1, " ", $y,"\n"; # prints 10 9
+
+but calling any method that modifies the number directly will result in
+B<both> the original and the copy beeing destroyed:
+
+ $x = 9; $y = $x;
+ print $x->badd(1), " ", $y,"\n"; # prints 10 10
+
+ $x = 9; $y = $x;
+ print $x->binc(1), " ", $y,"\n"; # prints 10 10
+
+ $x = 9; $y = $x;
+ print $x->bmul(2), " ", $y,"\n"; # prints 18 18
+
+Using methods that do not modify, but testthe contents works:
+
+ $x = 9; $y = $x;
+ $z = 9 if $x->is_zero(); # works fine
+
+See the documentation about the copy constructor and C<=> in overload, as
+well as the documentation in BigInt for further details.
+
=over 2
=item inf()
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib';
- plan tests => 28;
+ plan tests => 32;
}
use bigint;
###############################################################################
# accurarcy and precision
-# this might change!
+ok_undef (bigint->accuracy());
+ok (bigint->accuracy(12),12);
+ok (bigint->accuracy(),12);
-ok_undef ($Math::BigInt::accuracy);
-ok_undef ($Math::BigInt::precision);
-bigint->accuracy(5);
-ok ($Math::BigInt::accuracy,5);
-bigint->precision(-2);
-ok_undef ($Math::BigInt::accuracy);
-ok ($Math::BigInt::precision,-2);
+ok_undef (bigint->precision());
+ok (bigint->precision(12),12);
+ok (bigint->precision(),12);
+
+ok (bigint->round_mode(),'even');
+ok (bigint->round_mode('odd'),'odd');
+ok (bigint->round_mode(),'odd');
###############################################################################
###############################################################################
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib';
- plan tests => 21;
+ plan tests => 20;
}
use bignum;
###############################################################################
# accurarcy and precision
-# this might change!
-
-ok_undef ($Math::BigInt::accuracy);
-ok_undef ($Math::BigInt::precision);
-ok_undef ($Math::BigFloat::accuracy);
-ok_undef ($Math::BigFloat::precision);
-bignum->accuracy(5);
-ok ($Math::BigInt::accuracy,5);
-ok ($Math::BigFloat::accuracy,5);
-bignum->precision(-2);
-ok_undef ($Math::BigInt::accuracy);
-ok_undef ($Math::BigFloat::accuracy);
-ok ($Math::BigInt::precision,-2);
-ok ($Math::BigFloat::precision,-2);
+ok_undef (bignum->accuracy());
+ok (bignum->accuracy(12),12);
+ok (bignum->accuracy(),12);
+
+ok_undef (bignum->precision());
+ok (bignum->precision(12),12);
+ok (bignum->precision(),12);
+
+ok (bignum->round_mode(),'even');
+ok (bignum->round_mode('odd'),'odd');
+ok (bignum->round_mode(),'odd');
###############################################################################
###############################################################################
$| = 1;
chdir 't' if -d 't';
unshift @INC, '../lib';
- plan tests => 16;
+ plan tests => 25;
}
use bigrat;
###############################################################################
# accurarcy and precision
-# this might change!
-#ok_undef ($Math::BigInt::accuracy);
-#ok_undef ($Math::BigInt::precision);
-#ok_undef ($Math::BigFloat::accuracy);
-#ok_undef ($Math::BigFloat::precision);
-#bigrat->accuracy(5);
-#ok ($Math::BigInt::accuracy,5);
-#ok ($Math::BigFloat::accuracy,5);
-#bigrat->precision(-2);
-#ok_undef ($Math::BigInt::accuracy);
-#ok_undef ($Math::BigFloat::accuracy);
-#ok ($Math::BigInt::precision,-2);
-#ok ($Math::BigFloat::precision,-2);
+ok_undef (bigrat->accuracy());
+ok (bigrat->accuracy(12),12);
+ok (bigrat->accuracy(),12);
+
+ok_undef (bigrat->precision());
+ok (bigrat->precision(12),12);
+ok (bigrat->precision(),12);
+
+ok (bigrat->round_mode(),'even');
+ok (bigrat->round_mode('odd'),'odd');
+ok (bigrat->round_mode(),'odd');
###############################################################################
###############################################################################
BEGIN
{
$| = 1;
- my $location = $0; $location =~ s/biinfnan.t//i;
- if ($ENV{PERL_CORE})
- {
- @INC = qw(../lib); # testing with the core distribution
- }
- else
- {
- unshift @INC, '../lib'; # for testing manually
- }
- 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";
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+ unshift @INC, '../lib/bignum/t' if $ENV{PERL_CORE};
plan tests => 26;
}
BEGIN
{
$| = 1;
- my $location = $0; $location =~ s/bninfnan.t//;
+ my $location = $0; $location =~ s/biinfnan.t//i;
if ($ENV{PERL_CORE})
{
- @INC = qw(../lib); # testing with the core distribution
+ @INC = qw(../lib ../lib/bignum/t); # testing with the core distribution
}
else
{
BEGIN
{
$| = 1;
- my $location = $0; $location =~ s/brinfnan.t//;
- if ($ENV{PERL_CORE})
- {
- @INC = qw(../lib); # testing with the core distribution
- }
- else
- {
- unshift @INC, '../lib'; # for testing manually
- }
- 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";
+ chdir 't' if -d 't';
+ unshift @INC, '../lib';
+ unshift @INC, '../lib/bignum/t' if $ENV{PERL_CORE};
plan tests => 26;
}
package bigrat;
require 5.005;
-$VERSION = '0.05';
+$VERSION = '0.06';
use Exporter;
@ISA = qw( Exporter );
@EXPORT_OK = qw( );
{
Math::BigInt->$name($_[0]);
Math::BigFloat->$name($_[0]);
+ return Math::BigRat->$name($_[0]);
}
return Math::BigInt->$name();
};
the fxxx() notation, though. This makes you independed on the fact that the
underlying object might morph into a different class than BigFloat.
+=head2 CAVEAT
+
+But a warning is in order. When using the following to make a copy of a number,
+only a shallow copy will be made.
+
+ $x = 9; $y = $x;
+ $x = $y = 7;
+
+Using the copy or the original with overloaded math is okay, e.g. the
+following work:
+
+ $x = 9; $y = $x;
+ print $x + 1, " ", $y,"\n"; # prints 10 9
+
+but calling any method that modifies the number directly will result in
+B<both> the original and the copy beeing destroyed:
+
+ $x = 9; $y = $x;
+ print $x->badd(1), " ", $y,"\n"; # prints 10 10
+
+ $x = 9; $y = $x;
+ print $x->binc(1), " ", $y,"\n"; # prints 10 10
+
+ $x = 9; $y = $x;
+ print $x->bmul(2), " ", $y,"\n"; # prints 18 18
+
+Using methods that do not modify, but testthe contents works:
+
+ $x = 9; $y = $x;
+ $z = 9 if $x->is_zero(); # works fine
+
+See the documentation about the copy constructor and C<=> in overload, as
+well as the documentation in BigInt for further details.
+
=head1 EXAMPLES
perl -Mbigrat -le 'print sqrt(33)'
use strict;
use Exporter;
-use Math::BigFloat(1.30);
+use Math::BigFloat(1.38);
use vars qw($VERSION @ISA $PACKAGE
$accuracy $precision $round_mode $div_scale);
@ISA = qw(Exporter Math::BigFloat);
-$VERSION = 0.03;
+$VERSION = 0.04;
use overload; # inherit overload from BigInt
# uses Calc, but only features the strictly necc. methods.
-use Math::BigInt::Calc '0.29';
+use Math::BigInt::Calc '0.33';
BEGIN
{
my $name = "Math::BigInt::Calc::_$_";
*{"Math::BigInt::BareCalc::_$_"} = \&$name;
}
+ print "# BareCalc using Calc v$Math::BigInt::Calc::VERSION\n";
}
# catch and throw away
use strict;
use Exporter;
-use Math::BigInt(1.56);
+use Math::BigInt (1.64);
+# $lib is for the "lib => " test
use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK
+ $lib
$accuracy $precision $round_mode $div_scale);
@ISA = qw(Exporter Math::BigInt);
@EXPORT_OK = qw(bgcd objectify);
-$VERSION = 0.03;
+$VERSION = 0.04;
use overload; # inherit overload from BigInt
$accuracy = $precision = undef;
$round_mode = 'even';
$div_scale = 40;
+$lib = '';
sub new
{
my @a; my $t = 0;
foreach (@_)
{
- $t = 0, next if $t == 1;
+ # remove the "lib => foo" parameters and store it
+ $lib = $_, $t = 0, next if $t == 1;
if ($_ eq 'lib')
{
$t = 1; next;
projects / p5sagit/p5-mst-13.2.git / commitdiff