From: Rafael Garcia-Suarez Date: Thu, 19 Feb 2004 21:17:10 +0000 (+0000) Subject: Upgrade to prereleases of Math::BigInt 1.70 and X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9b924220109ab5ca4ffe2f23c240236dc5a723c2;p=p5sagit%2Fp5-mst-13.2.git Upgrade to prereleases of Math::BigInt 1.70 and Math::BigRat 0.12, by Tels. p4raw-id: //depot/perl@22344 --- diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index a8b53b0..a4ddd38 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -5,14 +5,14 @@ package Math::BigFloat; # # The following hash values are internally used: -# _e: exponent (BigInt) -# _m: mantissa (absolute BigInt) -# 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.43'; +# _e : exponent (ref to $CALC object) +# _m : mantissa (ref to $CALC object) +# _es : sign of _e +# sign : +,-,+inf,-inf, or "NaN" if not a number +# _a : accuracy +# _p : precision + +$VERSION = '1.44'; require 5.005; require Exporter; @@ -45,23 +45,19 @@ $div_scale = 40; $upgrade = undef; $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: - -sub MB_NEVER_ROUND () { 0x0001; } +# the package we are using for our private parts, defaults to: +# Math::BigInt->config()->{lib} +my $MBI = 'Math::BigInt::Calc'; # are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config() $_trap_nan = 0; -# the same for infs +# the same for infinity $_trap_inf = 0; # constant for easier life my $nan = 'NaN'; -my $IMPORT = 0; # was import() called yet? - # used to make require work +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 = @@ -129,9 +125,9 @@ sub new # shortcut for bigints and its subclasses if ((ref($wanted)) && (ref($wanted) ne $class)) { - $self->{_m} = $wanted->as_number(); # get us a bigint copy - $self->{_e} = $MBI->bzero(); - $self->{_m}->babs(); + $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy + $self->{_e} = $MBI->_zero(); + $self->{_es} = '+'; $self->{sign} = $wanted->sign(); return $self->bnorm(); } @@ -141,15 +137,15 @@ sub new { return $downgrade->new($wanted) if $downgrade; - $self->{_e} = $MBI->bzero(); - $self->{_m} = $MBI->bzero(); + $self->{_e} = $MBI->_zero(); + $self->{_es} = '+'; + $self->{_m} = $MBI->_zero(); $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf'; return $self->bnorm(); } - #print "new string '$wanted'\n"; - my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split(\$wanted); + my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($wanted); if (!ref $mis) { if ($_trap_nan) @@ -160,60 +156,84 @@ sub new return $downgrade->bnan() if $downgrade; - $self->{_e} = $MBI->bzero(); - $self->{_m} = $MBI->bzero(); + $self->{_e} = $MBI->_zero(); + $self->{_es} = '+'; + $self->{_m} = $MBI->_zero(); $self->{sign} = $nan; } else { - # make integer from mantissa by adjusting exp, then convert to bigint - # undef,undef to signal MBI that we don't need no bloody rounding - $self->{_e} = $MBI->new("$$es$$ev",undef,undef); # exponent - $self->{_m} = $MBI->new("$$miv$$mfv",undef,undef); # create mant. - - # this is to prevent automatically rounding when MBI's globals are set - $self->{_m}->{_f} = MB_NEVER_ROUND; - $self->{_e}->{_f} = MB_NEVER_ROUND; + # make integer from mantissa by adjusting exp, then convert to int + $self->{_e} = $MBI->_new($$ev); # exponent + $self->{_es} = $$es || '+'; + my $mantissa = "$$miv$$mfv"; # create mant. + $mantissa =~ s/^0+(\d)/$1/; # strip leading zeros + $self->{_m} = $MBI->_new($mantissa); # create mant. # 3.123E0 = 3123E-3, and 3.123E-2 => 3123E-5 - $self->{_e}->bsub( $MBI->new(CORE::length($$mfv),undef,undef)) - if CORE::length($$mfv) != 0; + if (CORE::length($$mfv) != 0) + { + my $len = $MBI->_new( CORE::length($$mfv)); + ($self->{_e}, $self->{_es}) = + _e_sub ($self->{_e}, $len, $self->{_es}, '+'); + } $self->{sign} = $$mis; - #print "$$miv$$mfv $$es$$ev\n"; - # we can only have trailing zeros on the mantissa of $$mfv eq '' if (CORE::length($$mfv) == 0) { - my $zeros = $self->{_m}->_trailing_zeros(); # correct for trailing zeros + my $zeros = $MBI->_zeros($self->{_m}); # correct for trailing zeros if ($zeros != 0) { - $self->{_m}->brsft($zeros,10); $self->{_e}->badd($MBI->new($zeros)); + my $z = $MBI->_new($zeros); + $MBI->_rsft ( $self->{_m}, $z, 10); + _e_add ( $self->{_e}, $z, $self->{_es}, '+'); } } -# else -# { - # for something like 0Ey, set y to 1, and -0 => +0 - $self->{sign} = '+', $self->{_e}->bone() if $self->{_m}->is_zero(); -# } + # for something like 0Ey, set y to 1, and -0 => +0 + $self->{sign} = '+', $self->{_e} = $MBI->_one() + if $MBI->_is_zero($self->{_m}); return $self->round(@r) if !$downgrade; } # if downgrade, inf, NaN or integers go down - if ($downgrade && $self->{_e}->{sign} eq '+') + if ($downgrade && $self->{_es} eq '+') { - #print "downgrading $$miv$$mfv"."E$$es$$ev"; - if ($self->{_e}->is_zero()) + if ($MBI->_is_zero( $self->{_e} )) { - $self->{_m}->{sign} = $$mis; # negative if wanted - return $downgrade->new($self->{_m}); + return $downgrade->new($$mis . $MBI->_str( $self->{_m} )); } return $downgrade->new($self->bsstr()); } - #print "mbf new $self->{sign} $self->{_m} e $self->{_e} ",ref($self),"\n"; $self->bnorm()->round(@r); # first normalize, then round } +sub copy + { + my ($c,$x); + if (@_ > 1) + { + # if two arguments, the first one is the class to "swallow" subclasses + ($c,$x) = @_; + } + else + { + $x = shift; + $c = ref($x); + } + return unless ref($x); # only for objects + + my $self = {}; bless $self,$c; + + $self->{sign} = $x->{sign}; + $self->{_es} = $x->{_es}; + $self->{_m} = $MBI->_copy($x->{_m}); + $self->{_e} = $MBI->_copy($x->{_e}); + $self->{_a} = $x->{_a} if defined $x->{_a}; + $self->{_p} = $x->{_p} if defined $x->{_p}; + $self; + } + sub _bnan { # used by parent class bone() to initialize number to NaN @@ -227,8 +247,9 @@ sub _bnan } $IMPORT=1; # call our import only once - $self->{_m} = $MBI->bzero(); - $self->{_e} = $MBI->bzero(); + $self->{_m} = $MBI->_zero(); + $self->{_e} = $MBI->_zero(); + $self->{_es} = '+'; } sub _binf @@ -244,8 +265,9 @@ sub _binf } $IMPORT=1; # call our import only once - $self->{_m} = $MBI->bzero(); - $self->{_e} = $MBI->bzero(); + $self->{_m} = $MBI->_zero(); + $self->{_e} = $MBI->_zero(); + $self->{_es} = '+'; } sub _bone @@ -253,8 +275,9 @@ 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(); + $self->{_m} = $MBI->_one(); + $self->{_e} = $MBI->_zero(); + $self->{_es} = '+'; } sub _bzero @@ -262,8 +285,9 @@ sub _bzero # 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(); + $self->{_m} = $MBI->_zero(); + $self->{_e} = $MBI->_one(); + $self->{_es} = '+'; } sub isa @@ -305,26 +329,26 @@ sub bstr my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.'; # $x is zero? - my $not_zero = !($x->{sign} eq '+' && $x->{_m}->is_zero()); + my $not_zero = !($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})); if ($not_zero) { - $es = $x->{_m}->bstr(); + $es = $MBI->_str($x->{_m}); $len = CORE::length($es); - my $e = $x->{_e}->numify(); + my $e = $MBI->_num($x->{_e}); + $e = -$e if $x->{_es} eq '-'; if ($e < 0) { $dot = ''; # if _e is bigger than a scalar, the following will blow your memory if ($e <= -$len) { - #print "style: 0.xxxx\n"; my $r = abs($e) - $len; $es = '0.'. ('0' x $r) . $es; $cad = -($len+$r); } else { - #print "insert '.' at $e in '$es'\n"; - substr($es,$e,0) = '.'; $cad = $x->{_e}; + substr($es,$e,0) = '.'; $cad = $MBI->_num($x->{_e}); + $cad = -$cad if $x->{_es} eq '-'; } } elsif ($e > 0) @@ -333,6 +357,7 @@ sub bstr $es .= '0' x $e; $len += $e; $cad = 0; } } # if not zero + $es = '-'.$es if $x->{sign} eq '-'; # if set accuracy or precision, pad with zeros on the right side if ((defined $x->{_a}) && ($not_zero)) @@ -363,11 +388,9 @@ sub bsstr return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } - # do $esign, because we need '1e+1', since $x->{_e}->bstr() misses the + - my $esign = $x->{_e}->{sign}; $esign = '' if $esign eq '-'; - my $sep = 'e'.$esign; + my $sep = 'e'.$x->{_es}; my $sign = $x->{sign}; $sign = '' if $sign eq '+'; - $sign . $x->{_m}->bstr() . $sep . $x->{_e}->bstr(); + $sign . $MBI->_str($x->{_m}) . $sep . $MBI->_str($x->{_e}); } sub numify @@ -427,11 +450,14 @@ sub bcmp return 1 if $yz && $x->{sign} eq '+'; # +x <=> 0 # adjust so that exponents are equal - my $lxm = $x->{_m}->length(); - my $lym = $y->{_m}->length(); + my $lxm = $MBI->_len($x->{_m}); + my $lym = $MBI->_len($y->{_m}); # the numify somewhat limits our length, but makes it much faster - my $lx = $lxm + $x->{_e}->numify(); - my $ly = $lym + $y->{_e}->numify(); + my ($xes,$yes) = (1,1); + $xes = -1 if $x->{_es} ne '+'; + $yes = -1 if $y->{_es} ne '+'; + my $lx = $lxm + $xes * $MBI->_num($x->{_e}); + my $ly = $lym + $yes * $MBI->_num($y->{_e}); my $l = $lx - $ly; $l = -$l if $x->{sign} eq '-'; return $l <=> 0 if $l != 0; @@ -442,13 +468,15 @@ sub bcmp my $ym = $y->{_m}; if ($diff > 0) { - $ym = $y->{_m}->copy()->blsft($diff,10); + $ym = $MBI->_copy($y->{_m}); + $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10); } elsif ($diff < 0) { - $xm = $x->{_m}->copy()->blsft(-$diff,10); + $xm = $MBI->_copy($x->{_m}); + $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10); } - my $rc = $xm->bacmp($ym); + my $rc = $MBI->_acmp($xm,$ym); $rc = -$rc if $x->{sign} eq '-'; # -124 < -123 $rc <=> 0; } @@ -486,11 +514,14 @@ sub bacmp return 1 if $yz && !$xz; # +x <=> 0 # adjust so that exponents are equal - my $lxm = $x->{_m}->length(); - my $lym = $y->{_m}->length(); + my $lxm = $MBI->_len($x->{_m}); + my $lym = $MBI->_len($y->{_m}); + my ($xes,$yes) = (1,1); + $xes = -1 if $x->{_es} ne '+'; + $yes = -1 if $y->{_es} ne '+'; # the numify somewhat limits our length, but makes it much faster - my $lx = $lxm + $x->{_e}->numify(); - my $ly = $lym + $y->{_e}->numify(); + my $lx = $lxm + $xes * $MBI->_num($x->{_e}); + my $ly = $lym + $yes * $MBI->_num($y->{_e}); my $l = $lx - $ly; return $l <=> 0 if $l != 0; @@ -501,13 +532,15 @@ sub bacmp my $ym = $y->{_m}; if ($diff > 0) { - $ym = $y->{_m}->copy()->blsft($diff,10); + $ym = $MBI->_copy($y->{_m}); + $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10); } elsif ($diff < 0) { - $xm = $x->{_m}->copy()->blsft(-$diff,10); + $xm = $MBI->_copy($x->{_m}); + $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10); } - $xm->bacmp($ym) <=> 0; + $MBI->_acmp($xm,$ym); } sub badd @@ -548,33 +581,46 @@ sub badd if ($x->is_zero()) # 0+y { # make copy, clobbering up x (modify in place!) - $x->{_e} = $y->{_e}->copy(); - $x->{_m} = $y->{_m}->copy(); + $x->{_e} = $MBI->_copy($y->{_e}); + $x->{_es} = $y->{_es}; + $x->{_m} = $MBI->_copy($y->{_m}); $x->{sign} = $y->{sign} || $nan; return $x->round($a,$p,$r,$y); } # take lower of the two e's and adapt m1 to it to match m2 my $e = $y->{_e}; - $e = $MBI->bzero() if !defined $e; # if no BFLOAT ? - $e = $e->copy(); # make copy (didn't do it yet) - $e->bsub($x->{_e}); # Ye - Xe - my $add = $y->{_m}->copy(); - if ($e->{sign} eq '-') # < 0 + $e = $MBI->_zero() if !defined $e; # if no BFLOAT? + $e = $MBI->_copy($e); # make copy (didn't do it yet) + + my $es; + + ($e,$es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es}); + + my $add = $MBI->_copy($y->{_m}); + + if ($es eq '-') # < 0 { - $x->{_e} += $e; # need the sign of e - $x->{_m}->blsft($e->babs(),10); # destroys copy of _e + $MBI->_lsft( $x->{_m}, $e, 10); + ($x->{_e},$x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); } - elsif (!$e->is_zero()) # > 0 + elsif (!$MBI->_is_zero($e)) # > 0 { - $add->blsft($e,10); + $MBI->_lsft($add, $e, 10); } # else: both e are the same, so just leave them - $x->{_m}->{sign} = $x->{sign}; # fiddle with signs - $add->{sign} = $y->{sign}; - $x->{_m} += $add; # finally do add/sub - $x->{sign} = $x->{_m}->{sign}; # re-adjust signs - $x->{_m}->{sign} = '+'; # mantissa always positiv + + if ($x->{sign} eq $y->{sign}) + { + # add + $x->{_m} = $MBI->_add($x->{_m}, $add); + } + else + { + ($x->{_m}, $x->{sign}) = + _e_add($x->{_m}, $add, $x->{sign}, $y->{sign}); + } + # delete trailing zeros, then round $x->bnorm()->round($a,$p,$r,$y); } @@ -609,29 +655,30 @@ sub binc # increment arg by one my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); - if ($x->{_e}->sign() eq '-') + if ($x->{_es} eq '-') { return $x->badd($self->bone(),@r); # digits after dot } - if (!$x->{_e}->is_zero()) # _e == 0 for NaN, inf, -inf + if (!$MBI->_is_zero($x->{_e})) # _e == 0 for NaN, inf, -inf { # 1e2 => 100, so after the shift below _m has a '0' as last digit - $x->{_m}->blsft($x->{_e},10); # 1e2 => 100 - $x->{_e}->bzero(); # normalize + $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e},10); # 1e2 => 100 + $x->{_e} = $MBI->_zero(); # normalize + $x->{_es} = '+'; # we know that the last digit of $x will be '1' or '9', depending on the # sign } # now $x->{_e} == 0 if ($x->{sign} eq '+') { - $x->{_m}->binc(); + $MBI->_inc($x->{_m}); return $x->bnorm()->bround(@r); } elsif ($x->{sign} eq '-') { - $x->{_m}->bdec(); - $x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0 + $MBI->_dec($x->{_m}); + $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0 return $x->bnorm()->bround(@r); } # inf, nan handling etc @@ -643,34 +690,35 @@ sub bdec # decrement arg by one my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); - if ($x->{_e}->sign() eq '-') + if ($x->{_es} eq '-') { return $x->badd($self->bone('-'),@r); # digits after dot } - if (!$x->{_e}->is_zero()) + if (!$MBI->_is_zero($x->{_e})) { - $x->{_m}->blsft($x->{_e},10); # 1e2 => 100 - $x->{_e}->bzero(); + $x->{_m} = $MBI->_lsft($x->{_m}, $x->{_e},10); # 1e2 => 100 + $x->{_e} = $MBI->_zero(); # normalize + $x->{_es} = '+'; } # now $x->{_e} == 0 my $zero = $x->is_zero(); # <= 0 if (($x->{sign} eq '-') || $zero) { - $x->{_m}->binc(); - $x->{sign} = '-' if $zero; # 0 => 1 => -1 - $x->{sign} = '+' if $x->{_m}->is_zero(); # -1 +1 => -0 => +0 + $MBI->_inc($x->{_m}); + $x->{sign} = '-' if $zero; # 0 => 1 => -1 + $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # -1 +1 => -0 => +0 return $x->bnorm()->round(@r); } # > 0 elsif ($x->{sign} eq '+') { - $x->{_m}->bdec(); + $MBI->_dec($x->{_m}); return $x->bnorm()->round(@r); } # inf, nan handling etc - $x->badd($self->bone('-'),@r); # does round + $x->badd($self->bone('-'),@r); # does round } sub DEBUG () { 0; } @@ -690,6 +738,7 @@ sub blog # also takes care of the "error in _find_round_parameters?" case return $x->bnan() if $x->{sign} ne '+' || $x->is_zero(); + # no rounding at all, so must use fallback if (scalar @params == 0) { @@ -747,15 +796,18 @@ sub blog # stop right here. if (defined $base && $base->is_int() && $x->is_int()) { - my $int = $x->{_m}->copy(); - $int->blsft($x->{_e},10) unless $x->{_e}->is_zero(); + my $i = $MBI->_copy( $x->{_m} ); + $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e}); + my $int = Math::BigInt->bzero(); + $int->{value} = $i; $int->blog($base->as_number()); # if ($exact) - if ($base->copy()->bpow($int) == $x) + if ($base->as_number()->bpow($int) == $x) { # found result, return it - $x->{_m} = $int; - $x->{_e} = $MBI->bzero(); + $x->{_m} = $int->{value}; + $x->{_e} = $MBI->_zero(); + $x->{_es} = '+'; $x->bnorm(); $done = 1; } @@ -765,7 +817,7 @@ sub blog { # first calculate the log to base e (using reduction by 10 (and probably 2)) $self->_log_10($x,$scale); - + # and if a different base was requested, convert it if (defined $base) { @@ -862,7 +914,6 @@ sub _log 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) @@ -893,7 +944,9 @@ sub _log_10 # log(10) afterwards to get the correct result. # calculate nr of digits before dot - my $dbd = $x->{_m}->length() + $x->{_e}->numify(); + my $dbd = $MBI->_num($x->{_e}); + $dbd = -$dbd if $x->{_es} eq '-'; + $dbd += $MBI->_len($x->{_m}); # more than one digit (e.g. at least 10), but *not* exactly 10 to avoid # infinite recursion @@ -902,7 +955,7 @@ sub _log_10 # 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()) + if ($x->{_es} eq '+' && $MBI->_is_one($x->{_e}) && $MBI->_is_one($x->{_m})) { $dbd = 0; # disable shortcut # we can use the cached value in these cases @@ -915,7 +968,7 @@ sub _log_10 else { # disable the shortcut for 2, since we maybe have it cached - if ($x->{_e}->is_zero() && $x->{_m}->bcmp(2) == 0) + if (($MBI->_is_zero($x->{_e}) && $MBI->_is_two($x->{_m}))) { $dbd = 0; # disable shortcut # we can use the cached value in these cases @@ -928,7 +981,8 @@ sub _log_10 } # if $x = 0.1, we know the result must be 0-log(10) - if ($calc != 0 && $x->{_e}->is_one('-') && $x->{_m}->is_one()) + if ($calc != 0 && $x->{_es} eq '-' && $MBI->_is_one($x->{_e}) && + $MBI->_is_one($x->{_m})) { $dbd = 0; # disable shortcut # we can use the cached value in these cases @@ -962,7 +1016,6 @@ sub _log_10 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 @@ -970,21 +1023,18 @@ sub _log_10 # 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"; + $l_10->bmul( $self->new($dbd)); # log(10) * (digits_before_dot-1) + my $dbd_sign = '+'; + if ($dbd < 0) + { + $dbd = -$dbd; + $dbd_sign = '-'; + } + ($x->{_e}, $x->{_es}) = + _e_sub( $x->{_e}, $MBI->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23 } @@ -1004,7 +1054,6 @@ sub _log_10 { $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) @@ -1013,7 +1062,6 @@ sub _log_10 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 @@ -1021,7 +1069,6 @@ sub _log_10 # else: slower, compute it (but don't cache it, because it could be big) # also disable downgrade for this code path local $Math::BigFloat::downgrade = undef; - #print "calculating value for l_2, scale $scale\n"; $l_2 = $two->blog(undef,$scale); # scale+4, actually } $l_2->bmul($twos); # * -2 => subtract, * 2 => add @@ -1057,25 +1104,63 @@ sub bgcd $x; } -############################################################################### -# is_foo methods (is_negative, is_positive are inherited from BigInt) +############################################################################## -sub _is_zero_or_one +sub _e_add { - # internal, return true if BigInt arg is zero or one, saving the - # two calls to is_zero() and is_one() - my $x = $_[0]; + # Internal helper sub to take two positive integers and their signs and + # then add them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')), + # output ($CALC,('+'|'-')) + my ($x,$y,$xs,$ys) = @_; + + # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8) + if ($xs eq $ys) + { + $x = $MBI->_add ($x, $y ); # a+b + # the sign follows $xs + return ($x, $xs); + } - $x->{sign} eq '+' && ($x->is_zero() || $x->is_one()); + my $a = $MBI->_acmp($x,$y); + if ($a > 0) + { + $x = $MBI->_sub ($x , $y); # abs sub + } + elsif ($a == 0) + { + $x = $MBI->_zero(); # result is 0 + $xs = '+'; + } + else # a < 0 + { + $x = $MBI->_sub ( $y, $x, 1 ); # abs sub + $xs = $ys; + } + ($x,$xs); } +sub _e_sub + { + # Internal helper sub to take two positive integers and their signs and + # then subtract them. Input ($CALC,$CALC,('+'|'-'),('+'|'-')), + # output ($CALC,('+'|'-')) + my ($x,$y,$xs,$ys) = @_; + + # flip sign + $ys =~ tr/+-/-+/; + _e_add($x,$y,$xs,$ys); # call add (does subtract now) + } + +############################################################################### +# is_foo methods (is_negative, is_positive are inherited from BigInt) + sub is_int { # return true if arg (BFLOAT or num_str) is an integer my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't - $x->{_e}->{sign} eq '+'; # 1e-1 => no integer + $x->{_es} eq '+'; # 1e-1 => no integer 0; } @@ -1084,7 +1169,7 @@ sub is_zero # return true if arg (BFLOAT or num_str) is zero my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero(); + return 1 if $x->{sign} eq '+' && $MBI->_is_zero($x->{_m}); 0; } @@ -1095,7 +1180,8 @@ sub is_one $sign = '+' if !defined $sign || $sign ne '-'; return 1 - if ($x->{sign} eq $sign && $x->{_e}->is_zero() && $x->{_m}->is_one()); + if ($x->{sign} eq $sign && + $MBI->_is_zero($x->{_e}) && $MBI->_is_one($x->{_m})); 0; } @@ -1105,7 +1191,7 @@ sub is_odd my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't - ($x->{_e}->is_zero() && $x->{_m}->is_odd()); + ($MBI->_is_zero($x->{_e}) && $MBI->_is_odd($x->{_m})); 0; } @@ -1115,8 +1201,8 @@ sub is_even my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't - return 1 if ($x->{_e}->{sign} eq '+' # 123.45 is never - && $x->{_m}->is_even()); # but 1200 is + return 1 if ($x->{_es} eq '+' # 123.45 is never + && $MBI->_is_even($x->{_m})); # but 1200 is 0; } @@ -1153,8 +1239,9 @@ sub bmul ((!$x->isa($self)) || (!$y->isa($self))); # aEb * cEd = (a*c)E(b+d) - $x->{_m}->bmul($y->{_m}); - $x->{_e}->badd($y->{_e}); + $MBI->_mul($x->{_m},$y->{_m}); + ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + # adjust sign: $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+'; return $x->bnorm()->round($a,$p,$r,$y); @@ -1204,7 +1291,7 @@ sub bdiv # enough... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } - my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length(); + my $lx = $MBI->_len($x->{_m}); my $ly = $MBI->_len($y->{_m}); $scale = $lx if $lx > $scale; $scale = $ly if $ly > $scale; my $diff = $ly - $lx; @@ -1225,15 +1312,16 @@ sub bdiv # promote BigInts and it's subclasses (except when already a BigFloat) $y = $self->new($y) unless $y->isa('Math::BigFloat'); - # need to disable $upgrade in BigInt, to avoid deep recursion - local $Math::BigInt::upgrade = undef; # should be parent class vs MBI - # calculate the result to $scale digits and then round it # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d) - $x->{_m}->blsft($scale,10); - $x->{_m}->bdiv( $y->{_m} ); # a/c - $x->{_e}->bsub( $y->{_e} ); # b-d - $x->{_e}->bsub($scale); # correct for 10**scale + $MBI->_lsft($x->{_m},$MBI->_new($scale),10); + $MBI->_div ($x->{_m},$y->{_m} ); # a/c + + ($x->{_e},$x->{_es}) = + _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); + # correct for 10**scale + ($x->{_e},$x->{_es}) = + _e_sub($x->{_e}, $MBI->_new($scale), $x->{_es}, '+'); $x->bnorm(); # remove trailing 0's } @@ -1286,6 +1374,7 @@ sub bmod ($self,$x,$y,$a,$p,$r) = objectify(2,@_); } + # handle NaN, inf, -inf if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { my ($d,$re) = $self->SUPER::_div_inf($x,$y); @@ -1294,13 +1383,13 @@ sub bmod $x->{_m} = $re->{_m}; return $x->round($a,$p,$r,$y); } - return $x->bnan() if $x->is_zero() && $y->is_zero(); - return $x if $y->is_zero(); - return $x->bnan() if $x->is_nan() || $y->is_nan(); + if ($y->is_zero()) + { + return $x->bnan() if $x->is_zero(); + return $x; + } return $x->bzero() if $y->is_one() || $x->is_zero(); - # inf handling is missing here - my $cmp = $x->bacmp($y); # equal or $x < $y? return $x->bzero($a,$p) if $cmp == 0; # $x == $y => result 0 @@ -1310,43 +1399,45 @@ sub bmod $x->{sign} = $y->{sign}; # calc sign first return $x->round($a,$p,$r) if $cmp < 0 && $neg == 0; # $x < $y => result $x - my $ym = $y->{_m}->copy(); + my $ym = $MBI->_copy($y->{_m}); # 2e1 => 20 - $ym->blsft($y->{_e},10) if $y->{_e}->{sign} eq '+' && !$y->{_e}->is_zero(); + $MBI->_lsft( $ym, $y->{_e}, 10) + if $y->{_es} eq '+' && !$MBI->_is_zero($y->{_e}); # if $y has digits after dot my $shifty = 0; # correct _e of $x by this - if ($y->{_e}->{sign} eq '-') # has digits after dot + if ($y->{_es} eq '-') # has digits after dot { # 123 % 2.5 => 1230 % 25 => 5 => 0.5 - $shifty = $y->{_e}->copy()->babs(); # no more digits after dot - $x->blsft($shifty,10); # 123 => 1230, $y->{_m} is already 25 + $shifty = $MBI->_num($y->{_e}); # no more digits after dot + $MBI->_lsft($x->{_m}, $y->{_e}, 10);# 123 => 1230, $y->{_m} is already 25 } # $ym is now mantissa of $y based on exponent 0 my $shiftx = 0; # correct _e of $x by this - if ($x->{_e}->{sign} eq '-') # has digits after dot + if ($x->{_es} eq '-') # has digits after dot { # 123.4 % 20 => 1234 % 200 - $shiftx = $x->{_e}->copy()->babs(); # no more digits after dot - $ym->blsft($shiftx,10); + $shiftx = $MBI->_num($x->{_e}); # no more digits after dot + $MBI->_lsft($ym, $x->{_e}, 10); # 123 => 1230 } # 123e1 % 20 => 1230 % 20 - if ($x->{_e}->{sign} eq '+' && !$x->{_e}->is_zero()) + if ($x->{_es} eq '+' && !$MBI->_is_zero($x->{_e})) { - $x->{_m}->blsft($x->{_e},10); + $MBI->_lsft( $x->{_m}, $x->{_e},10); # es => '+' here } - $x->{_e} = $MBI->bzero() unless $x->{_e}->is_zero(); - - $x->{_e}->bsub($shiftx) if $shiftx != 0; - $x->{_e}->bsub($shifty) if $shifty != 0; + + $x->{_e} = $MBI->_new($shiftx); + $x->{_es} = '+'; + $x->{_es} = '-' if $shiftx != 0 || $shifty != 0; + $MBI->_add( $x->{_e}, $MBI->_new($shifty)) if $shifty != 0; # now mantissas are equalized, exponent of $x is adjusted, so calc result - $x->{_m}->bmod($ym); + $x->{_m} = $MBI->_mod( $x->{_m}, $ym); - $x->{sign} = '+' if $x->{_m}->is_zero(); # fix sign for -0 + $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0 $x->bnorm(); if ($neg != 0) # one of them negative => correct in place @@ -1354,7 +1445,8 @@ sub bmod my $r = $y - $x; $x->{_m} = $r->{_m}; $x->{_e} = $r->{_e}; - $x->{sign} = '+' if $x->{_m}->is_zero(); # fix sign for -0 + $x->{_es} = $r->{_es}; + $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0 $x->bnorm(); } @@ -1392,7 +1484,7 @@ sub broot # 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 + $params[2] = $r; # iound mode by caller or undef $fallback = 1; # to clear a/p afterwards } else @@ -1414,7 +1506,7 @@ sub broot 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(); + my $sign = 0; $sign = 1 if $x->{sign} eq '-'; $x->babs(); if ($y->bcmp(2) == 0) # normal square root { @@ -1427,6 +1519,7 @@ sub broot # copy private parts over $x->{_m} = $u->{_m}; $x->{_e} = $u->{_e}; + $x->{_es} = $u->{_es}; } else { @@ -1436,15 +1529,18 @@ sub broot my $done = 0; # not yet if ($y->is_int() && $x->is_int()) { - my $int = $x->{_m}->copy(); - $int->blsft($x->{_e},10) unless $x->{_e}->is_zero(); + my $i = $MBI->_copy( $x->{_m} ); + $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e}); + my $int = Math::BigInt->bzero(); + $int->{value} = $i; $int->broot($y->as_number()); # if ($exact) if ($int->copy()->bpow($y) == $x) { # found result, return it - $x->{_m} = $int; - $x->{_e} = $MBI->bzero(); + $x->{_m} = $int->{value}; + $x->{_e} = $MBI->_zero(); + $x->{_es} = '+'; $x->bnorm(); $done = 1; } @@ -1520,15 +1616,20 @@ sub bsqrt # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI - my $xas = $x->as_number(); + my $i = $MBI->_copy( $x->{_m} ); + $MBI->_lsft( $i, $x->{_e}, 10 ) unless $MBI->_is_zero($x->{_e}); + my $xas = Math::BigInt->bzero(); + $xas->{value} = $i; + my $gs = $xas->copy()->bsqrt(); # some guess - if (($x->{_e}->{sign} ne '-') # guess can't be accurate if there are + if (($x->{_es} ne '-') # guess can't be accurate if there are # digits after the dot && ($xas->bacmp($gs * $gs) == 0)) # guess hit the nail on the head? { - # exact result - $x->{_m} = $gs; $x->{_e} = $MBI->bzero(); $x->bnorm(); + # exact result, copy result over to keep $x + $x->{_m} = $gs->{value}; $x->{_e} = $MBI->_zero(); $x->{_es} = '+'; + $x->bnorm(); # shortcut to not run through _find_round_parameters again if (defined $params[0]) { @@ -1551,32 +1652,45 @@ sub bsqrt # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy # of the result by multipyling the input by 100 and then divide the integer # result of sqrt(input) by 10. Rounding afterwards returns the real result. - # this will transform 123.456 (in $x) into 123456 (in $y1) - my $y1 = $x->{_m}->copy(); + + # The following steps will transform 123.456 (in $x) into 123456 (in $y1) + my $y1 = $MBI->_copy($x->{_m}); + + my $length = $MBI->_len($y1); + + # Now calculate how many digits the result of sqrt(y1) would have + 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) + # $shift = 0 if $shift < 0; + + # Multiply in steps of 100, by shifting left two times the "missing" digits + my $s2 = $shift * 2; + # We now make sure that $y1 has the same odd or even number of digits than # $x had. So when _e of $x is odd, we must shift $y1 by one digit left, # because we always must multiply by steps of 100 (sqrt(100) is 10) and not # 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($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) - # $shift = 0 if $shift < 0; - # multiply in steps of 100, by shifting left two times the "missing" digits - $y1->blsft($shift*2,10); + $s2++ if $MBI->_is_odd($x->{_e}); + + $MBI->_lsft( $y1, $MBI->_new($s2), 10); + # now take the square root and truncate to integer - $y1->bsqrt(); + $y1 = $MBI->_sqrt($y1); + # 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(); + # on sign of $dat, the result should have half as many: + my $dat = $MBI->_num($x->{_e}); + $dat = -$dat if $x->{_es} eq '-'; + $dat += $length; if ($dat > 0) { @@ -1589,9 +1703,20 @@ sub bsqrt { $dat = int(($dat)/2); } - $x->{_e}= $MBI->new( $dat - $y1->length() ); - + $dat -= $MBI->_len($y1); + if ($dat < 0) + { + $dat = abs($dat); + $x->{_e} = $MBI->_new( $dat ); + $x->{_es} = '-'; + } + else + { + $x->{_e} = $MBI->_new( $dat ); + $x->{_es} = '+'; + } $x->{_m} = $y1; + $x->bnorm(); # shortcut to not run through _find_round_parameters again if (defined $params[0]) @@ -1625,15 +1750,16 @@ sub bfac return $x if $x->{sign} eq '+inf'; # inf => inf return $x->bnan() if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN - ($x->{_e}->{sign} ne '+')); # digits after dot? + ($x->{_es} ne '+')); # digits after dot? # use BigInt's bfac() for faster calc - if (! $x->{_e}->is_zero()) + if (! $MBI->_is_zero($x->{_e})) { - $x->{_m}->blsft($x->{_e},10); # change 12e1 to 120e0 - $x->{_e}->bzero(); + $MBI->_lsft($x->{_m}, $x->{_e},10); # change 12e1 to 120e0 + $x->{_e} = $MBI->_zero(); # normalize + $x->{_es} = '+'; } - $x->{_m}->bfac(); # calculate factorial + $MBI->_fac($x->{_m}); # calculate factorial $x->bnorm()->round(@r); # norm again and round result } @@ -1712,6 +1838,9 @@ sub _pow $x->badd($next); # calculate things for the next term $over *= $u; $below *= $factor; $factor->binc(); + + last if $x->{sign} !~ /^[-+]$/; + #$steps++; } @@ -1755,25 +1884,30 @@ sub bpow return $x->_pow($y,$a,$p,$r) if !$y->is_int(); # non-integer power - my $y1 = $y->as_number(); # make bigint + my $y1 = $y->as_number()->{value}; # make CALC + # if ($x == -1) - if ($x->{sign} eq '-' && $x->{_m}->is_one() && $x->{_e}->is_zero()) + if ($x->{sign} eq '-' && $MBI->_is_one($x->{_m}) && $MBI->_is_zero($x->{_e})) { # if $x == -1 and odd/even y => +1/-1 because +-1 ^ (+-1) => +-1 - return $y1->is_odd() ? $x : $x->babs(1); + return $MBI->_is_odd($y1) ? $x : $x->babs(1); } if ($x->is_zero()) { + return $x->bone() if $y->is_zero(); return $x if $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0) - # 0 ** -y => 1 / (0 ** y) => / 0! (1 / 0 => +inf) - $x->binf(); + # 0 ** -y => 1 / (0 ** y) => 1 / 0! (1 / 0 => +inf) + return $x->binf(); } + my $new_sign = '+'; + $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+'); + # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster) - $y1->babs(); - $x->{_m}->bpow($y1); - $x->{_e}->bmul($y1); - $x->{sign} = $nan if $x->{_m}->{sign} eq $nan || $x->{_e}->{sign} eq $nan; + $x->{_m} = $MBI->_pow( $x->{_m}, $y1); + $MBI->_mul ($x->{_e}, $y1); + + $x->{sign} = $new_sign; $x->bnorm(); if ($y->{sign} eq '-') { @@ -1795,7 +1929,7 @@ sub bfround my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x); return $x if $x->modify('bfround'); - + my ($scale,$mode) = $x->_scale_p($self->precision(),$self->round_mode(),@_); return $x if !defined $scale; # no-op @@ -1816,18 +1950,18 @@ sub bfround { # round right from the '.' - return $x if $x->{_e}->{sign} eq '+'; # e >= 0 => nothing to round + return $x if $x->{_es} eq '+'; # e >= 0 => nothing to round $scale = -$scale; # positive for simplicity - my $len = $x->{_m}->length(); # length of mantissa + my $len = $MBI->_len($x->{_m}); # length of mantissa # the following poses a restriction on _e, but if _e is bigger than a # scalar, you got other problems (memory etc) anyway - my $dad = -($x->{_e}->numify()); # digits after dot + my $dad = -(0+ ($x->{_es}.$MBI->_num($x->{_e}))); # digits after dot my $zad = 0; # zeros after dot $zad = $dad - $len if (-$dad < -$len); # for 0.00..00xxx style - - #print "scale $scale dad $dad zad $zad len $len\n"; + + # p rint "scale $scale dad $dad zad $zad len $len\n"; # number bsstr len zad dad # 0.123 123e-3 3 0 3 # 0.0123 123e-4 3 1 4 @@ -1865,9 +1999,9 @@ sub bfround # 123 => 100 means length(123) = 3 - $scale (2) => 1 - my $dbt = $x->{_m}->length(); + my $dbt = $MBI->_len($x->{_m}); # digits before dot - my $dbd = $dbt + $x->{_e}->numify(); + my $dbd = $dbt + ($x->{_es} . $MBI->_num($x->{_e})); # should be the same, so treat it as this $scale = 1 if $scale == 0; # shortcut if already integer @@ -1891,9 +2025,9 @@ sub bfround } } # pass sign to bround for rounding modes '+inf' and '-inf' - $x->{_m}->{sign} = $x->{sign}; - $x->{_m}->bround($scale,$mode); - $x->{_m}->{sign} = '+'; # fix sign back + my $m = Math::BigInt->new( $x->{sign} . $MBI->_str($x->{_m})); + $m->bround($scale,$mode); + $x->{_m} = $m->{value}; # get our mantissa back $x->bnorm(); } @@ -1901,7 +2035,7 @@ 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); - + if (($_[0] || 0) < 0) { require Carp; Carp::croak ('bround() needs positive accuracy'); @@ -1925,16 +2059,17 @@ sub bround # 1: $scale == 0 => keep all digits # 2: never round a 0 # 3: if we should keep more digits than the mantissa has, do nothing - if ($scale == 0 || $x->is_zero() || $x->{_m}->length() <= $scale) + if ($scale == 0 || $x->is_zero() || $MBI->_len($x->{_m}) <= $scale) { $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; return $x; } # pass sign to bround for '+inf' and '-inf' rounding modes - $x->{_m}->{sign} = $x->{sign}; - $x->{_m}->bround($scale,$mode); # round mantissa - $x->{_m}->{sign} = '+'; # fix sign back + my $m = Math::BigInt->new( $x->{sign} . $MBI->_str($x->{_m})); + + $m->bround($scale,$mode); # round mantissa + $x->{_m} = $m->{value}; # get our mantissa back $x->{_a} = $scale; # remember rounding delete $x->{_p}; # and clear P $x->bnorm(); # del trailing zeros gen. by bround() @@ -1950,12 +2085,12 @@ sub bfloor return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf # if $x has digits after dot - if ($x->{_e}->{sign} eq '-') + if ($x->{_es} eq '-') { - $x->{_e}->{sign} = '+'; # negate e - $x->{_m}->brsft($x->{_e},10); # cut off digits after dot - $x->{_e}->bzero(); # trunc/norm - $x->{_m}->binc() if $x->{sign} eq '-'; # decrement if negative + $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot + $x->{_e} = $MBI->_zero(); # trunc/norm + $x->{_es} = '+'; # abs e + $MBI->_inc($x->{_m}) if $x->{sign} eq '-'; # increment if negative } $x->round($a,$p,$r); } @@ -1969,16 +2104,12 @@ sub bceil return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf # if $x has digits after dot - if ($x->{_e}->{sign} eq '-') + if ($x->{_es} eq '-') { - #$x->{_m}->brsft(-$x->{_e},10); - #$x->{_e}->bzero(); - #$x++ if $x->{sign} eq '+'; - - $x->{_e}->{sign} = '+'; # negate e - $x->{_m}->brsft($x->{_e},10); # cut off digits after dot - $x->{_e}->bzero(); # trunc/norm - $x->{_m}->binc() if $x->{sign} eq '+'; # decrement if negative + $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot + $x->{_e} = $MBI->_zero(); # trunc/norm + $x->{_es} = '+'; # abs e + $MBI->_inc($x->{_m}) if $x->{sign} eq '+'; # increment if positive } $x->round($a,$p,$r); } @@ -2054,7 +2185,7 @@ sub AUTOLOAD } # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx() $name =~ s/^f/b/; - return &{"$MBI"."::$name"}(@_); + return &{"Math::BigInt"."::$name"}(@_); } my $bname = $name; $bname =~ s/^f/b/; $c .= "::$name"; @@ -2070,9 +2201,9 @@ sub exponent if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; $s =~ s/^[+-]//; - return $self->new($s); # -inf, +inf => +inf + return Math::BigInt->new($s); # -inf, +inf => +inf } - return $x->{_e}->copy(); + Math::BigInt->new( $x->{_es} . $MBI->_str($x->{_e})); } sub mantissa @@ -2083,9 +2214,9 @@ sub mantissa if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; $s =~ s/^[+]//; - return $self->new($s); # -inf, +inf => +inf + return Math::BigInt->new($s); # -inf, +inf => +inf } - my $m = $x->{_m}->copy(); # faster than going via bstr() + my $m = Math::BigInt->new( $MBI->_str($x->{_m})); $m->bneg() if $x->{sign} eq '-'; $m; @@ -2101,9 +2232,10 @@ sub parts my $s = $x->{sign}; $s =~ s/^[+]//; my $se = $s; $se =~ s/^[-]//; return ($self->new($s),$self->new($se)); # +inf => inf and -inf,+inf => inf } - my $m = $x->{_m}->copy(); # faster than going via bstr() + my $m = Math::BigInt->bzero(); + $m->{value} = $MBI->_copy($x->{_m}); $m->bneg() if $x->{sign} eq '-'; - return ($m,$x->{_e}->copy()); + ($m, Math::BigInt->new( $x->{_es} . $MBI->_num($x->{_e}) )); } ############################################################################## @@ -2144,7 +2276,8 @@ sub import elsif ($_[$i] eq 'with') { # alternative class for our private parts() - $MBI = $_[$i+1] || 'Math::BigInt'; # default Math::BigInt + # XXX: no longer supported + # $MBI = $_[$i+1] || 'Math::BigInt'; $i++; } else @@ -2155,14 +2288,14 @@ sub import # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work my $mbilib = eval { Math::BigInt->config()->{lib} }; - if ((defined $mbilib) && ($MBI eq 'Math::BigInt')) + if ((defined $mbilib) && ($MBI eq 'Math::BigInt::Calc')) { # MBI already loaded - $MBI->import('lib',"$lib,$mbilib", 'objectify'); + Math::BigInt->import('lib',"$lib,$mbilib", 'objectify'); } else { - # MBI not loaded, or with ne "Math::BigInt" + # MBI not loaded, or with ne "Math::BigInt::Calc" $lib .= ",$mbilib" if defined $mbilib; $lib =~ s/^,//; # don't leave empty # replacement library can handle lib statement, but also could ignore it @@ -2170,23 +2303,20 @@ sub import { # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is # used in the same script, or eval inside import(). - my @parts = split /::/, $MBI; # Math::BigInt => Math BigInt - my $file = pop @parts; $file .= '.pm'; # BigInt => BigInt.pm - require File::Spec; - $file = File::Spec->catfile (@parts, $file); - eval { require "$file"; }; - $MBI->import( lib => $lib, 'objectify' ); + require Math::BigInt; + Math::BigInt->import( lib => $lib, 'objectify' ); } else { - my $rc = "use $MBI lib => '$lib', 'objectify';"; + my $rc = "use Math::BigInt lib => '$lib', 'objectify';"; eval $rc; } } if ($@) { - require Carp; Carp::croak ("Couldn't load $MBI: $! $@"); + require Carp; Carp::croak ("Couldn't load $lib: $! $@"); } + $MBI = Math::BigInt->config()->{lib}; # any non :constant stuff is handled by our parent, Exporter # even if @_ is empty, to give it a chance @@ -2198,29 +2328,40 @@ sub bnorm { # adjust m and e so that m is smallest possible # round number according to accuracy and precision settings - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc - my $zeros = $x->{_m}->_trailing_zeros(); # correct for trailing zeros + my $zeros = $MBI->_zeros($x->{_m}); # correct for trailing zeros if ($zeros != 0) { - my $z = $MBI->new($zeros,undef,undef); - $x->{_m}->brsft($z,10); $x->{_e}->badd($z); + my $z = $MBI->_new($zeros); + $x->{_m} = $MBI->_rsft ($x->{_m}, $z, 10); + if ($x->{_es} eq '-') + { + if ($MBI->_acmp($x->{_e},$z) >= 0) + { + $x->{_e} = $MBI->_sub ($x->{_e}, $z); + } + else + { + $x->{_e} = $MBI->_sub ( $MBI->_copy($z), $x->{_e}); + $x->{_es} = '+'; + } + } + else + { + $x->{_e} = $MBI->_add ($x->{_e}, $z); + } } else { # $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing # zeros). So, for something like 0Ey, set y to 1, and -0 => +0 - $x->{sign} = '+', $x->{_e}->bone() if $x->{_m}->is_zero(); + $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $MBI->_one() + if $MBI->_is_zero($x->{_m}); } - # this is to prevent automatically rounding when MBI's globals are set - $x->{_m}->{_f} = MB_NEVER_ROUND; - $x->{_e}->{_f} = MB_NEVER_ROUND; - # 'forget' that mantissa was rounded via MBI::bround() in MBF's bfround() - delete $x->{_m}->{_a}; delete $x->{_e}->{_a}; - delete $x->{_m}->{_p}; delete $x->{_e}->{_p}; $x; # MBI bnorm is no-op, so dont call it } @@ -2234,14 +2375,14 @@ 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->{_es} ne '+'; # how to do 1e-1 in hex!? - my $z = $x->{_m}->copy(); - if (!$x->{_e}->is_zero()) # > 0 + my $z = $MBI->_copy($x->{_m}); + if (! $MBI->_is_zero($x->{_e})) # > 0 { - $z->blsft($x->{_e},10); + $MBI->_lsft( $z, $x->{_e},10); } - $z->{sign} = $x->{sign}; + $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z)); $z->as_hex(); } @@ -2253,14 +2394,14 @@ 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->{_es} ne '+'; # how to do 1e-1 in hex!? - my $z = $x->{_m}->copy(); - if (!$x->{_e}->is_zero()) # > 0 + my $z = $MBI->_copy($x->{_m}); + if (! $MBI->_is_zero($x->{_e})) # > 0 { - $z->blsft($x->{_e},10); + $MBI->_lsft( $z, $x->{_e},10); } - $z->{sign} = $x->{sign}; + $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z)); $z->as_bin(); } @@ -2269,18 +2410,16 @@ sub as_number # return copy as a bigint representation of this BigFloat number my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - my $z = $x->{_m}->copy(); - if ($x->{_e}->{sign} eq '-') # < 0 + my $z = $MBI->_copy($x->{_m}); + if ($x->{_es} eq '-') # < 0 { - $x->{_e}->{sign} = '+'; # flip - $z->brsft($x->{_e},10); - $x->{_e}->{sign} = '-'; # flip back + $MBI->_rsft( $z, $x->{_e},10); } - elsif (!$x->{_e}->is_zero()) # > 0 + elsif (! $MBI->_is_zero($x->{_e})) # > 0 { - $z->blsft($x->{_e},10); + $MBI->_lsft( $z, $x->{_e},10); } - $z->{sign} = $x->{sign}; + $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z)); $z; } @@ -2290,14 +2429,15 @@ sub length my $class = ref($x) || $x; $x = $class->new(shift) unless ref($x); - return 1 if $x->{_m}->is_zero(); - my $len = $x->{_m}->length(); - $len += $x->{_e} if $x->{_e}->sign() eq '+'; + return 1 if $MBI->_is_zero($x->{_m}); + + my $len = $MBI->_len($x->{_m}); + $len += $MBI->_num($x->{_e}) if $x->{_es} eq '+'; if (wantarray()) { - my $t = $MBI->bzero(); - $t = $x->{_e}->copy()->babs() if $x->{_e}->sign() eq '-'; - return ($len,$t); + my $t = 0; + $t = $MBI->_num($x->{_e}) if $x->{_es} eq '-'; + return ($len, $t); } $len; } diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index 590f04f..7393b12 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -18,7 +18,7 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.69'; +$VERSION = '1.70'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( objectify bgcd blcm); @@ -155,12 +155,11 @@ my $nan = 'NaN'; # constants for easier life my $CALC = 'Math::BigInt::Calc'; # module to do the low level math # default is Calc.pm -my %CAN; # cache for $CALC->can(...) my $IMPORT = 0; # was import() called yet? # used to make require work - +my %WARN; # warn only once for low-level libs +my %CAN; # cache for $CALC->can(...) my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math -my $EMU = 'Math::BigInt::CalcEmu'; # emulate low-level math ############################################################################## # the old code had $rnd_mode, so we need to support it, too @@ -454,46 +453,11 @@ sub copy return unless ref($x); # only for objects my $self = {}; bless $self,$c; - my $r; - foreach my $k (keys %$x) - { - if ($k eq 'value') - { - $self->{value} = $CALC->_copy($x->{value}); next; - } - if (!($r = ref($x->{$k}))) - { - $self->{$k} = $x->{$k}; next; - } - if ($r eq 'SCALAR') - { - $self->{$k} = \${$x->{$k}}; - } - elsif ($r eq 'ARRAY') - { - $self->{$k} = [ @{$x->{$k}} ]; - } - elsif ($r eq 'HASH') - { - # only one level deep! - foreach my $h (keys %{$x->{$k}}) - { - $self->{$k}->{$h} = $x->{$k}->{$h}; - } - } - else # normal ref - { - my $xk = $x->{$k}; - if ($xk->can('copy')) - { - $self->{$k} = $xk->copy(); - } - else - { - $self->{$k} = $xk->new($xk); - } - } - } + + $self->{sign} = $x->{sign}; + $self->{value} = $CALC->_copy($x->{value}); + $self->{_a} = $x->{_a} if defined $x->{_a}; + $self->{_p} = $x->{_p} if defined $x->{_p}; $self; } @@ -521,17 +485,17 @@ sub new if ((!ref $wanted) && ($wanted =~ /^([+-]?)[1-9][0-9]*\z/)) { $self->{sign} = $1 || '+'; - my $ref = \$wanted; + if ($wanted =~ /^[+-]/) { # remove sign without touching wanted to make it work with constants - my $t = $wanted; $t =~ s/^[+-]//; $ref = \$t; + my $t = $wanted; $t =~ s/^[+-]//; + $self->{value} = $CALC->_new($t); + } + else + { + $self->{value} = $CALC->_new($wanted); } - # 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) || (defined ${"${class}::precision"}) @@ -551,7 +515,7 @@ sub new return $self; } # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign - my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted); + my ($mis,$miv,$mfv,$es,$ev) = _split($wanted); if (!ref $mis) { if ($_trap_nan) @@ -624,7 +588,7 @@ sub new } } $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0 - $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/; + $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/; # if any of the globals is set, use them to round and store them inside $self # do not round for new($x,undef,undef) since that is used by MBF to signal # no rounding @@ -805,7 +769,7 @@ sub bsstr my ($m,$e) = $x->parts(); #$m->bstr() . 'e+' . $e->bstr(); # e can only be positive in BigInt # 'e+' because E can only be positive in BigInt - $m->bstr() . 'e+' . ${$CALC->_str($e->{value})}; + $m->bstr() . 'e+' . $CALC->_str($e->{value}); } sub bstr @@ -820,7 +784,7 @@ sub bstr return 'inf'; # +inf } my $es = ''; $es = $x->{sign} if $x->{sign} eq '-'; - $es.${$CALC->_str($x->{value})}; + $es.$CALC->_str($x->{value}); } sub numify @@ -1167,9 +1131,8 @@ sub bsub return $x if $x->modify('bsub'); -# upgrade done by badd(): -# return $upgrade->badd($x,$y,@r) if defined $upgrade && -# ((!$x->isa($self)) || (!$y->isa($self))); + return $upgrade->new($x)->bsub($upgrade->new($y),@r) if defined $upgrade && + ((!$x->isa($self)) || (!$y->isa($self))); if ($y->is_zero()) { @@ -1246,28 +1209,22 @@ sub blog # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($self,$x,$base,@r) = objectify(2,$class,@_); + ($self,$x,$base,@r) = objectify(1,$class,@_); } - + return $x if $x->modify('blog'); # inf, -inf, NaN, <0 => NaN return $x->bnan() - if $x->{sign} ne '+' || $base->{sign} ne '+'; - - return $upgrade->blog($upgrade->new($x),$base,@r) if - defined $upgrade && (ref($x) ne $upgrade || ref($base) ne $upgrade); + if $x->{sign} ne '+' || (defined $base && $base->{sign} ne '+'); - if ($CAN{log_int}) - { - my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value}); - return $x->bnan() unless defined $rc; - $x->{value} = $rc; - return $x->round(@r); - } + return $upgrade->blog($upgrade->new($x),$base,@r) if + defined $upgrade; - require $EMU_LIB; - __emu_blog($self,$x,$base,@r); + my ($rc,$exact) = $CALC->_log_int($x->{value},$base->{value}); + return $x->bnan() unless defined $rc; # not possible to take log? + $x->{value} = $rc; + $x->round(@r); } sub blcm @@ -1283,9 +1240,14 @@ sub blcm } else { - $x = $class->new($y); + $x = __PACKAGE__->new($y); } - while (@_) { $x = __lcm($x,shift); } + my $self = ref($x); + while (@_) + { + my $y = shift; $y = $self->new($y) if !ref ($y); + $x = __lcm($x,$y); + } $x; } @@ -1298,26 +1260,17 @@ sub bgcd my $y = shift; $y = __PACKAGE__->new($y) if !ref($y); my $self = ref($y); - my $x = $y->copy(); # keep arguments - if ($CAN{gcd}) - { - while (@_) - { - $y = shift; $y = $self->new($y) if !ref($y); - next if $y->is_zero(); - return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN? - $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one(); - } - } - else + my $x = $y->copy()->babs(); # keep arguments + return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? + + while (@_) { - while (@_) - { - $y = shift; $y = $self->new($y) if !ref($y); - $x = __gcd($x,$y->copy()); last if $x->is_one(); # _gcd handles NaN - } + $y = shift; $y = $self->new($y) if !ref($y); + next if $y->is_zero(); + return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN? + $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one(); } - $x->babs(); + $x; } sub bnot @@ -1450,9 +1403,9 @@ sub bmul return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); return $x->binf('-'); } - - return $upgrade->bmul($x,$y,@r) - if defined $upgrade && $y->isa($upgrade); + + return $upgrade->bmul($x,$upgrade->new($y),@r) + if defined $upgrade && !$y->isa($self); $r[3] = $y; # no push here @@ -1591,35 +1544,23 @@ sub bmod return $x->round(@r); } - if ($CAN{mod}) + # calc new sign and in case $y == +/- 1, return $x + $x->{value} = $CALC->_mod($x->{value},$y->{value}); + if (!$CALC->_is_zero($x->{value})) { - # calc new sign and in case $y == +/- 1, return $x - $x->{value} = $CALC->_mod($x->{value},$y->{value}); - if (!$CALC->_is_zero($x->{value})) - { - my $xsign = $x->{sign}; - $x->{sign} = $y->{sign}; - if ($xsign ne $y->{sign}) - { - my $t = $CALC->_copy($x->{value}); # copy $x - $x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x - } - } - else + my $xsign = $x->{sign}; + $x->{sign} = $y->{sign}; + if ($xsign ne $y->{sign}) { - $x->{sign} = '+'; # dont leave -0 + my $t = $CALC->_copy($x->{value}); # copy $x + $x->{value} = $CALC->_sub($y->{value},$t,1); # $y-$x } - $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; - return $x; } - # disable upgrade temporarily, otherwise endless loop due to bdiv() - local $upgrade = undef; - my ($t,$rem) = $self->bdiv($x->copy(),$y,@r); # slow way (also rounds) - # modify in place - foreach (qw/value sign _a _p/) + else { - $x->{$_} = $rem->{$_}; + $x->{sign} = '+'; # dont leave -0 } + $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; $x; } @@ -1649,19 +1590,13 @@ sub bmodinv # put least residue into $x if $x was negative, and thus make it positive $x->bmod($y) if $x->{sign} eq '-'; - if ($CAN{modinv}) - { - my $sign; - ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value}); - return $x->bnan() if !defined $x->{value}; # in case no GCD found - return $x if !defined $sign; # already real result - $x->{sign} = $sign; # flip/flop see below - $x->bmod($y); # calc real result - return $x; - } - - require $EMU_LIB; - __emu_bmodinv($self,$x,$y,@r); + my $sign; + ($x->{value},$sign) = $CALC->_modinv($x->{value},$y->{value}); + return $x->bnan() if !defined $x->{value}; # in case no GCD found + return $x if !defined $sign; # already real result + $x->{sign} = $sign; # flip/flop see below + $x->bmod($y); # calc real result + $x; } sub bmodpow @@ -1689,15 +1624,9 @@ sub bmodpow # check num for valid values (also NaN if there was no inverse but $exp < 0) return $num->bnan() if $num->{sign} !~ /^[+-]$/; - if ($CAN{modpow}) - { - # $mod is positive, sign on $exp is ignored, result also positive - $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value}); - return $num; - } - - require $EMU_LIB; - __emu_bmodpow($self,$num,$exp,$mod,@r); + # $mod is positive, sign on $exp is ignored, result also positive + $num->{value} = $CALC->_modpow($num->{value},$exp->{value},$mod->{value}); + $num; } ############################################################################### @@ -1713,14 +1642,8 @@ sub bfac return $x if $x->{sign} eq '+inf'; # inf => inf return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN - if ($CAN{fac}) - { - $x->{value} = $CALC->_fac($x->{value}); - return $x->round(@r); - } - - require $EMU_LIB; - __emu_bfac($self,$x,@r); + $x->{value} = $CALC->_fac($x->{value}); + $x->round(@r); } sub bpow @@ -1748,26 +1671,21 @@ sub bpow # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu - if ($x->{sign} eq '-' && $CALC->_is_one($x->{value})) - { - # if $x == -1 and odd/even y => +1/-1 - return $y->is_odd() ? $x->round(@r) : $x->babs()->round(@r); - # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; - } + my $new_sign = '+'; + $new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+'); + + # 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf + return $x->binf() + if $y->{sign} eq '-' && $x->{sign} eq '+' && $CALC->_is_zero($x->{value}); # 1 ** -y => 1 / (1 ** |y|) # so do test for negative $y after above's clause - return $x->bnan() if $y->{sign} eq '-' && !$x->is_one(); - - if ($CAN{pow}) - { - $x->{value} = $CALC->_pow($x->{value},$y->{value}); - $x->{sign} = '+' if $CALC->_is_zero($y->{value}); - $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; - return $x; - } + return $x->bnan() if $y->{sign} eq '-' && !$CALC->_is_one($x->{value}); - require $EMU_LIB; - __emu_bpow($self,$x,$y,@r); + $x->{value} = $CALC->_pow($x->{value},$y->{value}); + $x->{sign} = $new_sign; + $x->{sign} = '+' if $CALC->_is_zero($y->{value}); + $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; + $x; } sub blsft @@ -1789,13 +1707,8 @@ sub blsft $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; - my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CAN{lsft}; - if (defined $t) - { - $x->{value} = $t; return $x->round(@r); - } - # fallback - $x->bmul( $self->bpow($n, $y, @r), @r ); + $x->{value} = $CALC->_lsft($x->{value},$y->{value},$n); + $x->round(@r); } sub brsft @@ -1855,15 +1768,8 @@ sub brsft $x->bdec(); # n == 2, but $y == 1: this fixes it } - my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CAN{rsft}; - if (defined $t) - { - $x->{value} = $t; - return $x->round(@r); - } - # fallback - $x->bdiv($self->bpow($n,$y, @r), @r); - $x; + $x->{value} = $CALC->_rsft($x->{value},$y->{value},$n); + $x->round(@r); } sub band @@ -1888,7 +1794,7 @@ sub band my $sx = $x->{sign} eq '+' ? 1 : -1; my $sy = $y->{sign} eq '+' ? 1 : -1; - if ($CAN{and} && $sx == 1 && $sy == 1) + if ($sx == 1 && $sy == 1) { $x->{value} = $CALC->_and($x->{value},$y->{value}); return $x->round(@r); @@ -1920,8 +1826,6 @@ sub bior return $x if $x->modify('bior'); $r[3] = $y; # no push! - local $Math::BigInt::upgrade = undef; - return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); my $sx = $x->{sign} eq '+' ? 1 : -1; @@ -1930,7 +1834,7 @@ sub bior # the sign of X follows the sign of X, e.g. sign of Y irrelevant for bior() # don't use lib for negative values - if ($CAN{or} && $sx == 1 && $sy == 1) + if ($sx == 1 && $sy == 1) { $x->{value} = $CALC->_or($x->{value},$y->{value}); return $x->round(@r); @@ -1969,7 +1873,7 @@ sub bxor my $sy = $y->{sign} eq '+' ? 1 : -1; # don't use lib for negative values - if ($CAN{xor} && $sx == 1 && $sy == 1) + if ($sx == 1 && $sy == 1) { $x->{value} = $CALC->_xor($x->{value},$y->{value}); return $x->round(@r); @@ -2009,14 +1913,9 @@ sub _trailing_zeros my $x = shift; $x = $class->new($x) unless ref $x; - return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/; - - return $CALC->_zeros($x->{value}) if $CAN{zeros}; + return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc - # if not: since we do not know underlying internal representation: - my $es = "$x"; $es =~ /([0]*)$/; - return 0 if !defined $1; # no zeros - CORE::length("$1"); # $1 as string, not as +0! + $CALC->_zeros($x->{value}); # must handle odd values, 0 etc } sub bsqrt @@ -2031,14 +1930,8 @@ sub bsqrt return $upgrade->bsqrt($x,@r) if defined $upgrade; - if ($CAN{sqrt}) - { - $x->{value} = $CALC->_sqrt($x->{value}); - return $x->round(@r); - } - - require $EMU_LIB; - __emu_bsqrt($self,$x,@r); + $x->{value} = $CALC->_sqrt($x->{value}); + $x->round(@r); } sub broot @@ -2067,14 +1960,8 @@ sub broot return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade; - if ($CAN{root}) - { - $x->{value} = $CALC->_root($x->{value},$y->{value}); - return $x->round(@r); - } - - require $EMU_LIB; - __emu_broot($self,$x,$y,@r); + $x->{value} = $CALC->_root($x->{value},$y->{value}); + $x->round(@r); } sub exponent @@ -2207,9 +2094,9 @@ sub bround # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3 - $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len; + $digit_round = '0'; $digit_round = substr($xs,$pl,1) if $pad <= $len; $pl++; $pl ++ if $pad >= $len; - $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0; + $digit_after = '0'; $digit_after = substr($xs,$pl,1) if $pad > 0; # in case of 01234 we round down, for 6789 up, and only in case 5 we look # closer at the remaining digits of the original $x, remember decision @@ -2231,7 +2118,7 @@ sub bround if (($pad > 0) && ($pad <= $len)) { - substr($$xs,-$pad,$pad) = '0' x $pad; + substr($xs,-$pad,$pad) = '0' x $pad; $put_back = 1; } elsif ($pad > $len) @@ -2242,18 +2129,18 @@ sub bround if ($round_up) # what gave test above? { $put_back = 1; - $pad = $len, $$xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0 + $pad = $len, $xs = '0' x $pad if $scale < 0; # tlr: whack 0.51=>1.0 # we modify directly the string variant instead of creating a number and # adding it, since that is faster (we already have the string) my $c = 0; $pad ++; # for $pad == $len case while ($pad <= $len) { - $c = substr($$xs,-$pad,1) + 1; $c = '0' if $c eq '10'; - substr($$xs,-$pad,1) = $c; $pad++; + $c = substr($xs,-$pad,1) + 1; $c = '0' if $c eq '10'; + substr($xs,-$pad,1) = $c; $pad++; last if $c != 0; # no overflow => early out } - $$xs = '1'.$$xs if $c == 0; + $xs = '1'.$xs if $c == 0; } $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back in if needed @@ -2300,13 +2187,7 @@ sub as_hex my $s = ''; $s = $x->{sign} if $x->{sign} eq '-'; - if ($CAN{as_hex}) - { - return $s . ${$CALC->_as_hex($x->{value})}; - } - - require $EMU_LIB; - __emu_as_hex(ref($x),$x,$s); + $s . $CALC->_as_hex($x->{value}); } sub as_bin @@ -2317,14 +2198,7 @@ sub as_bin return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc my $s = ''; $s = $x->{sign} if $x->{sign} eq '-'; - if ($CAN{as_bin}) - { - return $s . ${$CALC->_as_bin($x->{value})}; - } - - require $EMU_LIB; - __emu_as_bin(ref($x),$x,$s); - + return $s . $CALC->_as_bin($x->{value}); } ############################################################################## @@ -2487,14 +2361,60 @@ sub import { eval "use $lib qw/@c/;"; } - $CALC = $lib, last if $@ eq ''; # no error in loading lib? + if ($@ eq '') + { + my $ok = 1; + # loaded it ok, see if the api_version() is high enough + if ($lib->can('api_version') && $lib->api_version() >= 1.0) + { + $ok = 0; + # api_version matches, check if it really provides anything we need + for my $method (qw/ + one two ten + str num + add mul div sub dec inc + acmp len digit is_one is_zero is_even is_odd + is_two is_ten + new copy check from_hex from_bin as_hex as_bin zeros + rsft lsft xor and or + mod sqrt root fac pow modinv modpow log_int gcd + /) + { + if (!$lib->can("_$method")) + { + if (($WARN{$lib}||0) < 2) + { + require Carp; + Carp::carp ("$lib is missing method '_$method'"); + $WARN{$lib} = 1; # still warn about the lib + } + $ok++; last; + } + } + } + if ($ok == 0) + { + $CALC = $lib; + last; # found a usable one, break + } + else + { + if (($WARN{$lib}||0) < 2) + { + my $ver = eval "\$$lib\::VERSION"; + require Carp; + Carp::carp ("Cannot load outdated $lib v$ver, please upgrade"); + $WARN{$lib} = 2; # never warn again + } + } + } } if ($CALC eq '') { require Carp; Carp::croak ("Couldn't load any math lib, not even 'Calc.pm'"); } - _fill_can_cache(); + _fill_can_cache(); # for emulating lower math lib functions } sub _fill_can_cache @@ -2502,11 +2422,7 @@ sub _fill_can_cache # fill $CAN with the results of $CALC->can(...) %CAN = (); - for my $method (qw/gcd mod modinv modpow fac pow lsft rsft - and signed_and or signed_or xor signed_xor - from_hex as_hex from_bin as_bin - zeros sqrt root log_int log - /) + for my $method (qw/ signed_and or signed_or xor signed_xor /) { $CAN{$method} = $CALC->can("_$method") ? 1 : 0; } @@ -2520,36 +2436,15 @@ sub __from_hex my $x = Math::BigInt->bzero(); # strip underscores - $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g; - $$hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g; + $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g; + $hs =~ s/([0-9a-fA-F])_([0-9a-fA-F])/$1$2/g; - return $x->bnan() if $$hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/; + return $x->bnan() if $hs !~ /^[\-\+]?0x[0-9A-Fa-f]+$/; - my $sign = '+'; $sign = '-' if ($$hs =~ /^-/); + my $sign = '+'; $sign = '-' if $hs =~ /^-/; - $$hs =~ s/^[+-]//; # strip sign - if ($CAN{'from_hex'}) - { - $x->{value} = $CALC->_from_hex($hs); - } - else - { - # fallback to pure perl - my $mul = Math::BigInt->bone(); - my $x65536 = Math::BigInt->new(65536); - my $len = CORE::length($$hs)-2; # minus 2 for 0x - $len = int($len/4); # 4-digit parts, w/o '0x' - my $val; my $i = -4; - while ($len >= 0) - { - $val = substr($$hs,$i,4); - $val =~ s/^[+-]?0x// if $len == 0; # for last part only because - $val = hex($val); # hex does not like wrong chars - $i -= 4; $len --; - $x += $mul * $val if $val != 0; - $mul *= $x65536 if $len >= 0; # skip last mul - } - } + $hs =~ s/^[+-]//; # strip sign + $x->{value} = $CALC->_from_hex($hs); $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0' $x; } @@ -2561,36 +2456,14 @@ sub __from_bin my $x = Math::BigInt->bzero(); # strip underscores - $$bs =~ s/([01])_([01])/$1$2/g; - $$bs =~ s/([01])_([01])/$1$2/g; - return $x->bnan() if $$bs !~ /^[+-]?0b[01]+$/; + $bs =~ s/([01])_([01])/$1$2/g; + $bs =~ s/([01])_([01])/$1$2/g; + return $x->bnan() if $bs !~ /^[+-]?0b[01]+$/; - my $sign = '+'; $sign = '-' if ($$bs =~ /^\-/); - $$bs =~ s/^[+-]//; # strip sign - if ($CAN{'from_bin'}) - { - $x->{value} = $CALC->_from_bin($bs); - } - else - { - my $mul = Math::BigInt->bone(); - my $x256 = Math::BigInt->new(256); - my $len = CORE::length($$bs)-2; # minus 2 for 0b - $len = int($len/8); # 8-digit parts, w/o '0b' - my $val; my $i = -8; - while ($len >= 0) - { - $val = substr($$bs,$i,8); - $val =~ s/^[+-]?0b// if $len == 0; # for last part only - #$val = oct('0b'.$val); # does not work on Perl prior to 5.6.0 - # slower: - # $val = ('0' x (8-CORE::length($val))).$val if CORE::length($val) < 8; - $val = ord(pack('B8',substr('00000000'.$val,-8,8))); - $i -= 8; $len --; - $x += $mul * $val if $val != 0; - $mul *= $x256 if $len >= 0; # skip last mul - } - } + my $sign = '+'; $sign = '-' if $bs =~ /^\-/; + $bs =~ s/^[+-]//; # strip sign + + $x->{value} = $CALC->_from_bin($bs); $x->{sign} = $sign unless $CALC->_is_zero($x->{value}); # no '-0' $x; } @@ -2604,34 +2477,32 @@ sub _split my $x = shift; # strip white space at front, also extranous leading zeros - $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2' - $$x =~ s/^\s+//; # but this will - $$x =~ s/\s+$//g; # strip white space at end + $x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2' + $x =~ s/^\s+//; # but this will + $x =~ s/\s+$//g; # strip white space at end # shortcut, if nothing to split, return early - if ($$x =~ /^[+-]?\d+\z/) + if ($x =~ /^[+-]?\d+\z/) { - $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+'; - return (\$sign, $x, \'', \'', \0); + $x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+'; + return (\$sign, \$x, \'', \'', \0); } # invalid starting char? - return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/; + return if $x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/; - return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string - return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string + return __from_hex($x) if $x =~ /^[\-\+]?0x/; # hex string + return __from_bin($x) if $x =~ /^[\-\+]?0b/; # binary string # strip underscores between digits - $$x =~ s/(\d)_(\d)/$1$2/g; - $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3 + $x =~ s/(\d)_(\d)/$1$2/g; + $x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3 # some possible inputs: # 2.1234 # 0.12 # 1 # 1E1 # 2.134E1 # 434E-10 # 1.02009E-2 # .2 # 1_2_3.4_5_6 # 1.4E1_2_3 # 1e3 # +.2 # 0e999 - #return if $$x =~ /[Ee].*[Ee]/; # more than one E => error - - my ($m,$e,$last) = split /[Ee]/,$$x; + my ($m,$e,$last) = split /[Ee]/,$x; return if defined $last; # last defined => 1e2E3 or others $e = '0' if !defined $e || $e eq ""; @@ -2672,23 +2543,7 @@ sub __lcm my $x = shift; my $ty = shift; return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan); - return $x * $ty / bgcd($x,$ty); - } - -sub __gcd - { - # (BINT or num_str, BINT or num_str) return BINT - # does modify both arguments - # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296 - my ($x,$ty) = @_; - - return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/; - - while (!$ty->is_zero()) - { - ($x, $ty) = ($ty,bmod($x,$ty)); - } - $x; + $x * $ty / bgcd($x,$ty); } ############################################################################### @@ -2715,8 +2570,13 @@ Math::BigInt - Arbitrary size integer math package use Math::BigInt lib => 'GMP'; + my $str = '1234567890'; + my @values = (64,74,18); + my $n = 1; my $sign = '-'; + # Number creation $x = Math::BigInt->new($str); # defaults to 0 + $y = $x->copy(); # make a true copy $nan = Math::BigInt->bnan(); # create a NotANumber $zero = Math::BigInt->bzero(); # create a +0 $inf = Math::BigInt->binf(); # create a +inf @@ -2735,7 +2595,7 @@ Math::BigInt - Arbitrary size integer math package $x->is_even(); # if $x is even $x->is_pos(); # if $x >= 0 $x->is_neg(); # if $x < 0 - $x->is_inf(sign); # if $x is +inf, or -inf (sign is default '+') + $x->is_inf($sign); # if $x is +inf, or -inf (sign is default '+') $x->is_int(); # if $x is an integer (not a float) # comparing and digit/sign extration @@ -2789,8 +2649,8 @@ Math::BigInt - Arbitrary size integer math package $x->bfac(); # factorial of $x (1*2*3*4*..$x) $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 + $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 (are no-ops), # but do so in BigFloat: @@ -2800,11 +2660,13 @@ Math::BigInt - Arbitrary size integer math package # The following do not modify their arguments: - bgcd(@values); # greatest common divisor (no OO style) - blcm(@values); # lowest common multiplicator (no OO style) + # greatest common divisor (no OO style) + my $gcd = Math::BigInt::bgcd(@values); + # lowest common multiplicator (no OO style) + my $lcm = Math::BigInt::blcm(@values); $x->length(); # return number of digits in number - ($x,$f) = $x->length(); # length of number and length of fraction part, + ($xl,$f) = $x->length(); # length of number and length of fraction part, # latter is always 0 digits long for BigInt's $x->exponent(); # return exponent as BigInt diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index 1dd7619..f2f0c87 100644 --- a/lib/Math/BigInt/Calc.pm +++ b/lib/Math/BigInt/Calc.pm @@ -6,7 +6,7 @@ use strict; use vars qw/$VERSION/; -$VERSION = '0.38'; +$VERSION = '0.40'; # Package to store unsigned big integers in decimal and do math with them @@ -31,6 +31,9 @@ $VERSION = '0.38'; ############################################################################## # global constants, flags and accessory + +# announce that we are compatible with MBI v1.70 and up +sub api_version () { 1; } # constants for easier life my $nan = 'NaN'; @@ -70,9 +73,6 @@ sub _base_len $RBASE = abs('1e-'.$BASE_LEN_SMALL); # see USE_MUL $MAX_VAL = $MBASE-1; - #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; @@ -82,14 +82,12 @@ sub _base_len # & here. if ($caught == 2) # 2 { - # print "# use mul\n"; # must USE_MUL since we cannot use DIV *{_mul} = \&_mul_use_mul; *{_div} = \&_div_use_mul; } else # 0 or 1 { - # print "# use div\n"; # can USE_DIV instead *{_mul} = \&_mul_use_div; *{_div} = \&_div_use_div; @@ -190,22 +188,21 @@ sub _new # (ref to string) return ref to num_array # Convert a number from string format (without sign) to internal base # 1ex format. Assumes normalized value as input. - my $d = $_[1]; - my $il = length($$d)-1; + my $il = length($_[1])-1; # < BASE_LEN due len-1 above - return [ int($$d) ] if $il < $BASE_LEN; # shortcut for short numbers + return [ int($_[1]) ] if $il < $BASE_LEN; # shortcut for short numbers # this leaves '00000' instead of int 0 and will be corrected after any op [ reverse(unpack("a" . ($il % $BASE_LEN+1) - . ("a$BASE_LEN" x ($il / $BASE_LEN)), $$d)) ]; + . ("a$BASE_LEN" x ($il / $BASE_LEN)), $_[1])) ]; } BEGIN { - $AND_MASK = __PACKAGE__->_new( \( 2 ** $AND_BITS )); - $XOR_MASK = __PACKAGE__->_new( \( 2 ** $XOR_BITS )); - $OR_MASK = __PACKAGE__->_new( \( 2 ** $OR_BITS )); + $AND_MASK = __PACKAGE__->_new( ( 2 ** $AND_BITS )); + $XOR_MASK = __PACKAGE__->_new( ( 2 ** $XOR_BITS )); + $OR_MASK = __PACKAGE__->_new( ( 2 ** $OR_BITS )); } sub _zero @@ -226,6 +223,12 @@ sub _two [ 2 ]; } +sub _ten + { + # create a 10 (used internally for shifting) + [ 10 ]; + } + sub _copy { # make a true copy @@ -260,14 +263,15 @@ sub _str $ret .= substr($z.$ar->[$l],-$BASE_LEN); # fastest way I could think of $l--; } - \$ret; + $ret; } sub _num { - # Make a number (scalar int/float) from a BigInt object + # Make a number (scalar int/float) from a BigInt object my $x = $_[1]; - return $x->[0] if scalar @$x == 1; # below $BASE + + return 0+$x->[0] if scalar @$x == 1; # below $BASE my $fac = 1; my $num = 0; foreach (@$x) @@ -354,7 +358,6 @@ sub _sub my $car = 0; my $i; my $j = 0; if (!$s) { - #print "case 2\n"; for $i (@$sx) { last unless defined $sy->[$j] || $car; @@ -363,7 +366,6 @@ sub _sub # might leave leading zeros, so fix that return __strip_zeros($sx); } - #print "case 1 (swap)\n"; for $i (@$sx) { # we can't do an early out if $x is < than $y, since we @@ -976,6 +978,9 @@ sub _zeros # check each array elem in _m for having 0 at end as long as elem == 0 # Upon finding a elem != 0, stop my $x = $_[1]; + + return 0 if scalar @$x == 1 && $x->[0] == 0; + my $zeros = 0; my $elem; foreach my $e (@$x) { @@ -997,33 +1002,38 @@ sub _zeros sub _is_zero { - # return true if arg (BINT or num_str) is zero (array '+', '0') - my $x = $_[1]; - - (((scalar @$x == 1) && ($x->[0] == 0))) <=> 0; + # return true if arg is zero + (((scalar @{$_[1]} == 1) && ($_[1]->[0] == 0))) <=> 0; } sub _is_even { - # return true if arg (BINT or num_str) is even - my $x = $_[1]; - (!($x->[0] & 1)) <=> 0; + # return true if arg is even + (!($_[1]->[0] & 1)) <=> 0; } sub _is_odd { - # return true if arg (BINT or num_str) is even - my $x = $_[1]; - - (($x->[0] & 1)) <=> 0; + # return true if arg is even + (($_[1]->[0] & 1)) <=> 0; } sub _is_one { - # return true if arg (BINT or num_str) is one (array '+', '1') - my $x = $_[1]; + # return true if arg is one + (scalar @{$_[1]} == 1) && ($_[1]->[0] == 1) <=> 0; + } + +sub _is_two + { + # return true if arg is two + (scalar @{$_[1]} == 1) && ($_[1]->[0] == 2) <=> 0; + } - (scalar @$x == 1) && ($x->[0] == 1) <=> 0; +sub _is_ten + { + # return true if arg is ten + (scalar @{$_[1]} == 1) && ($_[1]->[0] == 10) <=> 0; } sub __strip_zeros @@ -1086,8 +1096,6 @@ sub _check ############################################################################### -############################################################################### -# some optional routines to make BigInt faster sub _mod { @@ -1160,7 +1168,7 @@ sub _rsft if ($n != 10) { - $n = _new($c,\$n); return _div($c,$x, _pow($c,$n,$y)); + $n = _new($c,$n); return _div($c,$x, _pow($c,$n,$y)); } # shortcut (faster) for shifting by 10) @@ -1208,7 +1216,7 @@ sub _lsft if ($n != 10) { - $n = _new($c,\$n); return _mul($c,$x, _pow($c,$n,$y)); + $n = _new($c,$n); return _mul($c,$x, _pow($c,$n,$y)); } # shortcut (faster) for shifting by 10) since we are in base 10eX @@ -1260,7 +1268,7 @@ sub _pow my $pow2 = _one(); - my $y_bin = ${_as_bin($c,$cy)}; $y_bin =~ s/^0b//; + my $y_bin = _as_bin($c,$cy); $y_bin =~ s/^0b//; my $len = length($y_bin); while (--$len > 0) { @@ -1354,6 +1362,8 @@ sub _fac $cx; # return result } +############################################################################# + sub _log_int { # calculate integer log of $x to base $base @@ -1422,7 +1432,7 @@ sub _log_int my $a; my $base_mul = _mul($c, _copy($c,$base), $base); - while (($a = _acmp($x,$trial,$x_org)) < 0) + while (($a = _acmp($c,$trial,$x_org)) < 0) { _mul($c,$trial,$base_mul); _add($c, $x, [2]); } @@ -1433,7 +1443,7 @@ sub _log_int # overstepped the result _dec($c, $x); _div($c,$trial,$base); - $a = _acmp($x,$trial,$x_org); + $a = _acmp($c,$trial,$x_org); if ($a > 0) { _dec($c, $x); @@ -1507,7 +1517,7 @@ sub _sqrt # an even better guess. Not implemented yet. Does it improve performance? $x->[$l--] = 0 while ($l >= 0); # all other digits of guess are zero - print "start x= ",${_str($c,$x)},"\n" if DEBUG; + print "start x= ",_str($c,$x),"\n" if DEBUG; my $two = _two(); my $last = _zero(); my $lastlast = _zero(); @@ -1519,7 +1529,7 @@ sub _sqrt $last = _copy($c,$x); _add($c,$x, _div($c,_copy($c,$y),$x)); _div($c,$x, $two ); - print " x= ",${_str($c,$x)},"\n" if DEBUG; + print " x= ",_str($c,$x),"\n" if DEBUG; } print "\nsteps in sqrt: $steps, " if DEBUG; _dec($c,$x) if _acmp($c,$y,_mul($c,_copy($c,$x),$x)) < 0; # overshot? @@ -1556,7 +1566,7 @@ sub _root # if $n is a power of two, we can repeatedly take sqrt($X) and find the # proper result, because sqrt(sqrt($x)) == root($x,4) my $b = _as_bin($c,$n); - if ($$b =~ /0b1(0+)$/) + if ($b =~ /0b1(0+)$/) { my $count = CORE::length($1); # 0b100 => len('00') => 2 my $cnt = $count; # counter for loop @@ -1658,13 +1668,13 @@ sub _and ($y1, $yr) = _div($c,$y1,$mask); # make ints() from $xr, $yr - # this is when the AND_BITS are greater tahn $BASE and is slower for + # this is when the AND_BITS are greater than $BASE and is slower for # small (<256 bits) numbers, but faster for large numbers. Disabled # due to KISS principle # $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; } # $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; } -# _add($c,$x, _mul($c, _new( $c, \($xrr & $yrr) ), $m) ); +# _add($c,$x, _mul($c, _new( $c, ($xrr & $yrr) ), $m) ); # 0+ due to '&' doesn't work in strings _add($c,$x, _mul($c, [ 0+$xr->[0] & 0+$yr->[0] ], $m) ); @@ -1694,7 +1704,7 @@ sub _xor # make ints() from $xr, $yr (see _and()) #$b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; } #$b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; } - #_add($c,$x, _mul($c, _new( $c, \($xrr ^ $yrr) ), $m) ); + #_add($c,$x, _mul($c, _new( $c, ($xrr ^ $yrr) ), $m) ); # 0+ due to '^' doesn't work in strings _add($c,$x, _mul($c, [ 0+$xr->[0] ^ 0+$yr->[0] ], $m) ); @@ -1730,7 +1740,7 @@ sub _or # make ints() from $xr, $yr (see _and()) # $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; } # $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; } -# _add($c,$x, _mul($c, _new( $c, \($xrr | $yrr) ), $m) ); +# _add($c,$x, _mul($c, _new( $c, ($xrr | $yrr) ), $m) ); # 0+ due to '|' doesn't work in strings _add($c,$x, _mul($c, [ 0+$xr->[0] | 0+$yr->[0] ], $m) ); @@ -1754,7 +1764,7 @@ sub _as_hex if (@$x == 1) { my $t = sprintf("0x%x",$x->[0]); - return \$t; + return $t; } my $x1 = _copy($c,$x); @@ -1778,7 +1788,7 @@ sub _as_hex $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros $es = '0x' . $es; - \$es; + $es; } sub _as_bin @@ -1790,12 +1800,12 @@ sub _as_bin # handle zero case for older Perls if ($] <= 5.005 && @$x == 1 && $x->[0] == 0) { - my $t = '0b0'; return \$t; + my $t = '0b0'; return $t; } if (@$x == 1 && $] >= 5.006) { my $t = sprintf("0b%b",$x->[0]); - return \$t; + return $t; } my $x1 = _copy($c,$x); @@ -1819,7 +1829,7 @@ sub _as_bin $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros $es = '0b' . $es; - \$es; + $es; } sub _from_hex @@ -1831,12 +1841,12 @@ sub _from_hex my $m = [ 0x10000 ]; # 16 bit at a time my $x = _zero(); - my $len = length($$hs)-2; + my $len = length($hs)-2; $len = int($len/4); # 4-digit parts, w/o '0x' my $val; my $i = -4; while ($len >= 0) { - $val = substr($$hs,$i,4); + $val = substr($hs,$i,4); $val =~ s/^[+-]?0x// if $len == 0; # for last part only because $val = hex($val); # hex does not like wrong chars $i -= 4; $len --; @@ -1854,13 +1864,13 @@ sub _from_bin # instead of converting X (8) bit at a time, it is faster to "convert" the # number to hex, and then call _from_hex. - my $hs = $$bs; + my $hs = $bs; $hs =~ s/^[+-]?0b//; # remove sign and 0b my $l = length($hs); # bits $hs = '0' x (8-($l % 8)) . $hs if ($l % 8) != 0; # padd left side w/ 0 my $h = unpack('H*', pack ('B*', $hs)); # repack as hex - $c->_from_hex(\('0x'.$h)); + $c->_from_hex('0x'.$h); } ############################################################################## @@ -1918,7 +1928,7 @@ sub _modpow my $acc = _copy($c,$num); my $t = _one(); - my $expbin = ${_as_bin($c,$exp)}; $expbin =~ s/^0b//; + my $expbin = _as_bin($c,$exp); $expbin =~ s/^0b//; my $len = length($expbin); while (--$len >= 0) { @@ -1934,6 +1944,20 @@ sub _modpow $num; } +sub _gcd + { + # greatest common divisor + my ($c,$x,$y) = @_; + + while (! _is_zero($c,$y)) + { + my $t = _copy($c,$y); + $y = _mod($c, $x, $y); + $x = $t; + } + $x; + } + ############################################################################## ############################################################################## @@ -1966,11 +1990,14 @@ version like 'Pari'. =head1 METHODS The following functions MUST be defined in order to support the use by -Math::BigInt: +Math::BigInt v1.70 or later: + api_version() return API version, minimum 1 for v1.70 _new(string) return ref to new object from ref to decimal string _zero() return a new object with value 0 _one() return a new object with value 1 + _two() return a new object with value 2 + _ten() return a new object with value 10 _str(obj) return ref to a string representing the object _num(obj) returns a Perl integer/floating point number @@ -2000,7 +2027,9 @@ Math::BigInt: _len(obj) returns count of the decimal digits of the object _digit(obj,n) returns the n'th decimal digit of object - _is_one(obj) return true if argument is +1 + _is_one(obj) return true if argument is 1 + _is_two(obj) return true if argument is 2 + _is_ten(obj) return true if argument is 10 _is_zero(obj) return true if argument is 0 _is_even(obj) return true if argument is even (0,2,4,6..) _is_odd(obj) return true if argument is odd (1,3,5,7..) @@ -2010,14 +2039,10 @@ Math::BigInt: _check(obj) check whether internal representation is still intact return 0 for ok, otherwise error message as string -The following functions are optional, and can be defined if the underlying lib -has a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence -slow) fallback routines to emulate these: - _from_hex(str) return ref to new object from ref to hexadecimal string _from_bin(str) return ref to new object from ref to binary string - _as_hex(str) return ref to scalar string containing the value as + _as_hex(str) return string containing the value as unsigned hex string, with the '0x' prepended. Leading zeros must be stripped. _as_bin(str) Like as_hex, only as binary string containing only @@ -2025,27 +2050,19 @@ slow) fallback routines to emulate these: '0b' must be prepended. _rsft(obj,N,B) shift object in base B by N 'digits' right - For unsupported bases B, return undef to signal failure _lsft(obj,N,B) shift object in base B by N 'digits' left - For unsupported bases B, return undef to signal failure _xor(obj1,obj2) XOR (bit-wise) object 1 with object 2 Note: XOR, AND and OR pad with zeros if size mismatches _and(obj1,obj2) AND (bit-wise) object 1 with object 2 _or(obj1,obj2) OR (bit-wise) object 1 with object 2 - _signed_or - _signed_and - _signed_xor - _mod(obj,obj) Return remainder of div of the 1st by the 2nd object _sqrt(obj) return the square root of object (truncated to int) _root(obj) return the n'th (n >= 3) root of obj (truncated to int) _fac(obj) return factorial of object 1 (1*2*3*4..) _pow(obj,obj) return object 1 to the power of object 2 return undef for NaN - _gcd(obj,obj) return Greatest Common Divisor of two objects - _zeros(obj) return number of trailing decimal zeros _modinv return inverse modulus _modpow return modulus of power ($x ** $y) % $z @@ -2055,6 +2072,16 @@ slow) fallback routines to emulate these: 1 : result is exactly RESULT 0 : result was truncated to RESULT undef : unknown whether result is exactly RESULT + _gcd(obj,obj) return Greatest Common Divisor of two objects + +The following functions are optional, and can be defined if the underlying lib +has a fast way to do them. If undefined, Math::BigInt will use pure Perl (hence +slow) fallback routines to emulate these: + + _signed_or + _signed_and + _signed_xor + Input strings come in as unsigned but with prefix (i.e. as '123', '0xabc' or '0b1101'). @@ -2072,11 +2099,6 @@ returning a different reference. 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 If you want to port your own favourite c-lib for big numbers to the @@ -2103,6 +2125,7 @@ Original math code by Mark Biggar, rewritten by Tels L in late 2000. Seperated from BigInt and shaped API with the help of John Peacock. Fixed, sped-up and enhanced by Tels http://bloodgate.com 2001-2003. +Further streamlining (api_version 1) by Tels 2004. =head1 SEE ALSO diff --git a/lib/Math/BigInt/CalcEmu.pm b/lib/Math/BigInt/CalcEmu.pm index c95b32f..9f7fd16 100644 --- a/lib/Math/BigInt/CalcEmu.pm +++ b/lib/Math/BigInt/CalcEmu.pm @@ -5,7 +5,7 @@ use strict; # use warnings; # dont use warnings for older Perls use vars qw/$VERSION/; -$VERSION = '0.03'; +$VERSION = '0.04'; package Math::BigInt; @@ -18,141 +18,6 @@ BEGIN $CALC_EMU = Math::BigInt->config()->{'lib'}; } -sub __emu_blog - { - my ($self,$x,$base,@r) = @_; - - return $x->bnan() if $x->is_zero() || $base->is_zero() || $base->is_one(); - - my $acmp = $x->bacmp($base); - return $x->bone('+',@r) if $acmp == 0; - return $x->bzero(@r) if $acmp < 0 || $x->is_one(); - - # blog($x,$base) ** $base + $y = $x - - # this trial multiplication is very fast, even for large counts (like for - # 2 ** 1024, since this still requires only 1024 very fast steps - # (multiplication of a large number by a very small number is very fast)) - # See Calc for an even faster algorightmn - my $x_org = $x->copy(); # preserve orgx - $x->bzero(); # keep ref to $x - my $trial = $base->copy(); - while ($trial->bacmp($x_org) <= 0) - { - $trial->bmul($base); $x->binc(); - } - $x->round(@r); - } - -sub __emu_bmodinv - { - my ($self,$x,$y,@r) = @_; - - my ($u, $u1) = ($self->bzero(), $self->bone()); - my ($a, $b) = ($y->copy(), $x->copy()); - - # first step need always be done since $num (and thus $b) is never 0 - # Note that the loop is aligned so that the check occurs between #2 and #1 - # thus saving us one step #2 at the loop end. Typical loop count is 1. Even - # a case with 28 loops still gains about 3% with this layout. - my $q; - ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 - # Euclid's Algorithm (calculate GCD of ($a,$b) in $a and also calculate - # two values in $u and $u1, we use only $u1 afterwards) - my $sign = 1; # flip-flop - while (!$b->is_zero()) # found GCD if $b == 0 - { - # the original algorithm had: - # ($u, $u1) = ($u1, $u->bsub($u1->copy()->bmul($q))); # step #2 - # The following creates exact the same sequence of numbers in $u1, - # except for the sign ($u1 is now always positive). Since formerly - # the sign of $u1 was alternating between '-' and '+', the $sign - # flip-flop will take care of that, so that at the end of the loop - # we have the real sign of $u1. Keeping numbers positive gains us - # speed since badd() is faster than bsub() and makes it possible - # to have the algorithmn in Calc for even more speed. - - ($u, $u1) = ($u1, $u->badd($u1->copy()->bmul($q))); # step #2 - $sign = - $sign; # flip sign - - ($a, $q, $b) = ($b, $a->bdiv($b)); # step #1 again - } - - # If the gcd is not 1, then return NaN! It would be pointless to have - # called bgcd to check this first, because we would then be performing - # the same Euclidean Algorithm *twice* in case the gcd is 1. - return $x->bnan() unless $a->is_one(); - - $u1->bneg() if $sign != 1; # need to flip? - - $u1->bmod($y); # calc result - $x->{value} = $u1->{value}; # and copy over to $x - $x->{sign} = $u1->{sign}; # to modify in place - $x->round(@r); - } - -sub __emu_bmodpow - { - my ($self,$num,$exp,$mod,@r) = @_; - - # in the trivial case, - return $num->bzero(@r) if $mod->is_one(); - return $num->bone('+',@r) if $num->is_zero() or $num->is_one(); - - # $num->bmod($mod); # if $x is large, make it smaller first - my $acc = $num->copy(); # but this is not really faster... - - $num->bone(); # keep ref to $num - - my $expbin = $exp->as_bin(); $expbin =~ s/^[-]?0b//; # ignore sign and prefix - my $len = CORE::length($expbin); - while (--$len >= 0) - { - $num->bmul($acc)->bmod($mod) if substr($expbin,$len,1) eq '1'; - $acc->bmul($acc)->bmod($mod); - } - - $num->round(@r); - } - -sub __emu_bfac - { - my ($self,$x,@r) = @_; - - return $x->bone('+',@r) if $x->is_zero() || $x->is_one(); # 0 or 1 => 1 - - my $n = $x->copy(); - $x->bone(); - # seems we need not to temp. clear A/P of $x since the result is the same - my $f = $self->new(2); - while ($f->bacmp($n) < 0) - { - $x->bmul($f); $f->binc(); - } - $x->bmul($f,@r); # last step and also round result - } - -sub __emu_bpow - { - my ($self,$x,$y,@r) = @_; - - return $x->bone('+',@r) if $y->is_zero(); - return $x->round(@r) if $x->is_one() || $y->is_one(); - return $x->round(@r) if $x->is_zero(); # 0**y => 0 (if not y <= 0) - - my $pow2 = $self->bone(); - my $y_bin = $y->as_bin(); $y_bin =~ s/^0b//; - my $len = CORE::length($y_bin); - while (--$len > 0) - { - $pow2->bmul($x) if substr($y_bin,$len,1) eq '1'; # is odd? - $x->bmul($x); - } - $x->bmul($pow2); - $x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0; - $x; - } - sub __emu_band { my ($self,$x,$y,$sx,$sy,@r) = @_; @@ -194,26 +59,29 @@ sub __emu_band $bx = reverse $bx; $by = reverse $by; - # cut the longer string to the length of the shorter one (the result would - # be 0 due to AND anyway) + # padd the shorter string + my $xx = "\x00"; $xx = "\x0f" if $sx == -1; + my $yy = "\x00"; $yy = "\x0f" if $sy == -1; my $diff = CORE::length($bx) - CORE::length($by); if ($diff > 0) { - $bx = substr($bx,0,CORE::length($by)); + # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by + $by .= $yy x $diff; } elsif ($diff < 0) { - $by = substr($by,0,CORE::length($bx)); + # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx + $bx .= $xx x abs($diff); } - + # and the strings together my $r = $bx & $by; # and reverse the result again $bx = reverse $r; - # one of $x or $y was negative, so need to flip bits in the result - # in both cases (one or two of them negative, or both positive) we need + # One of $x or $y was negative, so need to flip bits in the result. + # In both cases (one or two of them negative, or both positive) we need # to get the characters back. if ($sign == 1) { @@ -224,20 +92,12 @@ sub __emu_band $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; } + # leading zeros will be stripped by _from_hex() $bx = '0x' . $bx; - if ($CALC_EMU->can('_from_hex')) - { - $x->{value} = $CALC_EMU->_from_hex( \$bx ); - } - else - { - $r = $self->new($bx); - $x->{value} = $r->{value}; - } + $x->{value} = $CALC_EMU->_from_hex( $bx ); # calculate sign of result $x->{sign} = '+'; - #$x->{sign} = '-' if $sx == $sy && $sx == -1 && !$x->is_zero(); $x->{sign} = '-' if $sign == 1 && !$x->is_zero(); $x->bdec() if $sign == 1; @@ -317,16 +177,13 @@ sub __emu_bior $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; } + # leading zeros will be stripped by _from_hex() $bx = '0x' . $bx; - if ($CALC_EMU->can('_from_hex')) - { - $x->{value} = $CALC_EMU->_from_hex( \$bx ); - } - else - { - $r = $self->new($bx); - $x->{value} = $r->{value}; - } + $x->{value} = $CALC_EMU->_from_hex( $bx ); + + # calculate sign of result + $x->{sign} = '+'; + $x->{sign} = '-' if $sign == 1 && !$x->is_zero(); # if one of X or Y was negative, we need to decrement result $x->bdec() if $sign == 1; @@ -406,16 +263,9 @@ sub __emu_bxor $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; } + # leading zeros will be stripped by _from_hex() $bx = '0x' . $bx; - if ($CALC_EMU->can('_from_hex')) - { - $x->{value} = $CALC_EMU->_from_hex( \$bx ); - } - else - { - $r = $self->new($bx); - $x->{value} = $r->{value}; - } + $x->{value} = $CALC_EMU->_from_hex( $bx ); # calculate sign of result $x->{sign} = '+'; @@ -426,170 +276,6 @@ sub __emu_bxor $x->round(@r); } -sub __emu_bsqrt - { - my ($self,$x,@r) = @_; - - # this is slow: - return $x->round(@r) if $x->is_zero(); # 0,1 => 0,1 - - return $x->bone('+',@r) if $x < 4; # 1,2,3 => 1 - my $y = $x->copy(); - my $l = int($x->length()/2); - - $x->bone(); # keep ref($x), but modify it - $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 = $self->bzero(); - #my $lastlast = $x+$two; - while ($last != $x && $lastlast != $x) - { - $lastlast = $last; $last = $x->copy(); - $x->badd($y / $x); - $x->bdiv($two); - } - $x->bdec() if $x * $x > $y; # overshot? - $x->round(@r); - } - -sub __emu_broot - { - my ($self,$x,$y,@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 $num = $x->numify(); - - if ($num <= 1000000) - { - $x = $self->new( int ( sprintf ("%.8f", $num ** (1 / $y->numify() )))); - return $x->round(@r); - } - - # if $n is a power of two, we can repeatedly take sqrt($X) and find the - # proper result, because sqrt(sqrt($x)) == root($x,4) - # See Calc.pm for more details - my $b = $y->as_bin(); - if ($b =~ /0b1(0+)$/) - { - my $count = CORE::length($1); # 0b100 => len('00') => 2 - my $cnt = $count; # counter for loop - my $shift = $self->new(6); - $x->blsft($shift); # add some zeros (even amount) - while ($cnt-- > 0) - { - # 'inflate' $X by adding more zeros - $x->blsft($shift); - # calculate sqrt($x), $x is now a bit too big, again. In the next - # round we make even bigger, again. - $x->bsqrt($x); - } - # $x is still to big, so truncate result - $x->brsft($shift); - } - else - { - # trial computation by starting with 2,4,6,8,10 etc until we overstep - my $step; - my $trial = $self->new(2); - my $two = $self->new(2); - my $s_128 = $self->new(128); - - local undef $Math::BigInt::accuracy; - local undef $Math::BigInt::precision; - - # while still to do more than X steps - do - { - $step = $self->new(2); - while ( $trial->copy->bpow($y)->bacmp($x) < 0) - { - $step->bmul($two); - $trial->badd($step); - } - - # hit exactly? - if ( $trial->copy->bpow($y)->bacmp($x) == 0) - { - $x->{value} = $trial->{value}; # make copy while preserving ref to $x - return $x->round(@r); - } - # overstepped, so go back on step - $trial->bsub($step); - } while ($step > $s_128); - - $step = $two->copy(); - while ( $trial->copy->bpow($y)->bacmp($x) < 0) - { - $trial->badd($step); - } - - # not hit exactly? - if ( $x->bacmp( $trial->copy()->bpow($y) ) < 0) - { - $trial->bdec(); - } - # copy result into $x (preserve ref) - $x->{value} = $trial->{value}; - } - $x->round(@r); - } - -sub __emu_as_hex - { - my ($self,$x,$s) = @_; - - return '0x0' if $x->is_zero(); - - my $x1 = $x->copy()->babs(); my ($xr,$x10000,$h,$es); - if ($] >= 5.006) - { - $x10000 = $self->new (0x10000); $h = 'h4'; - } - else - { - $x10000 = $self->new (0x1000); $h = 'h3'; - } - while (!$x1->is_zero()) - { - ($x1, $xr) = bdiv($x1,$x10000); - $es .= unpack($h,pack('v',$xr->numify())); - } - $es = reverse $es; - $es =~ s/^[0]+//; # strip leading zeros - $s . '0x' . $es; - } - -sub __emu_as_bin - { - my ($self,$x,$s) = @_; - - return '0b0' if $x->is_zero(); - - my $x1 = $x->copy()->babs(); my ($xr,$x10000,$b,$es); - if ($] >= 5.006) - { - $x10000 = $self->new (0x10000); $b = 'b16'; - } - else - { - $x10000 = $self->new (0x1000); $b = 'b12'; - } - while (!$x1->is_zero()) - { - ($x1, $xr) = bdiv($x1,$x10000); - $es .= unpack($b,pack('v',$xr->numify())); - } - $es = reverse $es; - $es =~ s/^[0]+//; # strip leading zeros - $s . '0b' . $es; - } - ############################################################################## ############################################################################## @@ -622,7 +308,7 @@ the same terms as Perl itself. =head1 AUTHORS -(c) Tels http://bloodgate.com 2003 - based on BigInt code by +(c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by Tels from 2001-2003. =head1 SEE ALSO diff --git a/lib/Math/BigInt/t/bare_mbf.t b/lib/Math/BigInt/t/bare_mbf.t index 08ac4c2..9f94671 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 => 1772; + plan tests => 1814; } use Math::BigFloat lib => 'BareCalc'; diff --git a/lib/Math/BigInt/t/bare_mbi.t b/lib/Math/BigInt/t/bare_mbi.t index 0cc055e..6514e1e 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 => 2770; + plan tests => 2832; } use Math::BigInt lib => 'BareCalc'; diff --git a/lib/Math/BigInt/t/bare_mif.t b/lib/Math/BigInt/t/bare_mif.t index 00629fd9..0cc1de9 100644 --- a/lib/Math/BigInt/t/bare_mif.t +++ b/lib/Math/BigInt/t/bare_mif.t @@ -28,7 +28,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 679 + plan tests => 684 + 1; # our own tests } diff --git a/lib/Math/BigInt/t/bigfltpm.inc b/lib/Math/BigInt/t/bigfltpm.inc index 34d264a..d307ee6 100644 --- a/lib/Math/BigInt/t/bigfltpm.inc +++ b/lib/Math/BigInt/t/bigfltpm.inc @@ -30,7 +30,7 @@ while () { @args = split(/:/,$_,99); $ans = pop(@args); } - $try = "\$x = $class->new('$args[0]');"; + $try = "\$x = $class->new(\"$args[0]\");"; if ($f eq "fnorm") { $try .= "\$x;"; @@ -142,7 +142,7 @@ while () # trailing zeros #print $ans1->_trailing_zeros(),"\n"; print "# Has trailing zeros after '$try'\n" - if !ok ($ans1->{_m}->_trailing_zeros(), 0); + if !ok ($CL->_zeros( $ans1->{_m}), 0); } } } # end pattern or string @@ -165,9 +165,11 @@ ok ($y,1200); ok ($x,1200); my $monster = '1e1234567890123456789012345678901234567890'; -# new +# new and exponent ok ($class->new($monster)->bsstr(), '1e+1234567890123456789012345678901234567890'); +ok ($class->new($monster)->exponent(), + '1234567890123456789012345678901234567890'); # cmp ok ($class->new($monster) > 0,1); @@ -176,6 +178,11 @@ ok ($class->new($monster)->bsub( $monster),0); ok ($class->new($monster)->bmul(2)->bsstr(), '2e+1234567890123456789012345678901234567890'); +# mantissa +$monster = '1234567890123456789012345678901234567890e2'; +ok ($class->new($monster)->mantissa(), + '123456789012345678901234567890123456789'); + ############################################################################### # zero,inf,one,nan @@ -476,6 +483,18 @@ abc:NaN -3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 -4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004 &fpow +NaN:1:NaN +1:NaN:NaN +NaN:-1:NaN +-1:NaN:NaN +NaN:-21:NaN +-21:NaN:NaN +NaN:21:NaN +21:NaN:NaN +0:0:1 +0:1:0 +0:9:0 +0:-2:inf 2:2:4 1:2:1 1:3:1 @@ -491,6 +510,14 @@ abc:123.456:NaN -inf:123.45:-inf +inf:-123.45:inf -inf:-123.45:-inf +-2:2:4 +-2:3:-8 +-2:4:16 +-2:5:-32 +-3:2:9 +-3:3:-27 +-3:4:81 +-3:5:-243 # 2 ** 0.5 == sqrt(2) # 1.41..7 and not 1.4170 since fallback (bsqrt(9) is '3', not 3.0...0) 2:0.5:1.41421356237309504880168872420969807857 diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index 84741ba..3fce460 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 => 1772 + plan tests => 1814 + 2; # own tests } @@ -38,6 +38,6 @@ $class = "Math::BigFloat"; $CL = "Math::BigInt::Calc"; ok ($class->config()->{class},$class); -ok ($class->config()->{with},'Math::BigInt'); +ok ($class->config()->{with}, $CL); require 'bigfltpm.inc'; # all tests here for sharing diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t index 1f0804c..f0aa66d 100644 --- a/lib/Math/BigInt/t/bigintc.t +++ b/lib/Math/BigInt/t/bigintc.t @@ -8,15 +8,11 @@ BEGIN $| = 1; chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually + plan tests => 308; } use Math::BigInt::Calc; -BEGIN - { - plan tests => 300; - } - my ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL) = Math::BigInt::Calc->_base_len(); @@ -31,52 +27,59 @@ print "# IOR_BITS = $OR_BITS\n"; my $C = 'Math::BigInt::Calc'; # pass classname to sub's # _new and _str -my $x = $C->_new(\"123"); my $y = $C->_new(\"321"); -ok (ref($x),'ARRAY'); ok (${$C->_str($x)},123); ok (${$C->_str($y)},321); +my $x = $C->_new("123"); my $y = $C->_new("321"); +ok (ref($x),'ARRAY'); ok ($C->_str($x),123); ok ($C->_str($y),321); ############################################################################### # _add, _sub, _mul, _div -ok (${$C->_str($C->_add($x,$y))},444); -ok (${$C->_str($C->_sub($x,$y))},123); -ok (${$C->_str($C->_mul($x,$y))},39483); -ok (${$C->_str($C->_div($x,$y))},123); +ok ($C->_str($C->_add($x,$y)),444); +ok ($C->_str($C->_sub($x,$y)),123); +ok ($C->_str($C->_mul($x,$y)),39483); +ok ($C->_str($C->_div($x,$y)),123); ############################################################################### # check that mul/div doesn't change $y # and returns the same reference, not something new -ok (${$C->_str($C->_mul($x,$y))},39483); -ok (${$C->_str($x)},39483); ok (${$C->_str($y)},321); +ok ($C->_str($C->_mul($x,$y)),39483); +ok ($C->_str($x),39483); ok ($C->_str($y),321); -ok (${$C->_str($C->_div($x,$y))},123); -ok (${$C->_str($x)},123); ok (${$C->_str($y)},321); +ok ($C->_str($C->_div($x,$y)),123); +ok ($C->_str($x),123); ok ($C->_str($y),321); -$x = $C->_new(\"39483"); +$x = $C->_new("39483"); my ($x1,$r1) = $C->_div($x,$y); ok ("$x1","$x"); $C->_inc($x1); ok ("$x1","$x"); -ok (${$C->_str($r1)},'0'); +ok ($C->_str($r1),'0'); -$x = $C->_new(\"39483"); # reset +$x = $C->_new("39483"); # reset ############################################################################### -my $z = $C->_new(\"2"); -ok (${$C->_str($C->_add($x,$z))},39485); +my $z = $C->_new("2"); +ok ($C->_str($C->_add($x,$z)),39485); my ($re,$rr) = $C->_div($x,$y); -ok (${$C->_str($re)},123); ok (${$C->_str($rr)},2); +ok ($C->_str($re),123); ok ($C->_str($rr),2); # is_zero, _is_one, _one, _zero ok ($C->_is_zero($x)||0,0); ok ($C->_is_one($x)||0,0); -ok (${$C->_str($C->_zero())},"0"); -ok (${$C->_str($C->_one())},"1"); +ok ($C->_str($C->_zero()),"0"); +ok ($C->_str($C->_one()),"1"); -# _two() (only used internally) -ok (${$C->_str($C->_two())},"2"); +# _two() and _ten() +ok ($C->_str($C->_two()),"2"); +ok ($C->_str($C->_ten()),"10"); +ok ($C->_is_ten($C->_two()),0); +ok ($C->_is_two($C->_two()),1); +ok ($C->_is_ten($C->_ten()),1); +ok ($C->_is_two($C->_ten()),0); ok ($C->_is_one($C->_one()),1); +ok ($C->_is_one($C->_two()),0); +ok ($C->_is_one($C->_ten()),0); ok ($C->_is_one($C->_zero()) || 0,0); @@ -89,35 +92,35 @@ ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero())||0,0); ok ($C->_is_even($C->_one()) || 0,0); ok ($C->_is_even($C->_zero()),1); # _len -$x = $C->_new(\"1"); ok ($C->_len($x),1); -$x = $C->_new(\"12"); ok ($C->_len($x),2); -$x = $C->_new(\"123"); ok ($C->_len($x),3); -$x = $C->_new(\"1234"); ok ($C->_len($x),4); -$x = $C->_new(\"12345"); ok ($C->_len($x),5); -$x = $C->_new(\"123456"); ok ($C->_len($x),6); -$x = $C->_new(\"1234567"); ok ($C->_len($x),7); -$x = $C->_new(\"12345678"); ok ($C->_len($x),8); -$x = $C->_new(\"123456789"); ok ($C->_len($x),9); - -$x = $C->_new(\"8"); ok ($C->_len($x),1); -$x = $C->_new(\"21"); ok ($C->_len($x),2); -$x = $C->_new(\"321"); ok ($C->_len($x),3); -$x = $C->_new(\"4321"); ok ($C->_len($x),4); -$x = $C->_new(\"54321"); ok ($C->_len($x),5); -$x = $C->_new(\"654321"); ok ($C->_len($x),6); -$x = $C->_new(\"7654321"); ok ($C->_len($x),7); -$x = $C->_new(\"87654321"); ok ($C->_len($x),8); -$x = $C->_new(\"987654321"); ok ($C->_len($x),9); +$x = $C->_new("1"); ok ($C->_len($x),1); +$x = $C->_new("12"); ok ($C->_len($x),2); +$x = $C->_new("123"); ok ($C->_len($x),3); +$x = $C->_new("1234"); ok ($C->_len($x),4); +$x = $C->_new("12345"); ok ($C->_len($x),5); +$x = $C->_new("123456"); ok ($C->_len($x),6); +$x = $C->_new("1234567"); ok ($C->_len($x),7); +$x = $C->_new("12345678"); ok ($C->_len($x),8); +$x = $C->_new("123456789"); ok ($C->_len($x),9); + +$x = $C->_new("8"); ok ($C->_len($x),1); +$x = $C->_new("21"); ok ($C->_len($x),2); +$x = $C->_new("321"); ok ($C->_len($x),3); +$x = $C->_new("4321"); ok ($C->_len($x),4); +$x = $C->_new("54321"); ok ($C->_len($x),5); +$x = $C->_new("654321"); ok ($C->_len($x),6); +$x = $C->_new("7654321"); ok ($C->_len($x),7); +$x = $C->_new("87654321"); ok ($C->_len($x),8); +$x = $C->_new("987654321"); ok ($C->_len($x),9); for (my $i = 1; $i < 9; $i++) { my $a = "$i" . '0' x ($i-1); - $x = $C->_new(\$a); + $x = $C->_new($a); print "# Tried len '$a'\n" unless ok ($C->_len($x),$i); } # _digit -$x = $C->_new(\"123456789"); +$x = $C->_new("123456789"); ok ($C->_digit($x,0),9); ok ($C->_digit($x,1),8); ok ($C->_digit($x,2),7); @@ -128,201 +131,202 @@ ok ($C->_digit($x,-3),3); # _copy foreach (qw/ 1 12 123 1234 12345 123456 1234567 12345678 123456789/) { - $x = $C->_new(\"$_"); - ok (${$C->_str($C->_copy($x))},"$_"); - ok (${$C->_str($x)},"$_"); # did _copy destroy original x? + $x = $C->_new("$_"); + ok ($C->_str($C->_copy($x)),"$_"); + ok ($C->_str($x),"$_"); # did _copy destroy original x? } # _zeros -$x = $C->_new(\"1256000000"); ok ($C->_zeros($x),6); -$x = $C->_new(\"152"); ok ($C->_zeros($x),0); -$x = $C->_new(\"123000"); ok ($C->_zeros($x),3); +$x = $C->_new("1256000000"); ok ($C->_zeros($x),6); +$x = $C->_new("152"); ok ($C->_zeros($x),0); +$x = $C->_new("123000"); ok ($C->_zeros($x),3); +$x = $C->_new("0"); ok ($C->_zeros($x),0); # _lsft, _rsft -$x = $C->_new(\"10"); $y = $C->_new(\"3"); -ok (${$C->_str($C->_lsft($x,$y,10))},10000); -$x = $C->_new(\"20"); $y = $C->_new(\"3"); -ok (${$C->_str($C->_lsft($x,$y,10))},20000); +$x = $C->_new("10"); $y = $C->_new("3"); +ok ($C->_str($C->_lsft($x,$y,10)),10000); +$x = $C->_new("20"); $y = $C->_new("3"); +ok ($C->_str($C->_lsft($x,$y,10)),20000); -$x = $C->_new(\"128"); $y = $C->_new(\"4"); -ok (${$C->_str($C->_lsft($x,$y,2))}, 128 << 4); +$x = $C->_new("128"); $y = $C->_new("4"); +ok ($C->_str($C->_lsft($x,$y,2)), 128 << 4); -$x = $C->_new(\"1000"); $y = $C->_new(\"3"); -ok (${$C->_str($C->_rsft($x,$y,10))},1); -$x = $C->_new(\"20000"); $y = $C->_new(\"3"); -ok (${$C->_str($C->_rsft($x,$y,10))},20); -$x = $C->_new(\"256"); $y = $C->_new(\"4"); -ok (${$C->_str($C->_rsft($x,$y,2))},256 >> 4); +$x = $C->_new("1000"); $y = $C->_new("3"); +ok ($C->_str($C->_rsft($x,$y,10)),1); +$x = $C->_new("20000"); $y = $C->_new("3"); +ok ($C->_str($C->_rsft($x,$y,10)),20); +$x = $C->_new("256"); $y = $C->_new("4"); +ok ($C->_str($C->_rsft($x,$y,2)),256 >> 4); -$x = $C->_new(\"6411906467305339182857313397200584952398"); -$y = $C->_new(\"45"); -ok (${$C->_str($C->_rsft($x,$y,10))},0); +$x = $C->_new("6411906467305339182857313397200584952398"); +$y = $C->_new("45"); +ok ($C->_str($C->_rsft($x,$y,10)),0); # _acmp -$x = $C->_new(\"123456789"); -$y = $C->_new(\"987654321"); +$x = $C->_new("123456789"); +$y = $C->_new("987654321"); ok ($C->_acmp($x,$y),-1); ok ($C->_acmp($y,$x),1); ok ($C->_acmp($x,$x),0); ok ($C->_acmp($y,$y),0); -$x = $C->_new(\"12"); -$y = $C->_new(\"12"); +$x = $C->_new("12"); +$y = $C->_new("12"); ok ($C->_acmp($x,$y),0); -$x = $C->_new(\"21"); +$x = $C->_new("21"); ok ($C->_acmp($x,$y),1); ok ($C->_acmp($y,$x),-1); -$x = $C->_new(\"123456789"); -$y = $C->_new(\"1987654321"); +$x = $C->_new("123456789"); +$y = $C->_new("1987654321"); ok ($C->_acmp($x,$y),-1); ok ($C->_acmp($y,$x),+1); -$x = $C->_new(\"1234567890123456789"); -$y = $C->_new(\"987654321012345678"); +$x = $C->_new("1234567890123456789"); +$y = $C->_new("987654321012345678"); ok ($C->_acmp($x,$y),1); ok ($C->_acmp($y,$x),-1); ok ($C->_acmp($x,$x),0); ok ($C->_acmp($y,$y),0); -$x = $C->_new(\"1234"); -$y = $C->_new(\"987654321012345678"); +$x = $C->_new("1234"); +$y = $C->_new("987654321012345678"); ok ($C->_acmp($x,$y),-1); ok ($C->_acmp($y,$x),1); ok ($C->_acmp($x,$x),0); ok ($C->_acmp($y,$y),0); # _modinv -$x = $C->_new(\"8"); -$y = $C->_new(\"5033"); +$x = $C->_new("8"); +$y = $C->_new("5033"); my ($xmod,$sign) = $C->_modinv($x,$y); -ok (${$C->_str($xmod)},'629'); # -629 % 5033 == 4404 +ok ($C->_str($xmod),'629'); # -629 % 5033 == 4404 ok ($sign, '-'); # _div -$x = $C->_new(\"3333"); $y = $C->_new(\"1111"); -ok (${$C->_str(scalar $C->_div($x,$y))},3); -$x = $C->_new(\"33333"); $y = $C->_new(\"1111"); ($x,$y) = $C->_div($x,$y); -ok (${$C->_str($x)},30); ok (${$C->_str($y)},3); -$x = $C->_new(\"123"); $y = $C->_new(\"1111"); -($x,$y) = $C->_div($x,$y); ok (${$C->_str($x)},0); ok (${$C->_str($y)},123); +$x = $C->_new("3333"); $y = $C->_new("1111"); +ok ($C->_str(scalar $C->_div($x,$y)),3); +$x = $C->_new("33333"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y); +ok ($C->_str($x),30); ok ($C->_str($y),3); +$x = $C->_new("123"); $y = $C->_new("1111"); +($x,$y) = $C->_div($x,$y); ok ($C->_str($x),0); ok ($C->_str($y),123); # _num foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/) { - $x = $C->_new(\"$_"); - ok (ref($x)||'','ARRAY'); ok (${$C->_str($x)},"$_"); + $x = $C->_new("$_"); + ok (ref($x)||'','ARRAY'); ok ($C->_str($x),"$_"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,$_); } # _sqrt -$x = $C->_new(\"144"); ok (${$C->_str($C->_sqrt($x))},'12'); -$x = $C->_new(\"144000000000000"); ok (${$C->_str($C->_sqrt($x))},'12000000'); +$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'); +$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'); # _pow (and _root) -$x = $C->_new(\"0"); $n = $C->_new(\"3"); # 0 ** y => 0 -ok (${$C->_str($C->_pow($x,$n))}, 0); -$x = $C->_new(\"3"); $n = $C->_new(\"0"); # x ** 0 => 1 -ok (${$C->_str($C->_pow($x,$n))}, 1); -$x = $C->_new(\"1"); $n = $C->_new(\"3"); # 1 ** y => 1 -ok (${$C->_str($C->_pow($x,$n))}, 1); -$x = $C->_new(\"5"); $n = $C->_new(\"1"); # x ** 1 => x -ok (${$C->_str($C->_pow($x,$n))}, 5); +$x = $C->_new("0"); $n = $C->_new("3"); # 0 ** y => 0 +ok ($C->_str($C->_pow($x,$n)), 0); +$x = $C->_new("3"); $n = $C->_new("0"); # x ** 0 => 1 +ok ($C->_str($C->_pow($x,$n)), 1); +$x = $C->_new("1"); $n = $C->_new("3"); # 1 ** y => 1 +ok ($C->_str($C->_pow($x,$n)), 1); +$x = $C->_new("5"); $n = $C->_new("1"); # x ** 1 => x +ok ($C->_str($C->_pow($x,$n)), 5); -$x = $C->_new(\"81"); $n = $C->_new(\"3"); # 81 ** 3 == 531441 -ok (${$C->_str($C->_pow($x,$n))},81 ** 3); +$x = $C->_new("81"); $n = $C->_new("3"); # 81 ** 3 == 531441 +ok ($C->_str($C->_pow($x,$n)),81 ** 3); -ok (${$C->_str($C->_root($x,$n))},81); +ok ($C->_str($C->_root($x,$n)),81); -$x = $C->_new(\"81"); -ok (${$C->_str($C->_pow($x,$n))},81 ** 3); -ok (${$C->_str($C->_pow($x,$n))},'150094635296999121'); # 531441 ** 3 == +$x = $C->_new("81"); +ok ($C->_str($C->_pow($x,$n)),81 ** 3); +ok ($C->_str($C->_pow($x,$n)),'150094635296999121'); # 531441 ** 3 == -ok (${$C->_str($C->_root($x,$n))},'531441'); -ok (${$C->_str($C->_root($x,$n))},'81'); +ok ($C->_str($C->_root($x,$n)),'531441'); +ok ($C->_str($C->_root($x,$n)),'81'); -$x = $C->_new(\"81"); $n = $C->_new(\"14"); -ok (${$C->_str($C->_pow($x,$n))},'523347633027360537213511521'); -ok (${$C->_str($C->_root($x,$n))},'81'); +$x = $C->_new("81"); $n = $C->_new("14"); +ok ($C->_str($C->_pow($x,$n)),'523347633027360537213511521'); +ok ($C->_str($C->_root($x,$n)),'81'); -$x = $C->_new(\"523347633027360537213511520"); -ok (${$C->_str($C->_root($x,$n))},'80'); +$x = $C->_new("523347633027360537213511520"); +ok ($C->_str($C->_root($x,$n)),'80'); -$x = $C->_new(\"523347633027360537213511522"); -ok (${$C->_str($C->_root($x,$n))},'81'); +$x = $C->_new("523347633027360537213511522"); +ok ($C->_str($C->_root($x,$n)),'81'); my $res = [ qw/ 9 31 99 316 999 3162 9999/ ]; # 99 ** 2 = 9801, 999 ** 2 = 998001 etc for my $i (2 .. 9) { - $x = '9' x $i; $x = $C->_new(\$x); - $n = $C->_new(\"2"); + $x = '9' x $i; $x = $C->_new($x); + $n = $C->_new("2"); my $rc = '9' x ($i-1). '8' . '0' x ($i-1) . '1'; print "# _pow( ", '9' x $i, ", 2) \n" unless - ok (${$C->_str($C->_pow($x,$n))},$rc); + ok ($C->_str($C->_pow($x,$n)),$rc); if ($i <= 7) { - $x = '9' x $i; $x = $C->_new(\$x); - $n = '9' x $i; $n = $C->_new(\$n); + $x = '9' x $i; $x = $C->_new($x); + $n = '9' x $i; $n = $C->_new($n); print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless - ok (${$C->_str($C->_root($x,$n))},'1'); + ok ($C->_str($C->_root($x,$n)),'1'); - $x = '9' x $i; $x = $C->_new(\$x); - $n = $C->_new(\"2"); + $x = '9' x $i; $x = $C->_new($x); + $n = $C->_new("2"); print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless - ok (${$C->_str($C->_root($x,$n))}, $res->[$i-2]); + ok ($C->_str($C->_root($x,$n)), $res->[$i-2]); } } ############################################################################## # _fac -$x = $C->_new(\"0"); ok (${$C->_str($C->_fac($x))},'1'); -$x = $C->_new(\"1"); ok (${$C->_str($C->_fac($x))},'1'); -$x = $C->_new(\"2"); ok (${$C->_str($C->_fac($x))},'2'); -$x = $C->_new(\"3"); ok (${$C->_str($C->_fac($x))},'6'); -$x = $C->_new(\"4"); ok (${$C->_str($C->_fac($x))},'24'); -$x = $C->_new(\"5"); ok (${$C->_str($C->_fac($x))},'120'); -$x = $C->_new(\"10"); ok (${$C->_str($C->_fac($x))},'3628800'); -$x = $C->_new(\"11"); ok (${$C->_str($C->_fac($x))},'39916800'); -$x = $C->_new(\"12"); ok (${$C->_str($C->_fac($x))},'479001600'); -$x = $C->_new(\"13"); ok (${$C->_str($C->_fac($x))},'6227020800'); +$x = $C->_new("0"); ok ($C->_str($C->_fac($x)),'1'); +$x = $C->_new("1"); ok ($C->_str($C->_fac($x)),'1'); +$x = $C->_new("2"); ok ($C->_str($C->_fac($x)),'2'); +$x = $C->_new("3"); ok ($C->_str($C->_fac($x)),'6'); +$x = $C->_new("4"); ok ($C->_str($C->_fac($x)),'24'); +$x = $C->_new("5"); ok ($C->_str($C->_fac($x)),'120'); +$x = $C->_new("10"); ok ($C->_str($C->_fac($x)),'3628800'); +$x = $C->_new("11"); ok ($C->_str($C->_fac($x)),'39916800'); +$x = $C->_new("12"); ok ($C->_str($C->_fac($x)),'479001600'); +$x = $C->_new("13"); ok ($C->_str($C->_fac($x)),'6227020800'); # test that _fac modifes $x in place for small arguments -$x = $C->_new(\"3"); $C->_fac($x); ok (${$C->_str($x)},'6'); -$x = $C->_new(\"13"); $C->_fac($x); ok (${$C->_str($x)},'6227020800'); +$x = $C->_new("3"); $C->_fac($x); ok ($C->_str($x),'6'); +$x = $C->_new("13"); $C->_fac($x); ok ($C->_str($x),'6227020800'); ############################################################################## # _inc and _dec foreach (qw/1 11 121 1231 12341 1234561 12345671 123456781 1234567891/) { - $x = $C->_new(\"$_"); $C->_inc($x); - print "# \$x = ",${$C->_str($x)},"\n" - unless ok (${$C->_str($x)},substr($_,0,length($_)-1) . '2'); - $C->_dec($x); ok (${$C->_str($x)},$_); + $x = $C->_new("$_"); $C->_inc($x); + print "# \$x = ",$C->_str($x),"\n" + unless ok ($C->_str($x),substr($_,0,length($_)-1) . '2'); + $C->_dec($x); ok ($C->_str($x),$_); } foreach (qw/19 119 1219 12319 1234519 12345619 123456719 1234567819/) { - $x = $C->_new(\"$_"); $C->_inc($x); - print "# \$x = ",${$C->_str($x)},"\n" - unless ok (${$C->_str($x)},substr($_,0,length($_)-2) . '20'); - $C->_dec($x); ok (${$C->_str($x)},$_); + $x = $C->_new("$_"); $C->_inc($x); + print "# \$x = ",$C->_str($x),"\n" + unless ok ($C->_str($x),substr($_,0,length($_)-2) . '20'); + $C->_dec($x); ok ($C->_str($x),$_); } foreach (qw/999 9999 99999 9999999 99999999 999999999 9999999999 99999999999/) { - $x = $C->_new(\"$_"); $C->_inc($x); - print "# \$x = ",${$C->_str($x)},"\n" - unless ok (${$C->_str($x)}, '1' . '0' x (length($_))); - $C->_dec($x); ok (${$C->_str($x)},$_); + $x = $C->_new("$_"); $C->_inc($x); + print "# \$x = ",$C->_str($x),"\n" + unless ok ($C->_str($x), '1' . '0' x (length($_))); + $C->_dec($x); ok ($C->_str($x),$_); } -$x = $C->_new(\"1000"); $C->_inc($x); ok (${$C->_str($x)},'1001'); -$C->_dec($x); ok (${$C->_str($x)},'1000'); +$x = $C->_new("1000"); $C->_inc($x); ok ($C->_str($x),'1001'); +$C->_dec($x); ok ($C->_str($x),'1000'); my $BL; { @@ -332,45 +336,45 @@ my $BL; $x = '1' . '0' x $BL; $z = '1' . '0' x ($BL-1); $z .= '1'; -$x = $C->_new(\$x); $C->_inc($x); ok (${$C->_str($x)},$z); +$x = $C->_new($x); $C->_inc($x); ok ($C->_str($x),$z); $x = '1' . '0' x $BL; $z = '9' x $BL; -$x = $C->_new(\$x); $C->_dec($x); ok (${$C->_str($x)},$z); +$x = $C->_new($x); $C->_dec($x); ok ($C->_str($x),$z); # should not happen: -# $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1); +# $x = $C->_new("-2"); $y = $C->_new("4"); ok ($C->_acmp($x,$y),-1); ############################################################################### # _mod -$x = $C->_new(\"1000"); $y = $C->_new(\"3"); -ok (${$C->_str(scalar $C->_mod($x,$y))},1); -$x = $C->_new(\"1000"); $y = $C->_new(\"2"); -ok (${$C->_str(scalar $C->_mod($x,$y))},0); +$x = $C->_new("1000"); $y = $C->_new("3"); +ok ($C->_str(scalar $C->_mod($x,$y)),1); +$x = $C->_new("1000"); $y = $C->_new("2"); +ok ($C->_str(scalar $C->_mod($x,$y)),0); # _and, _or, _xor -$x = $C->_new(\"5"); $y = $C->_new(\"2"); -ok (${$C->_str(scalar $C->_xor($x,$y))},7); -$x = $C->_new(\"5"); $y = $C->_new(\"2"); -ok (${$C->_str(scalar $C->_or($x,$y))},7); -$x = $C->_new(\"5"); $y = $C->_new(\"3"); -ok (${$C->_str(scalar $C->_and($x,$y))},1); +$x = $C->_new("5"); $y = $C->_new("2"); +ok ($C->_str(scalar $C->_xor($x,$y)),7); +$x = $C->_new("5"); $y = $C->_new("2"); +ok ($C->_str(scalar $C->_or($x,$y)),7); +$x = $C->_new("5"); $y = $C->_new("3"); +ok ($C->_str(scalar $C->_and($x,$y)),1); # _from_hex, _from_bin -ok (${$C->_str(scalar $C->_from_hex(\"0xFf"))},255); -ok (${$C->_str(scalar $C->_from_bin(\"0b10101011"))},160+11); +ok ($C->_str( $C->_from_hex("0xFf")),255); +ok ($C->_str( $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'); +ok ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new("128")))), 128); +ok ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new("128")))), 128); +ok ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new("0")))), 0); +ok ($C->_str( $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"); +$x = $C->_new("123456789"); ok ($C->_check($x),0); ok ($C->_check(123),'123 is not a reference'); diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc index 4e52667..cdefea6 100644 --- a/lib/Math/BigInt/t/bigintpm.inc +++ b/lib/Math/BigInt/t/bigintpm.inc @@ -1683,6 +1683,13 @@ abc:1:abc:NaN 111111111111111111111111111111:111111111111111111111111111111:0 12345678901234567890:12345678901234567890:0 &bgcd +inf:12:NaN +-inf:12:NaN +12:inf:NaN +12:-inf:NaN +inf:inf:NaN +inf:-inf:NaN +-inf:-inf:NaN abc:abc:NaN abc:+0:NaN +0:abc:NaN @@ -1693,6 +1700,10 @@ abc:+0:NaN +2:+3:1 +3:+2:1 -3:+2:1 +-3:-2:1 +-144:-60:12 +144:-60:12 +144:60:12 100:625:25 4096:81:1 1034:804:2 @@ -1717,12 +1728,16 @@ abc:0:NaN +281474976710656:0:0 +281474976710656:1:0 +281474976710656:+281474976710656:281474976710656 +281474976710656:-1:281474976710656 -2:-3:-4 -1:-1:-1 -6:-6:-6 -7:-4:-8 -7:4:0 -4:7:4 +# negative argument is bitwise shorter than positive [perl #26559] +30:-3:28 +123:-1:123 # equal arguments are treated special, so also do some test with unequal ones 0xFFFF:0xFFFF:0x0xFFFF 0xFFFFFF:0xFFFFFF:0x0xFFFFFF @@ -1754,6 +1769,11 @@ abc:0:NaN -6:-6:-6 -7:4:-3 -4:7:-1 ++281474976710656:-1:-1 +30:-3:-1 +30:-4:-2 +300:-76:-68 +-76:300:-68 # equal arguments are treated special, so also do some test with unequal ones 0xFFFF:0xFFFF:0x0xFFFF 0xFFFFFF:0xFFFFFF:0x0xFFFFFF @@ -1802,6 +1822,10 @@ abc:0:NaN -4:7:-5 4:-7:-3 -4:-7:5 +30:-3:-29 +30:-4:-30 +300:-76:-360 +-76:300:-360 # equal arguments are treated special, so also do some test with unequal ones 0xFFFF:0xFFFF:0 0xFFFFFF:0xFFFFFF:0 @@ -1916,8 +1940,8 @@ abc:12:NaN 0:0:1 0:1:0 0:2:0 -0:-1:NaN -0:-2:NaN +0:-1:inf +0:-2:inf 1:0:1 1:1:1 1:2:1 @@ -1960,6 +1984,14 @@ abc:12:NaN 10:9:1000000000 10:20:100000000000000000000 123456:2:15241383936 +-2:2:4 +-2:3:-8 +-2:4:16 +-2:5:-32 +-3:2:9 +-3:3:-27 +-3:4:81 +-3:5:-243 &length 100:3 10:2 diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index 0ffa4a2..50fca1d 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 => 2770; + plan tests => 2832; } use Math::BigInt; diff --git a/lib/Math/BigInt/t/bigints.t b/lib/Math/BigInt/t/bigints.t index 6b21a75..de073e2 100644 --- a/lib/Math/BigInt/t/bigints.t +++ b/lib/Math/BigInt/t/bigints.t @@ -36,24 +36,24 @@ use Math::BigInt::Scalar; my $C = 'Math::BigInt::Scalar'; # pass classname to sub's # _new and _str -my $x = $C->_new(\"123"); my $y = $C->_new(\"321"); -ok (ref($x),'SCALAR'); ok (${$C->_str($x)},123); ok (${$C->_str($y)},321); +my $x = $C->_new("123"); my $y = $C->_new("321"); +ok (ref($x),'SCALAR'); ok ($C->_str($x),123); ok ($C->_str($y),321); # _add, _sub, _mul, _div -ok (${$C->_str($C->_add($x,$y))},444); -ok (${$C->_str($C->_sub($x,$y))},123); -ok (${$C->_str($C->_mul($x,$y))},39483); -ok (${$C->_str($C->_div($x,$y))},123); +ok ($C->_str($C->_add($x,$y)),444); +ok ($C->_str($C->_sub($x,$y)),123); +ok ($C->_str($C->_mul($x,$y)),39483); +ok ($C->_str($C->_div($x,$y)),123); -ok (${$C->_str($C->_mul($x,$y))},39483); -ok (${$C->_str($x)},39483); -ok (${$C->_str($y)},321); -my $z = $C->_new(\"2"); -ok (${$C->_str($C->_add($x,$z))},39485); +ok ($C->_str($C->_mul($x,$y)),39483); +ok ($C->_str($x),39483); +ok ($C->_str($y),321); +my $z = $C->_new("2"); +ok ($C->_str($C->_add($x,$z)),39485); my ($re,$rr) = $C->_div($x,$y); -ok (${$C->_str($re)},123); ok (${$C->_str($rr)},2); +ok ($C->_str($re),123); ok ($C->_str($rr),2); # is_zero, _is_one, _one, _zero ok ($C->_is_zero($x),0); @@ -67,7 +67,7 @@ ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero()),0); ok ($C->_is_even($C->_one()),0); ok ($C->_is_even($C->_zero()),1); # _digit -$x = $C->_new(\"123456789"); +$x = $C->_new("123456789"); ok ($C->_digit($x,0),9); ok ($C->_digit($x,1),8); ok ($C->_digit($x,2),7); @@ -76,47 +76,44 @@ ok ($C->_digit($x,-2),2); ok ($C->_digit($x,-3),3); # _copy -$x = $C->_new(\"12356"); -ok (${$C->_str($C->_copy($x))},12356); +$x = $C->_new("12356"); +ok ($C->_str($C->_copy($x)),12356); # _acmp -$x = $C->_new(\"123456789"); -$y = $C->_new(\"987654321"); +$x = $C->_new("123456789"); +$y = $C->_new("987654321"); ok ($C->_acmp($x,$y),-1); ok ($C->_acmp($y,$x),1); ok ($C->_acmp($x,$x),0); ok ($C->_acmp($y,$y),0); # _div -$x = $C->_new(\"3333"); $y = $C->_new(\"1111"); -ok (${$C->_str( scalar $C->_div($x,$y))},3); -$x = $C->_new(\"33333"); $y = $C->_new(\"1111"); ($x,$y) = $C->_div($x,$y); -ok (${$C->_str($x)},30); ok (${$C->_str($y)},3); -$x = $C->_new(\"123"); $y = $C->_new(\"1111"); -($x,$y) = $C->_div($x,$y); ok (${$C->_str($x)},0); ok (${$C->_str($y)},123); +$x = $C->_new("3333"); $y = $C->_new("1111"); +ok ($C->_str( scalar $C->_div($x,$y)),3); +$x = $C->_new("33333"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y); +ok ($C->_str($x),30); ok ($C->_str($y),3); +$x = $C->_new("123"); $y = $C->_new("1111"); +($x,$y) = $C->_div($x,$y); ok ($C->_str($x),0); ok ($C->_str($y),123); # _num -$x = $C->_new(\"12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345); +$x = $C->_new("12345"); $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,12345); # _len -$x = $C->_new(\"12345"); $x = $C->_len($x); ok (ref($x)||'',''); ok ($x,5); +$x = $C->_new("12345"); $x = $C->_len($x); ok (ref($x)||'',''); ok ($x,5); # _and, _or, _xor -$x = $C->_new(\"3"); $y = $C->_new(\"4"); ok (${$C->_str( $C->_or($x,$y))},7); -$x = $C->_new(\"1"); $y = $C->_new(\"4"); ok (${$C->_str( $C->_xor($x,$y))},5); -$x = $C->_new(\"7"); $y = $C->_new(\"3"); ok (${$C->_str( $C->_and($x,$y))},3); +$x = $C->_new("3"); $y = $C->_new("4"); ok ($C->_str( $C->_or($x,$y)),7); +$x = $C->_new("1"); $y = $C->_new("4"); ok ($C->_str( $C->_xor($x,$y)),5); +$x = $C->_new("7"); $y = $C->_new("3"); ok ($C->_str( $C->_and($x,$y)),3); # _pow -$x = $C->_new(\"2"); $y = $C->_new(\"4"); ok (${$C->_str( $C->_pow($x,$y))},16); -$x = $C->_new(\"2"); $y = $C->_new(\"5"); ok (${$C->_str( $C->_pow($x,$y))},32); -$x = $C->_new(\"3"); $y = $C->_new(\"3"); ok (${$C->_str( $C->_pow($x,$y))},27); +$x = $C->_new("2"); $y = $C->_new("4"); ok ($C->_str( $C->_pow($x,$y)),16); +$x = $C->_new("2"); $y = $C->_new("5"); ok ($C->_str( $C->_pow($x,$y)),32); +$x = $C->_new("3"); $y = $C->_new("3"); ok ($C->_str( $C->_pow($x,$y)),27); -# should not happen: -# $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1); - # _check -$x = $C->_new(\"123456789"); +$x = $C->_new("123456789"); ok ($C->_check($x),0); ok ($C->_check(123),'123 is not a reference'); diff --git a/lib/Math/BigInt/t/biglog.t b/lib/Math/BigInt/t/biglog.t index 9ed9c2a..cba2643 100644 --- a/lib/Math/BigInt/t/biglog.t +++ b/lib/Math/BigInt/t/biglog.t @@ -37,7 +37,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 50; + plan tests => 53; } use Math::BigFloat; @@ -45,7 +45,7 @@ use Math::BigInt; my $cl = "Math::BigFloat"; -# these tests are now really fast, since they collapse to blog(10), basically +# 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 @@ -99,6 +99,11 @@ ok ($cl->new('10')->bpow('0.6',10), '3.981071706'); # blog should handle bigint input ok (Math::BigFloat::blog(Math::BigInt->new(100),10), 2); +# some integer results +ok ($cl->new(2)->bpow(32)->blog(2), '32'); # 2 ** 32 +ok ($cl->new(3)->bpow(32)->blog(3), '32'); # 3 ** 32 +ok ($cl->new(2)->bpow(65)->blog(2), '65'); # 2 ** 65 + # 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'); @@ -127,7 +132,7 @@ sub test_bpow { my ($x,$y,$scale,$result) = @_; - print "# Tried: $x->bpow($y,$scale);\n" + print "# Tried: $x->bpow($y,$scale);\n" unless ok ($cl->new($x)->bpow($y,$scale),$result); } diff --git a/lib/Math/BigInt/t/calling.t b/lib/Math/BigInt/t/calling.t index 3b0ff41..71c6b48 100644 --- a/lib/Math/BigInt/t/calling.t +++ b/lib/Math/BigInt/t/calling.t @@ -30,7 +30,7 @@ BEGIN unshift @INC, $location; } print "# INC = @INC\n"; - my $tests = 161; + my $tests = 160; plan tests => $tests; if ($] < 5.006) { @@ -95,11 +95,12 @@ while () $class = 'Math::BigInt'; +# XXX TODO this test does not work/fail. # test whether use Math::BigInt qw/version/ works -$try = "use $class ($version.'1');"; -$try .= ' $x = $class->new(123); $x = "$x";'; -eval $try; -ok_undef ( $_ ); # should result in error! +#$try = "use $class ($version.'1');"; +#$try .= ' $x = $class->new(123); $x = "$x";'; +#eval $try; +#ok_undef ( $x ); # should result in error! # test whether fallback to calc works $try = "use $class ($version,'lib','foo, bar , ');"; @@ -122,14 +123,6 @@ $try = "use $class ($version,'LiB','$class\::Scalar');"; $try .= ' $x = 2**10; $x = "$x";'; $ans = eval $try; ok ( $ans, "1024"); -# test wether calc => undef (array element not existing) works -# no longer supported -#$try = "use $class ($version,'LIB');"; -#$try = "require $class; $class\::import($version,'CALC');"; -#$try .= " \$x = $class\->new(2)**10; \$x = ".'"$x";'; -#print "$try\n"; -#$ans = eval $try; ok ( $ans, 1024); - # all done ############################################################################### diff --git a/lib/Math/BigInt/t/config.t b/lib/Math/BigInt/t/config.t index 5c48053..da75344 100644 --- a/lib/Math/BigInt/t/config.t +++ b/lib/Math/BigInt/t/config.t @@ -51,7 +51,7 @@ $cfg = $mbf->config(); ok (ref($cfg),'HASH'); ok ($cfg->{lib},'Math::BigInt::Calc'); -ok ($cfg->{with},$mbi); +ok ($cfg->{with},'Math::BigInt::Calc'); ok ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION); ok ($cfg->{class},$mbf); ok ($cfg->{upgrade}||'',''); diff --git a/lib/Math/BigInt/t/mbimbf.inc b/lib/Math/BigInt/t/mbimbf.inc index 192b1cc..b9c94c4 100644 --- a/lib/Math/BigInt/t/mbimbf.inc +++ b/lib/Math/BigInt/t/mbimbf.inc @@ -264,9 +264,9 @@ foreach my $c ($mbi,$mbf) ok ($c->bpow(2,16),65536); ok ($c->bpow(2,$c->new(16)),65536); -# ok ($c->new(2**15)->brsft(1),2**14); -# ok ($c->brsft(2**15,1),2**14); -# ok ($c->brsft(2**15,$c->new(1)),2**14); + ok ($c->new(2**15)->brsft(1),2**14); + ok ($c->brsft(2**15,1),2**14); + ok ($c->brsft(2**15,$c->new(1)),2**14); ok ($c->new(2**13)->blsft(1),2**14); ok ($c->blsft(2**13,1),2**14); @@ -544,6 +544,17 @@ $x = $mbf->new('12340'); $x->bfround(2); ok ($x,'12340'); $x = $mbi->new('1234'); $x->accuracy(3); $x->bfround(-2); ok_undef ($x->{_a}); +# test that bfround() and bround() work with large numbers + +$x = $mbf->new(1)->bdiv(5678,undef,-63); +ok ($x, '0.000176118351532229658330398027474462839027826699542092286016203'); + +$x = $mbf->new(1)->bdiv(5678,undef,-90); +ok ($x, '0.000176118351532229658330398027474462839027826699542092286016202888340965128566396618527651'); + +$x = $mbf->new(1)->bdiv(5678,80); +ok ($x, '0.00017611835153222965833039802747446283902782669954209228601620288834096512856639662'); + ############################################################################### # rounding with already set precision/accuracy @@ -565,8 +576,9 @@ ok ($x->{_a},2); # mantissa/exponent format and A/P $x = $mbf->new('12345.678'); $x->accuracy(4); ok ($x,'12350'); ok ($x->{_a},4); ok_undef ($x->{_p}); -ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a}); -ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p}); + +#ok_undef ($x->{_m}->{_a}); ok_undef ($x->{_e}->{_a}); +#ok_undef ($x->{_m}->{_p}); ok_undef ($x->{_e}->{_p}); # check for no A/P in case of fallback # result @@ -792,7 +804,7 @@ while () $try .= "\$x->$f(\$y);"; - # print "trying $try\n"; + # print "trying $try\n"; $rc = eval $try; # convert hex/binary targets to decimal if ($ans =~ /^(0x0x|0b0b)/) diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t index 17cd712..fae3c8c 100644 --- a/lib/Math/BigInt/t/mbimbf.t +++ b/lib/Math/BigInt/t/mbimbf.t @@ -31,12 +31,12 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 679 + plan tests => 684 + 23; # own tests } -use Math::BigInt 1.63; -use Math::BigFloat 1.38; +use Math::BigInt 1.70; +use Math::BigFloat 1.43; use vars qw/$mbi $mbf/; @@ -95,7 +95,6 @@ foreach my $class (qw/Math::BigInt Math::BigFloat/) $class->accuracy(undef); # reset for further tests $class->precision(undef); } - # bug with flog(Math::BigFloat,Math::BigInt) $x = Math::BigFloat->new(100); $x = $x->blog(Math::BigInt->new(10)); diff --git a/lib/Math/BigInt/t/req_mbfw.t b/lib/Math/BigInt/t/req_mbfw.t index b216c79..025722d 100644 --- a/lib/Math/BigInt/t/req_mbfw.t +++ b/lib/Math/BigInt/t/req_mbfw.t @@ -34,12 +34,13 @@ BEGIN # 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' ); +ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Calc' ); # now override Math::BigFloat->import ( with => 'Math::BigInt::Subclass' ); -ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Subclass' ); +# thw with argument is ignored +ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Calc' ); # all tests done diff --git a/lib/Math/BigInt/t/sub_mbf.t b/lib/Math/BigInt/t/sub_mbf.t index 91fda97..9a8b9a3 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 => 1772 + plan tests => 1814 + 6; # + our own tests } diff --git a/lib/Math/BigInt/t/sub_mbi.t b/lib/Math/BigInt/t/sub_mbi.t index 16968d4..3e831c5 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 => 2770 + plan tests => 2832 + 5; # +5 own tests } diff --git a/lib/Math/BigInt/t/sub_mif.t b/lib/Math/BigInt/t/sub_mif.t index cbaf06a..cd0c863 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 => 679; + plan tests => 684; } use Math::BigInt::Subclass; diff --git a/lib/Math/BigInt/t/upgrade.inc b/lib/Math/BigInt/t/upgrade.inc index 49dbf91..4799420 100644 --- a/lib/Math/BigInt/t/upgrade.inc +++ b/lib/Math/BigInt/t/upgrade.inc @@ -1263,8 +1263,8 @@ abc:12:NaN 0:0:1 0:1:0 0:2:0 -0:-1:NaN -0:-2:NaN +0:-1:inf +0:-2:inf 1:0:1 1:1:1 1:2:1 @@ -1297,6 +1297,14 @@ abc:12:NaN -1:-2:1 -1:-3:-1 -1:-4:1 +-2:2:4 +-2:3:-8 +-2:4:16 +-2:5:-32 +-3:2:9 +-3:3:-27 +-3:4:81 +-3:5:-243 10:2:100 10:3:1000 10:4:10000 diff --git a/lib/Math/BigInt/t/upgrade.t b/lib/Math/BigInt/t/upgrade.t index 3fc4067..a06aec3 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 => 2082 + plan tests => 2098 + 2; # our own tests } diff --git a/lib/Math/BigInt/t/use_mbfw.t b/lib/Math/BigInt/t/use_mbfw.t index d58de04..c6a0471 100644 --- a/lib/Math/BigInt/t/use_mbfw.t +++ b/lib/Math/BigInt/t/use_mbfw.t @@ -29,7 +29,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 3; + plan tests => 2; } @@ -41,12 +41,12 @@ BEGIN use Math::BigFloat with => 'Math::BigInt::Subclass', lib => 'BareCalc'; -ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Subclass' ); +ok (Math::BigFloat->config()->{with}, 'Math::BigInt::BareCalc' ); -ok ($Math::BigInt::Subclass::lib, 'BareCalc' ); +# 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' ); +ok (Math::BigInt->config->{lib}, 'Math::BigInt::BareCalc' ); # all tests done diff --git a/lib/Math/BigInt/t/with_sub.t b/lib/Math/BigInt/t/with_sub.t index a3af404..d7391d9 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 => 1772 + plan tests => 1814 + 1; } @@ -38,6 +38,7 @@ use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); $class = "Math::BigFloat"; $CL = "Math::BigInt::Calc"; -ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Subclass'); +# the with argument is ignored +ok (Math::BigFloat->config()->{with}, 'Math::BigInt::Calc'); require 'bigfltpm.inc'; # all tests here for sharing diff --git a/lib/Math/BigRat.pm b/lib/Math/BigRat.pm index 8a5feef..c344e17 100644 --- a/lib/Math/BigRat.pm +++ b/lib/Math/BigRat.pm @@ -19,16 +19,17 @@ use strict; require Exporter; use Math::BigFloat; -use vars qw($VERSION @ISA $PACKAGE @EXPORT_OK $upgrade $downgrade +use vars qw($VERSION @ISA $PACKAGE $upgrade $downgrade $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf); @ISA = qw(Exporter Math::BigFloat); -@EXPORT_OK = qw(); -$VERSION = '0.11'; +$VERSION = '0.12'; use overload; # inherit from Math::BigFloat +BEGIN { *objectify = \&Math::BigInt::objectify; } + ############################################################################## # global constants, flags and accessory @@ -46,8 +47,10 @@ $_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'; +my $CALC = 'Math::BigInt::Calc'; +my $class = 'Math::BigRat'; +my $IMPORT = 0; sub isa { @@ -55,28 +58,36 @@ sub isa UNIVERSAL::isa(@_); } +sub BEGIN + { + *AUTOLOAD = \&Math::BigFloat::AUTOLOAD; + } + sub _new_from_float { # turn a single float input into a rational number (like '0.1') my ($self,$f) = @_; return $self->bnan() if $f->is_nan(); - return $self->binf('-inf') if $f->{sign} eq '-inf'; - return $self->binf('+inf') if $f->{sign} eq '+inf'; + return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/; - $self->{_n} = $f->{_m}->copy(); # mantissa + local $Math::BigInt::accuracy = undef; + local $Math::BigInt::precision = undef; + $self->{_n} = $MBI->new($CALC->_str ( $f->{_m} ),undef,undef);# mantissa $self->{_d} = $MBI->bone(); - $self->{sign} = $f->{sign} || '+'; $self->{_n}->{sign} = '+'; - if ($f->{_e}->{sign} eq '-') + $self->{sign} = $f->{sign} || '+'; + if ($f->{_es} eq '-') { # something like Math::BigRat->new('0.1'); - $self->{_d}->blsft($f->{_e}->copy()->babs(),10); # 1 / 1 => 1/10 + # 1 / 1 => 1/10 + $self->{_d}->blsft( $MBI->new($CALC->_str ( $f->{_e} )),10); } else { # something like Math::BigRat->new('10'); # 1 / 1 => 10/1 - $self->{_n}->blsft($f->{_e},10) unless $f->{_e}->is_zero(); + $self->{_n}->blsft( $MBI->new($CALC->_str($f->{_e})),10) unless + $CALC->_is_zero($f->{_e}); } $self; } @@ -138,17 +149,19 @@ sub new local $Math::BigFloat::precision = undef; local $Math::BigInt::accuracy = undef; local $Math::BigInt::precision = undef; - my $nf = Math::BigFloat->new($n); + + my $nf = Math::BigFloat->new($n,undef,undef); $self->{sign} = '+'; return $self->bnan() if $nf->is_nan(); - $self->{_n} = $nf->{_m}; + $self->{_n} = $MBI->new( $CALC->_str( $nf->{_m} ) ); + # now correct $self->{_n} due to $n my $f = Math::BigFloat->new($d,undef,undef); - $self->{_d} = $f->{_m}; return $self->bnan() if $f->is_nan(); - #print "n=$nf e$nf->{_e} d=$f e$f->{_e}\n"; + $self->{_d} = $MBI->new( $CALC->_str( $f->{_m} ) ); + # calculate the difference between nE and dE - my $diff_e = $nf->{_e}->copy()->bsub ( $f->{_e} ); + my $diff_e = $MBI->new ($nf->exponent())->bsub ( $f->exponent); if ($diff_e->is_negative()) { # < 0: mul d with it @@ -217,6 +230,31 @@ sub new $self->bnorm(); } +sub copy + { + my ($c,$x); + if (@_ > 1) + { + # if two arguments, the first one is the class to "swallow" subclasses + ($c,$x) = @_; + } + else + { + $x = shift; + $c = ref($x); + } + return unless ref($x); # only for objects + + my $self = {}; bless $self,$c; + + $self->{sign} = $x->{sign}; + $self->{_d} = $x->{_d}->copy(); + $self->{_n} = $x->{_n}->copy(); + $self->{_a} = $x->{_a} if defined $x->{_a}; + $self->{_p} = $x->{_p} if defined $x->{_p}; + $self; + } + ############################################################################## sub config @@ -446,9 +484,8 @@ 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); + $x = $self->new($x) unless $x->isa($self); + $y = $self->new($y) unless $y->isa($self); return $x->bnan() if ($x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'); @@ -498,9 +535,8 @@ 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); + $x = $self->new($x) unless $x->isa($self); + $y = $self->new($y) unless $y->isa($self); return $self->_div_inf($x,$y) if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); @@ -514,8 +550,8 @@ sub bdiv # - / - == - * - # 4 3 4 1 -# local $Math::BigInt::accuracy = undef; -# local $Math::BigInt::precision = undef; + local $Math::BigInt::accuracy = undef; + local $Math::BigInt::precision = undef; $x->{_n}->bmul($y->{_d}); $x->{_d}->bmul($y->{_n}); @@ -538,9 +574,8 @@ sub bmod ($self,$x,$y,@r) = objectify(2,@_); } - # TODO: $self instead or $class?? - $x = $class->new($x) unless $x->isa($class); - $y = $class->new($y) unless $y->isa($class); + $x = $self->new($x) unless $x->isa($self); + $y = $self->new($y) unless $y->isa($self); return $self->_div_inf($x,$y) if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); @@ -592,6 +627,8 @@ sub bdec return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf + local $Math::BigInt::accuracy = undef; + local $Math::BigInt::precision = undef; if ($x->{sign} eq '-') { $x->{_n}->badd($x->{_d}); # -5/2 => -7/2 @@ -619,6 +656,8 @@ sub binc return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf + local $Math::BigInt::accuracy = undef; + local $Math::BigInt::precision = undef; if ($x->{sign} eq '-') { if ($x->{_n}->bacmp($x->{_d}) < 0) @@ -645,7 +684,7 @@ sub binc sub is_int { # return true if arg (BRAT or num_str) is an integer - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't $x->{_d}->is_one(); # x/y && y != 1 => no integer @@ -655,7 +694,7 @@ sub is_int sub is_zero { # return true if arg (BRAT or num_str) is zero - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if $x->{sign} eq '+' && $x->{_n}->is_zero(); 0; @@ -664,9 +703,9 @@ sub is_zero sub is_one { # return true if arg (BRAT or num_str) is +1 or -1 if signis given - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - my $sign = shift || ''; $sign = '+' if $sign ne '-'; + my $sign = $_[2] || ''; $sign = '+' if $sign ne '-'; return 1 if ($x->{sign} eq $sign && $x->{_n}->is_one() && $x->{_d}->is_one()); 0; @@ -675,7 +714,7 @@ sub is_one sub is_odd { # return true if arg (BFLOAT or num_str) is odd or false if even - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if ($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't ($x->{_d}->is_one() && $x->{_n}->is_odd()); # x/2 is not, but 3/1 @@ -685,7 +724,7 @@ sub is_odd sub is_even { # return true if arg (BINT or num_str) is even or false if odd - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't return 1 if ($x->{_d}->is_one() # x/3 is never @@ -693,11 +732,6 @@ sub is_even 0; } -BEGIN - { - *objectify = \&Math::BigInt::objectify; - } - ############################################################################## # parts() and friends @@ -734,12 +768,18 @@ sub parts sub length { - return 0; + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return $nan unless $x->is_int(); + $x->{_n}->length(); # length(-123/1) => length(123) } sub digit { - return 0; + my ($self,$x,$n) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return $nan unless $x->is_int(); + $x->{_n}->digit($n); # digit(-123/1,2) => digit(123,2) } ############################################################################## @@ -879,9 +919,12 @@ sub blog # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($self,$x,$y,@r) = objectify(2,@_); + ($self,$x,$y,@r) = objectify(2,$class,@_); } + # blog(1,Y) => 0 + return $x->bzero() if $x->is_one() && $y->{sign} eq '+'; + # $x <= 0 => NaN return $x->bnan() if $x->is_zero() || $x->{sign} ne '+' || $y->{sign} ne '+'; @@ -890,8 +933,19 @@ sub blog return $self->new($x->as_number()->blog($y->as_number(),@r)); } - warn ("blog() not fully implemented"); - $x->bnan(); + # do it with floats + $x->_new_from_float( $x->_as_float()->blog(Math::BigFloat->new("$y"),@r) ); + } + +sub _as_float + { + my $x = shift; + + local $Math::BigFloat::upgrade = undef; + local $Math::BigFloat::accuracy = undef; + local $Math::BigFloat::precision = undef; + # 22/7 => 3.142857143.. + Math::BigFloat->new($x->{_n})->bdiv($x->{_d}, $x->accuracy()); } sub broot @@ -908,9 +962,9 @@ sub broot { return $self->new($x->as_number()->broot($y->as_number(),@r)); } - - warn ("broot() not fully implemented"); - $x->bnan(); + + # do it with floats + $x->_new_from_float( $x->_as_float()->broot($y,@r) ); } sub bmodpow @@ -975,41 +1029,46 @@ sub bsqrt local $Math::BigInt::upgrade = undef; local $Math::BigInt::precision = undef; local $Math::BigInt::accuracy = undef; + $x->{_d} = Math::BigFloat->new($x->{_d})->bsqrt(); $x->{_n} = Math::BigFloat->new($x->{_n})->bsqrt(); # if sqrt(D) was not integer - if ($x->{_d}->{_e}->{sign} ne '+') + if ($x->{_d}->{_es} 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 + $x->{_n}->blsft($x->{_d}->exponent()->babs(),10); # 7.1/4.51 => 7.1/45.1 + $x->{_d} = $MBI->new($CALC->_str($x->{_d}->{_m})); # 7.1/45.1 => 71/45.1 } # if sqrt(N) was not integer - if ($x->{_n}->{_e}->{sign} ne '+') + if ($x->{_n}->{_es} ne '+') { - $x->{_d}->blsft($x->{_n}->{_e}->babs(),10); # 71/45.1 => 710/45.1 - $x->{_n} = $x->{_n}->{_m}; # 710/45.1 => 710/451 + $x->{_d}->blsft($x->{_n}->exponent()->babs(),10); # 71/45.1 => 710/45.1 + $x->{_n} = $MBI->new($CALC->_str($x->{_n}->{_m})); # 710/45.1 => 710/451 } # convert parts to $MBI again - $x->{_n} = $x->{_n}->as_number(); - $x->{_d} = $x->{_d}->as_number(); + $x->{_n} = $x->{_n}->as_number() unless $x->{_n}->isa($MBI); + $x->{_d} = $x->{_d}->as_number() unless $x->{_d}->isa($MBI); $x->bnorm()->round(@r); } sub blsft { - my ($self,$x,$y,$b,$a,$p,$r) = objectify(3,@_); + my ($self,$x,$y,$b,@r) = objectify(3,@_); - $x->bmul( $b->copy()->bpow($y), $a,$p,$r); + $b = 2 unless defined $b; + $b = $self->new($b) unless ref ($b); + $x->bmul( $b->copy()->bpow($y), @r); $x; } sub brsft { - my ($self,$x,$y,$b,$a,$p,$r) = objectify(2,@_); + my ($self,$x,$y,$b,@r) = objectify(2,@_); - $x->bdiv( $b->copy()->bpow($y), $a,$p,$r); + $b = 2 unless defined $b; + $b = $self->new($b) unless ref ($b); + $x->bdiv( $b->copy()->bpow($y), @r); $x; } @@ -1075,13 +1134,13 @@ sub bcmp sub bacmp { # compare two numbers (as unsigned) - + # set up parameters my ($self,$x,$y) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { - ($self,$x,$y) = objectify(2,@_); + ($self,$x,$y) = objectify(2,$class,@_); } if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) @@ -1118,7 +1177,7 @@ sub numify sub as_number { - my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $x if $x->{sign} !~ /^[+-]$/; # NaN, inf etc @@ -1131,11 +1190,33 @@ sub as_number $t; } +sub as_bin + { + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return $x unless $x->is_int(); + + my $s = $x->{sign}; $s = '' if $s eq '+'; + $s . $x->{_n}->as_bin(); + } + +sub as_hex + { + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return $x unless $x->is_int(); + + my $s = $x->{sign}; $s = '' if $s eq '+'; + $s . $x->{_n}->as_hex(); + } + sub import { my $self = shift; my $l = scalar @_; my $lib = ''; my @a; + $IMPORT++; + for ( my $i = 0; $i < $l ; $i++) { # print "at $_[$i] (",$_[$i+1]||'undef',")\n"; @@ -1172,7 +1253,7 @@ sub import push @a, $_[$i]; } } - # let use Math::BigInt lib => 'GMP'; use Math::BigFloat; still work + # let use Math::BigInt lib => 'GMP'; use Math::BigRat; still work my $mbilib = eval { Math::BigInt->config()->{lib} }; if ((defined $mbilib) && ($MBI eq 'Math::BigInt')) { @@ -1204,6 +1285,8 @@ sub import require Carp; Carp::croak ("Couldn't load $MBI: $! $@"); } + $CALC = Math::BigFloat->config()->{lib}; + # any non :constant stuff is handled by our parent, Exporter # even if @_ is empty, to give it a chance $self->SUPER::import(@a); # for subclasses diff --git a/lib/Math/BigRat/t/bigfltpm.inc b/lib/Math/BigRat/t/bigfltpm.inc index 36bb35d..a0a7453 100644 --- a/lib/Math/BigRat/t/bigfltpm.inc +++ b/lib/Math/BigRat/t/bigfltpm.inc @@ -2,6 +2,8 @@ ok ($class->config()->{lib},$CL); +use strict; + while () { chomp; @@ -28,19 +30,19 @@ while () { @args = split(/:/,$_,99); $ans = pop(@args); } - $try = "\$x = new $class \"$args[0]\";"; + $try = "\$x = $class->new('$args[0]');"; if ($f eq "fnorm") { $try .= "\$x;"; } elsif ($f eq "finf") { - $try .= "\$x->binf('$args[1]');"; + $try .= "\$x->finf('$args[1]');"; } elsif ($f eq "is_inf") { $try .= "\$x->is_inf('$args[1]');"; } elsif ($f eq "fone") { $try .= "\$x->bone('$args[1]');"; } elsif ($f eq "fstr") { $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; - $try .= '$x->bstr();'; + $try .= '$x->fstr();'; } elsif ($f eq "parts") { # ->bstr() to see if an object is returned $try .= '($a,$b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; @@ -51,42 +53,48 @@ while () } elsif ($f eq "mantissa") { # ->bstr() to see if an object is returned $try .= '$x->mantissa()->bstr();'; - } elsif ($f eq "numify") { - $try .= "\$x->numify();"; - } elsif ($f eq "length") { - $try .= "\$x->length();"; + } elsif ($f =~ /^(numify|length|as_number|as_hex|as_bin)$/) { + $try .= "\$x->$f();"; # some unary ops (test the fxxx form, since that is done by AUTOLOAD) } elsif ($f =~ /^f(nan|sstr|neg|floor|ceil|abs)$/) { - $try .= "\$x->b$1();"; + $try .= "\$x->f$1();"; # some is_xxx test function } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) { $try .= "\$x->$f();"; - } elsif ($f eq "as_number") { - $try .= '$x->as_number();'; } elsif ($f eq "finc") { $try .= '++$x;'; } elsif ($f eq "fdec") { $try .= '--$x;'; }elsif ($f eq "fround") { - $try .= "$setup; \$x->bround($args[1]);"; + $try .= "$setup; \$x->fround($args[1]);"; } elsif ($f eq "ffround") { - $try .= "$setup; \$x->bfround($args[1]);"; + $try .= "$setup; \$x->ffround($args[1]);"; } elsif ($f eq "fsqrt") { - $try .= "$setup; \$x->bsqrt();"; - } elsif ($f eq "flog") { - $try .= "$setup; \$x->blog();"; + $try .= "$setup; \$x->fsqrt();"; } elsif ($f eq "ffac") { - $try .= "$setup; \$x->bfac();"; + $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->bacmp($y);'; + $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") { @@ -96,7 +104,7 @@ while () } elsif ($f eq "fdiv") { $try .= "$setup; \$x / \$y;"; } elsif ($f eq "fdiv-list") { - $try .= "$setup; join(',',\$x->bdiv(\$y));"; + $try .= "$setup; join(',',\$x->fdiv(\$y));"; } elsif ($f eq "frsft") { $try .= '$x >> $y;'; } elsif ($f eq "flsft") { @@ -105,7 +113,7 @@ while () $try .= '$x % $y;'; } else { warn "Unknown op '$f'"; } } - # print "# Trying: '$try'\n"; + print "# Trying: '$try'\n"; $ans1 = eval $try; if ($ans =~ m|^/(.*)$|) { @@ -128,14 +136,14 @@ while () else { print "# Tried: '$try'\n" if !ok ($ans1, $ans); -# if (ref($ans1) eq "$class") -# { -# # float numbers are normalized (for now), so mantissa shouldn't have -# # trailing zeros -# #print $ans1->_trailing_zeros(),"\n"; -# print "# Has trailing zeros after '$try'\n" -# if !ok ($ans1->{_m}->_trailing_zeros(), 0); -# } + if (ref($ans1) eq "$class") + { + # float numbers are normalized (for now), so mantissa shouldn't have + # trailing zeros + #print $ans1->_trailing_zeros(),"\n"; + print "# Has trailing zeros after '$try'\n" + if ref($ans) eq 'HASH' && exists $ans->{_m} && !ok ($ans1->{_m}->_trailing_zeros(), 0); + } } } # end pattern or string } @@ -147,18 +155,62 @@ $x = Math::BigInt->new(1200); $y = $class->new($x); ok ($y,1200); ok ($x,1200); ############################################################################### +# Really huge, big, ultra-mega-biggy-monster exponents +# Technically, the exponents should not be limited (they are BigInts), but +# practically there are a few places were they are limited to a Perl scalar. +# This is sometimes for speed, sometimes because otherwise the number wouldn't +# fit into your memory (just think of 1e123456789012345678901234567890 + 1!) +# anyway. We don't test everything here, but let's make sure it just basically +# works. + +# +#my $monster = '1e1234567890123456789012345678901234567890'; +# +## new +#ok ($class->new($monster)->bsstr(), +# '1e+1234567890123456789012345678901234567890'); +## cmp +#ok ($class->new($monster) > 0,1); +# +## sub/mul +#ok ($class->new($monster)->bsub( $monster),0); +#ok ($class->new($monster)->bmul(2)->bsstr(), +# '2e+1234567890123456789012345678901234567890'); + +############################################################################### # zero,inf,one,nan $x = $class->new(2); $x->fzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); $x = $class->new(2); $x->finf(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); $x = $class->new(2); $x->fone(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); $x = $class->new(2); $x->fnan(); ok_undef ($x->{_a}); ok_undef ($x->{_p}); + +############################################################################### +# bone/binf etc as plain calls (Lite failed them) + +ok ($class->fzero(),0); +ok ($class->fone(),1); +ok ($class->fone('+'),1); +ok ($class->fone('-'),-1); +ok ($class->fnan(),'NaN'); +ok ($class->finf(),'inf'); +ok ($class->finf('+'),'inf'); +ok ($class->finf('-'),'-inf'); +ok ($class->finf('-inf'),'-inf'); +$class->accuracy(undef); $class->precision(undef); # reset + +############################################################################### +# bug in bsstr()/numify() showed up in after-rounding in bdiv() + +$x = $class->new('0.008'); $y = $class->new(2); +$x->bdiv(3,$y); +ok ($x,'0.0027'); + ############################################################################### # fsqrt() with set global A/P or A/P enabled on $x, also a test whether fsqrt() # correctly modifies $x -$class->accuracy(undef); $class->precision(undef); # reset $x = $class->new(12); $class->precision(-2); $x->fsqrt(); ok ($x,'3.46'); @@ -167,12 +219,32 @@ $x = $class->new(12); $class->precision(0); $x->fsqrt(); ok ($x,'3'); $class->precision(-3); $x = $class->new(12); $x->fsqrt(); ok ($x,'3.464'); -# A and P set => NaN -${${class}.'::accuracy'} = 4; $x = $class->new(12); $x->fsqrt(3); ok ($x,'NaN'); -# supplied arg overrides set global -$class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46'); +{ + no strict 'refs'; + # A and P set => NaN + ${${class}.'::accuracy'} = 4; $x = $class->new(12); + $x->fsqrt(3); ok ($x,'NaN'); + # supplied arg overrides set global + $class->precision(undef); $x = $class->new(12); $x->fsqrt(3); ok ($x,'3.46'); + $class->accuracy(undef); $class->precision(undef); # reset for further tests +} + +############################################################################# +# can we call objectify (broken until v1.52) + +{ + no strict; + $try = + '@args' . " = $class" . "::objectify(2,$class,4,5);".'join(" ",@args);'; + $ans = eval $try; + ok ($ans,"$class 4 5"); +} -$class->accuracy(undef); $class->precision(undef); # reset for further tests +############################################################################# +# is_one('-') (broken until v1.64) + +ok ($class->new(-1)->is_one(),0); +ok ($class->new(-1)->is_one('-'),1); 1; # all done @@ -190,27 +262,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 -1:0 -# too slow, too (or hangs?) +# too slow, too #123:4.8112184355 -# $div_scale = 14; +$div_scale = 14; #10:0:2.302585092994 #1000:0:6.90775527898214 #100:0:4.60517018598809 -#2:0:0.693147180559945 +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 &frsft NaNfrsft:2:NaN 0:2:0 @@ -250,17 +331,61 @@ fnormNaN:NaN -2:-2 -123.456:-123 -200:-200 +# test for bug in brsft() not handling cases that return 0 +0.000641:0 +0.0006412:0 +0.00064123:0 +0.000641234:0 +0.0006412345:0 +0.00064123456:0 +0.000641234567:0 +0.0006412345678:0 +0.00064123456789:0 +0.1:0 +0.01:0 +0.001:0 +0.0001:0 +0.00001:0 +0.000001:0 +0.0000001:0 +0.00000001:0 +0.000000001:0 +0.0000000001:0 +0.00000000001:0 +0.12345:0 +0.123456:0 +0.1234567:0 +0.12345678:0 +0.123456789:0 &finf 1:+:inf 2:-:-inf 3:abc:inf +&as_hex ++inf:inf +-inf:-inf +hexNaN:NaN +0:0x0 +5:0x5 +-5:-0x5 +&as_bin ++inf:inf +-inf:-inf +hexNaN:NaN +0:0b0 +5:0b101 +-5:-0b101 &numify +# uses bsstr() so 5 => 5e+0 to be compatible w/ Perls output 0:0e+1 +1:1e+0 1234:1234e+0 NaN:NaN +inf:inf -inf:-inf +-5:-5e+0 +100:1e+2 +-100:-1e+2 &fnan abc:NaN 2:NaN @@ -279,7 +404,11 @@ abc::1 +inf:inf -inf:-inf abcfsstr:NaN +-abcfsstr:NaN 1234.567:1234567e-3 +123:123e+0 +-5:-5e+0 +-100:-1e+2 &fstr +inf:::inf -inf:::-inf @@ -303,6 +432,10 @@ abc:NaN 11111b:NaN +1z:NaN -1z:NaN +0e999:0 +0e-999:0 +-0e999:0 +-0e-999:0 0:0 +0:0 +00:0 @@ -359,6 +492,14 @@ abc:123.456:NaN -inf:123.45:-inf +inf:-123.45:inf -inf:-123.45:-inf +# 2 ** 0.5 == sqrt(2) +# 1.41..7 and not 1.4170 since fallback (bsqrt(9) is '3', not 3.0...0) +2:0.5:1.41421356237309504880168872420969807857 +#2:0.2:1.148698354997035006798626946777927589444 +#6:1.5:14.6969384566990685891837044482353483518 +$div_scale = 20; +#62.5:12.5:26447206647554886213592.3959144 +$div_scale = 40; &fneg fnegNaN:NaN +inf:-inf @@ -752,8 +893,8 @@ fincNaN:NaN abc:abc:NaN abc:+0:NaN +0:abc:NaN -+inf:-inf:0 --inf:+inf:0 ++inf:-inf:NaN +-inf:+inf:NaN +inf:+inf:inf -inf:-inf:-inf baddNaN:+inf:NaN @@ -801,8 +942,8 @@ abc:+0:NaN +0:abc:NaN +inf:-inf:inf -inf:+inf:-inf -+inf:+inf:0 --inf:-inf:0 ++inf:+inf:NaN +-inf:-inf:NaN baddNaN:+inf:NaN baddNaN:+inf:NaN +inf:baddNaN:NaN @@ -1054,13 +1195,15 @@ abc:1:abc:NaN 152403346:12345:4321 87654321:87654321:0 # now some floating point tests -#123:2.5:0.5 -#1230:2.5:0 -#123.4:2.5:0.9 -#123e1:25:5 +123:2.5:0.5 +1230:2.5:0 +123.4:2.5:0.9 +123e1:25:5 &ffac Nanfac:NaN -1:NaN ++inf:inf +-inf:NaN 0:1 1:1 2:2 @@ -1071,6 +1214,56 @@ 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 +# see t/bigroot() for more tests &fsqrt +0:0 -1:NaN @@ -1095,6 +1288,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 @@ -1233,6 +1428,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/BigRat/t/bigfltrt.t b/lib/Math/BigRat/t/bigfltrt.t index d408b23..3ad98db 100755 --- a/lib/Math/BigRat/t/bigfltrt.t +++ b/lib/Math/BigRat/t/bigfltrt.t @@ -26,13 +26,10 @@ BEGIN } print "# INC = @INC\n"; -# plan tests => 1585; plan tests => 1; } -#use Math::BigInt; -#use Math::BigRat; -use Math::BigRat::Test; # test via this +use Math::BigRat::Test; # test via this Subclass use vars qw ($class $try $x $y $f @args $ans $ans1 $ans1_str $setup $CL); $class = "Math::BigRat::Test"; @@ -40,5 +37,5 @@ $CL = "Math::BigInt::Calc"; ok (1,1); -# does not fully work yet -#require 'bigfltpm.inc'; # all tests here for sharing +# fails stil 185 tests +#require 'bigfltpm.inc'; # all tests here for sharing diff --git a/lib/Math/BigRat/t/bigrat.t b/lib/Math/BigRat/t/bigrat.t index dd39275..af0aa49 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 => 170; + plan tests => 174; } # testing of Math::BigRat @@ -67,7 +67,7 @@ foreach my $func (qw/new bnorm/) $x = $cr->$func($mbf->new(1232)); ok ($x,'1232'); $x = $cr->$func($mbf->new(1232.3)); ok ($x,'12323/10'); } - + $x = $cr->new('-0'); ok ($x,'0'); ok ($x->{_n}, '0'); ok ($x->{_d},'1'); $x = $cr->new('NaN'); ok ($x,'NaN'); ok ($x->{_n}, '0'); ok ($x->{_d},'0'); $x = $cr->new('-NaN'); ok ($x,'NaN'); ok ($x->{_n}, '0'); ok ($x->{_d},'0'); @@ -115,6 +115,7 @@ ok ($cr->new('3/10')->bdiv($mbf->new('1.1')),'3/11'); ############################################################################## $x = $cr->new('1/4'); $y = $cr->new('1/3'); + ok ($x + $y, '7/12'); ok ($x * $y, '1/12'); ok ($x / $y, '3/4'); @@ -246,6 +247,7 @@ $z = $cr->new(3); ok ($x->copy()->broot($y), 2 ** 8); ok (ref($x->copy()->broot($y)), $cr); + ok ($x->copy()->bmodpow($y,$z), 1); ok (ref($x->copy()->bmodpow($y,$z)), $cr); @@ -256,6 +258,17 @@ $z = $cr->new(4404); ok ($x->copy()->bmodinv($y), $z); ok (ref($x->copy()->bmodinv($y)), $cr); +# square root with exact result +$x = $cr->new('1.44'); +ok ($x->copy()->broot(2), '12/10'); +ok (ref($x->copy()->broot(2)), $cr); + +# log with exact result +$x = $cr->new('256.1'); +ok ($x->copy()->blog(2), '8000563442710106079310294693803606983661/1000000000000000000000000000000000000000'); +ok (ref($x->copy()->blog(2)), $cr); + + ############################################################################## # done diff --git a/lib/bigint.pm b/lib/bigint.pm index 9920dad..6738a03 100644 --- a/lib/bigint.pm +++ b/lib/bigint.pm @@ -73,7 +73,7 @@ sub _constant $float =~ s/\..*//; return $float; } - my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split(\$float); + my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($float); return $float if !defined $mis; # doesn't look like a number to me my $ec = int($$ev); my $sign = $$mis; $sign = '' if $sign eq '+'; diff --git a/t/lib/Math/BigInt/BareCalc.pm b/t/lib/Math/BigInt/BareCalc.pm index cfd4ae8..3efa525 100644 --- a/t/lib/Math/BigInt/BareCalc.pm +++ b/t/lib/Math/BigInt/BareCalc.pm @@ -8,22 +8,29 @@ require Exporter; use vars qw/@ISA $VERSION/; @ISA = qw(Exporter); -$VERSION = '0.03'; +$VERSION = '0.02'; + +sub api_version () { 1; } # Package to to test Bigint's simulation of Calc # uses Calc, but only features the strictly necc. methods. -use Math::BigInt::Calc '0.33'; +use Math::BigInt::Calc '0.40'; BEGIN { no strict 'refs'; - foreach (qw/ base_len new zero one two copy str num add sub mul div inc dec - acmp len digit zeros - is_zero is_one is_odd is_even is_one check - to_small to_large - /) + foreach (qw/ + base_len new zero one two ten copy str num add sub mul div mod inc dec + acmp len digit zeros + rsft lsft + fac pow gcd log_int sqrt root + is_zero is_one is_odd is_even is_one is_two is_ten check + as_hex as_bin from_hex from_bin + modpow modinv + and xor or + /) { my $name = "Math::BigInt::Calc::_$_"; *{"Math::BigInt::BareCalc::_$_"} = \&$name; diff --git a/t/lib/Math/BigInt/Scalar.pm b/t/lib/Math/BigInt/Scalar.pm index 44bab5d..94fb9b8 100644 --- a/t/lib/Math/BigInt/Scalar.pm +++ b/t/lib/Math/BigInt/Scalar.pm @@ -13,7 +13,9 @@ require Exporter; use vars qw/@ISA $VERSION/; @ISA = qw(Exporter); -$VERSION = '0.11'; +$VERSION = '0.12'; + +sub api_version() { 1; } ############################################################################## # global constants, flags and accessory @@ -26,27 +28,47 @@ my $nan = 'NaN'; sub _new { - # (string) return ref to num + # create scalar ref from string my $d = $_[1]; - my $x = $$d; # make copy - return \$x; + my $x = $d; # make copy + \$x; } +sub _from_hex + { + # not used + } + +sub _from_bin + { + # not used + } + sub _zero { - my $x = 0; return \$x; + my $x = 0; \$x; } sub _one { - my $x = 1; return \$x; + my $x = 1; \$x; + } + +sub _two + { + my $x = 2; \$x; + } + +sub _ten + { + my $x = 10; \$x; } sub _copy { my $x = $_[1]; my $z = $$x; - return \$z; + \$z; } # catch and throw away @@ -58,15 +80,82 @@ sub import { } sub _str { # make string - return \"${$_[1]}"; + "${$_[1]}"; } sub _num { # make a number - return ${$_[1]}; + 0+${$_[1]}; + } + +sub _zeros + { + my $x = $_[1]; + + $x =~ /\d(0*)$/; + length($1 || ''); + } + +sub _rsft + { + # not used + } + +sub _lsft + { + # not used + } + +sub _mod + { + # not used + } + +sub _gcd + { + # not used + } + +sub _sqrt + { + # not used + } + +sub _root + { + # not used + } + +sub _fac + { + # not used + } + +sub _modinv + { + # not used + } + +sub _modpow + { + # not used } +sub _log_int + { + # not used + } + +sub _as_hex + { + sprintf("0x%x",${$_[1]}); + } + +sub _as_bin + { + sprintf("0b%b",${$_[1]}); + } ############################################################################## # actual math code @@ -174,28 +263,42 @@ sub _is_zero { # return true if arg is zero my ($c,$x) = @_; - return ($$x == 0) <=> 0; + ($$x == 0) <=> 0; } sub _is_even { # return true if arg is even my ($c,$x) = @_; - return (!($$x & 1)) <=> 0; + (!($$x & 1)) <=> 0; } sub _is_odd { # return true if arg is odd my ($c,$x) = @_; - return ($$x & 1) <=> 0; + ($$x & 1) <=> 0; } sub _is_one { # return true if arg is one my ($c,$x) = @_; - return ($$x == 1) <=> 0; + ($$x == 1) <=> 0; + } + +sub _is_two + { + # return true if arg is one + my ($c,$x) = @_; + ($$x == 2) <=> 0; + } + +sub _is_ten + { + # return true if arg is one + my ($c,$x) = @_; + ($$x == 10) <=> 0; } ############################################################################### diff --git a/t/lib/Math/BigRat/Test.pm b/t/lib/Math/BigRat/Test.pm index 80be068..630a843 100644 --- a/t/lib/Math/BigRat/Test.pm +++ b/t/lib/Math/BigRat/Test.pm @@ -1,5 +1,3 @@ -#!/usr/bin/perl -w - package Math::BigRat::Test; require 5.005_02; @@ -8,11 +6,11 @@ use strict; use Exporter; use Math::BigRat; use Math::BigFloat; -use vars qw($VERSION @ISA $PACKAGE +use vars qw($VERSION @ISA $accuracy $precision $round_mode $div_scale); -@ISA = qw(Exporter Math::BigRat); -$VERSION = 0.03; +@ISA = qw(Math::BigRat Exporter); +$VERSION = 0.04; use overload; # inherit overload from BigRat @@ -38,6 +36,42 @@ my $class = 'Math::BigRat::Test'; # return $self; #} +BEGIN + { + *fstr = \&bstr; + *fsstr = \&bsstr; + *objectify = \&Math::BigInt::objectify; + *AUTOLOAD = \&Math::BigRat::AUTOLOAD; + no strict 'refs'; + foreach my $method ( qw/ div acmp floor ceil root sqrt log fac modpow modinv/) + { + *{'b' . $method} = \&{'Math::BigRat::b' . $method}; + } + } + +sub fround + { + my ($x,$a) = @_; + + #print "$a $accuracy $precision $round_mode\n"; + Math::BigFloat->round_mode($round_mode); + Math::BigFloat->accuracy($a || $accuracy); + Math::BigFloat->precision(undef); + my $y = Math::BigFloat->new($x->bsstr(),undef,undef); + $class->new($y->fround($a)); + } + +sub ffround + { + my ($x,$p) = @_; + + Math::BigFloat->round_mode($round_mode); + Math::BigFloat->accuracy(undef); + Math::BigFloat->precision($p || $precision); + my $y = Math::BigFloat->new($x->bsstr(),undef,undef); + $class->new($y->ffround($p)); + } + sub bstr { # calculate a BigFloat compatible string output @@ -53,9 +87,17 @@ sub bstr my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 +# print " bstr \$x ", $accuracy || $x->{_a} || 'notset', " ", $precision || $x->{_p} || 'notset', "\n"; return $s.$x->{_n} if $x->{_d}->is_one(); my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); - return $s.$output->bstr(); + local $Math::BigFloat::accuracy = $accuracy || $x->{_a}; + local $Math::BigFloat::precision = $precision || $x->{_p}; + $s.$output->bstr(); + } + +sub numify + { + $_[0]->bsstr(); } sub bsstr @@ -73,7 +115,6 @@ sub bsstr my $s = ''; $s = $x->{sign} if $x->{sign} ne '+'; # +3 vs 3 - return $s.$x->{_n}->bsstr() if $x->{_d}->is_one(); my $output = Math::BigFloat->new($x->{_n})->bdiv($x->{_d}); return $s.$output->bsstr(); }