diff options
Diffstat (limited to 'lib/Math')
40 files changed, 2540 insertions, 746 deletions
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index 4e93a2ffb7..4a5a74eede 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -7,12 +7,12 @@ package Math::BigFloat; # 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); @@ -20,6 +20,8 @@ use Exporter; 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 @@ -30,14 +32,10 @@ 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' @@ -50,6 +48,30 @@ $downgrade = undef; 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 @@ -58,9 +80,10 @@ sub FETCH { return $round_mode; } 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'; } ############################################################################## @@ -73,12 +96,12 @@ BEGIN 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 /; @@ -103,6 +126,8 @@ sub new 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)) @@ -129,7 +154,11 @@ sub new 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; @@ -151,7 +180,7 @@ sub new 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 @@ -159,22 +188,40 @@ sub new } 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(); } @@ -183,14 +230,16 @@ sub _bone { # 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(); } @@ -207,16 +256,11 @@ sub config # 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; } @@ -232,8 +276,6 @@ sub bstr #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 @@ -254,13 +296,13 @@ sub bstr $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}; } } @@ -298,8 +340,6 @@ sub bsstr #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 @@ -615,50 +655,52 @@ sub bdec $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 @@ -670,63 +712,31 @@ sub blog 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) { @@ -739,6 +749,251 @@ sub blog $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 @@ -788,9 +1043,9 @@ sub is_zero 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; @@ -881,23 +1136,25 @@ sub bdiv # 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; @@ -933,15 +1190,15 @@ sub bdiv } # 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) { @@ -953,7 +1210,7 @@ sub bdiv { if (!$y->is_one()) { - $rem->bmod($y,$params[1],$params[2],$params[3]); # copy already done + $rem->bmod($y,@params); # copy already done } else { @@ -1056,36 +1313,123 @@ sub bmod $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 @@ -1109,13 +1453,13 @@ sub bsqrt # 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) { @@ -1138,9 +1482,10 @@ sub bsqrt # 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) @@ -1151,20 +1496,34 @@ sub bsqrt $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) { @@ -1196,107 +1555,6 @@ sub bfac $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 @@ -1306,31 +1564,37 @@ sub _pow # 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 @@ -1346,7 +1610,7 @@ sub _pow 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 @@ -1362,22 +1626,21 @@ sub _pow # 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) { @@ -1557,7 +1820,10 @@ sub bround # 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 @@ -1689,6 +1955,7 @@ sub AUTOLOAD $name =~ s/.*:://; # split package no strict 'refs'; + $class->import() if $IMPORT == 0; if (!method_alias($name)) { if (!defined $name) @@ -1764,12 +2031,12 @@ sub import 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') @@ -1786,11 +2053,13 @@ sub import } 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++; } @@ -1812,6 +2081,7 @@ sub import # 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 @@ -1829,7 +2099,10 @@ sub import 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 @@ -1874,7 +2147,7 @@ sub as_hex 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 @@ -1893,7 +2166,7 @@ sub as_bin 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 @@ -1979,8 +2252,10 @@ Math::BigFloat - Arbitrary size floating point math package $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 @@ -1999,17 +2274,17 @@ Math::BigFloat - Arbitrary size floating point math package $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 @@ -2017,21 +2292,23 @@ Math::BigFloat - Arbitrary size floating point math package $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 @@ -2044,8 +2321,10 @@ Math::BigFloat - Arbitrary size floating point math package $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 @@ -2097,7 +2376,7 @@ Output values are BigFloat objects (normalized), except for bstr() and bsstr(). 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' @@ -2110,7 +2389,9 @@ Some routines (C<is_odd()>, C<is_even()>, C<is_zero()>, C<is_one()>, 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. @@ -2143,18 +2424,31 @@ L<Math::BigInt>. 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 @@ -2182,7 +2476,7 @@ significant digits count from the first non-zero after the '.' =item fround ( -$scale ) and fround ( 0 ) -These are effetively no-ops. +These are effectively no-ops. =back @@ -2190,13 +2484,13 @@ All rounding functions take as a second parameter a rounding mode from one of 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; @@ -2264,7 +2558,15 @@ you can roll it all into one line: 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 @@ -2286,7 +2588,9 @@ Of course, you can combine this with the C<lib> parameter. # 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; @@ -2301,41 +2605,68 @@ it's lib will be used if the lib is available: 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 @@ -2368,16 +2699,8 @@ Beware of: 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 @@ -2391,6 +2714,19 @@ C<badd()> etc. The first will modify $x, the second one won't: =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 @@ -2399,6 +2735,7 @@ the same terms as Perl itself. =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 diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index f59395c58e..75a9be7e08 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -18,13 +18,14 @@ package Math::BigInt; 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 @@ -115,13 +116,8 @@ use overload ############################################################################## # 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; @@ -131,6 +127,18 @@ $div_scale = 40; $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 @@ -152,11 +160,13 @@ sub round_mode 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 @@ -171,7 +181,7 @@ sub upgrade my $u = shift; return ${"${class}::upgrade"} = $u; } - return ${"${class}::upgrade"}; + ${"${class}::upgrade"}; } sub downgrade @@ -186,21 +196,24 @@ 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 @@ -218,21 +231,39 @@ 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; @@ -241,7 +272,7 @@ sub accuracy # but don't return global undef, when $x's accuracy is 0! $r = ${"${class}::accuracy"} if !defined $r; $r; - } + } sub precision { @@ -254,24 +285,32 @@ 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; @@ -280,24 +319,66 @@ sub precision # 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; } @@ -416,6 +497,10 @@ sub new # 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) @@ -439,8 +524,10 @@ sub new 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; @@ -461,6 +548,10 @@ sub new 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; @@ -468,7 +559,7 @@ sub new 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); } } @@ -477,6 +568,10 @@ sub new 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; @@ -488,6 +583,10 @@ sub new $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; @@ -512,9 +611,14 @@ sub bnan { 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 @@ -541,9 +645,14 @@ sub binf { 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 @@ -572,7 +681,7 @@ sub bzero } $self->import() if $IMPORT == 0; # make require work return if $self->modify('bzero'); - + if ($self->can('_bzero')) { # use subclass to initialize @@ -609,7 +718,7 @@ sub bone 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; @@ -709,9 +818,14 @@ sub _find_round_parameters # 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 @@ -720,7 +834,7 @@ sub _find_round_parameters # @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'; @@ -747,17 +861,23 @@ sub _find_round_parameters # 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 @@ -774,7 +894,7 @@ 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'; @@ -802,6 +922,9 @@ sub round $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 @@ -809,7 +932,10 @@ sub round 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) @@ -1084,7 +1210,7 @@ sub blog # 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(); } @@ -1197,7 +1323,7 @@ sub is_one # 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}); @@ -1361,44 +1487,14 @@ sub bdiv 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) { @@ -1407,23 +1503,24 @@ sub bdiv $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; } @@ -1605,7 +1702,7 @@ sub bmodpow $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') @@ -1710,7 +1807,7 @@ sub bpow 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? @@ -2008,13 +2105,14 @@ sub _trailing_zeros 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; @@ -2029,11 +2127,12 @@ sub bsqrt 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(); @@ -2044,6 +2143,71 @@ sub bsqrt $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) @@ -2350,7 +2514,7 @@ sub objectify } 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 (@_) @@ -2387,7 +2551,10 @@ sub objectify } 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; } @@ -2453,7 +2620,11 @@ sub import } $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 @@ -2619,7 +2790,6 @@ sub as_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 '-'; @@ -2629,6 +2799,8 @@ sub as_hex } else { + return '0x0' if $x->is_zero(); + my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h); if ($] >= 5.006) { @@ -2656,7 +2828,6 @@ sub as_bin 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 '-'; @@ -2666,6 +2837,7 @@ sub as_bin } else { + return '0b0' if $x->is_zero(); my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b); if ($] >= 5.006) { @@ -2735,6 +2907,12 @@ Math::BigInt - Arbitrary size integer math package 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 @@ -2765,7 +2943,9 @@ Math::BigInt - Arbitrary size integer math package $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 @@ -2803,13 +2983,14 @@ Math::BigInt - Arbitrary size integer math package $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 @@ -3561,7 +3742,7 @@ This is how it works now: 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); @@ -3767,8 +3948,8 @@ numerical sense, e.g. $m might get minimized. $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") @@ -3836,7 +4017,7 @@ so that 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'); @@ -4006,6 +4187,11 @@ versions to a more sophisticated scheme): =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 @@ -4313,13 +4499,14 @@ will both result in the proper type due to the way the overloaded math works. 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: @@ -4345,8 +4532,11 @@ the same terms as Perl itself. =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 @@ -4356,6 +4546,11 @@ subclass files and benchmarks. =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 diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index 44e4c9b89b..b1d88fa887 100644 --- a/lib/Math/BigInt/Calc.pm +++ b/lib/Math/BigInt/Calc.pm @@ -8,7 +8,7 @@ require Exporter; use vars qw/@ISA $VERSION/; @ISA = qw(Exporter); -$VERSION = '0.32'; +$VERSION = '0.34'; # Package to store unsigned big integers in decimal and do math with them @@ -25,6 +25,12 @@ $VERSION = '0.32'; # 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 @@ -33,7 +39,6 @@ my $nan = 'NaN'; 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 { @@ -66,23 +71,27 @@ 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; @@ -171,73 +180,6 @@ BEGIN } -############################################################################## -# 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 @@ -437,32 +379,39 @@ sub _mul_use_mul # 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) @@ -494,15 +443,7 @@ sub _mul_use_mul $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; } @@ -513,34 +454,41 @@ sub _mul_use_div # 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) { @@ -557,15 +505,7 @@ sub _mul_use_div $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; } @@ -610,10 +550,6 @@ sub _div_use_mul } 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); @@ -686,26 +622,12 @@ sub _div_use_mul } @$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; } @@ -715,6 +637,13 @@ sub _div_use_div # 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 @@ -730,6 +659,7 @@ sub _div_use_div return $x; } } + # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; @@ -748,12 +678,66 @@ sub _div_use_div 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); @@ -826,26 +810,12 @@ sub _div_use_div } @$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; } @@ -1110,7 +1080,7 @@ sub _rsft 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 @@ -1224,12 +1194,43 @@ sub _fac $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; } @@ -1242,7 +1243,7 @@ sub _fac 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) = @_; @@ -1317,6 +1318,33 @@ sub _sqrt $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 @@ -1435,6 +1463,13 @@ sub _as_hex # 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 = ''; @@ -1463,6 +1498,12 @@ sub _as_bin # convert a decimal number to bin (ref to array, return ref to string) my ($c,$x) = @_; + # fit's into one element + if (@$x == 1) + { + my $t = '0b' . sprintf("%b",$x->[0]); + return \$t; + } my $x1 = _copy($c,$x); my $es = ''; @@ -1631,7 +1672,7 @@ Math::BigInt::Calc - Pure Perl module to support Math::BigInt 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 @@ -1644,7 +1685,9 @@ follows the same API as this can be used instead by using the following: '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: @@ -1665,6 +1708,8 @@ 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 @@ -1714,7 +1759,8 @@ slow) fallback routines to emulate these: _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 @@ -1726,20 +1772,23 @@ slow) fallback routines to emulate these: 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 @@ -1764,12 +1813,13 @@ the same terms as Perl itself. =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 diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t index 9548fe80c6..d11daf7e8e 100644 --- a/lib/Math/BigInt/t/bare_mbf.t +++ b/lib/Math/BigInt/t/bare_mbf.t @@ -27,7 +27,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1643; + plan tests => 1760; } use Math::BigFloat lib => 'BareCalc'; diff --git a/lib/Math/BigInt/t/bare_mbi.t b/lib/Math/BigInt/t/bare_mbi.t index b2d5446ba8..61064668e7 100644 --- a/lib/Math/BigInt/t/bare_mbi.t +++ b/lib/Math/BigInt/t/bare_mbi.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 2527; + plan tests => 2648; } use Math::BigInt lib => 'BareCalc'; diff --git a/lib/Math/BigInt/t/bare_mif.t b/lib/Math/BigInt/t/bare_mif.t index 15a1448e0a..00629fd9a5 100644 --- a/lib/Math/BigInt/t/bare_mif.t +++ b/lib/Math/BigInt/t/bare_mif.t @@ -28,8 +28,8 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 669 - + 1; # our onw tests + plan tests => 679 + + 1; # our own tests } print "# ",Math::BigInt->config()->{lib},"\n"; diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc index 774e26e208..2cb55437a2 100644 --- a/lib/Math/BigInt/t/bigfltpm.inc +++ b/lib/Math/BigInt/t/bigfltpm.inc @@ -30,7 +30,7 @@ while (<DATA>) { @args = split(/:/,$_,99); $ans = pop(@args); } - $try = "\$x = new $class \"$args[0]\";"; + $try = "\$x = $class->new('$args[0]');"; if ($f eq "fnorm") { $try .= "\$x;"; @@ -71,20 +71,30 @@ while (<DATA>) $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") { @@ -229,6 +239,12 @@ $class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464'); 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 ############################################################################### @@ -245,28 +261,36 @@ sub ok_undef __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 @@ -327,6 +351,11 @@ fnormNaN:NaN 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 @@ -1178,6 +1207,55 @@ Nanfac:NaN 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 @@ -1202,6 +1280,8 @@ nanfsqrt: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 @@ -1340,6 +1420,11 @@ abc:NaN -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 diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index bab134f25f..000856bd17 100755 --- a/lib/Math/BigInt/t/bigfltpm.t +++ b/lib/Math/BigInt/t/bigfltpm.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1643 + plan tests => 1760 + 2; # own tests } diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t index 22e64c5f2c..fe3b7c4259 100644 --- a/lib/Math/BigInt/t/bigintc.t +++ b/lib/Math/BigInt/t/bigintc.t @@ -14,7 +14,7 @@ use Math::BigInt::Calc; BEGIN { - plan tests => 276; + plan tests => 258; } # testing of Math::BigInt::Calc @@ -196,6 +196,13 @@ foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/) # _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'); @@ -273,6 +280,12 @@ ok (${$C->_str(scalar $C->_from_bin(\"0b10101011"))},160+11); # _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"); @@ -310,37 +323,6 @@ ok ($C->_check(123),'123 is not a reference'); 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; diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc index 9f3a1abc5c..3852c1c3dc 100644 --- a/lib/Math/BigInt/t/bigintpm.inc +++ b/lib/Math/BigInt/t/bigintpm.inc @@ -154,6 +154,8 @@ while (<DATA>) { $try .= "\$x >> \$y;"; } + }elsif ($f eq "broot"){ + $try .= "\$x->broot(\$y);"; }elsif ($f eq "band"){ $try .= "\$x & \$y;"; }elsif ($f eq "bior"){ @@ -612,6 +614,14 @@ ok ($class->binf('-'),'-inf'); 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; @@ -1364,6 +1374,16 @@ inf:0:inf,inf -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 @@ -1443,6 +1463,16 @@ inf:0:inf 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 @@ -1810,6 +1840,9 @@ NaNfac:NaN 4:24 5:120 6:720 +7:5040 +8:40320 +9:362880 10:3628800 11:39916800 12:479001600 @@ -1872,6 +1905,55 @@ abc:12:NaN 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 @@ -1896,7 +1978,8 @@ abc:12:NaN -2:NaN -123:NaN Nan:NaN -+inf:NaN ++inf:inf +-inf:NaN &bround $round_mode('trunc') 0:12:0 diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index be3e3596c9..2522f8319b 100755 --- a/lib/Math/BigInt/t/bigintpm.t +++ b/lib/Math/BigInt/t/bigintpm.t @@ -10,7 +10,7 @@ BEGIN my $location = $0; $location =~ s/bigintpm.t//; unshift @INC, $location; # to locate the testing files chdir 't' if -d 't'; - plan tests => 2527; + plan tests => 2648; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/bigints.t b/lib/Math/BigInt/t/bigints.t index fb9b2f49f6..e7972fb78e 100644 --- a/lib/Math/BigInt/t/bigints.t +++ b/lib/Math/BigInt/t/bigints.t @@ -6,8 +6,25 @@ use Test; BEGIN { $| = 1; - # chdir 't' if -d 't'; - unshift @INC, '../lib'; # for running manually + # to locate the testing files + my $location = $0; $location =~ s/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; } diff --git a/lib/Math/BigInt/t/biglog.t b/lib/Math/BigInt/t/biglog.t new file mode 100644 index 0000000000..e79a5d2518 --- /dev/null +++ b/lib/Math/BigInt/t/biglog.t @@ -0,0 +1,135 @@ +#!/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); + } + diff --git a/lib/Math/BigInt/t/config.t b/lib/Math/BigInt/t/config.t index da574bf362..5c480536bd 100644 --- a/lib/Math/BigInt/t/config.t +++ b/lib/Math/BigInt/t/config.t @@ -8,22 +8,52 @@ BEGIN $| = 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); @@ -32,5 +62,59 @@ ok ($cfg->{accuracy}||0,0); 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 diff --git a/lib/Math/BigInt/t/inf_nan.t b/lib/Math/BigInt/t/inf_nan.t index 9e8c8d39a7..852ffed7bd 100644 --- a/lib/Math/BigInt/t/inf_nan.t +++ b/lib/Math/BigInt/t/inf_nan.t @@ -33,9 +33,9 @@ BEGIN } 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; diff --git a/lib/Math/BigInt/t/mbi_rand.t b/lib/Math/BigInt/t/mbi_rand.t index 1aeb6857ab..fa8e966b0a 100644 --- a/lib/Math/BigInt/t/mbi_rand.t +++ b/lib/Math/BigInt/t/mbi_rand.t @@ -14,7 +14,7 @@ BEGIN 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; @@ -48,17 +48,25 @@ for (my $i = 0; $i < $count; $i++) # 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); } diff --git a/lib/Math/BigInt/t/mbimbf.inc b/lib/Math/BigInt/t/mbimbf.inc index a00183f0ec..192b1cc4bf 100644 --- a/lib/Math/BigInt/t/mbimbf.inc +++ b/lib/Math/BigInt/t/mbimbf.inc @@ -320,6 +320,18 @@ $x = $mbi->new(-123401); $x->{_a} = 4; ok ($x->bneg(),123401); $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) @@ -386,10 +398,10 @@ my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; }; # 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); @@ -639,12 +651,14 @@ ok ($params[0],$x); # self @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 } diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t index 67645ef244..bada2aade0 100644 --- a/lib/Math/BigInt/t/mbimbf.t +++ b/lib/Math/BigInt/t/mbimbf.t @@ -31,8 +31,8 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 669 - + 16; # own tests + plan tests => 679 + + 22; # own tests } use Math::BigInt 1.63; @@ -56,16 +56,20 @@ ok ($Math::BigInt::rnd_mode,'even'); 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'); @@ -78,3 +82,14 @@ foreach my $class (qw/Math::BigInt Math::BigFloat/) 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 + } diff --git a/lib/Math/BigInt/t/req_mbf0.t b/lib/Math/BigInt/t/req_mbf0.t new file mode 100644 index 0000000000..af312f1b92 --- /dev/null +++ b/lib/Math/BigInt/t/req_mbf0.t @@ -0,0 +1,37 @@ +#!/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 + diff --git a/lib/Math/BigInt/t/req_mbf1.t b/lib/Math/BigInt/t/req_mbf1.t new file mode 100644 index 0000000000..b0b4aea810 --- /dev/null +++ b/lib/Math/BigInt/t/req_mbf1.t @@ -0,0 +1,37 @@ +#!/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 + diff --git a/lib/Math/BigInt/t/req_mbfa.t b/lib/Math/BigInt/t/req_mbfa.t new file mode 100644 index 0000000000..b2d2a07099 --- /dev/null +++ b/lib/Math/BigInt/t/req_mbfa.t @@ -0,0 +1,37 @@ +#!/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 + diff --git a/lib/Math/BigInt/t/req_mbfi.t b/lib/Math/BigInt/t/req_mbfi.t new file mode 100644 index 0000000000..2c0ec67b02 --- /dev/null +++ b/lib/Math/BigInt/t/req_mbfi.t @@ -0,0 +1,37 @@ +#!/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 + diff --git a/lib/Math/BigInt/t/req_mbfn.t b/lib/Math/BigInt/t/req_mbfn.t new file mode 100644 index 0000000000..e3887d41de --- /dev/null +++ b/lib/Math/BigInt/t/req_mbfn.t @@ -0,0 +1,37 @@ +#!/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 + diff --git a/lib/Math/BigInt/t/req_mbfw.t b/lib/Math/BigInt/t/req_mbfw.t new file mode 100644 index 0000000000..b216c797d9 --- /dev/null +++ b/lib/Math/BigInt/t/req_mbfw.t @@ -0,0 +1,45 @@ +#!/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 + diff --git a/lib/Math/BigInt/t/require.t b/lib/Math/BigInt/t/require.t index 2775a77a6f..50831e611d 100644 --- a/lib/Math/BigInt/t/require.t +++ b/lib/Math/BigInt/t/require.t @@ -1,5 +1,7 @@ #!/usr/bin/perl -w +# check that simple requiring BigInt works + use strict; use Test; diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t index dbd68f10d4..c812191678 100755 --- a/lib/Math/BigInt/t/sub_mbf.t +++ b/lib/Math/BigInt/t/sub_mbf.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1643 + plan tests => 1760 + 6; # + our own tests } diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t index 9953f4b802..39e47d5a2a 100755 --- a/lib/Math/BigInt/t/sub_mbi.t +++ b/lib/Math/BigInt/t/sub_mbi.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 2527 + plan tests => 2648 + 5; # +5 own tests } diff --git a/lib/Math/BigInt/t/sub_mif.t b/lib/Math/BigInt/t/sub_mif.t index 365fe617d7..cbaf06a97c 100644 --- a/lib/Math/BigInt/t/sub_mif.t +++ b/lib/Math/BigInt/t/sub_mif.t @@ -28,7 +28,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 669; + plan tests => 679; } use Math::BigInt::Subclass; diff --git a/lib/Math/BigInt/t/trap.t b/lib/Math/BigInt/t/trap.t new file mode 100644 index 0000000000..af454092a2 --- /dev/null +++ b/lib/Math/BigInt/t/trap.t @@ -0,0 +1,81 @@ +#!/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 + diff --git a/lib/Math/BigInt/t/upgrade.inc b/lib/Math/BigInt/t/upgrade.inc index 4bb5d35fd3..fa5f639827 100644 --- a/lib/Math/BigInt/t/upgrade.inc +++ b/lib/Math/BigInt/t/upgrade.inc @@ -1339,7 +1339,8 @@ abc:12:NaN -2:NaN -123:NaN Nan:NaN -+inf:NaN ++inf:inf +-inf:NaN &bround $round_mode('trunc') 0:12:0 diff --git a/lib/Math/BigInt/t/upgrade.t b/lib/Math/BigInt/t/upgrade.t index 6c087a5348..7d98ba17ed 100644 --- a/lib/Math/BigInt/t/upgrade.t +++ b/lib/Math/BigInt/t/upgrade.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 2072 + plan tests => 2074 + 2; # our own tests } diff --git a/lib/Math/BigInt/t/use_mbfw.t b/lib/Math/BigInt/t/use_mbfw.t new file mode 100644 index 0000000000..d58de047f2 --- /dev/null +++ b/lib/Math/BigInt/t/use_mbfw.t @@ -0,0 +1,52 @@ +#!/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 + diff --git a/lib/Math/BigInt/t/with_sub.t b/lib/Math/BigInt/t/with_sub.t index 226533252e..2b6d8716ed 100644 --- a/lib/Math/BigInt/t/with_sub.t +++ b/lib/Math/BigInt/t/with_sub.t @@ -28,7 +28,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 1643 + plan tests => 1760 + 1; } diff --git a/lib/Math/BigRat.pm b/lib/Math/BigRat.pm index f33fcf13de..b00aed4708 100644 --- a/lib/Math/BigRat.pm +++ b/lib/Math/BigRat.pm @@ -19,26 +19,31 @@ use strict; 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'; @@ -60,7 +65,7 @@ sub _new_from_float $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'); @@ -94,6 +99,7 @@ sub new } 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} = '+'; @@ -101,9 +107,10 @@ sub new } 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(); } } @@ -119,8 +126,8 @@ sub new # 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]/)) @@ -131,32 +138,54 @@ sub new 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(); } @@ -169,20 +198,36 @@ sub new 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 { @@ -220,11 +265,15 @@ sub bnorm # 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; @@ -267,8 +316,15 @@ sub bnorm 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(); } @@ -277,6 +333,13 @@ sub _binf { # 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(); } @@ -291,7 +354,7 @@ sub _bone 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(); @@ -357,6 +420,7 @@ sub bsub ($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); @@ -400,6 +464,7 @@ sub bmul ($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); @@ -451,6 +516,7 @@ sub bdiv ($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); @@ -478,6 +544,62 @@ sub bdiv $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 @@ -648,6 +770,9 @@ sub bceil 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 @@ -662,6 +787,9 @@ sub bfloor 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 @@ -767,12 +895,39 @@ sub blog 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 @@ -879,7 +1034,12 @@ sub as_number { 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; @@ -1058,7 +1218,7 @@ BigInts. $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() @@ -1079,6 +1239,15 @@ Is not yet implemented. 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(); @@ -1137,6 +1306,49 @@ and then increment it by 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: diff --git a/lib/Math/BigRat/t/bigrat.t b/lib/Math/BigRat/t/bigrat.t index dd289f241f..dd6f8ad096 100755 --- a/lib/Math/BigRat/t/bigrat.t +++ b/lib/Math/BigRat/t/bigrat.t @@ -8,7 +8,7 @@ BEGIN $| = 1; chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 151; + plan tests => 159; } # testing of Math::BigRat @@ -44,6 +44,7 @@ foreach my $func (qw/new bnorm/) $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'); @@ -54,6 +55,10 @@ foreach my $func (qw/new bnorm/) # 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 diff --git a/lib/Math/BigRat/t/bigratpm.inc b/lib/Math/BigRat/t/bigratpm.inc index fbf8338064..8b706beb44 100644 --- a/lib/Math/BigRat/t/bigratpm.inc +++ b/lib/Math/BigRat/t/bigratpm.inc @@ -2,6 +2,8 @@ ok ($class->config()->{lib},$CL); +$setup = ''; + while (<DATA>) { chomp; @@ -33,7 +35,8 @@ while (<DATA>) { $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") { @@ -168,15 +171,53 @@ sub ok_undef } __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 diff --git a/lib/Math/BigRat/t/bigratpm.t b/lib/Math/BigRat/t/bigratpm.t index 1ef0a88387..befed733d0 100755 --- a/lib/Math/BigRat/t/bigratpm.t +++ b/lib/Math/BigRat/t/bigratpm.t @@ -26,7 +26,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 491; + plan tests => 525; } use Math::BigRat; diff --git a/lib/Math/BigRat/t/bigratup.t b/lib/Math/BigRat/t/bigratup.t new file mode 100644 index 0000000000..99c4dc3811 --- /dev/null +++ b/lib/Math/BigRat/t/bigratup.t @@ -0,0 +1,38 @@ +#!/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'); + + + + diff --git a/lib/Math/BigRat/t/requirer.t b/lib/Math/BigRat/t/requirer.t new file mode 100644 index 0000000000..6805658624 --- /dev/null +++ b/lib/Math/BigRat/t/requirer.t @@ -0,0 +1,41 @@ +#!/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 + diff --git a/lib/Math/BigRat/t/trap.t b/lib/Math/BigRat/t/trap.t new file mode 100644 index 0000000000..ccd9ae8143 --- /dev/null +++ b/lib/Math/BigRat/t/trap.t @@ -0,0 +1,86 @@ +#!/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 + |