Math-BigInt-1.999715/0000755403072340010010000000000012642757326014251 5ustar ospjaDomain UsersMath-BigInt-1.999715/BENCHMARK0000644403072340010010000000021612626121055015447 0ustar ospjaDomain Users Please see for detailed and up-todate benchmarks, as well as a program to generate them. Math-BigInt-1.999715/BUGS0000644403072340010010000000355512626121055014726 0ustar ospjaDomain UsersFor an updated list of bugs, see https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt The following list is not up to date: Known bugs: * TODO BUGS: + implement test for the upgrading bug in bsub() * NaN handling in comparisons slightly broken. See also [perl #33106]. * General: + BigInt can not the IEEE '-0'. Currently there are no plans to add this. If you need it, please bug the author(s) about it. * BigFloat: + comparing (<=> or == or !=) a BigFloat to a BigInt don't work yet + new is first running the entire number trough _split, then again the parts to construct BigInts. Could be a bit more optimized. + fdiv() using F (fallback) mode does not work properly in all cases of local (aka $x's or $y's) A or P settings. Not definite test case yet, but it might calculate not enough digits to satisfy the rounding needs. * BigInt: + exponent on input is limited to a Perl int (bigger numbers won't fit into your memory, anyway - use BigFloat) + doesn't have a mode akin to 'use integer;', e.g. it always emulates Perl (this is solved partially by use bigint ;) + Handling of undef arguments is somewhat broken (no proper warnings) + eval('use...') and use Math::BigInt qw/:constant/ fail on Perl prior 5.6.0 This is likely an Exporter bug, and causes Math::BigInt to eval require on earlier Perls when loading the core math lib. Thus the loading can fail under older Perls on filesystems that can not cope with the 'Math/BigInt/Calc.pm'-style filenames. ############################################################################### Mixing of classes does not always work like expected. "use bignum;", "use bigint;" and "use bigrat;" should solve this problem for most cases. Please send me test-reports, your experiences with this and your ideas - I love to hear about my work! Tels Math-BigInt-1.999715/CHANGES0000644403072340010010000017720212642756626015257 0ustar ospjaDomain UsersComplete version history of the rewrite project =============================================== If you just want to see which things are new and different from the original Math::* in the Perl core, see HISTORY. The file NEW lists only the changes for the latest version. ############################################################################## Math::BigInt::Calc: 2001-07-09 v0.06 Tels * first release 2001-07-15 v0.07 Tels * applied Philip Newtons spelling and doc patch(s) * accidentally had the old, slow mul() code in. Oups. * fixed also a bug in that new code * also the speedup in mul() occurs with $x having lots of zeros, not $y. * first argument is always classname, so removed checks and shift * shift in base ten by _lsft() and _rsft() 2001-07-15 v0.08 Tels * fixed bug in mul() shortcut 2001-07-20 v0.09 Tels * don't use warnings for older Perls 2001-08-24 v0.10 Tels * no longer export anything, ignore import calls 2001-09-07 v0.11 Tels * automatically USE_MUL or USE_DIV 2001-10-03 v0.12 Tels * _div: 99999 => $BASE-1 ($MAX_VAL), that made some div's fail if $BASE != 5 2001-10-23 v0.13 Tels * better detection of BASELEN by matching against expected pattern 2001-11-04 v0.14 Tels * added _mod() for faster $x % $y 2001-11-11 v0.15 Tels * added _dec() and _inc() for much faster $x++ and $x-- 2001-11-19 v0.16 Tels * fixed comments a bit * finished _mod() when $y < $BASE and $BASE % $y != 0 and $BASE % $y != 1 * streamlined _mod() loops a bit * added _pow() for faster bpow() * small fix to make 5.005_03 happy ($x = shift @prod vs $x = shift @prod || 0) 2001-12-06 v0.17 Tels * added _sqrt() for more speed * _sqrt() shortcut for small (< $BASE) numbers for better performance * shortcut in _mul for small numbers (< $BASE_LEN2) * added _and, _or, and _xor and let them use more than 16 bits * find out how many bits _and, _or and _xor can safely use (cap at 23) * div() might leave empty array, so __strip_zeros fixes these * streamlined _acmp() * cap of 5 for BASE for UTS and UNICOS/Cray * better test to find out what BASE should be (use +0.0 to force floats) 2001-12-20 v0.18 Tels * added _as_hex() and _as_bin() with 16 bit chunks * from_bin() now uses oct() and 16 bits per iteration * removed needless return statements 2001-12-23 v0.19 Tels * first working version of using two different bases: one for mul/div, the other for all other ops, including converting via _to_large()/_to_small() 2002-01-07 v0.20 Tels * better detection of higher-int-only base (but disabled due to failures) * streamlined converting * turned dual-basis off by default (now 7-7 on 32 bit and 9-9 on most 64 it) * _str() uses int() on first part to avoid '0000' instead of '0' 2002-02-10 v0.22 Tels * _sqrt1() => _sqrt() (oups) * much better guess for _sqrt() resulting in faster sqrt * added _fac() 2002-02-24 v0.23 Tels * from_bin() repack input and use from_hex(): twice as fast 2002-02-27 v0.24 Tels * streamlined _mod() shortcuts * _div() has shortcut if $y is very small 2002-03-03 v0.25 Tels * started _square() (not done yet) 2002-03-17 v0.26 Tels * a fix in _rsft() that left empty array instead of (0) * a fix in _sub(): early out made -1 + 100000000001 == 0 (if length($y) > 8) 2002-05-30 v0.28 Tels * added _modinv(), _modpow() (not yet implemented) 2002-06-09 v0.29 Tels * filled in _modpow() 2002-06-10 v0.30 Tels * undef mul/div in case Calc.pm get's loaded twice * fix in _as_hex() and _as_bin() for older Perls * speedups in _pow() and _modpow() 2002-08-13 v0.31 Tels * _acmp() no longer calls _len() => tad faster * some cleanup of old code, added some more comments 2002-08-21 v0.32 Tels * fixed bug in _rsft() that did not set result to 0 in some cases * _modinv() now works, thanx to the all-positive algorithm * much more tests in bigintc.t (taken over from FastCalc) 2002-09-09 v0.33 Tels * _fac() keep $n as scalar if possible * test for when to USE_MUL or not was inverted * _mul() is about 6 times faster if $y is small and $x is big 2002-09-27 v0.34 Tels * fixed bug in mul_use_div() shortcut that used * $RBASE instead of / $MBASE * $caught & 1 != 0 vs ($caught & 1) != 0 (changed to $caught != 2) * $i %= $MBASE does not work on ARM (v5.003), so make it $i -= $car * $MBASE * removed unused LEN_CONVERT code (smaller memory footprint) 2003-07-06 v0.35 Tels * fixed a bug in _floor() which caused ffloor(0.1234567) to fail. (Thanx to cpan@ali.as for finding it and sending a fix/testcases) * make _as_hex() and _as_bin() handle 0, and make them faster for very short numbers (less than BASE_LEN digits) 2003-08-31 v0.36 Tels * fixed a bug in div_use_div() that computed remainder wrong if X == X and X was very large * fixed a off-by-one error discovered with mbi_rand.t in _div_use_XXX() (one internal in $x overflowed, thus the wrong computation) 2003-12-11 v0.37 Tels * implemented _log_int() with a simple and fast "iterative" method * fixed bug in _root(): int() rounds sometimes wrong, so use sprintf() * _as_bin() and _as_hex() are faster (for small values) due to inlining is_zero() * _acmp() is about 26% faster for very small numbers or numbers that differ in length, and slightly faster for bigger numbers. This helps both bacmp() and bcmp() * _fac() did: + not modify $x in place for small arguments + something strange for large arguments + not handle 0..2 optimal (code now simplified) * _as_bin() used %b, which was not known to v5.5.3 - workaround that * implemented _log_int(), which is simple and very fast * implemented the missing pieces for _root() (which is quite fast) 2003-12-30 v0.38 Tels * guess _log_int() result based on $base if $base < $BASE * _pow() handle cases 0 ** Y, 1 ** Y, X ** 0 and X ** 1 * _new(): shortcut for short numbers, makes MBI->new() about 20% faster * _root() was wrong for numbers like 9 (0b1001) because they start with the pattern /^0b1(0+)/ (missing '$' in regexp) and after fixing this it was dead slow for large numbers. 2004-01-25 v0.39 Tels (not released) * _zeros(0) is 0, not 1 2004-03-12 v0.40 Tels * added: api_version(), _ten(), _two(), _is_ten(), _is_two(), _gcd() * streamlined: is_foo() methods * _new() takes scalar, not scalar ref * _str() returns scalar, not scalar ref * _and(): bugfix for [perl #26559]: negative arguments that are shorter than the positive one caused an error due to cutting instead padding * _ior(): forgot to calculate the proper sing of result, making, for instance, 30 | -4 go wrong 2004-04-05 v0.41a Tels (not released) * removed the unused integer-detection code and combined the two BEGIN blocks 2004-07-30 v0.41 Tels * from_hex() convert 28 bits (vs 16) at a time, faster (helps from_bin(), too) * potential bug in padding with '0' in _digit() * fixed undef warnings in fceil(0.222222222222...) (thanx kenny!) 2004-10-10 v0.42 Tels * fix critical bug in _from_hex() with parts that were to big for one part (introduced in v1.72, thanx Mark Lakata for finding it!) 2005-01-01 v0.44 Tels * small cleanups * shortcut for numbers of same length in _div, where X > Y 2005-03-20 v0.45 Tels * fix the div() shortcut for short numbers to actually work 2005-03-29 v0.46 Tels * avoid crash in FastCalc by making $BASE and $BASE_LEN use vars qw//; 2005-05-17 v0.47 Tels * remove shortcut in div(), it wasn't working properly 2007-01-27 v0.48 Tels * support for octal numbers 2007-04-16 v0.49 Tels * API version 2.0 support: add _1ex(), _alen() * make _fac() about twice as fast 2007-05-05 v0.50 Tels * speed up _mul() by "use integer;" * we do not need to remove zeros after mul() * implement an alternative algorithm for _fac() 2007-05-30 v0.51 Tels * use CORE::hex() instead of hex() to help bigint/bignum/bigrat * use 9 digit parts on 64bit integer or long double systems 2007-09-16 v0.52 Tels * fix 64bit ints on Perl v5.8.0 (thanx zefram) ############################################################################## Math::BigInt::CalcEmu: 2003-12-26 v0.01 Tels * first version, taken over all the code from BigInt 2003-12-30 v0.02 Tels * the code in Calc::_root() uses now sprintf(), but the one in Emu was not 2004-01-13 v0.03 Tels * $VERSION was overriding the $VERSION from MBI (Thanx Gisle Aas!) 2004-03-12 v0.04 Tels * removed unnec. emulation routines (all except _signed_foo) ############################################################################## Math::BigInt::Scalar: 2001-07-09 v0.04 Tels * first release 2001-07-15 v0.05 Tels * first argument is always classname, so removed checks and shift 2001-07-20 v0.06 Tels * don't use warnings for older Perls 2001-08-24 v0.10 Tels * no longer export anything, ignore import calls 2002-01-07 v0.11 Tels * fixed version * added DESCRIPTION section to stop pod2man complaining * added _dec, _inc ############################################################################## Math::BigFloat: 2001-02-18 1.00: started work 2001-02-22 1.01: new() and bstr() work now (sort of) 2001-02-24 1.02: add()/sub() should work now 2001-03-06 1.03: layed more foundations (mul() etc) 2001-03-27 1.04: bmul/bdiv/cmp work now, better _norm() 2001-03-31 1.05: fixed bstr() and bsstr() added AUTOLOAD for fxxx() to work as well as bxxx() enhanced and fixed testsuite for mul/cmp/add/new 2001-04-05 1.06: bstr() returns NaN for NaN's renamed _norm to bnorm, added it to AUTOLOAD for compatibility fixed bug Math::BigFloat->new(Math::BigInt->new(3)); bug mul/div when second arg was BigInt bdiv() works now with precision precision() doc about mixing different objects in overloaded math 2001-04-07 1.07: bug in bstr() for 0.xxx style numbers, as well as for "-xxx" babs(), bneg(), bint() work now empty stubs for bsqrt(), bround() and bmod() exponent(), mantissa(), parts() work now as expected 2001-04-18 1.08: exponent(), mantissa() and parts() now return BigInt's bnorm: 0Ey => 0E1 (was wrongly 0E0) fixed is_zero() added bround() and bfround() (only truncate mode) fixed bug in bstr() for 1.203E-2 style numbers (Thanx Tom!) 2001-04-23 1.09: length() in list context return length of mantissa & exponent bug in bstr() for '0.x' style strings added bsqrt() workaround for Perl v5.6.0 overload-bool bug (via MBI) fixed rounding 2001-05-07 1.10: Tom's round fixes (minus one nit) new: .xxx, -.xxx, +.xxx etc are valid inputs, while '.', 'x x x' and 'Exxx' are now invalid finally got rid of C&P of overload section and clone() 2001-05-09 1.11: bug bcmp() (1e-08 was < 0, aka fractions were broken) 2001-05-11 1.12 Tels * taken over testsuite from John P. * added tests for compare with fraction * fixed fcmp/fround/ffround * added accuracy/precision/fallback/round_mode * bsstr('NaN') returned 'NaNeNaN' 2001-06-09 1.13 Tels: * adjusted fdiv() so that it now works proper with old testcases * (except a few nits, see testsuite and ACCURACY) * fdiv() in listmode (uses non-working fmod()) * fixed/test A/P after each op * $x->accuracy(), $x->precision() actually round $x to the value A/P * fixed fpow(), added tests for it * hexadecimal integer input (0xdeadbeef) * is_one() for -1 was wrongly true, tests for is_one() 2001-06-13 1.14 Tels: * accuracy/precision rounding after fdiv() was missing * binary integer input (0b01110 etc) * A/P rounding after fdiv() was missing * '-0x0' would wrongly leave '-0' * as_number() was wrong for negative numbers and had no tests * added is_even(), is_odd(), _set(), the inherited ones were broken * fixed is_zero() for NaN * $x->bpow($y) for negative $y was unfinished * added is_inf(), binf() and some support for +-inf in new(), bsstr() etc * added tests for is_odd(), is_even(), _set() and is_zero(), is_inf(), bsstr() 2001-06-15 v1.15 Tels * added bfloor(), bceil() 2001-07-09 v1.16 Tels * is_positive(), is_negative() * various pod fixes (overlong =item, spelling erorrs etc) * removed internal _set() and the tests for it * infinity support for fcmp(), fpow() * nailed the bug in fdiv() that caused fsqrt() to fail. fsqr() works now, too. * more tests 2001-07-15 v1.17 Tels * applied Philip Newtons spelling and doc patch(s) * added bone() * tests for bnan() and bone() 2001-08-02 v1.19 Tels * 123/+-inf => 0, test for that and -1,0 / NaN => NaN * +123 / 0 => +inf, -123 / 0 => -inf (was missing in MBF) * fixed +-inf handling in bacmp/bcmp/bsub/badd/bdiv and tests for that * padd bstr() output of numbers with set A or P * remove bfloat() (Math::BigInt->bfloat() did not work, anyway, see bint()) 2001-08-03 v1.20 Tels * streamlined bcmp * drop leading '+' for inf 2001-09-03 v1.21 Tels * serious bug in bcmp() caused 1.5 to be greater than 2. Yikes! * bcmp() did not only return -1,0,1 and undef but other values, too * new('inf') produced NaN (was expecting '+inf') * exponent(), mantissa() & parts() failed or returned scalars for inf,-inf,NaN * include finf in AUTOLOAD list 2001-10-03 v1.22 Tels * Quite a lot of rounding fixes * $x->bnorm() is 4 times faster if $x == 0 * $x->bround($n) is 43 times faster if $n > $x->{_a} (no-op) * added as_number() 2001-10-05 v1.23 Tels * fixed facmp() (was broken the same way as fcmp()) * more rounding fixes from John P. 2001-11-11 v1.24 Tels * bacmp() fix for +-inf * streamlined new() * faster finc()/fdec() 2001-11-18 v1.25 Tels * streamlining fixes in new() were missing * further streamlining in new() for 12345e1234 cases (fraction part empty) * added $rnd_mode support for compatibility * replaced the 'laber schwad blah blah' pod section by a pointer to MBI 2001-12-06 v1.26 Tels * fneg() failed (now hand up to MBI) * frsft() and flsft() were no aliases to brsft() and blsft() * fone() was no alias for bone() * blsft() and brsft() were missing altogether * streamlined: fpow() and fmul() * removed the EXPORT_OK * fqsrt() uses now BigInt::bsqrt() as guess: greatly improved performance * make fsqrt() subclass proof by using $self instead of Math::BigFloat * bzero(), bone(): take additional A and P and store 'em * bnan(), binf(): clear A and P 2002-01-06 v1.27 Tels * overload for log() and flog()/blog() * bzero()/bone() handling of A & P was broken * bround()/bfround() handling of zeros forgot to set A & P * fdiv: fixed a bug in round to A with given round_mode (always used global) * fsqrt(): would hang/fail if either $x's or global A or P were set * fsqrt() didn't modify $x sometimes, but returned a new reference * fsqrt(): calc 4 more digits for rounding, not 1 (endless looping otherwise) * fmod() now actually works 2002-02-10 v1.27 Tels (forgot to increase version) * ffac() * various: disable Math::BigInt::upgrade to avoid deep recursion 2002-02-16 v1.28 Tels * fixed use Math::BigFloat ':constant'; * fixed flog() function to calc right result, honour rounding-globals 2002-02-24 v1.29 Tels * overload for 'log' now inherited by BigInt * _binf(), _bnan(), _bone() and _bzero() instead of longer bone() etc * inf/NaN fixes from v1.51 were missing for BigFloat * bdiv() upgrades if applicable 2002-02-25 v1.30 Tels * bug in bsub() with not rounding when $x->bsub(0) was also in MBF * bcmp() and bacmp() 5 times faster due to numify() (might have now impose a limit on exponent - but I couldn't find a test that breaks it) * streamlined ffloor() and fceil() * fixed bug in $x->bsub(0) and $x->badd(0) (both forgot to round result) * new() downgrade integers if $downgrade is in effect * optimized fpow() (one is_zero() less) * optimized as_number (nearly twice as fast) * $x->badd(0) forgot to round $x * downgrade and upgrade are valid methods for inheritance 2002-03-03 v1.31 Tels * bpow() can handle second arguments beeing non-integer (f.i. 2 ** 0.2) * $x->bpow(0.5) optimized to $x->bsqrt(); 2002-05-19 v1.32 Tels * upgrade used badd() instead of bmul() inside bmul() * bpow() now uses slower, but more correct way for fractions (this needs work) 2002-06-09 v1.33 Tels * import() fixed for older Perls 2002-06-10 v1.34 Tels * upgrade used badd() instead of bmul() inside bmul() (again! arg!) 2002-07-07 v1.35 Tels * bfround() used accidentally BigInt math; is now about 5.6 times faster for small numbers * bdiv()/badd() etc skip objectify() if possible and are thus faster * doc for accuracy()/precision() * $x->bmod() was not modifying $x in place when returning NaN/inf/-inf * avoid unec. calls to objectify() for binary op's 2002-08-13 v1.36 Tels * as_hex() and as_bin() work now at least for inf, NaN and integers * fixed bsstr() (and thus also numify()) for negative numbers - Ouch! * $x->new("0.02"); $x->accuracy($a); $x->bdiv($y,$d) failed to round when $d > $a * numify() returned '+inf' instead of 'inf' * (more) tests for bsstr(), numify(), as_hex(), as_bin 2002-08-20 v1.37 Tels * bcmp()/bacmp() upgrade now if requested 2002-09-08 v1.38 Tels * fix that bsqrt() would hang for certain inputs. Instead of using Newton's, we now rely on the fact that sqrt(x*y) = sqrt(x) * sqrt(y) by setting y to 100. This removes the while loop entirely and makes it much faster while fixing the bug at the same time. * $x->bsqrt(0) did needless warn about undef values, and round to 4 digits instead of beeing equivalent to $x->bsqrt(undef) * ditto for $x->bpow($y,0), $x->blog($base,0) and $x->bdiv($y,0) * use File::Spec was needless, since it was required later on again 2002-11-03 v1.39 Tels * $x->bpow($y,0), $x->blog($base,0) and $x->bdiv($y,0) were still not doing the right thing and no tests caught it *sigh* * blog(): + MUCH faster when $x > 10 or $x < 0.1 (constant time vs. time * 10 when doubling/halving $x) + also much faster if $x has many digits (like 1/3 or 123**123) + for $x < 1 and $x > 0 did not work at all (bacmp vs bcmp) + returns now NaN if $base <= 0 or $base == 1 + does handle other bases than "undef" (aka e) properly now * require Math::BigFloat did not work (opposed to BigInt, where it does) * _pow() suffered the same bug of bacmp vs bcmp (so 0.2 ** 0.2 failed) * removed unused _pow2() routine * _find_round_parameters() returns ($x,$a,$p,$r) and not ($a,$p,$r), so use it correctly, and also test for $x = NaN afterwards (happens when $a and $p were set and thus $x became NaN) * bsqrt() failed since v1.63 for values like 0.2, 0.002, 0.00134 etc * added broot() method (albeit slow for now) * $x->is_one('-') was broken (never returned true for $x == -1) * config() can take arguments and set them, croak on wrong ones * config(trap_nan => 1) to manipulate former $NaNOK variable * config(trap_inf => 1), too * trap_nan/trap_inf really croak on any attempt to create an NaN/inf * spellings of Bigint => BigInt * simplify config() by using SUPER::config() 2003-07-06 v1.39 Tels * $x->blog($base) can handle a $base which is a Math::Bigint * replace die() with Carp::croak 2003-09-23 v1.40 Tels * bstr(): removed unnec. BigInt math and inlined is_zero() => great speedup (10% to factor 6.5 depending on input) * replace $self->_one() by $self->bone() 2003-12-11 v1.41 Tels * flog(): 0.5, 0.25, 0.125, 2, 4 and 8 were not scaled properly back to 1, instead they remained 0.5 and 2, respectively. This was a '<' vs. '>=' respective '<' vs. '<=' issue. No other values are affected (neither getting slower nor faster), but the ones in question (incl. their multiples like 20, 80, 0.0125 etc) are now tremendously faster - about a factor of 30 to 60! :-) * removed some crufty logic from _log_10() and made the special cases of 2, 10 and 0.1 slightly faster. This also helps log($x,2) and log($x,10). * bfac() slightly faster for small arguments * downgrading to bigint failed for .2e2 (produced 200 vs. 20) 2003-12-30 v1.42 Tels * ffac(inf) is inf, not NaN * flog() calculate integer result first, and if it fits, return it this makes it much faster in case the result is a perfect integer * require (instead of use) Exporter * froot() calculates an integer result first, and it if fits, returns it 2004-01-13 v1.43 Tels * small fixes in AUTOLOAD * delete $x->{_a} vs. $x->{_a} = undef to save memory 2004-03-12 v1.44 Tels * bpow() computed -X ** Y wrong for Y that are odd * use $HALF instead of 0.5 to speed up broot() * use Calc instead of BigInt for parts, that makes it roughly 2x faster it also saves memory (419 vs. 767 bytes per (small number) object) * bmod() did needlessly test for NaN arguments twice 2004-07-30 v1.45 Tels * simple inherit bsub() from BigInt, also fixes bsub() failing under $x -= $x - Thanx Peter J. Acklam! * bdiv() failed when passed a variable twice (thanx Peter J. Acklam!) * bfround() and bround() are about 10% faster when going via Math::BigInt's bround() due to constructing a fake BigInt instead of going via ->new() * fixed undef warnings in bpow(0,$y) ($y non-integer) (thanx kenny!) 2004-08-13 v1.46 Tels * blog(10,10) ($x == $y) returned '1.0000...' instead of '1' 2004-10-10 v1.47 Tels * inf/NaN fixes for bpow() * eliminate the need for _zeros() in new() (speed-up for GMP et. al.) * eliminate _is_zero() in new() (small speed up) * added shortcut for simple numbers in new() (speed up) 2005-01-01 v1.48 Tels * use new interface to _scale_a() and _scale_p() in BigInt * add bneg() and inline is_zero() in it, making it 1.6 times faster * replace ref($_[0]) w/ undef when it isn't actually needed. This makes some ops (bsstr(), bneg etc) about 2% faster for small numbers * use MBI::_register_callback() to get notified of lib changes * bgcd()/blcm() never worked, so fix them for integers and add tests 2005-03-20 v1.49 Tels * remove dependecy on Scalar::Util in bdiv() * bdiv() cache result of "!$y->is_one()" for wantarray case to make ($res,$rem) = $x->bdiv($y); about 10% faster 2005-03-29 v1.50 Tels * fix rounding doc, add notes about prevision vs. accuracy * set FastCalc as default (we still use whatever MBI uses) 2005-04-10 v1.51 Tels * fix new() to work with Math::BigInt::Pari 2007-01-27 v1.52 Tels * fix brsft() and bpow() in list context only return on number (bug #21413) * make as_int() return a BigInt, too (not just as_number()) (bug #21412) * add as_oct() * bpow(): handle negative X and negative Y (instead of returning NaN) 2007-03-04 v1.53 Tels * fix #25144: [PATCH] Math::BigFloat->new considers any reference a BigInt (Thanx mschwern!) * fix bug #13866: NaN (in bignum queue) * fix bug #21586: Incorrect result when comparing with NaN * fix bug #15896: "==" overloading is broken for "NaN" 2007-04-09 v1.54 Tels * fix bug #21747: Re: weirdity in bignum... (powers and high precision): infinite loops for blog() (and consequently bpow()) if you requested an accuracy greater than 67 digits (uses _log() now, and not blog()) Thanx to darconc! * cache the result of _log(2) and _log(10) so that subsequent calculations can re-use the already done work * instead of computing _log(10), compute _log(1.25) and _log(2) and then do: _log(1.25 * 2 * 2 * 2) = _log(1.25) + _log(2) + _log(2) + _log(2) This makes computing _log(10) much faster, so that computing blog(N) is about a factor of 5 faster when N >= 10 or N <= 0.1 * add bexp() 2007-04-16 v1.55 Tels * make bexp() much faster (esp. under GMP) by caching the first coefficients and rewriting the inner loop * support "try" and "only" in import() 2007-05-05 v1.57 Tels * add bnok() method (n over k) * add all the missing modify() hooks 2007-06-30 v1.58 Tels * remove Exporer from @ISA * support config('lib') as shortcut for config()->{lib} * add bpi(), bcos(), bsin(), batan(), batan2() methods * add bmuladd() * streamline the is_xxx() and copy() methods 2008-04-20 v1.60 Tels * fix #34459: bsqrt() breaks on floats with enough digits (Thanx Niko Tyni!) * fix #35238: batan2() handles inf/+inf wrong * fix #35162: MBI segfault (as_number(Math::BigRat()) was wrong) ############################################################################## Math::BigInt: 2000-11-13 v1.02 Tels fixed sub and mul (sort of) found out that "$wanted = shift || return bzero()" causes a call to numify, testing for undefined fixes this problem (but might waste more time for a new(0), will save time on average. 2000-11-14 v1.03 Tels x**0 => 1 (instead of x) fixed bigintpm to include bpow, binc, bdec, new() test 2000-11-15 v1.04 Tels fixed bigintpm to test '++' and '--' properly done div, fixed mul/bpow (13 tests remain) 2000-11-16 v1.05 Tels 8 tests remain new copies _all_ fields, not only Math::Bigint ones 2000-11-19 v1.06 Tels 7 tests remain bgcd accepts lists, added blcm 2000-11-20 v1.07 Tels objectify fixed to not make copies and work with subclasses 2000-11-22 v1.08 Tels fixed all but one test (band bior bxor etc) 2000-11-23 v1.09 Tels fixed bug in bmul (and thus bpow) (self multiply works now) 2000-11-24 v1.10 Tels finally made it Math::BigInt (w/o trailing 's') 2001-02-14 v1.11 Tels (first release) * fixed bug in band(), bxor(), etc that used badd($x, fixed_number_here); * since subclasses might not be happy with fixed numbers, make sure we pass BigInts all the time if using something like $someclass->badd(); * fixed bug in band/bxor/bior which destroyed second argument * bxor/band/bior work now correctly for subclasses * ++ and -- are now a tad (ca 5%) faster 2001-02-16 v1.12 Tels * accidentally dropped self-multiply test in bigintpm.t * fixed bug in overloading cmp * after correcting the overload for 'cmp', I got a lot of test failings and finally discovered that the bstr()'s return of '[+-][0-9]+' instead of Perls ways of '[-]?[0-9]+' breaks string comparisons with numbers :( F.i. ok() from Test.pm uses 'eq' and you can not do ok($a,3*3) where $a is a BigInt. IMNSHO clearly wrong. And only changing the way cmp is overloaded would lead to the curios situation that the following: 'print "$a eq $b" if $a eq $b;' would print "+3 eq 3", which looks wrong. Mark B. said go ahead and change bstr(), so I changed it ;) to drop the '+', adapted all the tests, changed the doc, etc. BigInts behave now transparently like build-in scalars in integer/string context ;o) 2001-02-18 v1.13 Tels * got rid of duplicated copy() code in new() 2001-02-21 v1.14 Tels * overload +=, -=, *= and /= for about 20-30% more speed if both args have roughly same length * shortcut in add() makes $x += $y; $x -= $y; for large $x and small $y an O(1) case instead of O(N) * fixed (non-critical) bug that caused objectify in numify/bool/stringify to create scratch objects from undef params. 2001-02-24 v1.15 Tels * $x / $x is now a lot faster (more O(1) than O(N)) * 10 ** $x is now a lot faster (more O(N/5) instead of O(N)) * overload of **= makes $x **= $y faster * 0 ** 0 was NaN, not 1 * -a % b = +c (was -c) to be compatible with perl * added $x->length() and test for it; fixed _digits() (was off by 1) * objectify() was not exported, added tests for objectify() 2001-03-09 v1.16 Tels * Math::BigInt::badd(4,5) and Math::SomeChildOfBI->badd(4,5) work now * '$x = scalar (**|%|+|-|*|\) $object;' failed (was not tested, either) * 'if ($x)' is now O(1) instead of O(N) and at least twice as fast * fixed nasty bug in _digits that caused <=> after add/sub/mul etc to fail if result was between 100001 and 109999, added test for this * added test cases for op's that should preserve args (+,+=,abs(), neg() etc) * added tests for overloaded 'bool' * added test.pl and some examples (prime.pl, bigprimes.pl) * tests after "use Math::BigInt :constant" were screwed due to not using eval * $x->numify() (for $array[$x] = 0; etc) is much faster now * added caveat documentation for $x = -$x; and $x *= string1 operator string2; 2001-03-24 v1.20 Tels * added: is_nan() * bug in bmod/bdiv, I forgot some cases with negatives. Thanx to Bruce Fields! * documented ':constant' and eval() crash on Perl 5.00x * documented BigInts behaviour of bmod/bdiv and use integer 2001-03-30 v1.21 Tels * bool() works now under 5_005 * bug in bsub where numbers with at least 6 trailing digits after any op failed 2001-04-05 v1.22 Tels * documented Peters OS/390 patch/changes (fix was in for quite some time) * fixed bug Math::BigInt->new(Math::BigFloat->new(3)); * objectify() with other objects than BigInt as further args, copy() etc * $x->digit($n) to query fast value of Nth digit * as_number() 2001-04-07 v1.23 Tels * spelling errors in pod 2001-04-23 v1.3 Tels * added (compatible to MBF) mantissa(), exponent() & parts() as well as tests * _trailing_zeros() * fixed as_number() to return copy of BigInt * added bround(), bfround() and support for round_mode() as well as $rnd_mode * fixed bug in bdiv() wich left reminder "-0", causing further op's to die() * added is_valid to testsuite to see whether invalid objects are created * added bsqrt() * workaround coredump bug in bool() for v5.6.1 2001-05-08 v1.31 Tels * _ between digits now accepted, ' ' no longer valid inside (but at front/end) * Exxx is NaN, and no longer produces warning * .xxx style numbers are valid input * tests for 1E1, 123E-2, 1E2 etc style input to Bigint.pm * fixed overload (w/ _swap/copy), subclasses can inherit it easily * removed clone() * added bsstr() 2001-05-11 v1.32 Tels * added accuracy/precision/fallback/round_mode 2001-06-09 v1.33 Tels * bround() no longer uses 10 ** $pad and is thus much faster when rounding up * fixed and added rounding benchmark (did time bmul instead bround) * blsft(),brsft(): can work in different bases, check against invalid inputs, more tests, speedup when in base 10 * _trailing_zeros is 50% faster * A/P after each op, tests for it in accuracy.t * round() instead of bnorm() * $x->accuracy(), $x->precision() actually round $x to the set value * tests for is_one() * hexadecimal integer input (0xcafebabe etc) 2001-06-13 v1.34 Tels * binary integer input (0b01110 etc) * fixed: '-0x0' left '-0' * added is_inf(), binf() and some support for +-inf in new(), bsstr() etc * added tests for is_odd(), is_even(), _set() and is_zero(), is_inf(), bsstr() 2001-06-15 v1.35 Tels * added bfloor(), bceil() * fixed bior(), bxor(), band() for $x->bxxx(NaN,0), added modify() to them 2001-07-04 v1.36 Tels * is_positive(), is_negative() * various pod fixes (overlong =item, spelling erorrs etc) * torn out the bones from under the flesh and moved them to Math::BigInt::Calc * added Math::BigInt::Calc, Math::BigInt::Small (and Math::BigInt::BitVect) * fixed tests for bacmp() (could never fail) * removed internal _set() and tests for it * +-inf handling in bcmp(), bpow() 2001-07-15 v1.37 Tels * applied Philip Newtons spelling and doc patch(s) * Benjamin Trott: _split() is faster for numbers that need no splitting * Benjamin Trott: don't take shortcut in badd(), or Pari won't work * allow use Math::BigInt lib => 'Pari,BitVect,Foo,Bar'; * delegate shifting to CALC if possible, otherwise fallback * test for self-pow, to see if lib's fail (since BitVect failed for self-pow) * _one() => bone() * +x / 0 => +inf, -x / 0 => -inf, while 0/0 and +-x % 0 are still NaN * tests for bnan() and bone() * Math::BigInt::Calc now determines biggest $BASE to use. Default should now be 1e7 on most systems, giving 20% to 40% speedups. 2001-07-15 v1.38 Tels * test for mul() shortcut 2001-08-02 v1.39 Tels * fixed history (duh!) * assign return values from $CALC back to $x->{value} * fixed +-inf handling in a lot of places and tests for that * band(), bxor() and bior() now work with negative inputs * remove bint() (Math::BigFloat->bint() just DNDWIM and no sense, either) 2001-08-03 v1.40 Tels * bxor(-$x,-$y) was broken (and not tested *sigh*) * streamlined bcmp * drop leading '+' for inf * bxor(), band(), bior() with negative arguments don't get passed to lib (makes it work with BitVect, Pari, GMP etc) 2001-08-08 v1.41 Tels * fixed inf test (coredumps) 2001-09-03 v1.42 Tels * bug in overload section causing performance losses in subclasses * call $CALC->import() with list of libs * odd numbers never have trailing zeros, so don't convert them to DEC to look * as_hex() and as_bin() * $x->bmod() did not modify $x, only returned result. Oups. * new('inf') produced NaN (was expecting '+inf') * exponent(), mantissa() & parts() failed or returned scalars for inf,-inf,NaN 2001-10-05 v1.43 Tels * $x->bround($n) is 43 times faster if $n > $x->{_a} (no-op) * Heaploads of rounding fixes (and tests) * Test for 99999-bug in Calc 2001-11-04 v1.45 Tels * tests run now in subclass, too * bmod() can use _mod in lib * lots of tests fixed (assumed wrong base etc) and added * bpow() about 10-15% faster for small numbers (like 2 ** 150, 3 * 200 etc) 2001-11-11 v1.46 Tels * binc(),bdec() use lib (via _inc(),_dec()) => faster (see BENCHMARK) * avoid the unnec. rounding bsub()/binc()/bdec() (badd() already took care) * made bsub() faster by removing the bneg() overhead from it 2001-11-18 v1.47 Tels * added $rnd_mode support for compatibility * two 'my $t = ... if ..;' cases to 'my $t; $t = ... if ...;' * added overload for %=, |=, &= and ^= for more speed * _split(): check for 1e2e3 and reject it 2001-12-06 v1.48 Tels * fixed pod in many places * bmod: use round(), not bround() * bsqrt: use _sqrt() from lib, if possible * bsqrt: would hang for certain (most?) inputs * bdiv: slow check for 1 || -1 replaced by much faster version * bdiv: call _div() only when nec. in list context, otherwise scalar * streamlined copy(), _find_round_parameters() * removed the EXPORT_OK except for objectify, _swap and bgcd/blcm * bzero(), bone(): take additional A and P and store 'em * bnan(), binf(): clear A and P 2002-01-07 v1.49 Tels * as_hex() and as_bin() use 16 instead of 8 bits per iteration * overload for log() and blog() * tricks to make 'require Math::BigInt' and 'use Math::BigInt();' work again * use $CALC instead of require for newer Perls (test for $] > 5.006 vs 5.6) * bzero()/bone() handling of A & P was broken * bround()/bfround() forgot to set A or P for zeros * embedded _find_round_parameters into round(), streamlined both versions * round() now uses string-add to make it almost twice as fast * bnot() did round twice 2002-02-10 v1.50 Tels * bfac() and hook for _fac() in libs * documented sub-classing and auto-upgrade * < 4 test in bsqrt() after the CALC call for more performance * added overload for sqrt() * added possibility to upgrade via use Math::BigInt upgrade => 'Foo::Bar' * Math::Big(Int|Float)->accuracy() clears precision, and vice versa * small optimization in bdiv() regarding abs($x) < abs($y) * brsft() for negative numbers in base 2 was completely wrong 2002-02-16 v1.51 Tels * fixed bfround(-x) (f.i. 0.004->bfround(-2) resulted in 0.01, not 0.00) * bfround(x) rounded at wrong place (off by one) * calling bfround(x) rounded further and further instead of keeping result * blog() upgrades if requested * added doc stub for every public function 2002-02-24 v1.52 Tels * hooks for _bin(), _bnan(), _bone() and _bzero() * =head2 section for accuracy 2002-02-27 v1.53 Tels * precisision typo * fixed overlong pod =item * added downgrade() 2002-03-03 v1.54 Tels * really fixed overlong pod =item * downgrade() and upgrade() with undef as argument didn't clear the variable * bmul() upgrades if second argument is non-integer * bdiv() upgrades if $x > $y * bpow() upgrades if second argument is non-integer * objectify disable downgrade (for MBF) * new() twice as fast due to shortcut simple numbers, save _split() & _round() 2002-03-17 v1.55 Tels * :constant picks up binary/hexadecimal constants * Math::BigInt->digit(123) works now 2002-03-17 v1.56 Tels * documented config() * simplified import() logic a bit * changed some isa->($upgrade) => !$isa->($self); 2002-05-30 v1.57 Tels * fixed objectify() to make "perl -Mbigrat -le 'print 1+2/3'" work * added bmodpow() and bmodinv() as (not-working yet) stubs 2002-06-09 v1.58 Tels * invalid inputs with two dot's (1.2.3 or 1..2 etc) are now really invalid 2002-06-10 v1.59 Tels * pod fixes for bmodpow()/bmodinv() * fix in as_hex() and as_bin() for older Perls * speedups in bpow(), bmodin() and bmodpow() 2002-07-07 v1.60 Tels * shortcuts to avoid calls to objectify for add/sub/mul/div/mod/pow/bcmp etc * fix overloaded bcmp() so that the objectify()-avoidance kicks in * avoid calling round() when BigFloat requested 'no rounding please' * bcmp()'s shortcut for comparing x <=> 0, 0 <=> 0, 0 <=> $y was making things slower than just handing the compare to Calc. Even more so for Pari et al. * $x->accuracy() and $x->precision() returned undef, instead of 0 if A/P of $x was 0 and global A/P was undef. * $x->bmod() did not modify $x in place when returning NaN/inf/-inf * some binary ops (band/bxor/bior/bpow) were not properly rounding the result to the requested A/P/R; the same ops also forgot to take $y into account * doc for accuracy()/precision() 2002-08-13 v1.61 Tels * tests for bsstr()/numify() with negative/special inputs * bround() keeps $scale as scalar for speed and less problems * fix for trailing newlines in input * some doc fixes (especially return values of is_foo() methods) * make testsuite so that it will pass under FastCalc easily 2002-08-21 v1.62 Tels * bcmp()/bacmp() upgrade now if requested * bmodinv() uses an all-positive algorithm, speeding it up by about 5-8% and allowing to implement the same algorithm in Calc for factor 4 speedup 2002-09-08 v1.63 Tels * bsqrt() did not modify $x but returned new object when lib does not have a _sqrt() routine (BareCalc, BitVect and Pari are affected, Calc, FastCalc and GMP were not) 2002-11-03 v1.64 Tels * removed needless "my $c = ...;" statements in binf() and bnan() * forgot () around "$x->{_f} & MB_NEVER_ROUND" * bsqrt(inf) == inf, not NaN * $x->bdiv($x) did not round the resulting 1 properly * removed the shortcut testcode in bdiv() (Calc handles this now) * added (non-working for now) broot() method * changed length() to CORE::length() in two places (thanx Liz!) * config() can take arguments and set them, croak on wrong ones * config(trap_nan => 1) to manipulate former $NaNOK variable * config(trap_inf => 1), too * trap_nan/trap_inf really croak on any attempt to create an NaN/inf * spellings of Bigint => BigInt * _find_rounding_parameters(): set $a to undef if it is 0 2003-07-13 v1.65 Tels * document that config() can set certain values * replace die() with Carp::croak() * remove needless is_zero() check in as_bin() and as_hex(), making them faster, especially when under a different lib like GMP. * Fixed the infinite recursion in bignum. See http://xrl.us/k6y * fix handling of 0e999, 0e-999 etc 2003-09-01 v1.66 Tels * document accepted inputs better * fix wrong upgrade and undef-parameter handling in broot() * implement broot() if lib doesn't have a _root() routine for $y that are powers of two and for small $x * warn if broot() cannot yet compute proper result * remove needless _one(): 3% speedup for binc() * remove needless _swap(): 1% (Calc) - 6% (GMP) speedup for overloaded math 2003-12-02 v1.67 Tels * overload for cos/sin/exp/atan2 to make cos(Math::BigInt->new(...)) work * implemented blog() with a simple and fast "iterative" method * use _log_int() in $CALC if possible * cache $CALC->can(...) calls in global %CAN hash for speed * reorder is_zero() check for band(), bior() and bxor() to speed up the case for when the underlying lib has _and(), _ior() and _xor() * implement a new way of emulating AND, OR and XOR, this tremendously helps if band() et. al. are called with negative arguments * try to call _signed_or(), _signed_and() and _signed_xor() in lib * is_foobar() methods are slightly faster * bnot() is about 12% faster * bsqrt(): moved is_zero() || is_one() test out of the way => 28% faster for "small" values (Calc and GMP) * small change for overload::constant * bfac(): do 0 or 1 check only if CALC cannot do _fac() (thus faster) * removed a needless _copy in bmod() with negative arguments (slightly faster) 2003-12-26 v1.68 Tels * bfac(inf) is inf, not NaN * added alias names: as_int() (as_number()), is_pos(), is_neg() and doc * factored out all the emulation code and moved it to Math::BigInt::CalcEmu * binary/hexadecimal input was twice as slow as v1.66 due to a typo in v1.67 * streamlined overload for boolean context (20% faster "... if $x;") * round() was missing a croak() in path testing for wrong roundmode * badd(): optimize away setting of sign if it is already right * bdec() is about 10% faster for negative numbers * bpow(): removed some now needless tests for 0 and 1: about 30% faster for small numbers * streamlined exponent() (parts() benefits from this, too) 2004-01-13 v1.69 Tels * bacmp(+-$x,-inf) was wrong (Thanx William T. Morgan!) * digit($x,$y) segfaulted under 5.6.1 if $y was a BigInt * blog() was missing the modify() check (breaking MBI::Constant) * delete $x->{_a} vs. $x->{_a} = undef to save memory 2004-03-12 v1.70 Tels * bpow() computed -X ** Y wrong for Y that are odd * 0 ** -Y => +inf (was NaN) due to 0 ** -Y => 1/0**Y => 1/0 => +inf * fixed bug in perl -Mbignum -le 'print 2 ** 46 * 3' under Bigint::Lite leading to "Can't use an undefined value as an ARRAY reference at /usr/local/lib/perl5/5.8.2/Math/BigInt/Calc.pm line 462." * fixed upgrading of blog() with base = undef (means: base e) * make the synopsis actually runnable (Thanx Paul McCarthy) * blcm(): handle a list of strings (instead one obj and some strings), too 2004-07-08 v1.71 Tels * fixed bsub() failing under $x -= $x; Thanx Peter J. Acklam! * _scan_for_nonzero() reuses length/stringform of $x and is thus faster, this helps rounding if the number after the roundposition is '5' 2004-07-13 v1.72 Tels * no changes 2004-10-10 v1.73 Tels * overloading of <<= and >>= makes these ops about 10% faster and fixes the problem that "$a <<= 2" would create a different object for $a to point to * quite a lot of fixes for NaN/inf handling in bpow() (bmul already did it right) - bug report by jeff at thekidders com and Hugo - Thank you! 2005-01-01 v1.74 Tels * streamline _scale_a() and _scale_p() for more speed in rounding * remove the now unnec. support for MB_NEVER_ROUND and {_f}, this makes all ops that call round() a tad faster (one exists is removed) and shrinks the codesize a bit * streamline bneg(), inline is_zero(): makes it 1.6 times faster * replace ref($_[0]) w/ undef when it isn't actually needed. This makes some ops (bsstr(), bneg etc) about 2% faster for small numbers * restrict low-level math library names to sane chars to avoid exploitation of eval() * fill_can_cache() accidentally did checks for 'or' & 'xor' * inline _fill_can_cache * add _register_callback() to notify subclasses of lower math lib changes * bgcd() is now about 10% faster * is_positive(0) == 0, since 0 is neither positive nor negative * streamline bmod() a bit * fix blog() constructing arguments (broke Math::BigInt::Constant) 2005-03-20 v1.75 Tels * use a trick to remove the dependency on Scalar::Util in bsub() * fix atan2(), it did not preserve the order of arguments (Thanx to Ambros & Zaxo for report and patch!) 2005-04-10 v1.76 Tels * fix rounding doc, add notes about prevision vs. accuracy * trap inf and -inf in new() * load FastCalc as default 2005-05-17 v1.77 Tels * bump version 2007-01-27 v1.78 Tels * implement "try" and "only" as replacements for "lib" * make 'use Math::BigInt lib => "foo"' warn if foo cannot be loaded and a fallback occurs * fix bug #21446 - Docs/code inconsistency for bnorm() method * fix bug #21964 - A patch to include a rounding mode of 'common' * fix bug #21445 - Documentation error for exponent() method * fix bug perl #41050 - NaN returned when raising integer value to negative power * add from_hex(), from_oct(), and from_bin() * add as_oct() 2007-02-02 v1.79 Tels * fix typos 2007-03-04 v1.80 Tels * require Perl v5.6.2 as minimum * fix bug #24969 (Can't use an undefined value as an ARRAY reference) * fix bug #12857: Subclasses and overload * fix bug #13866: NaN (in bignum queue) * fix bug #21586: Incorrect result when comparing with NaN * fix bug #15896: "==" overloading is broken for "NaN" 2007-03-16 v1.81 Tels * no code change, just a package update 2007-04-09 v1.82 Tels * use $CALC->_zeros() directly (instead _trailing_zeros()) to speed up exponent() and mantissa() * fix documentation that blsft() and brsft() default to base 2 (not 10) * add bexp() and fix overloading for exp() 2007-04-16 v1.83 Tels * bump version 2007-05-04 v1.84 Tels * add bnok() method (n over k) 2007-05-05 v1.85 Tels * bump version 2007-05-05 v1.86 Tels * bump version 2007-06-30 v1.87 Tels * fix undef base in blog() * support config('lib') as shortcut for config()->{lib} * _find_round_parameters(): convert $a & $p to normal scalars, or bad things will happen during rounding of BigFloats * add bpi(), bcos(), bsin(), batan(), batan2() methods * add bmuladd() * streamline the is_xxx() and copy() methods 2007-09-22 v1.88 Tels * fix wide ints on Perl v5.8.0 (Thanx zefram!) * minimum required is Perl v5.6 (tested by zefram) * _find_round_parameters(), _scale_a() and _scale_p(): trunc A/P to integers * fix from_oct(), from_bin() and from_hex() 2008-04-20 v1.89 Tels * fix #35238: batan2() handles inf/+inf wrong 2010-09-03 v1.90 rafl * fix bnok() for k==0 and k==n-1 2010-09-10 v1.91 rafl * fix various documentation bugs 2010-09-10 v1.92 rafl * re-upload v1.91 with a fixed SIGNATURE 2010-09-13 v1.93 rafl * Depend on perl >= 5.6.2 * Remove obsolete core test directory boilerplate * Convert from Test to Test::More 2010-09-13 v1.94 rafl DEVELOPMENT RELEASE * Attempt to fix Math::BigInt::Lite failures 2010-09-14 v1.95 rafl * Re-upload v1.94 as a stable release 2010-09-28 v1.96 rafl * Various documentation fixes provided by gregor herrmann 2010-11-07 v1.97 rafl * Reorder the list return of Math::BigInt::Calc::_base_len() (Nicholas Clark) This change requires an update of Math::BigInt::FastCalc to version 0.24. * Fix segfault when upgrading irrational numbers (Father Chrysostomos) 2010-11-08 v1.98 rafl * Fix from_bin() documentation error (Peter John Acklam) (Closes: RT#61845). * Make as_int($inf) return inf, not NaN (Peter John Acklam) (Closes RT#62101). * Fix various typos in documentation and tests (Peter John Acklam) (Closes RT#62643). * Make digit($n) return 0 for "out of range"-digits (Peter John Acklam) (Closes RT#61812). 2010-11-15 v1.99 rafl * Stop as_int/as_number from losing precision (Peter John Acklam) (Closes: RT#43694) * Fix Math::BigInt::Calc::_modpow for (0 ** $x) % $y, with $x > 0 (Peter John Acklam) (Closes: RT#62918). * Stop $x -> bmodpow(1, 1) from failing when $x is large (Peter John Acklam) (Closes: RT#62949). ############################################################################## The changes are now grouped by distribution. 2011-01-29 v1.99_05 pjacklam * Fix typos (reminder -> remainder etc.) (Peter John Acklam) * Fix Math::BigInt::Calc::_num returning NaN, not Inf, when it overflowed (Peter John Acklam) (Closes: RT #25274). * Fix Math::BigFloat->bcmp() so it can handle arbitrarily large exponents (Peter John Acklam) (Closes: RT #62764). * Fix bmodpow() in Math::BigInt 1.99 mis-calculating powers of one (Peter John Acklam) (Closes: RT #63237). * Fix bmodpow() and bmodinv() in Math::BigInt to handle negative input (Peter John Acklam) (Closes: RT #61543) * Clean up whitespace (Nicholas Clark). * Added file t/00-signature.t for testing SIGNATURE (Peter John Acklam). 2011-02-05 v1.991 pjacklam * Add workaround for library inconsistencies (Math::BigInt::Calc vs. Math::BigInt::GMP). This makes older versions of Math::BigInt::GMP work with latest version of Math::BigInt (Peter John Acklam). * Correct and extend API documentation (Peter John Acklam). 2011-02-18 v1.992 pjacklam * Math::BigInt::Calc->_nok(): Use symmetry property nok(n,k) = nok(n,n-k) to speed up execution when k is large. Also general code cleanup. (Peter John Acklam). * Math::BigInt::Calc->_gcd(): Speed up by reducing amount of data copying (Peter John Acklam). * Add '01load.t' for basic module loading and diagnostics useful for debugging. Rename '00-signature.t' to '00sig.t', 'pod.t' to '02pod.t', and 'pod_cov.t' to '03podcov.t' (Peter John Acklam). * Math::BigInt:: Make from_hex(), from_oct(), and behave more like hex() and oct() in the Perl core, and make from_bin() consistent with from_hex() and from_oct() (this is related to RT #58954) (Peter John Acklam). * Math::BigInt::Calc->_rem(): Modify first input arg always, not just sometimes (Peter John Acklam). * Math::BigInt::Calc->_modinv(): be more consistent with the _modinv() method in other libraries (Math::BigInt::GMP, etc.) (Peter John Acklam) * Math::BigInt::Calc->_nok(): use symmetry property nok(n,k) = nok(n,n-k). This cuts computation time tremendously when n and k are large (Peter John Acklam). * Math::BigInt::Calc->_gcd(): quickly handle zero cases, avoid code duplication, and always modify the first input argument in-place (Peter John Acklam). * Clean up code and add more code comments (Peter John Acklam). * Fix typos (Peter John Acklam). 2011-02-26 v1.993 pjacklam * Change default backend library from Math::BigInt::FastCalc to Math::BigInt::Calc, which is included in the Math-BigInt distro. This avoids recursive distribution dependency (RT #65976) (Peter John Acklam). 2011-09-04 v1.997 pjacklam * Document actual behaviour of from_xxx() methods. [perl #85334] (Peter John Acklam) * Make bmuladd() able to handle third arg properly. [perl #85482] (Peter John Acklam) * Add sign function bsgn() as a complement to babs(). (Peter John Acklam) * Fix objectify()'s handling of "foreign objects". (RT #16221 and #52124) (Peter John Acklam) * Rewrap some verbatim pod in Math::BigInt. (Father Chrysostomos) * Correct links to sections. (Alexandr Ciornii) * Remove incorrect formatting inside verbatim paragraphs. (Alexandr Ciornii) * Upgrade bundled modules in "inc" to latest version. (Peter John Acklam) * Include "^MYMETA\.(yml|json)\z" in MANIFEST.SKIP. Whereas META.* are generated by the distribution author at packaging time, MYMETA.* are generated by the end user at configure time after any dynamic dependencies are known. (Peter John Acklam) 2014-04-03 v1.9993 pjacklam BUGS * Add reference to CPAN RT for the Math-BigInt distro. CHANGES * Add recent changes. examples/hailstone.pl * Remove this file as it doesn't seem to be working. lib/Math/BigFloat.pm * Correct spelling errors. * Reformat code to avoid long lines. * Improve POD formatting. * Add meta-documentation (CPAN ratings, CPAN testers matrix, etc.) * Add the bint() method. lib/Math/BigInt.pm * Correct spelling errors. * Reformat code to avoid long lines. * Improve POD formatting. * Add meta-documentation (CPAN ratings, CPAN testers matrix, etc.) * Add the bint() method. * Remove references to the obsolete Math::Big lib/Math/BigInt/Calc.pm * Correct spelling errors. * Added meta-documentation (CPAN ratings, CPAN testers matrix, etc.) lib/Math/BigInt/CalcEmu.pm * Correct spelling errors. * Improve POD formatting. * Add meta-documentation (CPAN ratings, CPAN testers matrix, etc.) * Remove references to Math::BigInt::BitVect, which is no longer on CPAN. Makefile.PL * Remove code that checks for compatible versions of distributions that depend on Math-BigInt. Such checking should be done in the distributions that depend on Math-BigInt, not in Math-BigInt itself. NEW * This file now only refers to the change log. t/bigfltpm.inc * Add tests for fint(). t/bigintpm.inc * Add tests for int(). t/upgrade.inc * Add tests for int(). t/*.t * Increment test counts as needed for the new tests in the t/*.inc files. inc/Module/Install* * Upgrade bundled Module::Install from version 1.01 to version 1.08. 2015-08-10 v1.9994 pjacklam CHANGES * Add recent changes. lib/Math/BigFloat.pm * Fix blog() which sometimes returns incorrect result. * bdiv() in list context now returns the integer quotient and the remainder. t/bigfltpm.inc * Modify tests for blog() in list context. t/biglog.t * Change incorrect use of ok() to is(). t/upgrade.inc * Modify tests for blog() in list context. inc/Module/Install* * Upgrade bundled Module::Install from version 1.08 to version 1.16. 2015-08-11 v1.9995 pjacklam CHANGES * Move changes that were incorrectly reported as being for the release 1.9994 when they were in fact for release 1.9993. * Add changes both for release 1.9994 and 1.9995. lib/Math/BigInt.pm * Break lines to avoid lines with more than 80 characters. * Improve objectify() for better handling of subclasses. 2015-08-12 v1.9996 pjacklam CHANGES * Add recent changes. * Use present tense in change descriptions. lib/Math/BigInt.pm * Change incorrect use of ok() to is() in example. 2015-08-12 v1.9997 pjacklam CHANGES * Add recent changes. t/bigintpm.inc * Correct spelling errors. t/upgrade.inc * Correct spelling errors. 2015-09-11 v1.999701 pjacklam * The POD documentation, as well as the comments in the code, said that $x->bdiv($y) in list context should return quotient $q and remainder $r so that $x = $q * $y + $r, and that the remainder (modulo) $r should correspond to Perl's % operator as well as the bmod() method. This has not been the actual behaviour. This is now fixed. * Clearer POD documentation for the bdiv() and bmod() methods. * All non-integer input values to Math::BigInt gave a NaN, except non-zero numbers in the range (-1,1) that were written without an exponent, e.g., "-0.75" and "0.5". Now also these return a NaN. * Input values with a large (absolute value) negative exponent, e.g., 1e-9999999, now return NaN. The former behaviour was to die with the message "Quantifier in {,} bigger than 32766 in regex; marked by ..." * Intermediate computations in blog() increased the number of digits significantly in some cases. Now reduce the number of digits by rounding. However, keep some extra digits for remaining intermediate computations before the final rounding. * When $x is a Math::BigFloat, $x -> bceil() and $x -> bint() for -1 < $x < 0 returned -0. Negative zero is never used by Math::Big(Int|Float), and care has been taken to avoid it, so this bug is surely an oversight. * Explicitly specify the backend (lib => 'Calc') in t/mbimbf.t for easier release management of the backend distributions. * Add "use warnings" to test scripts, since Perl 5.6.2 is required anyway, and "use warnings" was introduced in Perl 5.6.1. * Modified test scripts so the difference between the test files in the Math-BigInt distribution and the backend distributions are as few and as small as possible. This makes for easier release management. 2015-09-17 v1.999702 pjacklam * The overloaded log() is a unary operator, so don't pass additional arguments. * Fix blog() so the cases $x->blog() and $x->blog(undef) work correctly. An undefined base means that blog() should use base e (Euler's number). * Both CORE::log() and other mathematical software returns inf for log(inf), so we do the same. * Add tests for log() as well as templates for future tests of the other overloadable functions. * Improve descriptions of a few tests. 2015-09-21 v1.999703 pjacklam * Fix blog() in Math::BigInt and Math::BigFloat to work correctly regardless of the base. * Correct existing tests in bigintpm.inc and bigfltpm.inc. * Update test plans (number of tests) in t/bare_mbi.t, t/bigintpm.t, and t/sub_mbi.t. * Add test files t/blog-mbf.t and t/blog-mbi.t for better testing of the blog() methods. 2015-09-25 v1.999704 pjacklam * objectify() in lib/Math/BigInt.pm now uses 'isa' not 'eq' to check object relationship. This is necessary for correct handling of subclasses. * objectify() in lib/Math/BigInt.pm no longer expects as_int(), as_number() and as_float() to return objects, but allows them to return numbers formatted as strings. This is used by some other modules on CPAN. * Better documentation of as_int() and as_number() in lib/Math/BigInt.pm. * Add documentation for as_float() in lib/Math/BigFloat.pm * Add test files t/objectify_mbf.t and t/objectify_mbi.t. 2015-10-26 v1.999705 pjacklam * Avoid using "my" in a false conditional. See "Deprecated use of my() in false conditional" in perldiag(1). * Faster algorithm for bpi() when accuracy is >= 1000. 2015-10-28 v1.999706 pjacklam * Correct release date of v1.999705 in CHANGES. * Add code and tests for numify() on non-finite objects. 2015-10-29 v1.999707 pjacklam * Add dependency on Math::Complex 1.39 for Math::Complex::Inf(), which is used for numifying infinity. * Update author information. * Update information in the file README. * Remove the files INSTALL and LICENSE as this information is already covered in the file README. * Enable 'use warnings' in all modules. We require a Perl newer than 5.6.0 anyway. * Replace 'use vars ...' with 'our ...'. We require a Perl newer than 5.6.0 anyway. * Avoid indirect object syntax in documentation. * Moved 'Test::More' from 'build_requires' to 'test_requires' in Makefile.PL. 2015-11-03 v1.999708 pjacklam * Use bxxx() method names consistently, rather than mixing bxxx() and fxxx() in code and test files. The fxxx() methods for Math::BigFloat objects are still available through autoloading. However, we leave the fround() method in Math::BigInt, as it seems to provide some kind of compatibility with Math::BigFloat. * Correct author information in the README file. * Remove INSTALL file, which by accident wasn't removed in v1.999707. * Use present tense, not past tense, in CHANGES file. * Add '#!perl' to Makefile.PL for correct syntax highlighting in editors supporting this. * Use Math::Complex::Inf() in testfiles also (for generating Perl scalar infinity) since it is more portable. 2015-11-06 v1.999709 pjacklam * Represent and return zero as 0E0, not 0E1. The old POD said "A zero is represented and returned as 0E1, not 0E0 (after Knuth)." I find no references to Knuth ever having said this. The closest reference I can find is that Knuth says 0**0 should be defined to be 1, not 0, but that is something else than 0e0, which is 0*10**0. I have yet to see any other mathematical software that represents and returns zero as 0e1 rather than 0e0. * Required version of Test::More is 0.9301. 2015-11-12 v1.999710 pjacklam * New method Math::BigFloat -> from_hex() which supports hexadecimal floating point numbers, e.g., "0x1.999ap-4". * New test file t/from_hex-mbf.t for testing Math::BigFloat -> from_hex(). * Add 'from_hex' and 'from_bin' to list of methods in the Math::BigInt POD. 2012-12-10 v1.9997_11 pjacklam This release introduces no changes in the library code, i.e., the .pm files in the 'lib' directory, but there are a lot of changes in the test files. Since there are so many changes, I let this be a development release. * Add 'use strict;' and 'use warnings;' to all test files. * Reformat code in the test files according to the "perlstyle" manual page. This makes the code a lot easier to read -- for me, anyway. * Decrement required version of Perl from v5.6.2 to v5.6.1. All tests pass when running the test suite with Perl 5.6.1 on Cygwin. * Replace "use vars ..." with "our ..." in test files. * Replace "BEGIN { unshift @INC, 't'; }" with "use lib 't';" in test files. * Use "our $x; $x = ...;" rather than "our $x = ...;" since the latter causes Perl 5.6.1 to complain about variables only used once. * Add comment to all tests. Now the tests no longer says just "ok 123", but rather "ok 123 - $x->blog(2)" etc. This makes it easier to identify failed tests, especially in the smoke testing reports. * Fix various flawed tests, e.g., ok($x, 2) was used testing whether $x was 2. * Use the skip() feature of Test::More for skipping tests. * Use more descriptive variable names in test files. * Remove unused variables in test files. * Move variable declarations to limit their scope in test files. * Remove trailing whitespace in test files. * Wrap (most) lines to fit 80 columns in test files. 2015-12-29 v1.999712 pjacklam * Fix bug in internal function _e_add() and _e_sub() which causes it to return "-0" in some cases. * Let new() be used for assignment. Now $x->new(3) assigns 3 to $x. * Improve code in new() for non-zero scalar integers with no exponent. * Allow both "inf" and "infinity". Allow a leading sign, and ignore letter case. This is to be consistent with core Perl. * Be more consistent about allowed whitespace in input. E.g., "23 " gave 23, but "inf " gave a NaN. * Core Perl allows both "0x" and "0X" as hexadecimal prefix, and both "0b" and "0B" as binary prefix, so we do too. Previously, only 0x and 0b were allowed. * Math::BigFloat now has its own from_bin() method which supports binary floating point numbers, e.g., "0b1.1001p-4". This complements from_hex(). * Math::BigFloat now has its own from_oct() method which supports octal floating point numbers, e.g., "1.3267p-4". This complements from_hex(). * The Math::BigInt and Math::BigFloat methods from_hex(), from_oct(), and from_bin() can now be used as instance methods to assign values to the invocand, e.g, $x->from_oct("10") assigns 8 to $x. * Update documentation. Perl now uses "Inf", not "inf" to represent infinity. * When the new() method is called with an undefined argument, the round parameters are now passed on to bzero(). This applies to both Math::BigInt and Math::BigFloat. * Replace "UNIVERSAL::isa($this, $that)" with "$this->isa($that)", and ditto for "can()", where possible. Not every instance of "UNIVERSAL::Isa()" has been replaced, though, since the change causes some tests to fail. This must be looked into. * Simplify the copy() methods. Always copy accuracy and precision parameters, even when they are undefined. * Reformat more of the code in accordancw with the "perlstyle" manual page. This makes the code a lot easier to read -- for me, anyway. * Use a more generic regex in t/calling.t, since the exact wording of the error message depends not on the Perl version, but on the module that does the version checking. * Avoid infinite loop in the Math::BigFloat->batan() method. Thanks to DANAJ (Dana Jacobsen) for the patch. This was not intended to be added before the next release, but was included in this release by accident. 2015-12-31 v1.999713 pjacklam * Fix Math::BigInt->new(), which had a faulty handling in the shortcut for non-zero scalar integers with no non-zero exponent, like "12", "12.000", "12e3", and "12.000e4". Added tests for this in t/bigintpm.inc. 2016-01-03 v1.999714 pjacklam * Add code to speed up Math::BigFloat->batan(). Thanks to DANAJ (Dana Jacobsen) for the patch. * Re-write Math::BigFloat->batan2() completely, except for the parts related to the rounding. The old version was sometimes correct, sometimes off by pi, and sometimes very inaccurate. Also add more tests. * Make it clearer in Math::BigFloat->bpi() when it is called as a method vs. as a function. * The Math::BigFloat->bpi() method can now be used as an instance method to assign pi to $x, as in $x->bpi(). * Add tests for as_oct(). * Minor simplifications in Math::BigInt->as_oct() as Math::BigInt::Calc::_as_oct(). 2016-01-05 v1.999715 pjacklam * Fix Math::BigFloat->bexp() based on patch by DANAJ (Dana Jacobsen). * Add Math::BigFloat->bexp() tests to "t/biglog.t" and new file "t/author-bexp-mbf.t". * Fix flawed test in test_bpow. It used ok($x, $y) rather than is($x, $y). * Add better descriptions (test names) to a few tests. * Wrap long line in the CHANGES file. Please send us test-reports, your experiences with this and your ideas - we love to hear about our work! The Math-BigInt developers Math-BigInt-1.999715/CREDITS0000644403072340010010000000343612626121056015262 0ustar ospjaDomain UsersI wish to thank the following people: * Mark A. Biggar and Ilya for the original versions. * Steffen Beyer for the discussions and ideas, and for Bit::Vector. * Bruce Fields for spotting bugs. * Mark Dickinson for spotting bugs. * HH for listening to my boring explanations. * Peter Prymmer for spotting the OS/390 problems with / 1e5 * Tom Phoenix for the discussions about factoring/primes/speed. * John Peacock for pushing me to finish Math::BigInt::Calc. * Benjamin Trott for the _split optimization and finding the bug in badd() * Daniel Pfeiffer for v0.49 * Compaq for their TestDrive accounts and the admins managing them - this makes testing on a large variety of platforms possible. Thanx! * Sisyphus for the discussions and ideas * Jarkko for the inf/NaN help and for beeing generally helpful and witty * Creager, Robert S for pointing me towards the precision/accuracy bug and for general asking questions and providing feedback * Feztaa for the report that let to the discovery of the _rsft() bug in v1.61 He also deserves the mention as the first known user of bignum :) * Tim Rushing for reporting the bsqrt() hang and giving me the chance to improve BigInt/BigFloat. * cpan@ali.as for reporting the floor() bug with 0.1412024 and providing a fix and testcase - thanx! * Stephen Ross for finding the -2 ** Y with odd Y bug Special thanx must go to John Peacock and Tom Roche, both have helped me a lot in developing the latest version, not only by cheerfully kicking my lazy butt from time to time, but also by providing advice, bug-reports, suggestions and nagging questions, as well as bearing with my countless ranting emails. So, thank you very much! Also I want to thank all the ever-busy people on p5p. You guys (and gals) rock! List still not complete ;o) Tels Math-BigInt-1.999715/examples/0000755403072340010010000000000012642757312016062 5ustar ospjaDomain UsersMath-BigInt-1.999715/examples/1000.txt0000644403072340010010000001631512626121056017201 0ustar ospjaDomain Users# The First 1,000 Primes # (the 1,000th is 7919) # For more information on primes see http://www.utm.edu/research/primes 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 3527 3529 3533 3539 3541 3547 3557 3559 3571 3581 3583 3593 3607 3613 3617 3623 3631 3637 3643 3659 3671 3673 3677 3691 3697 3701 3709 3719 3727 3733 3739 3761 3767 3769 3779 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 3877 3881 3889 3907 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 4003 4007 4013 4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 4127 4129 4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 4243 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363 4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493 4507 4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621 4637 4639 4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729 4733 4751 4759 4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871 4877 4889 4903 4909 4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 4987 4993 4999 5003 5009 5011 5021 5023 5039 5051 5059 5077 5081 5087 5099 5101 5107 5113 5119 5147 5153 5167 5171 5179 5189 5197 5209 5227 5231 5233 5237 5261 5273 5279 5281 5297 5303 5309 5323 5333 5347 5351 5381 5387 5393 5399 5407 5413 5417 5419 5431 5437 5441 5443 5449 5471 5477 5479 5483 5501 5503 5507 5519 5521 5527 5531 5557 5563 5569 5573 5581 5591 5623 5639 5641 5647 5651 5653 5657 5659 5669 5683 5689 5693 5701 5711 5717 5737 5741 5743 5749 5779 5783 5791 5801 5807 5813 5821 5827 5839 5843 5849 5851 5857 5861 5867 5869 5879 5881 5897 5903 5923 5927 5939 5953 5981 5987 6007 6011 6029 6037 6043 6047 6053 6067 6073 6079 6089 6091 6101 6113 6121 6131 6133 6143 6151 6163 6173 6197 6199 6203 6211 6217 6221 6229 6247 6257 6263 6269 6271 6277 6287 6299 6301 6311 6317 6323 6329 6337 6343 6353 6359 6361 6367 6373 6379 6389 6397 6421 6427 6449 6451 6469 6473 6481 6491 6521 6529 6547 6551 6553 6563 6569 6571 6577 6581 6599 6607 6619 6637 6653 6659 6661 6673 6679 6689 6691 6701 6703 6709 6719 6733 6737 6761 6763 6779 6781 6791 6793 6803 6823 6827 6829 6833 6841 6857 6863 6869 6871 6883 6899 6907 6911 6917 6947 6949 6959 6961 6967 6971 6977 6983 6991 6997 7001 7013 7019 7027 7039 7043 7057 7069 7079 7103 7109 7121 7127 7129 7151 7159 7177 7187 7193 7207 7211 7213 7219 7229 7237 7243 7247 7253 7283 7297 7307 7309 7321 7331 7333 7349 7351 7369 7393 7411 7417 7433 7451 7457 7459 7477 7481 7487 7489 7499 7507 7517 7523 7529 7537 7541 7547 7549 7559 7561 7573 7577 7583 7589 7591 7603 7607 7621 7639 7643 7649 7669 7673 7681 7687 7691 7699 7703 7717 7723 7727 7741 7753 7757 7759 7789 7793 7817 7823 7829 7841 7853 7867 7873 7877 7879 7883 7901 7907 7919 Math-BigInt-1.999715/examples/bigprimes.pl0000644403072340010010000001013612622371717020400 0ustar ospjaDomain Users#!/usr/bin/perl -w use Test; BEGIN { plan tests => 17; } use lib '../lib'; # comment out to use old module #use lib '../../old/Math-BigInt-0.01/lib'; # for old version use strict; #use Math::BigInt; use Math::BigInt qw/:constant/; #use Math::BigInt qw/calc BitVect :constant/; print "# Using Math::BigInt v",$Math::BigInt::VERSION,"\n"; # calculate some sample prime numbers from # http://www.utm.edu/research/primes/largest.html # also: http://www-stud.enst.fr/~bellard/mersenne.html # (c takes 1 minute on 800 Mhz, so Perl will take..ages..) my ($x,$y,$z); my $two = Math::BigInt->new(2); # some new() are to make stop Perl from calculating things like 1234 ** 4321 # at compile time. (we want to see run-time behaviour) # Also there is len(), since the old BigInt has not got length() and we want # this script to be comparable between old and new version. ############################################################################## # Todo: these do not complete in reasonable time: # $x = $two ** 6972593; $x--; #ok (len($x),'2098960'); # $x = $two ** 3021377; $x--; #ok (len($x),'909526'); # $x = $two ** 756839; $x--; #ok (len($x),'227832'); # $x = 1041870 ** 32768; $x++; #ok (len($x),'197192'); ############################################################################## # but these do: # some twin primes (first in list at 03/2001) $x = ($two ** 80025) * 665551035; $x++; $y = $x-2; ok (len($x),'24099'); $x = ($two ** 66443) * 1693965; $x++; $y = $x-2; ok (len($x),'20008'); $x = ($two ** 64955) * 83475759; $x++; $y = $x-2; ok (len($x),'19562'); # ... $x = ($two ** 38880) * 242206083; $x++; $y = $x-2; ok (len($x),'11713'); ############################################################################## # Sophie Germain primes # todo: does not finish after 30 m on 800 Mhz # $x = Math::BigInt->new(72021)**223630; $x--; ok (len($x),'7119'); ############################################################################## # some quadruplet primes... # 3510160221387831655*(2^3363-2^1121)-6*2^1121-7 $x = '3510160221387831655' * (2 ** 3363 - 2**1121) - 6*(2**1121); my @q = ( $x-7,$x-5,$x-1,$x+1); ok (len($q[0]),'1031'); ok (len($q[1]),'1031'); ok (len($q[2]),'1031'); ok (len($q[3]),'1031'); ############################################################################## # some real weird primes: # (2^3833-1)/(14193959303*340789152474053904109001) $x = Math::BigInt->new('340789152474053904109001'); $x *= '14193959303'; $x = (2**3833-1) / $x; ok (len($x),'1121'); #(2^4751-1)/(268982617*3274778783*629530076753*81630665742097*1507074535068001) $x = Math::BigInt->new('268982617'); $x = $x * '3274778783' * '629530076753' * '81630665742097' * '1507074535068001'; $x = ((2**4751)-1) / $x; ok (len($x),'1372'); # 2^7039-1)/ (1252943*1057032553*8541573097*218216841131937276721 $x = Math::BigInt->new('1252943')*'1057032553'*'8541573097'; $x *= '218216841131937276721'; $x = ((2**7039)-1) / $x; ok (len($x),'2074'); # 5616^1153-1)/5615 $x = Math::BigInt->new(5616) ** 1153; $x--; $x /= 5616; ok (len($x),'4320'); # (7147^2161-1)/7146 $x = Math::BigInt->new(7147) ** 2161; $x--; $x /= 7146; ok (len($x),'8325'); # 16*R(5700)*(150093*10^8000+1)+1 # most ending 7's # gives error in BigInt $x = 16 * R(5700); $x *= (150093*(Math::BigInt->new(10)**8000))+1; $x++; ok (len($x),'13706'); # 2*11^13359+1 $x = 2*(Math::BigInt->new(11)**13359)+1; ok(len($x),'13913'); # 10^14800+5*(10^8880+10^5920)+7*10^7400+1 # palindrome $x = Math::BigInt->new(10) ** 14800; $x += 5*((Math::BigInt->new(10) ** 8800) + (Math::BigInt->new(10)**5920)); $x += 7*(Math::BigInt->new(10) ** 7400); ok(len($x),'14801'); $y = "$x"; $y =~ s/^\+//; my $left = substr("$y",7400); my $right = substr("$y",-7401); ok($left,$right); # EOF ############################################################################## # some helper functions sub R { my $x = shift; # These numbers have a decimal expansion of n '1's, # and are usually called "repunits". return ((Math::BigInt->new(10) ** $x) - 1)/9; } sub len { # old bigint has not got length, so use "" and strip it's sign my $x = shift; $x = "$x"; $x =~ s/^\+//; return length($x); } Math-BigInt-1.999715/examples/prime.pl0000644403072340010010000000361612626121056017531 0ustar ospjaDomain Users#!/usr/bin/perl -w BEGIN { unshift @INC, '../lib'; } # uncomment to use old, org version $| = 1; use Math::BigInt; # this is a complicated version of the prime number sieve. # It is not optimized (since we want to benchmark as many features as # possible). $amount = Math::BigInt->new( shift || 1000000 ); @primes = (1,1,0); # any not defined number is prime, 0,1 are not, but 2 is my $prime = Math::BigInt->new (3); # start # the loop below is faster in the old version than in the new, since it is # the worst case for new lib: small numbers and lot's of bstr()/new(). # It also slows down the benchmark too much so we use slightly faster int here $r = 0; my $a = $amount->numify(); for ($i = 3; $i < $a; $i++) # int version { $primes[$i] = $r; $r = 1-$r; } # find primes OUTER: while ($prime < $amount) { # find first unmarked, it is the next prime $cur = $prime; while ($primes[$cur]) { $cur += 2; last OUTER if $cur >= $amount; # no more to do } # $cur is now new prime $str = "$cur"; $str =~ s/\+//; # unify output for comapre #print "$str $prime $amount\n"; # now strike out all multiples of $cur $add = $cur*2; $prime = $cur + 2; # next round start two higher $cur += $add; while ($cur < $amount) { $primes[$cur] = 1; $cur += $add; } } $i = 0; foreach (@primes) { push @real_primes, $i if $primes[$i] == 0; $i++; } # uncomment to print em: # foreach (@real_primes) { print "$_\n"; } print "last prime: $real_primes[-1]\n"; # check against text open FILE, '1000.txt' or die "Can't read 1000.txt: $!"; my @test; while () { next if /^#/; next if /^\s*$/; $_ =~ s/\s+/ /g; $_ =~ s/^\s+//; $_ =~ s/\s+$//; push @test, split /\s+/,$_; } close FILE; my $i = 0; foreach (@real_primes) { print "oups: $i: $test[$i] != $real_primes[$i]\n" if $test[$i] != $real_primes[$i]; $i++; last if $i >= 1000; } print "done\n"; Math-BigInt-1.999715/GOALS0000644403072340010010000000246512626121056015033 0ustar ospjaDomain UsersThis file contains a short description of what the goals of this project are, building guidelines etc. This was born after discussions with John Peacock, who provided helpfull feedback. * KISS - Keep It Simple, Stupid! * Favour correctness over speed * Make your code maintable, so avoid Copy&Paste, unclear constructs, read-only code and special hacks whenever possible * Optimize more for the average case than the worst, while trying to avoid performance hits for the worst case. The average case is more for longer numbers than short, based on the assumption that if you wanted to add 1 and 2 _fast_ together, you wouldn't use BigInt nor Perl, now would you? ;) (Or in other words: Time saved in one case of a large number may be multitudes of what you can waste on a small number) * Make subclassing as easy and painless as possible. This means clean inheritance and overload section, no C&P code etc. * Keep the interface as consistent and easy as possible. Secondary goals: * Make mixing of classes work, like in: $x = Math::BigFloat->new(10); $y = Math::BigInt->new(2); $z = $x / $y; # $z = Math::BigFloat = 5 * Make auto-upgrading/downgrading work See also BUGS. Please send me test-reports, your experiences with this and your ideas - I love to hear about my work! Tels Math-BigInt-1.999715/HISTORY0000644403072340010010000001136612626121056015327 0ustar ospjaDomain UsersThis file contains all the changes and bugfixes from the original version of BigInt/BigFloat to the rewritten one. For what has changed in the latest version see NEW and for a complete list of changes see the file CHANGES. v1.82: general: + It is subsequent faster than the original in many places + Use more than 16 bit at a time, greater BASELEN for 64 bit systems + overload for things like += + special operations like binc() + many optimizations and shortcuts in normal operations + Can use Math::BigInt lib => 'name'; for Pari, GMP, Bit::Vector or others + regression test suite greatly enhanced to cover more problematic cases + added example scripts (prime.pl, bigprimes.pl, hailstone.pl) + documentation fixed and greatly enhanced + BigInt is sub-classable with very little effort, see M::S or M::BF + subclasses of Math::BigInt know all the same methods, so that you can call $x->some_method() without having to know which type of class $x is + added infinity handling + much better NaN handling caveats: + bstr() and stringify now drop the leading '+' (to make overloaded cmp work as expected when cmp'aring to scalars and other objects (read: bugfix) + due to the dropping of '+' the string sort order has changed. It is now compatible to the way perl sorts it's strings. + spaces are no longer allowed in a number (but may precede or follow it) !! You can always make a subclass and change all these things quite easily !! input: + underscores are now valid between any two digits (in hex/binary input, too) + integers of the form 1E2, 1.23E2, 2.00 etc now valid for BigInt.pm, too + hexadecimal numbers of the form 0xabcdefABCDEF0123456789 + binary numbers of the form 0b01010101101000001000100101 + octal numbers can be input via from_oct() output: + as_hex(), as_bin() and as_oct() for easier conversation between bases bugs and buglets fixed over Mark's original: + 0**0 gave NaN instead of 1 + -1**y gave -1 instead of +1 for even y + fsqrt() gave slightly wrong results (like for fsqrt(9)) + +x/0 is now +inf, -x/0 is -inf (both were NaN), as well as other inf cases + mod/div for negative numbers were incompatible to Perl's way + added P. Prymmer's OS/390 '/1e5 vs *1e-5' patch w/o the performance snag + incorporated all the patches to the core modules by John Peacock + BigFloat::bxxx() works as well as BigFloat::fxxx() + Math::BigInt->new(10) / Math::BigFloat->new(2) returned NaN (ditto for other subclasses of Math::BigInt) + $a = new Math::BigInt; creates now a +0, while "" still gives a NaN This suppresses all warnings on undef arguments. Wether this is better... + import() would always use "Math::BigInt" and clash with Exporter + use Math::BigInt qw(bneg); $a = bneg('1234'); etc did not work at all + $x->xxx() now modifies $x in all cases of modifiers and actually returns the same $x (e.g. not a plain scalar or a different reference). All testing routines leave $x alone. bpow(), bmod(), fround(), ffround() etc were broken in this regard. accuracy and precision: + there is now support for both accuracy (significant digits) and precision (fixed number of digits after decimal point), which by default is off + objects/numbers now can have a local accuracy/precision internal fixes: + uses a blessed hash ref instead scalar ref (easier subclassable) + my instead of local + use strict and -w + s/$[/0/ (after all, $[ = 1; in main does not effect this package) + $# partially removed ($#y is scalar @y -1, $#$y is scalar @$y-1 - ugh!) + added LICENSE section and file new stuff: + MBF: :constant works now + MBI: :constant picks up binary and hexadecimal constants + brsft()/blsft() also can do other bases than 2 + bacmp (acmp), because needed for more efficient add() + bzero(), bnan(), bone(), binf() + binc(), bdec(), bfac() + is_zero(), is_nan(), is_one(), is_odd(), is_even(), is_inf(), is_int() + digit(), length(), copy() + as_number() (alias: as_int()), as_hex(), as_bin() + is_positive(), is_negative() (alias: is_pos() and is_neg()) + mantissa(), exponent(), parts(), sign() + bgcd() accepts now lists, blcm() (also accepts lists) + flog()/blog() for overloading of log() + fexp()/bexp() for overloading of exp() + round(accuracy,precision,mode) round to accuracy/precision using mode + MBF: fpow(), fmod(), fdiv() in list context (Thanx J. Peacock) + fpow() can now handle non-integer arguments, like in fpow(2.1 ** 0.2) + MBI: bsqrt() + bmodpow(), bmodinv() (Thanx John Borwick) + bfloor(), bceil(), broot() + CORE cos()/sin()/exp()/atan2() now work when passed BigInts or BigFloats Please send me test-reports, your experiences with this and your ideas - I love to hear about my work! Tels Math-BigInt-1.999715/inc/0000755403072340010010000000000012642757311015014 5ustar ospjaDomain UsersMath-BigInt-1.999715/inc/Module/0000755403072340010010000000000012642757311016241 5ustar ospjaDomain UsersMath-BigInt-1.999715/inc/Module/Install/0000755403072340010010000000000012642757312017650 5ustar ospjaDomain UsersMath-BigInt-1.999715/inc/Module/Install/Base.pm0000644403072340010010000000214712642757310021062 0ustar ospjaDomain Users#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.16'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Math-BigInt-1.999715/inc/Module/Install/Can.pm0000644403072340010010000000615712642757310020716 0ustar ospjaDomain Users#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Math-BigInt-1.999715/inc/Module/Install/Fetch.pm0000644403072340010010000000462712642757310021246 0ustar ospjaDomain Users#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Math-BigInt-1.999715/inc/Module/Install/Makefile.pm0000644403072340010010000002743712642757310021736 0ustar ospjaDomain Users#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-separated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Math-BigInt-1.999715/inc/Module/Install/Metadata.pm0000644403072340010010000004330212642757310021726 0ustar ospjaDomain Users#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) [\s|;]* /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashes delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Math-BigInt-1.999715/inc/Module/Install/Win32.pm0000644403072340010010000000340312642757310021106 0ustar ospjaDomain Users#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Math-BigInt-1.999715/inc/Module/Install/WriteAll.pm0000644403072340010010000000237612642757310021737 0ustar ospjaDomain Users#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.16'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Math-BigInt-1.999715/inc/Module/Install.pm0000644403072340010010000003021712642757307020215 0ustar ospjaDomain Users#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.006; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.16'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::getcwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::getcwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split /\n/, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; binmode FH; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; binmode FH; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; binmode FH; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; binmode FH; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Math-BigInt-1.999715/lib/0000755403072340010010000000000012642757311015011 5ustar ospjaDomain UsersMath-BigInt-1.999715/lib/Math/0000755403072340010010000000000012642757312015703 5ustar ospjaDomain UsersMath-BigInt-1.999715/lib/Math/BigFloat.pm0000644403072340010010000046140712642755043017743 0ustar ospjaDomain Userspackage Math::BigFloat; # # Mike grinned. 'Two down, infinity to go' - Mike Nostrus in 'Before and After' # # The following hash values are internally used: # _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 use 5.006001; use strict; use warnings; our $VERSION = '1.999715'; $VERSION = eval $VERSION; require Exporter; our @ISA = qw/Math::BigInt/; our @EXPORT_OK = qw/bpi/; # $_trap_inf/$_trap_nan are internal and should never be accessed from outside our ($AUTOLOAD, $accuracy, $precision, $div_scale, $round_mode, $rnd_mode, $upgrade, $downgrade, $_trap_nan, $_trap_inf); my $class = "Math::BigFloat"; use overload '<=>' => sub { my $rc = $_[2] ? ref($_[0])->bcmp($_[1], $_[0]) : ref($_[0])->bcmp($_[0], $_[1]); $rc = 1 unless defined $rc; $rc <=> 0; }, # we need '>=' to get things like "1 >= NaN" right: '>=' => sub { my $rc = $_[2] ? ref($_[0])->bcmp($_[1],$_[0]) : ref($_[0])->bcmp($_[0],$_[1]); # if there was a NaN involved, return false return '' unless defined $rc; $rc >= 0; }, 'int' => sub { $_[0]->as_number() }, # 'trunc' to bigint ; ############################################################################## # global constants, flags and assorted stuff # the following are public, but their usage is not recommended. Use the # accessor methods instead. # class constants, use Class->constant_name() to access # one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common' $round_mode = 'even'; $accuracy = undef; $precision = undef; $div_scale = 40; $upgrade = undef; $downgrade = undef; # 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 infinity $_trap_inf = 0; # constant for easier life my $nan = 'NaN'; my $IMPORT = 0; # was import() called yet? used to make require work # some digits of accuracy for blog(undef,10); which we use in blog() for speed my $LOG_10 = '2.3025850929940456840179914546843642076011014886287729760333279009675726097'; my $LOG_10_A = length($LOG_10)-1; # ditto for log(2) my $LOG_2 = '0.6931471805599453094172321214581765680755001343602552541206800094933936220'; my $LOG_2_A = length($LOG_2)-1; my $HALF = '0.5'; # made into an object if nec. ############################################################################## # the old code had $rnd_mode, so we need to support it, too sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; } sub FETCH { return $round_mode; } sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); } BEGIN { # when someone sets $rnd_mode, we catch this and check the value to see # whether it is valid or not. $rnd_mode = 'even'; tie $rnd_mode, 'Math::BigFloat'; # we need both of them in this package: *as_int = \&as_number; } ############################################################################## { # valid method aliases for AUTOLOAD my %methods = map { $_ => 1 } qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm fint facmp fcmp fzero fnan finf finc fdec ffac fneg fceil ffloor frsft flsft fone flog froot fexp /; # valid methods that can be handed up (for AUTOLOAD) my %hand_ups = map { $_ => 1 } qw / is_nan is_inf is_negative is_positive is_pos is_neg accuracy precision div_scale round_mode fabs fnot objectify upgrade downgrade bone binf bnan bzero bsub /; sub _method_alias { exists $methods{$_[0]||''}; } sub _method_hand_up { exists $hand_ups{$_[0]||''}; } } ############################################################################## # constructors sub new { # Create a new BigFloat object from a string or another bigfloat object. # _e: exponent # _m: mantissa # sign => sign ("+", "-", "+inf", "-inf", or "NaN" my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; my ($wanted, @r) = @_; # avoid numify-calls by not using || on $wanted! unless (defined $wanted) { require Carp; Carp::carp("Use of uninitialized value in new"); return $self->bzero(@r); } # Using $wanted->isa("Math::BigFloat") here causes a 'Deep recursion on # subroutine "Math::BigFloat::as_number"' in some tests. Fixme! if (UNIVERSAL::isa($wanted, 'Math::BigFloat')) { my $copy = $wanted -> copy(); if ($selfref) { # if new() called as instance method %$self = %$copy; } else { # if new() called as class method $self = $copy; } return $copy; } $class->import() if $IMPORT == 0; # make require work # If called as a class method, initialize a new object. $self = bless {}, $class unless $selfref; # shortcut for bigints and its subclasses if ((ref($wanted)) && $wanted -> can("as_number")) { $self->{_m} = $wanted->as_number()->{value}; # get us a bigint copy $self->{_e} = $MBI->_zero(); $self->{_es} = '+'; $self->{sign} = $wanted->sign(); return $self->bnorm(); } # else: got a string or something masquerading as number (with overload) # Handle Infs. if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { return $downgrade->new($wanted) if $downgrade; my $sgn = $1 || '+'; $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() return $self->binf($sgn); } # Shortcut for simple forms like '12' that have no trailing zeros. if ($wanted =~ /^([+-]?)0*([1-9][0-9]*[1-9])$/) { $self->{_e} = $MBI->_zero(); $self->{_es} = '+'; $self->{sign} = $1 || '+'; $self->{_m} = $MBI->_new($2); return $self->round(@r) if !$downgrade; } my ($mis,$miv,$mfv,$es,$ev) = Math::BigInt::_split($wanted); if (!ref $mis) { if ($_trap_nan) { require Carp; Carp::croak ("$wanted is not a number initialized to $class"); } return $downgrade->bnan() if $downgrade; $self->{_e} = $MBI->_zero(); $self->{_es} = '+'; $self->{_m} = $MBI->_zero(); $self->{sign} = $nan; } else { # 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 if (CORE::length($$mfv) != 0) { my $len = $MBI->_new( CORE::length($$mfv)); ($self->{_e}, $self->{_es}) = _e_sub ($self->{_e}, $len, $self->{_es}, '+'); } # we can only have trailing zeros on the mantissa if $$mfv eq '' else { # Use a regexp to count the trailing zeros in $$miv instead of _zeros() # because that is faster, especially when _m is not stored in base 10. my $zeros = 0; $zeros = CORE::length($1) if $$miv =~ /[1-9](0*)$/; if ($zeros != 0) { my $z = $MBI->_new($zeros); # turn '120e2' into '12e3' $MBI->_rsft ( $self->{_m}, $z, 10); ($self->{_e}, $self->{_es}) = _e_add ( $self->{_e}, $z, $self->{_es}, '+'); } } $self->{sign} = $$mis; # for something like 0Ey, set y to 0, and -0 => +0 # Check $$miv for being '0' and $$mfv eq '', because otherwise _m could not # have become 0. That's faster than to call $MBI->_is_zero(). $self->{sign} = '+', $self->{_e} = $MBI->_zero() if $$miv eq '0' and $$mfv eq ''; return $self->round(@r) if !$downgrade; } # if downgrade, inf, NaN or integers go down if ($downgrade && $self->{_es} eq '+') { if ($MBI->_is_zero( $self->{_e} )) { return $downgrade->new($$mis . $MBI->_str( $self->{_m} )); } return $downgrade->new($self->bsstr()); } $self->bnorm()->round(@r); # first normalize, then round } sub copy { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; # If called as a class method, the object to copy is the next argument. $self = shift() unless $selfref; my $copy = bless {}, $class; $copy->{sign} = $self->{sign}; $copy->{_es} = $self->{_es}; $copy->{_m} = $MBI->_copy($self->{_m}); $copy->{_e} = $MBI->_copy($self->{_e}); $copy->{_a} = $self->{_a} if exists $self->{_a}; $copy->{_p} = $self->{_p} if exists $self->{_p}; return $copy; } sub _bnan { # used by parent class bone() to initialize number to NaN my $self = shift; if ($_trap_nan) { require Carp; my $class = ref($self); Carp::croak ("Tried to set $self to NaN in $class\::_bnan()"); } $IMPORT=1; # call our import only once $self->{_m} = $MBI->_zero(); $self->{_e} = $MBI->_zero(); $self->{_es} = '+'; } sub _binf { # used by parent class bone() to initialize number to +-inf my $self = shift; if ($_trap_inf) { require Carp; my $class = ref($self); Carp::croak ("Tried to set $self to +-inf in $class\::_binf()"); } $IMPORT=1; # call our import only once $self->{_m} = $MBI->_zero(); $self->{_e} = $MBI->_zero(); $self->{_es} = '+'; } 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->_one(); $self->{_e} = $MBI->_zero(); $self->{_es} = '+'; } sub _bzero { # used by parent class bzero() to initialize number to 0 my $self = shift; $IMPORT=1; # call our import only once $self->{_m} = $MBI->_zero(); $self->{_e} = $MBI->_zero(); $self->{_es} = '+'; } sub isa { my ($self,$class) = @_; return if $class =~ /^Math::BigInt/; # we aren't one of these UNIVERSAL::isa($self,$class); } sub config { # return (later set?) configuration data as hash ref my $class = shift || 'Math::BigFloat'; if (@_ == 1 && ref($_[0]) ne 'HASH') { my $cfg = $class->SUPER::config(); return $cfg->{$_[0]}; } my $cfg = $class->SUPER::config(@_); # now we need only to override the ones that are different from our parent $cfg->{class} = $class; $cfg->{with} = $MBI; $cfg; } ############################################################################## # string conversion sub bstr { # (ref to BFLOAT or num_str ) return num_str # Convert number from internal format to (non-scientific) string format. # internal format is always normalized (no leading zeros, "-0" => "+0") my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.'; # $x is zero? my $not_zero = !($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})); if ($not_zero) { $es = $MBI->_str($x->{_m}); $len = CORE::length($es); 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) { my $r = abs($e) - $len; $es = '0.'. ('0' x $r) . $es; $cad = -($len+$r); } else { substr($es,$e,0) = '.'; $cad = $MBI->_num($x->{_e}); $cad = -$cad if $x->{_es} eq '-'; } } elsif ($e > 0) { # expand with zeros $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)) { # 123400 => 6, 0.1234 => 4, 0.001234 => 4 my $zeros = $x->{_a} - $cad; # cad == 0 => 12340 $zeros = $x->{_a} - $len if $cad != $len; $es .= $dot.'0' x $zeros if $zeros > 0; } elsif ((($x->{_p} || 0) < 0)) { # 123400 => 6, 0.1234 => 4, 0.001234 => 6 my $zeros = -$x->{_p} + $cad; $es .= $dot.'0' x $zeros if $zeros > 0; } $es; } sub bsstr { # (ref to BFLOAT or num_str ) return num_str # Convert number from internal format to scientific string format. # internal format is always normalized (no leading zeros, "-0E0" => "+0E0") my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } my $sep = 'e'.$x->{_es}; my $sign = $x->{sign}; $sign = '' if $sign eq '+'; $sign . $MBI->_str($x->{_m}) . $sep . $MBI->_str($x->{_e}); } sub numify { # Make a Perl scalar number from a Math::BigFloat object. my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); if ($x -> is_nan()) { require Math::Complex; my $inf = Math::Complex::Inf(); return $inf - $inf; } if ($x -> is_inf()) { require Math::Complex; my $inf = Math::Complex::Inf(); return $x -> is_negative() ? -$inf : $inf; } # Create a string and let Perl's atoi()/atof() handle the rest. return 0 + $x -> bsstr(); } ############################################################################## # public stuff (usually prefixed with "b") sub bneg { # (BINT or num_str) return BINT # negate number or make a negated number from string my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $x if $x->modify('bneg'); # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN' $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})); $x; } # tels 2001-08-04 # XXX TODO this must be overwritten and return NaN for non-integer values # band(), bior(), bxor(), too #sub bnot # { # $class->SUPER::bnot($class,@_); # } sub bcmp { # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort) # 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,@_); } return $upgrade->bcmp($x,$y) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); # Handle all 'nan' cases. return undef if ($x->{sign} eq $nan) || ($y->{sign} eq $nan); # Handle all '+inf' and '-inf' cases. return 0 if ($x->{sign} eq '+inf' && $y->{sign} eq '+inf' || $x->{sign} eq '-inf' && $y->{sign} eq '-inf'); return +1 if $x->{sign} eq '+inf'; # x = +inf and y < +inf return -1 if $x->{sign} eq '-inf'; # x = -inf and y > -inf return -1 if $y->{sign} eq '+inf'; # x < +inf and y = +inf return +1 if $y->{sign} eq '-inf'; # x > -inf and y = -inf # Handle all cases with opposite signs. return +1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # also does 0 <=> -y return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # also does -x <=> 0 # Handle all remaining zero cases. my $xz = $x->is_zero(); my $yz = $y->is_zero(); return 0 if $xz && $yz; # 0 <=> 0 return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y return +1 if $yz && $x->{sign} eq '+'; # +x <=> 0 # Both arguments are now finite, non-zero numbers with the same sign. my $cmp; # The next step is to compare the exponents, but since each mantissa is an # integer of arbitrary value, the exponents must be normalized by the length # of the mantissas before we can compare them. my $mxl = $MBI->_len($x->{_m}); my $myl = $MBI->_len($y->{_m}); # If the mantissas have the same length, there is no point in normalizing the # exponents by the length of the mantissas, so treat that as a special case. if ($mxl == $myl) { # First handle the two cases where the exponents have different signs. if ($x->{_es} eq '+' && $y->{_es} eq '-') { $cmp = +1; } elsif ($x->{_es} eq '-' && $y->{_es} eq '+') { $cmp = -1; } # Then handle the case where the exponents have the same sign. else { $cmp = $MBI->_acmp($x->{_e}, $y->{_e}); $cmp = -$cmp if $x->{_es} eq '-'; } # Adjust for the sign, which is the same for x and y, and bail out if # we're done. $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123 return $cmp if $cmp; } # We must normalize each exponent by the length of the corresponding # mantissa. Life is a lot easier if we first make both exponents # non-negative. We do this by adding the same positive value to both # exponent. This is safe, because when comparing the exponents, only the # relative difference is important. my $ex; my $ey; if ($x->{_es} eq '+') { # If the exponent of x is >= 0 and the exponent of y is >= 0, there is no # need to do anything special. if ($y->{_es} eq '+') { $ex = $MBI->_copy($x->{_e}); $ey = $MBI->_copy($y->{_e}); } # If the exponent of x is >= 0 and the exponent of y is < 0, add the # absolute value of the exponent of y to both. else { $ex = $MBI->_copy($x->{_e}); $ex = $MBI->_add($ex, $y->{_e}); # ex + |ey| $ey = $MBI->_zero(); # -ex + |ey| = 0 } } else { # If the exponent of x is < 0 and the exponent of y is >= 0, add the # absolute value of the exponent of x to both. if ($y->{_es} eq '+') { $ex = $MBI->_zero(); # -ex + |ex| = 0 $ey = $MBI->_copy($y->{_e}); $ey = $MBI->_add($ey, $x->{_e}); # ey + |ex| } # If the exponent of x is < 0 and the exponent of y is < 0, add the # absolute values of both exponents to both exponents. else { $ex = $MBI->_copy($y->{_e}); # -ex + |ey| + |ex| = |ey| $ey = $MBI->_copy($x->{_e}); # -ey + |ex| + |ey| = |ex| } } # Now we can normalize the exponents by adding lengths of the mantissas. $MBI->_add($ex, $MBI->_new($mxl)); $MBI->_add($ey, $MBI->_new($myl)); # We're done if the exponents are different. $cmp = $MBI->_acmp($ex, $ey); $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123 return $cmp if $cmp; # Compare the mantissas, but first normalize them by padding the shorter # mantissa with zeros (shift left) until it has the same length as the longer # mantissa. my $mx = $x->{_m}; my $my = $y->{_m}; if ($mxl > $myl) { $my = $MBI->_lsft($MBI->_copy($my), $MBI->_new($mxl - $myl), 10); } elsif ($mxl < $myl) { $mx = $MBI->_lsft($MBI->_copy($mx), $MBI->_new($myl - $mxl), 10); } $cmp = $MBI->_acmp($mx, $my); $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123 return $cmp; } sub bacmp { # Compares 2 values, ignoring their signs. # Returns one of undef, <0, =0, >0. (suitable for sort) # 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,@_); } return $upgrade->bacmp($x,$y) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); # handle +-inf and NaN's if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) { return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); return 0 if ($x->is_inf() && $y->is_inf()); return 1 if ($x->is_inf() && !$y->is_inf()); return -1; } # shortcut my $xz = $x->is_zero(); my $yz = $y->is_zero(); return 0 if $xz && $yz; # 0 <=> 0 return -1 if $xz && !$yz; # 0 <=> +y return 1 if $yz && !$xz; # +x <=> 0 # adjust so that exponents are equal 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 + $xes * $MBI->_num($x->{_e}); my $ly = $lym + $yes * $MBI->_num($y->{_e}); my $l = $lx - $ly; return $l <=> 0 if $l != 0; # lengths (corrected by exponent) are equal # so make mantissa equal-length by padding with zero (shift left) my $diff = $lxm - $lym; my $xm = $x->{_m}; # not yet copy it my $ym = $y->{_m}; if ($diff > 0) { $ym = $MBI->_copy($y->{_m}); $ym = $MBI->_lsft($ym, $MBI->_new($diff), 10); } elsif ($diff < 0) { $xm = $MBI->_copy($x->{_m}); $xm = $MBI->_lsft($xm, $MBI->_new(-$diff), 10); } $MBI->_acmp($xm,$ym); } sub badd { # add second arg (BFLOAT or string) to first (BFLOAT) (modifies first) # return result as BFLOAT # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('badd'); # inf and NaN handling if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # NaN first return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); # inf handling if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) { # +inf++inf or -inf+-inf => same, rest is NaN return $x if $x->{sign} eq $y->{sign}; return $x->bnan(); } # +-inf + something => +inf; something +-inf => +-inf $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/; return $x; } return $upgrade->badd($x,$y,@r) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); $r[3] = $y; # no push! # speed: no add for 0+y or x+0 return $x->bround(@r) if $y->is_zero(); # x+0 if ($x->is_zero()) # 0+y { # make copy, clobbering up x (modify in place!) $x->{_e} = $MBI->_copy($y->{_e}); $x->{_es} = $y->{_es}; $x->{_m} = $MBI->_copy($y->{_m}); $x->{sign} = $y->{sign} || $nan; return $x->round(@r); } # take lower of the two e's and adapt m1 to it to match m2 my $e = $y->{_e}; $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 { $MBI->_lsft( $x->{_m}, $e, 10); ($x->{_e},$x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); } elsif (!$MBI->_is_zero($e)) # > 0 { $MBI->_lsft($add, $e, 10); } # else: both e are the same, so just leave them 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(@r); } # sub bsub is inherited from Math::BigInt! sub binc { # increment arg by one my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('binc'); if ($x->{_es} eq '-') { return $x->badd($self->bone(),@r); # digits after dot } 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} = $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 '+') { $MBI->_inc($x->{_m}); return $x->bnorm()->bround(@r); } elsif ($x->{sign} eq '-') { $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 $x->badd($self->bone(),@r); # badd() does round } sub bdec { # decrement arg by one my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bdec'); if ($x->{_es} eq '-') { return $x->badd($self->bone('-'),@r); # digits after dot } if (!$MBI->_is_zero($x->{_e})) { $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) { $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 '+') { $MBI->_dec($x->{_m}); return $x->bnorm()->round(@r); } # inf, nan handling etc $x->badd($self->bone('-'),@r); # does round } sub DEBUG () { 0; } sub blog { my ($self,$x,$base,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); # If called as $x -> blog() or $x -> blog(undef), don't objectify the # undefined base, since undef signals that the base is Euler's number. #unless (ref($x) && !defined($base)) { # # objectify is costly, so avoid it # if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { # ($self,$x,$base,$a,$p,$r) = objectify(2,@_); # } #} return $x if $x->modify('blog'); return $x -> bnan() if $x -> is_nan(); # we need to limit the accuracy to protect against overflow my $fallback = 0; my ($scale,@params); ($x,@params) = $x->_find_round_parameters($a,$p,$r); # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $self->div_scale(); # and round to it as accuracy $params[1] = undef; # P = undef $scale = $params[0]+4; # at least four more for proper round $params[2] = $r; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not # enough... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } my $done = 0; if (defined $base) { $base = $self -> new($base) unless ref $base; if ($base -> is_nan() || $base -> is_one()) { $x -> bnan(); $done = 1; } elsif ($base -> is_inf() || $base -> is_zero()) { if ($x -> is_inf() || $x -> is_zero()) { $x -> bnan(); } else { $x -> bzero(@params); } $done = 1; } elsif ($base -> is_negative()) { # -inf < base < 0 if ($x -> is_one()) { # x = 1 $x -> bzero(@params); } elsif ($x == $base) { $x -> bone('+', @params); # x = base } else { $x -> bnan(); # otherwise } $done = 1; } elsif ($x == $base) { $x -> bone('+', @params); # 0 < base && 0 < x < inf $done = 1; } } # We now know that the base is either undefined or positive and finite. unless ($done) { if ($x -> is_inf()) { # x = +/-inf my $sign = defined $base && $base < 1 ? '-' : '+'; $x -> binf($sign); $done = 1; } elsif ($x -> is_neg()) { # -inf < x < 0 $x -> bnan(); $done = 1; } elsif ($x -> is_one()) { # x = 1 $x -> bzero(@params); $done = 1; } elsif ($x -> is_zero()) { # x = 0 my $sign = defined $base && $base < 1 ? '+' : '-'; $x -> binf($sign); $done = 1; } } if ($done) { if ($fallback) { # clear a/p after round, since user did not request it delete $x->{_a}; delete $x->{_p}; } return $x; } # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; local $Math::BigFloat::downgrade = undef; # upgrade $x if $x is not a BigFloat (handle BigInt input) # XXX TODO: rebless! if (!$x->isa('Math::BigFloat')) { $x = Math::BigFloat->new($x); $self = ref($x); } $done = 0; # If the base is defined and an integer, try to calculate integer result # first. This is very fast, and in case the real result was found, we can # stop right here. if (defined $base && $base->is_int() && $x->is_int()) { 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->as_number()->bpow($int) == $x) { # found result, return it $x->{_m} = $int->{value}; $x->{_e} = $MBI->_zero(); $x->{_es} = '+'; $x->bnorm(); $done = 1; } } if ($done == 0) { # base is undef, so base should be e (Euler's number), so 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) { $base = Math::BigFloat->new($base) unless $base->isa('Math::BigFloat'); # not ln, but some other base (don't modify $base) $x->bdiv( $base->copy()->blog(undef,$scale), $scale ); } } # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly } else { $x->bfround($params[1],$params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it delete $x->{_a}; delete $x->{_p}; } # restore globals $$abr = $ab; $$pbr = $pb; $x; } sub _len_to_steps { # Given D (digits in decimal), compute N so that N! (N factorial) is # at least D digits long. D should be at least 50. my $d = shift; # two constants for the Ramanujan estimate of ln(N!) my $lg2 = log(2 * 3.14159265) / 2; my $lg10 = log(10); # D = 50 => N => 42, so L = 40 and R = 50 my $l = 40; my $r = $d; # Otherwise this does not work under -Mbignum and we do not yet have "no bignum;" :( $l = $l->numify if ref($l); $r = $r->numify if ref($r); $lg2 = $lg2->numify if ref($lg2); $lg10 = $lg10->numify if ref($lg10); # binary search for the right value (could this be written as the reverse of lg(n!)?) while ($r - $l > 1) { my $n = int(($r - $l) / 2) + $l; my $ramanujan = int(($n * log($n) - $n + log( $n * (1 + 4*$n*(1+2*$n)) ) / 6 + $lg2) / $lg10); $ramanujan > $d ? $r = $n : $l = $n; } $l; } sub bnok { # Calculate n over k (binomial coefficient or "choose" function) as integer. # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bnok'); return $x->bnan() if $x->is_nan() || $y->is_nan(); return $x->binf() if $x->is_inf(); my $u = $x->as_int(); $u->bnok($y->as_int()); $x->{_m} = $u->{value}; $x->{_e} = $MBI->_zero(); $x->{_es} = '+'; $x->{sign} = '+'; $x->bnorm(@r); } sub bexp { # Calculate e ** X (Euler's number to the power of X) my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bexp'); return $x->binf() if $x->{sign} eq '+inf'; return $x->bzero() if $x->{sign} eq '-inf'; # we need to limit the accuracy to protect against overflow my $fallback = 0; my ($scale,@params); ($x,@params) = $x->_find_round_parameters($a,$p,$r); # also takes care of the "error in _find_round_parameters?" case return $x if $x->{sign} eq 'NaN'; # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $self->div_scale(); # and round to it as accuracy $params[1] = undef; # P = undef $scale = $params[0]+4; # at least four more for proper round $params[2] = $r; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it's not enough... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } return $x->bone(@params) if $x->is_zero(); if (!$x->isa('Math::BigFloat')) { $x = Math::BigFloat->new($x); $self = ref($x); } # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; local $Math::BigFloat::downgrade = undef; my $x_org = $x->copy(); # We use the following Taylor series: # x x^2 x^3 x^4 # e = 1 + --- + --- + --- + --- ... # 1! 2! 3! 4! # The difference for each term is X and N, which would result in: # 2 copy, 2 mul, 2 add, 1 inc, 1 div operations per term # But it is faster to compute exp(1) and then raising it to the # given power, esp. if $x is really big and an integer because: # * The numerator is always 1, making the computation faster # * the series converges faster in the case of x == 1 # * We can also easily check when we have reached our limit: when the # term to be added is smaller than "1E$scale", we can stop - f.i. # scale == 5, and we have 1/40320, then we stop since 1/40320 < 1E-5. # * we can compute the *exact* result by simulating bigrat math: # 1 1 gcd(3,4) = 1 1*24 + 1*6 5 # - + - = ---------- = -- # 6 24 6*24 24 # We do not compute the gcd() here, but simple do: # 1 1 1*24 + 1*6 30 # - + - = --------- = -- # 6 24 6*24 144 # In general: # a c a*d + c*b and note that c is always 1 and d = (b*f) # - + - = --------- # b d b*d # This leads to: which can be reduced by b to: # a 1 a*b*f + b a*f + 1 # - + - = --------- = ------- # b b*f b*b*f b*f # The first terms in the series are: # 1 1 1 1 1 1 1 1 13700 # -- + -- + -- + -- + -- + --- + --- + ---- = ----- # 1 1 2 6 24 120 720 5040 5040 # Note that we cannot simple reduce 13700/5040 to 685/252, but must keep A and B! if ($scale <= 75) { # set $x directly from a cached string form $x->{_m} = $MBI->_new( "27182818284590452353602874713526624977572470936999595749669676277240766303535476"); $x->{sign} = '+'; $x->{_es} = '-'; $x->{_e} = $MBI->_new(79); } else { # compute A and B so that e = A / B. # After some terms we end up with this, so we use it as a starting point: my $A = $MBI->_new("90933395208605785401971970164779391644753259799242"); my $F = $MBI->_new(42); my $step = 42; # Compute how many steps we need to take to get $A and $B sufficiently big my $steps = _len_to_steps($scale - 4); # print STDERR "# Doing $steps steps for ", $scale-4, " digits\n"; while ($step++ <= $steps) { # calculate $a * $f + 1 $A = $MBI->_mul($A, $F); $A = $MBI->_inc($A); # increment f $F = $MBI->_inc($F); } # compute $B as factorial of $steps (this is faster than doing it manually) my $B = $MBI->_fac($MBI->_new($steps)); # print "A ", $MBI->_str($A), "\nB ", $MBI->_str($B), "\n"; # compute A/B with $scale digits in the result (truncate, not round) $A = $MBI->_lsft( $A, $MBI->_new($scale), 10); $A = $MBI->_div( $A, $B ); $x->{_m} = $A; $x->{sign} = '+'; $x->{_es} = '-'; $x->{_e} = $MBI->_new($scale); } # $x contains now an estimate of e, with some surplus digits, so we can round if (!$x_org->is_one()) { # Reduce size of fractional part, followup with integer power of two. my $lshift = 0; while ($lshift < 30 && $x_org->bacmp(2 << $lshift) > 0) { $lshift++; } # Raise $x to the wanted power and round it. if ($lshift == 0) { $x->bpow($x_org, @params); } else { my($mul, $rescale) = (1 << $lshift, $scale+1+$lshift); $x->bpow(scalar $x_org->bdiv($mul,$rescale),$rescale)->bpow($mul, @params); } } else { # else just round the already computed result delete $x->{_a}; delete $x->{_p}; # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly } else { $x->bfround($params[1],$params[2]); # then round accordingly } } if ($fallback) { # clear a/p after round, since user did not request it delete $x->{_a}; delete $x->{_p}; } # restore globals $$abr = $ab; $$pbr = $pb; $x; # return modified $x } sub _log { # internal log function to calculate ln() based on Taylor series. # Modifies $x in place. my ($self,$x,$scale) = @_; # in case of $x == 1, result is 0 return $x->bzero() if $x->is_one(); # XXX TODO: rewrite this in a similar manner to bexp() # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log # u = x-1, v = x+1 # _ _ # Taylor: | u 1 u^3 1 u^5 | # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 0 # |_ v 3 v^3 5 v^5 _| # This takes much more steps to calculate the result and is thus not used # u = x-1 # _ _ # Taylor: | u 1 u^2 1 u^3 | # ln (x) = 2 | --- + - * --- + - * --- + ... | x > 1/2 # |_ x 2 x^2 3 x^3 _| my ($limit,$v,$u,$below,$factor,$two,$next,$over,$f); $v = $x->copy(); $v->binc(); # v = x+1 $x->bdec(); $u = $x->copy(); # u = x-1; x = x-1 $x->bdiv($v,$scale); # first term: u/v $below = $v->copy(); $over = $u->copy(); $u *= $u; $v *= $v; # u^2, v^2 $below->bmul($v); # u^3, v^3 $over->bmul($u); $factor = $self->new(3); $f = $self->new(2); my $steps = 0; $limit = $self->new("1E-". ($scale-1)); while (3 < 5) { # we calculate the next term, and add it to the last # when the next term is below our limit, it won't affect the outcome # anymore, so we stop # calculating the next term simple from over/below will result in quite # a time hog if the input has many digits, since over and below will # accumulate more and more digits, and the result will also have many # digits, but in the end it is rounded to $scale digits anyway. So if we # round $over and $below first, we save a lot of time for the division # (not with log(1.2345), but try log (123**123) to see what I mean. This # can introduce a rounding error if the division result would be f.i. # 0.1234500000001 and we round it to 5 digits it would become 0.12346, but # if we truncated $over and $below we might get 0.12345. Does this matter # for the end result? So we give $over and $below 4 more digits to be # on the safe side (unscientific error handling as usual... :+D $next = $over->copy->bround($scale+4)->bdiv( $below->copy->bmul($factor)->bround($scale+4), $scale); ## old version: ## $next = $over->copy()->bdiv($below->copy()->bmul($factor),$scale); last if $next->bacmp($limit) <= 0; delete $next->{_a}; delete $next->{_p}; $x->badd($next); # calculate things for the next term $over *= $u; $below *= $v; $factor->badd($f); if (DEBUG) { $steps++; print "step $steps = $x\n" if $steps % 10 == 0; } } print "took $steps steps\n" if DEBUG; $x->bmul($f); # $x *= 2 } sub _log_10 { # Internal log function based on reducing input to the range of 0.1 .. 9.99 # and then "correcting" the result to the proper one. Modifies $x in place. my ($self,$x,$scale) = @_; # Taking blog() from numbers greater than 10 takes a *very long* time, so we # break the computation down into parts based on the observation that: # blog(X*Y) = blog(X) + blog(Y) # We set Y here to multiples of 10 so that $x becomes below 1 - the smaller # $x is the faster it gets. Since 2*$x takes about 10 times as # long, we make it faster by about a factor of 100 by dividing $x by 10. # The same observation is valid for numbers smaller than 0.1, e.g. computing # log(1) is fastest, and the further away we get from 1, the longer it takes. # So we also 'break' this down by multiplying $x with 10 and subtract the # log(10) afterwards to get the correct result. # To get $x even closer to 1, we also divide by 2 and then use log(2) to # correct for this. For instance if $x is 2.4, we use the formula: # blog(2.4 * 2) == blog (1.2) + blog(2) # and thus calculate only blog(1.2) and blog(2), which is faster in total # than calculating blog(2.4). # In addition, the values for blog(2) and blog(10) are cached. # Calculate nr of digits before dot: 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 my $calc = 1; # do some calculation? # disable the shortcut for 10, since we need log(10) and this would recurse # infinitely deep 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 if ($scale <= $LOG_10_A) { $x->bzero(); $x->badd($LOG_10); # modify $x in place $calc = 0; # no need to calc, but round } # if we can't use the shortcut, we continue normally } else { # disable the shortcut for 2, since we maybe have it cached if (($MBI->_is_zero($x->{_e}) && $MBI->_is_two($x->{_m}))) { $dbd = 0; # disable shortcut # we can use the cached value in these cases if ($scale <= $LOG_2_A) { $x->bzero(); $x->badd($LOG_2); # modify $x in place $calc = 0; # no need to calc, but round } # if we can't use the shortcut, we continue normally } } # if $x = 0.1, we know the result must be 0-log(10) 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 if ($scale <= $LOG_10_A) { $x->bzero(); $x->bsub($LOG_10); $calc = 0; # no need to calc, but round } } return if $calc == 0; # already have the result # default: these correction factors are undef and thus not used my $l_10; # value of ln(10) to A of $scale my $l_2; # value of ln(2) to A of $scale my $two = $self->new(2); # $x == 2 => 1, $x == 13 => 2, $x == 0.1 => 0, $x == 0.01 => -1 # so don't do this shortcut for 1 or 0 if (($dbd > 1) || ($dbd < 0)) { # convert our cached value to an object if not already (avoid doing this # at import() time, since not everybody needs this) $LOG_10 = $self->new($LOG_10,undef,undef) unless ref $LOG_10; #print "x = $x, dbd = $dbd, calc = $calc\n"; # got more than one digit before the dot, or more than one zero after the # dot, so do: # log(123) == log(1.23) + log(10) * 2 # log(0.0123) == log(1.23) - log(10) * 2 if ($scale <= $LOG_10_A) { # use cached value $l_10 = $LOG_10->copy(); # copy for mul } else { # else: slower, compute and cache result # also disable downgrade for this code path local $Math::BigFloat::downgrade = undef; # shorten the time to calculate log(10) based on the following: # log(1.25 * 8) = log(1.25) + log(8) # = log(1.25) + log(2) + log(2) + log(2) # first get $l_2 (and possible compute and cache log(2)) $LOG_2 = $self->new($LOG_2,undef,undef) unless ref $LOG_2; if ($scale <= $LOG_2_A) { # use cached value $l_2 = $LOG_2->copy(); # copy() for the mul below } else { # else: slower, compute and cache result $l_2 = $two->copy(); $self->_log($l_2, $scale); # scale+4, actually $LOG_2 = $l_2->copy(); # cache the result for later # the copy() is for mul below $LOG_2_A = $scale; } # now calculate log(1.25): $l_10 = $self->new('1.25'); $self->_log($l_10, $scale); # scale+4, actually # log(1.25) + log(2) + log(2) + log(2): $l_10->badd($l_2); $l_10->badd($l_2); $l_10->badd($l_2); $LOG_10 = $l_10->copy(); # cache the result for later # the copy() is for mul below $LOG_10_A = $scale; } $dbd-- if ($dbd > 1); # 20 => dbd=2, so make it dbd=1 $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 } # Now: 0.1 <= $x < 10 (and possible correction in l_10) ### Since $x in the range 0.5 .. 1.5 is MUCH faster, we do a repeated div ### or mul by 2 (maximum times 3, since x < 10 and x > 0.1) $HALF = $self->new($HALF) unless ref($HALF); my $twos = 0; # default: none (0 times) while ($x->bacmp($HALF) <= 0) # X <= 0.5 { $twos--; $x->bmul($two); } while ($x->bacmp($two) >= 0) # X >= 2 { $twos++; $x->bdiv($two,$scale+4); # keep all digits } $x->bround($scale+4); # $twos > 0 => did mul 2, < 0 => did div 2 (but we never did both) # So calculate correction factor based on ln(2): if ($twos != 0) { $LOG_2 = $self->new($LOG_2,undef,undef) unless ref $LOG_2; if ($scale <= $LOG_2_A) { # use cached value $l_2 = $LOG_2->copy(); # copy() for the mul below } else { # else: slower, compute and cache result # also disable downgrade for this code path local $Math::BigFloat::downgrade = undef; $l_2 = $two->copy(); $self->_log($l_2, $scale); # scale+4, actually $LOG_2 = $l_2->copy(); # cache the result for later # the copy() is for mul below $LOG_2_A = $scale; } $l_2->bmul($twos); # * -2 => subtract, * 2 => add } else { undef $l_2; } $self->_log($x,$scale); # need to do the "normal" way $x->badd($l_10) if defined $l_10; # correct it by ln(10) $x->badd($l_2) if defined $l_2; # and maybe by ln(2) # all done, $x contains now the result $x; } sub blcm { # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT # does not modify arguments, but returns new object # Lowest Common Multiplicator my ($self,@arg) = objectify(0,@_); my $x = $self->new(shift @arg); while (@arg) { $x = Math::BigInt::__lcm($x,shift @arg); } $x; } sub bgcd { # (BINT or num_str, BINT or num_str) return BINT # does not modify arguments, but returns new object my $y = shift; $y = __PACKAGE__->new($y) if !ref($y); my $self = ref($y); my $x = $y->copy()->babs(); # keep arguments return $x->bnan() if $x->{sign} !~ /^[+-]$/ # x NaN? || !$x->is_int(); # only for integers now while (@_) { my $t = shift; $t = $self->new($t) if !ref($t); $y = $t->copy()->babs(); return $x->bnan() if $y->{sign} !~ /^[+-]$/ # y NaN? || !$y->is_int(); # only for integers now # greatest common divisor while (! $y->is_zero()) { ($x,$y) = ($y->copy(), $x->copy()->bmod($y)); } last if $x->is_one(); } $x; } ############################################################################## sub _e_add { # 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 or -a + -b } else { my $a = $MBI->_acmp($x, $y); if ($a == 0) { # This does NOT modify $x in-place. TODO: Fix this? $x = $MBI->_zero(); # result is 0 $xs = '+'; return ($x, $xs); } if ($a > 0) { $x = $MBI->_sub($x, $y); # abs sub } else { # a < 0 $x = $MBI->_sub ( $y, $x, 1 ); # abs sub $xs = $ys; } } $xs = '+' if $xs eq '-' && $MBI->_is_zero($x); # no "-0" return ($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 = $ys eq '+' ? '-' : '+'; # swap sign of second operand ... _e_add($x, $y, $xs, $ys); # ... and let _e_add() do the job } ############################################################################### # 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,@_); (($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't ($x->{_es} eq '+')) ? 1 : 0; # 1e-1 => no integer } sub is_zero { # return true if arg (BFLOAT or num_str) is zero my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); ($x->{sign} eq '+' && $MBI->_is_zero($x->{_m})) ? 1 : 0; } sub is_one { # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $sign = '+' if !defined $sign || $sign ne '-'; ($x->{sign} eq $sign && $MBI->_is_zero($x->{_e}) && $MBI->_is_one($x->{_m}) ) ? 1 : 0; } sub is_odd { # return true if arg (BFLOAT or num_str) is odd or false if even my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); (($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't ($MBI->_is_zero($x->{_e})) && ($MBI->_is_odd($x->{_m}))) ? 1 : 0; } sub is_even { # return true if arg (BINT or num_str) is even or false if odd my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); (($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't ($x->{_es} eq '+') && # 123.45 isn't ($MBI->_is_even($x->{_m}))) ? 1 : 0; # but 1200 is } sub bmul { # multiply two numbers # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bmul'); return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); # inf handling if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { return $x->bnan() if $x->is_zero() || $y->is_zero(); # result will always be +-inf: # +inf * +/+inf => +inf, -inf * -/-inf => +inf # +inf * -/-inf => -inf, -inf * +/+inf => -inf return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); return $x->binf('-'); } return $upgrade->bmul($x,$y,@r) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); # aEb * cEd = (a*c)E(b+d) $MBI->_mul($x->{_m},$y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); $r[3] = $y; # no push! # adjust sign: $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+'; $x->bnorm->round(@r); } sub bmuladd { # multiply two numbers and add the third to the result # set up parameters my ($self,$x,$y,$z,@r) = objectify(3,@_); return $x if $x->modify('bmuladd'); return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan) || ($z->{sign} eq $nan)); # inf handling if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { return $x->bnan() if $x->is_zero() || $y->is_zero(); # result will always be +-inf: # +inf * +/+inf => +inf, -inf * -/-inf => +inf # +inf * -/-inf => -inf, -inf * +/+inf => -inf return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); return $x->binf('-'); } return $upgrade->bmul($x,$y,@r) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); # aEb * cEd = (a*c)E(b+d) $MBI->_mul($x->{_m},$y->{_m}); ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es}); $r[3] = $y; # no push! # adjust sign: $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+'; # z=inf handling (z=NaN handled above) $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/; # take lower of the two e's and adapt m1 to it to match m2 my $e = $z->{_e}; $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}, $z->{_es} || '+', $x->{_es}); my $add = $MBI->_copy($z->{_m}); if ($es eq '-') # < 0 { $MBI->_lsft( $x->{_m}, $e, 10); ($x->{_e},$x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es); } elsif (!$MBI->_is_zero($e)) # > 0 { $MBI->_lsft($add, $e, 10); } # else: both e are the same, so just leave them if ($x->{sign} eq $z->{sign}) { # add $x->{_m} = $MBI->_add($x->{_m}, $add); } else { ($x->{_m}, $x->{sign}) = _e_add($x->{_m}, $add, $x->{sign}, $z->{sign}); } # delete trailing zeros, then round $x->bnorm()->round(@r); } sub bdiv { # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return # (BFLOAT, BFLOAT) (quo, rem) or BFLOAT (only quo) # set up parameters my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,$a,$p,$r) = objectify(2,@_); } return $x if $x->modify('bdiv'); my $wantarray = wantarray; # call only once # At least one argument is NaN. This is handled the same way as in # Math::BigInt -> bdiv(). if ($x -> is_nan() || $y -> is_nan()) { return $wantarray ? ($x -> bnan(), $self -> bnan()) : $x -> bnan(); } # Divide by zero and modulo zero. This is handled the same way as in # Math::BigInt -> bdiv(). See the comment in the code for Math::BigInt -> # bdiv() for further details. if ($y -> is_zero()) { my ($quo, $rem); if ($wantarray) { $rem = $x -> copy(); } if ($x -> is_zero()) { $quo = $x -> bnan(); } else { $quo = $x -> binf($x -> {sign}); } return $wantarray ? ($quo, $rem) : $quo; } # Numerator (dividend) is +/-inf. This is handled the same way as in # Math::BigInt -> bdiv(). See the comment in the code for Math::BigInt -> # bdiv() for further details. if ($x -> is_inf()) { my ($quo, $rem); $rem = $self -> bnan() if $wantarray; if ($y -> is_inf()) { $quo = $x -> bnan(); } else { my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-'; $quo = $x -> binf($sign); } return $wantarray ? ($quo, $rem) : $quo; } # Denominator (divisor) is +/-inf. This is handled the same way as in # Math::BigInt -> bdiv(), with one exception: In scalar context, # Math::BigFloat does true division (although rounded), not floored division # (F-division), so a finite number divided by +/-inf is always zero. See the # comment in the code for Math::BigInt -> bdiv() for further details. if ($y -> is_inf()) { my ($quo, $rem); if ($wantarray) { if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { $rem = $x -> copy(); $quo = $x -> bzero(); } else { $rem = $self -> binf($y -> {sign}); $quo = $x -> bone('-'); } return ($quo, $rem); } else { if ($y -> is_inf()) { if ($x -> is_nan() || $x -> is_inf()) { return $x -> bnan(); } else { return $x -> bzero(); } } } } # At this point, both the numerator and denominator are finite numbers, and # the denominator (divisor) is non-zero. # x == 0? return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); # upgrade ? return $upgrade->bdiv($upgrade->new($x),$y,$a,$p,$r) if defined $upgrade; # we need to limit the accuracy to protect against overflow my $fallback = 0; my (@params,$scale); ($x,@params) = $x->_find_round_parameters($a,$p,$r,$y); return $x if $x->is_nan(); # error in _find_round_parameters? # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $self->div_scale(); # and round to it as accuracy $scale = $params[0]+4; # at least four more for proper round $params[2] = $r; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not # enough... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } my $rem; $rem = $self -> bzero() if wantarray; $y = $self->new($y) unless $y->isa('Math::BigFloat'); 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; $scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx! # check that $y is not 1 nor -1 and cache the result: my $y_not_one = !($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m})); # flipping the sign of $y will also flip the sign of $x for the special # case of $x->bsub($x); so we can catch it below: my $xsign = $x->{sign}; $y->{sign} =~ tr/+-/-+/; if ($xsign ne $x->{sign}) { # special case of $x /= $x results in 1 $x->bone(); # "fixes" also sign of $y, since $x is $y } else { # correct $y's sign again $y->{sign} =~ tr/+-/-+/; # continue with normal div code: # make copy of $x in case of list context for later remainder calculation if (wantarray && $y_not_one) { $rem = $x->copy(); } $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+'; # check for / +-1 ( +/- 1E0) if ($y_not_one) { # promote BigInts and it's subclasses (except when already a BigFloat) $y = $self->new($y) unless $y->isa('Math::BigFloat'); # calculate the result to $scale digits and then round it # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d) $MBI->_lsft($x->{_m},$MBI->_new($scale),10); $MBI->_div ($x->{_m},$y->{_m}); # a/c # correct exponent of $x ($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 } } # end else $x != $y # shortcut to not run through _find_round_parameters again if (defined $params[0]) { delete $x->{_a}; # clear before round $x->bround($params[0],$params[2]); # then round accordingly } else { delete $x->{_p}; # clear before round $x->bfround($params[1],$params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it delete $x->{_a}; delete $x->{_p}; } if (wantarray) { if ($y_not_one) { $x -> bfloor(); $rem->bmod($y,@params); # copy already done } if ($fallback) { # clear a/p after round, since user did not request it delete $rem->{_a}; delete $rem->{_p}; } return ($x,$rem); } $x; } sub bmod { # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return remainder # set up parameters my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,$a,$p,$r) = objectify(2,@_); } return $x if $x->modify('bmod'); # At least one argument is NaN. This is handled the same way as in # Math::BigInt -> bmod(). if ($x -> is_nan() || $y -> is_nan()) { return $x -> bnan(); } # Modulo zero. This is handled the same way as in Math::BigInt -> bmod(). if ($y -> is_zero()) { return $x; } # Numerator (dividend) is +/-inf. This is handled the same way as in # Math::BigInt -> bmod(). if ($x -> is_inf()) { return $x -> bnan(); } # Denominator (divisor) is +/-inf. This is handled the same way as in # Math::BigInt -> bmod(). if ($y -> is_inf()) { if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { return $x; } else { return $x -> binf($y -> sign()); } } return $x->bzero() if $x->is_zero() || ($x->is_int() && # check that $y == +1 or $y == -1: ($MBI->_is_zero($y->{_e}) && $MBI->_is_one($y->{_m}))); my $cmp = $x->bacmp($y); # equal or $x < $y? if ($cmp == 0) { # $x == $y => result 0 return $x -> bzero($a, $p); } # only $y of the operands negative? my $neg = $x->{sign} ne $y->{sign} ? 1 : 0; $x->{sign} = $y->{sign}; # calc sign first if ($cmp < 0 && $neg == 0) { # $x < $y => result $x return $x -> round($a, $p, $r); } my $ym = $MBI->_copy($y->{_m}); # 2e1 => 20 $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->{_es} eq '-') # has digits after dot { # 123 % 2.5 => 1230 % 25 => 5 => 0.5 $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->{_es} eq '-') # has digits after dot { # 123.4 % 20 => 1234 % 200 $shiftx = $MBI->_num($x->{_e}); # no more digits after dot $MBI->_lsft($ym, $x->{_e}, 10); # 123 => 1230 } # 123e1 % 20 => 1230 % 20 if ($x->{_es} eq '+' && !$MBI->_is_zero($x->{_e})) { $MBI->_lsft( $x->{_m}, $x->{_e},10); # es => '+' here } $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} = $MBI->_mod( $x->{_m}, $ym); $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0 $x->bnorm(); if ($neg != 0 && ! $x -> is_zero()) # one of them negative => correct in place { my $r = $y - $x; $x->{_m} = $r->{_m}; $x->{_e} = $r->{_e}; $x->{_es} = $r->{_es}; $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # fix sign for -0 $x->bnorm(); } $x->round($a,$p,$r,$y); # round and return } sub broot { # calculate $y'th root of $x # set up parameters my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,$a,$p,$r) = objectify(2,@_); } return $x if $x->modify('broot'); # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0 return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() || $y->{sign} !~ /^\+$/; return $x if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one(); # we need to limit the accuracy to protect against overflow my $fallback = 0; my (@params,$scale); ($x,@params) = $x->_find_round_parameters($a,$p,$r); return $x if $x->is_nan(); # error in _find_round_parameters? # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $self->div_scale(); # and round to it as accuracy $scale = $params[0]+4; # at least four more for proper round $params[2] = $r; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not # enough... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI # remember sign and make $x positive, since -4 ** (1/2) => -2 my $sign = 0; $sign = 1 if $x->{sign} eq '-'; $x->{sign} = '+'; my $is_two = 0; if ($y->isa('Math::BigFloat')) { $is_two = ($y->{sign} eq '+' && $MBI->_is_two($y->{_m}) && $MBI->_is_zero($y->{_e})); } else { $is_two = ($y == 2); } # normal square root if $y == 2: if ($is_two) { $x->bsqrt($scale+4); } elsif ($y->is_one('-')) { # $x ** -1 => 1/$x my $u = $self->bone()->bdiv($x,$scale); # copy private parts over $x->{_m} = $u->{_m}; $x->{_e} = $u->{_e}; $x->{_es} = $u->{_es}; } else { # calculate the broot() as integer result first, and if it fits, return # it rightaway (but only if $x and $y are integer): my $done = 0; # not yet if ($y->is_int() && $x->is_int()) { 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->{value}; $x->{_e} = $MBI->_zero(); $x->{_es} = '+'; $x->bnorm(); $done = 1; } } if ($done == 0) { my $u = $self->bone()->bdiv($y,$scale+4); delete $u->{_a}; delete $u->{_p}; # otherwise it conflicts $x->bpow($u,$scale+4); # el cheapo } } $x->bneg() if $sign == 1; # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly } else { $x->bfround($params[1],$params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it delete $x->{_a}; delete $x->{_p}; } # restore globals $$abr = $ab; $$pbr = $pb; $x; } sub bsqrt { # calculate square root my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bsqrt'); return $x->bnan() if $x->{sign} !~ /^[+]/; # NaN, -inf or < 0 return $x if $x->{sign} eq '+inf'; # sqrt(inf) == inf return $x->round($a,$p,$r) if $x->is_zero() || $x->is_one(); # we need to limit the accuracy to protect against overflow my $fallback = 0; my (@params,$scale); ($x,@params) = $x->_find_round_parameters($a,$p,$r); return $x if $x->is_nan(); # error in _find_round_parameters? # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $self->div_scale(); # and round to it as accuracy $scale = $params[0]+4; # at least four more for proper round $params[2] = $r; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not # enough... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI 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->{_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, 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]) { $x->bround($params[0],$params[2]); # then round accordingly } else { $x->bfround($params[1],$params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it delete $x->{_a}; delete $x->{_p}; } # re-enable A and P, upgrade is taken care of by "local" ${"$self\::accuracy"} = $ab; ${"$self\::precision"} = $pb; return $x; } # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy # of the result by multiplying the input by 100 and then divide the integer # result of sqrt(input) by 10. Rounding afterwards returns the real result. # 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; # This happens if the input had enough digits # (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). $s2++ if $MBI->_is_odd($x->{_e}); $MBI->_lsft( $y1, $MBI->_new($s2), 10); # now take the square root and truncate to integer $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 = $MBI->_num($x->{_e}); $dat = -$dat if $x->{_es} eq '-'; $dat += $length; if ($dat > 0) { # no zeros after the dot (e.g. 1.23, 0.49 etc) # preserve half as many digits before the dot than the input had # (but round this "up") $dat = int(($dat+1)/2); } else { $dat = int(($dat)/2); } $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]) { $x->bround($params[0],$params[2]); # then round accordingly } else { $x->bfround($params[1],$params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it delete $x->{_a}; delete $x->{_p}; } # restore globals $$abr = $ab; $$pbr = $pb; $x; } sub bfac { # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT # compute factorial number, modifies first argument # set up parameters my ($self,$x,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it ($self,$x,@r) = objectify(1,@_) if !ref($x); # inf => inf return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; return $x->bnan() if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN ($x->{_es} ne '+')); # digits after dot? # use BigInt's bfac() for faster calc if (! $MBI->_is_zero($x->{_e})) { $MBI->_lsft($x->{_m}, $x->{_e},10); # change 12e1 to 120e0 $x->{_e} = $MBI->_zero(); # normalize $x->{_es} = '+'; } $MBI->_fac($x->{_m}); # calculate factorial $x->bnorm()->round(@r); # norm again and round result } sub _pow { # Calculate a power where $y is a non-integer, like 2 ** 0.3 my ($x,$y,@r) = @_; my $self = ref($x); # if $y == 0.5, it is sqrt($x) $HALF = $self->new($HALF) unless ref($HALF); return $x->bsqrt(@r,$y) if $y->bcmp($HALF) == 0; # Using: # a ** x == e ** (x * ln a) # u = y * ln x # _ _ # Taylor: | u u^2 u^3 | # x ** y = 1 + | --- + --- + ----- + ... | # |_ 1 1*2 1*2*3 _| # we need to limit the accuracy to protect against overflow my $fallback = 0; my ($scale,@params); ($x,@params) = $x->_find_round_parameters(@r); return $x if $x->is_nan(); # error in _find_round_parameters? # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $self->div_scale(); # and round to it as accuracy $params[1] = undef; # disable P $scale = $params[0]+4; # at least four more for proper round $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not # enough... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; my ($limit,$v,$u,$below,$factor,$next,$over); $u = $x->copy()->blog(undef,$scale)->bmul($y); my $do_invert = ($u->{sign} eq '-'); $u->bneg() if $do_invert; $v = $self->bone(); # 1 $factor = $self->new(2); # 2 $x->bone(); # first term: 1 $below = $v->copy(); $over = $u->copy(); $limit = $self->new("1E-". ($scale-1)); #my $steps = 0; while (3 < 5) { # we calculate the next term, and add it to the last # when the next term is below our limit, it won't affect the outcome # anymore, so we stop: $next = $over->copy()->bdiv($below,$scale); last if $next->bacmp($limit) <= 0; $x->badd($next); # calculate things for the next term $over *= $u; $below *= $factor; $factor->binc(); last if $x->{sign} !~ /^[-+]$/; #$steps++; } if ($do_invert) { my $x_copy = $x->copy; $x->bone->bdiv($x_copy, $scale); } # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly } else { $x->bfround($params[1],$params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it delete $x->{_a}; delete $x->{_p}; } # restore globals $$abr = $ab; $$pbr = $pb; $x; } sub bpow { # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT # compute power of two numbers, second arg is used as integer # modifies first argument # set up parameters my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,$a,$p,$r) = objectify(2,@_); } return $x if $x->modify('bpow'); return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; return $x if $x->{sign} =~ /^[+-]inf$/; # cache the result of is_zero my $y_is_zero = $y->is_zero(); return $x->bone() if $y_is_zero; return $x if $x->is_one() || $y->is_one(); my $x_is_zero = $x->is_zero(); return $x->_pow($y,$a,$p,$r) if !$x_is_zero && !$y->is_int(); # non-integer power my $y1 = $y->as_number()->{value}; # make MBI part # if ($x == -1) 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 $MBI->_is_odd($y1) ? $x : $x->babs(1); } if ($x_is_zero) { return $x if $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0) # 0 ** -y => 1 / (0 ** y) => 1 / 0! (1 / 0 => +inf) return $x->binf(); } my $new_sign = '+'; $new_sign = $MBI->_is_odd($y1) ? '-' : '+' if $x->{sign} ne '+'; # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster) $x->{_m} = $MBI->_pow( $x->{_m}, $y1); $x->{_e} = $MBI->_mul ($x->{_e}, $y1); $x->{sign} = $new_sign; $x->bnorm(); if ($y->{sign} eq '-') { # modify $x in place! my $z = $x->copy(); $x->bone(); return scalar $x->bdiv($z,$a,$p,$r); # round in one go (might ignore y's A!) } $x->round($a,$p,$r,$y); } sub bmodpow { # takes a very large number to a very large exponent in a given very # large modulus, quickly, thanks to binary exponentiation. Supports # negative exponents. my ($self,$num,$exp,$mod,@r) = objectify(3,@_); return $num if $num->modify('bmodpow'); # check modulus for valid values return $num->bnan() if ($mod->{sign} ne '+' # NaN, - , -inf, +inf || $mod->is_zero()); # check exponent for valid values if ($exp->{sign} =~ /\w/) { # i.e., if it's NaN, +inf, or -inf... return $num->bnan(); } $num->bmodinv ($mod) if ($exp->{sign} eq '-'); # check num for valid values (also NaN if there was no inverse but $exp < 0) return $num->bnan() if $num->{sign} !~ /^[+-]$/; # $mod is positive, sign on $exp is ignored, result also positive # XXX TODO: speed it up when all three numbers are integers $num->bpow($exp)->bmod($mod); } ############################################################################### # trigonometric functions # helper function for bpi() and batan2(), calculates arcus tanges (1/x) sub _atan_inv { # return a/b so that a/b approximates atan(1/x) to at least limit digits my ($self, $x, $limit) = @_; # Taylor: x^3 x^5 x^7 x^9 # atan = x - --- + --- - --- + --- - ... # 3 5 7 9 # 1 1 1 1 # atan 1/x = - - ------- + ------- - ------- + ... # x x^3 * 3 x^5 * 5 x^7 * 7 # 1 1 1 1 # atan 1/x = - - --------- + ---------- - ----------- + ... # 5 3 * 125 5 * 3125 7 * 78125 # Subtraction/addition of a rational: # 5 7 5*3 +- 7*4 # - +- - = ---------- # 4 3 4*3 # Term: N N+1 # # a 1 a * d * c +- b # ----- +- ------------------ = ---------------- # b d * c b * d * c # since b1 = b0 * (d-2) * c # a 1 a * d +- b / c # ----- +- ------------------ = ---------------- # b d * c b * d # and d = d + 2 # and c = c * x * x # u = d * c # stop if length($u) > limit # a = a * u +- b # b = b * u # d = d + 2 # c = c * x * x # sign = 1 - sign my $a = $MBI->_one(); my $b = $MBI->_copy($x); my $x2 = $MBI->_mul( $MBI->_copy($x), $b); # x2 = x * x my $d = $MBI->_new( 3 ); # d = 3 my $c = $MBI->_mul( $MBI->_copy($x), $x2); # c = x ^ 3 my $two = $MBI->_new( 2 ); # run the first step unconditionally my $u = $MBI->_mul( $MBI->_copy($d), $c); $a = $MBI->_mul($a, $u); $a = $MBI->_sub($a, $b); $b = $MBI->_mul($b, $u); $d = $MBI->_add($d, $two); $c = $MBI->_mul($c, $x2); # a is now a * (d-3) * c # b is now b * (d-2) * c # run the second step unconditionally $u = $MBI->_mul( $MBI->_copy($d), $c); $a = $MBI->_mul($a, $u); $a = $MBI->_add($a, $b); $b = $MBI->_mul($b, $u); $d = $MBI->_add($d, $two); $c = $MBI->_mul($c, $x2); # a is now a * (d-3) * (d-5) * c * c # b is now b * (d-2) * (d-4) * c * c # so we can remove c * c from both a and b to shorten the numbers involved: $a = $MBI->_div($a, $x2); $b = $MBI->_div($b, $x2); $a = $MBI->_div($a, $x2); $b = $MBI->_div($b, $x2); # my $step = 0; my $sign = 0; # 0 => -, 1 => + while (3 < 5) { # $step++; # if (($i++ % 100) == 0) # { # print "a=",$MBI->_str($a),"\n"; # print "b=",$MBI->_str($b),"\n"; # } # print "d=",$MBI->_str($d),"\n"; # print "x2=",$MBI->_str($x2),"\n"; # print "c=",$MBI->_str($c),"\n"; my $u = $MBI->_mul( $MBI->_copy($d), $c); # use _alen() for libs like GMP where _len() would be O(N^2) last if $MBI->_alen($u) > $limit; my ($bc,$r) = $MBI->_div( $MBI->_copy($b), $c); if ($MBI->_is_zero($r)) { # b / c is an integer, so we can remove c from all terms # this happens almost every time: $a = $MBI->_mul($a, $d); $a = $MBI->_sub($a, $bc) if $sign == 0; $a = $MBI->_add($a, $bc) if $sign == 1; $b = $MBI->_mul($b, $d); } else { # b / c is not an integer, so we keep c in the terms # this happens very rarely, for instance for x = 5, this happens only # at the following steps: # 1, 5, 14, 32, 72, 157, 340, ... $a = $MBI->_mul($a, $u); $a = $MBI->_sub($a, $b) if $sign == 0; $a = $MBI->_add($a, $b) if $sign == 1; $b = $MBI->_mul($b, $u); } $d = $MBI->_add($d, $two); $c = $MBI->_mul($c, $x2); $sign = 1 - $sign; } # print "Took $step steps for ", $MBI->_str($x),"\n"; # print "a=",$MBI->_str($a),"\n"; print "b=",$MBI->_str($b),"\n"; # return a/b so that a/b approximates atan(1/x) ($a,$b); } sub bpi { # Called as Argument list # --------- ------------- # Math::BigFloat->bpi() ("Math::BigFloat") # Math::BigFloat->bpi(10) ("Math::BigFloat", 10) # $x->bpi() ($x) # $x->bpi(10) ($x, 10) # Math::BigFloat::bpi() () # Math::BigFloat::bpi(10) (10) # # In ambiguous cases, we favour the OO-style, so the following case # # $n = Math::BigFloat->new("10"); # $x = Math::BigFloat->bpi($n); # # which gives an argument list with the single element $n, is resolved as # # $n->bpi(); my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; my $accu; # accuracy (number of digits) my $prec; # precision my $rndm; # round mode # If bpi() is called as a function ... # # This cludge is necessary because we still support bpi() as a function. If # bpi() is called with either no argument or one argument, and that one # argument is either undefined or a scalar that looks like a number, then # we assume bpi() is called as a function. if (@_ == 0 && (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/i) || !defined($self)) { $accu = $self; $class = __PACKAGE__; $self = $class -> bzero(); # initialize } # ... or if bpi() is called as a method ... else { if ($selfref) { # bpi() called as instance method return $self if $self -> modify('bpi'); } else { # bpi() called as class method $self = $class -> bzero(); # initialize } $accu = shift; $prec = shift; $rndm = shift; } my @r = ($accu, $prec, $rndm); # We need to limit the accuracy to protect against overflow. my $fallback = 0; my ($scale, @params); ($self, @params) = $self -> _find_round_parameters(@r); # Error in _find_round_parameters? # # We can't return here, because that will fail if $self was a NaN when # bpi() was invoked, and we want to assign pi to $x. It is probably not a # good idea that _find_round_parameters() signals invalid round parameters # by silently returning a NaN. Fixme! #return $self if $self && $self->is_nan(); # No rounding at all, so must use fallback. if (scalar @params == 0) { # Simulate old behaviour $params[0] = $self -> div_scale(); # and round to it as accuracy $params[1] = undef; # disable P $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } # The accuracy, i.e., the number of digits. Pi has one digit before the # dot, so a precision of 4 digits is equivalent to an accuracy of 5 digits. my $n = $params[0] || 1 - $params[1]; if ($n < 1000) { # after 黃見利 (Hwang Chien-Lih) (1997) # pi/4 = 183 * atan(1/239) + 32 * atan(1/1023) – 68 * atan(1/5832) # + 12 * atan(1/110443) - 12 * atan(1/4841182) - 100 * atan(1/6826318) # Use a few more digits in the intermediate computations. my $nextra = $n < 800 ? 4 : 5; $n += $nextra; my ($a, $b) = $class->_atan_inv($MBI->_new(239), $n); my ($c, $d) = $class->_atan_inv($MBI->_new(1023), $n); my ($e, $f) = $class->_atan_inv($MBI->_new(5832), $n); my ($g, $h) = $class->_atan_inv($MBI->_new(110443), $n); my ($i, $j) = $class->_atan_inv($MBI->_new(4841182), $n); my ($k, $l) = $class->_atan_inv($MBI->_new(6826318), $n); $MBI->_mul($a, $MBI->_new(732)); $MBI->_mul($c, $MBI->_new(128)); $MBI->_mul($e, $MBI->_new(272)); $MBI->_mul($g, $MBI->_new(48)); $MBI->_mul($i, $MBI->_new(48)); $MBI->_mul($k, $MBI->_new(400)); my $x = $class->bone(); $x->{_m} = $a; my $x_d = $class->bone(); $x_d->{_m} = $b; my $y = $class->bone(); $y->{_m} = $c; my $y_d = $class->bone(); $y_d->{_m} = $d; my $z = $class->bone(); $z->{_m} = $e; my $z_d = $class->bone(); $z_d->{_m} = $f; my $u = $class->bone(); $u->{_m} = $g; my $u_d = $class->bone(); $u_d->{_m} = $h; my $v = $class->bone(); $v->{_m} = $i; my $v_d = $class->bone(); $v_d->{_m} = $j; my $w = $class->bone(); $w->{_m} = $k; my $w_d = $class->bone(); $w_d->{_m} = $l; $x->bdiv($x_d, $n); $y->bdiv($y_d, $n); $z->bdiv($z_d, $n); $u->bdiv($u_d, $n); $v->bdiv($v_d, $n); $w->bdiv($w_d, $n); delete $x->{_a}; delete $y->{_a}; delete $z->{_a}; delete $u->{_a}; delete $v->{_a}; delete $w->{_a}; $x->badd($y)->bsub($z)->badd($u)->bsub($v)->bsub($w); for my $key (qw/ sign _m _es _e _a _p /) { $self -> {$key} = $x -> {$key} if exists $x -> {$key}; } } else { # For large accuracy, the arctan formulas become very inefficient with # Math::BigFloat. Switch to Brent-Salamin (aka AGM or Gauss-Legendre). # Use a few more digits in the intermediate computations. my $nextra = 8; $HALF = $class -> new($HALF) unless ref($HALF); my ($an, $bn, $tn, $pn) = ($class -> bone, $HALF -> copy -> bsqrt($n), $HALF -> copy -> bmul($HALF), $class -> bone); while ($pn < $n) { my $prev_an = $an -> copy; $an -> badd($bn) -> bmul($HALF, $n); $bn -> bmul($prev_an) -> bsqrt($n); $prev_an -> bsub($an); $tn -> bsub($pn * $prev_an * $prev_an); $pn -> badd($pn); } $an -> badd($bn); $an -> bmul($an, $n) -> bdiv(4 * $tn, $n); for my $key (qw/ sign _m _es _e _a _p /) { $self -> {$key} = $an -> {$key} if exists $an -> {$key};; } } $self -> round(@params); if ($fallback) { delete $self->{_a}; delete $self->{_p}; } return $self; } sub bcos { # Calculate a cosinus of x. my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); # Taylor: x^2 x^4 x^6 x^8 # cos = 1 - --- + --- - --- + --- ... # 2! 4! 6! 8! # we need to limit the accuracy to protect against overflow my $fallback = 0; my ($scale,@params); ($x,@params) = $x->_find_round_parameters(@r); # constant object or error in _find_round_parameters? return $x if $x->modify('bcos') || $x->is_nan(); return $x->bone(@r) if $x->is_zero(); # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $self->div_scale(); # and round to it as accuracy $params[1] = undef; # disable P $scale = $params[0]+4; # at least four more for proper round $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not # enough... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; my $last = 0; my $over = $x * $x; # X ^ 2 my $x2 = $over->copy(); # X ^ 2; difference between terms my $sign = 1; # start with -= my $below = $self->new(2); my $factorial = $self->new(3); $x->bone(); delete $x->{_a}; delete $x->{_p}; my $limit = $self->new("1E-". ($scale-1)); #my $steps = 0; while (3 < 5) { # we calculate the next term, and add it to the last # when the next term is below our limit, it won't affect the outcome # anymore, so we stop: my $next = $over->copy()->bdiv($below,$scale); last if $next->bacmp($limit) <= 0; if ($sign == 0) { $x->badd($next); } else { $x->bsub($next); } $sign = 1-$sign; # alternate # calculate things for the next term $over->bmul($x2); # $x*$x $below->bmul($factorial); $factorial->binc(); # n*(n+1) $below->bmul($factorial); $factorial->binc(); # n*(n+1) } # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly } else { $x->bfround($params[1],$params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it delete $x->{_a}; delete $x->{_p}; } # restore globals $$abr = $ab; $$pbr = $pb; $x; } sub bsin { # Calculate a sinus of x. my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); # taylor: x^3 x^5 x^7 x^9 # sin = x - --- + --- - --- + --- ... # 3! 5! 7! 9! # we need to limit the accuracy to protect against overflow my $fallback = 0; my ($scale,@params); ($x,@params) = $x->_find_round_parameters(@r); # constant object or error in _find_round_parameters? return $x if $x->modify('bsin') || $x->is_nan(); return $x->bzero(@r) if $x->is_zero(); # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $self->div_scale(); # and round to it as accuracy $params[1] = undef; # disable P $scale = $params[0]+4; # at least four more for proper round $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not # enough... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } # when user set globals, they would interfere with our calculation, so # disable them and later re-enable them no strict 'refs'; my $abr = "$self\::accuracy"; my $ab = $$abr; $$abr = undef; my $pbr = "$self\::precision"; my $pb = $$pbr; $$pbr = undef; # we also need to disable any set A or P on $x (_find_round_parameters took # them already into account), since these would interfere, too delete $x->{_a}; delete $x->{_p}; # need to disable $upgrade in BigInt, to avoid deep recursion local $Math::BigInt::upgrade = undef; my $last = 0; my $over = $x * $x; # X ^ 2 my $x2 = $over->copy(); # X ^ 2; difference between terms $over->bmul($x); # X ^ 3 as starting value my $sign = 1; # start with -= my $below = $self->new(6); my $factorial = $self->new(4); delete $x->{_a}; delete $x->{_p}; my $limit = $self->new("1E-". ($scale-1)); #my $steps = 0; while (3 < 5) { # we calculate the next term, and add it to the last # when the next term is below our limit, it won't affect the outcome # anymore, so we stop: my $next = $over->copy()->bdiv($below,$scale); last if $next->bacmp($limit) <= 0; if ($sign == 0) { $x->badd($next); } else { $x->bsub($next); } $sign = 1-$sign; # alternate # calculate things for the next term $over->bmul($x2); # $x*$x $below->bmul($factorial); $factorial->binc(); # n*(n+1) $below->bmul($factorial); $factorial->binc(); # n*(n+1) } # shortcut to not run through _find_round_parameters again if (defined $params[0]) { $x->bround($params[0],$params[2]); # then round accordingly } else { $x->bfround($params[1],$params[2]); # then round accordingly } if ($fallback) { # clear a/p after round, since user did not request it delete $x->{_a}; delete $x->{_p}; } # restore globals $$abr = $ab; $$pbr = $pb; $x; } sub batan2 { # $y -> batan2($x) returns the arcus tangens of $y / $x. # Set up parameters. my ($self, $y, $x, @r) = (ref($_[0]), @_); # Objectify is costly, so avoid it if we can. if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self, $y, $x, @r) = objectify(2, @_); } # Quick exit if $y is read-only. return $y if $y -> modify('batan2'); # Handle all NaN cases. return $y -> bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; # We need to limit the accuracy to protect against overflow. my $fallback = 0; my ($scale, @params); ($y, @params) = $y -> _find_round_parameters(@r); # Error in _find_round_parameters? return $y if $y->is_nan(); # No rounding at all, so must use fallback. if (scalar @params == 0) { # Simulate old behaviour $params[0] = $self -> div_scale(); # and round to it as accuracy $params[1] = undef; # disable P $scale = $params[0] + 4; # at least four more for proper round $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # The 4 below is empirical, and there might be cases where it is not # enough ... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } if ($x -> is_inf("+")) { # x = inf if ($y -> is_inf("+")) { # y = inf $y -> bpi($scale) -> bmul("0.25"); # pi/4 } elsif ($y -> is_inf("-")) { # y = -inf $y -> bpi($scale) -> bmul("-0.25"); # -pi/4 } else { # -inf < y < inf return $y -> bzero(@r); # 0 } } elsif ($x -> is_inf("-")) { # x = -inf if ($y -> is_inf("+")) { # y = inf $y -> bpi($scale) -> bmul("0.75"); # 3/4 pi } elsif ($y -> is_inf("-")) { # y = -inf $y -> bpi($scale) -> bmul("-0.75"); # -3/4 pi } elsif ($y >= 0) { # y >= 0 $y -> bpi($scale); # pi } else { # y < 0 $y -> bpi($scale) -> bneg(); # -pi } } elsif ($x > 0) { # 0 < x < inf if ($y -> is_inf("+")) { # y = inf $y -> bpi($scale) -> bmul("0.5"); # pi/2 } elsif ($y -> is_inf("-")) { # y = -inf $y -> bpi($scale) -> bmul("-0.5"); # -pi/2 } else { # -inf < y < inf $y -> bdiv($x, $scale) -> batan($scale); # atan(y/x) } } elsif ($x < 0) { # -inf < x < 0 my $pi = $class -> bpi($scale); if ($y >= 0) { # y >= 0 $y -> bdiv($x, $scale) -> batan() # atan(y/x) + pi -> badd($pi); } else { # y < 0 $y -> bdiv($x, $scale) -> batan() # atan(y/x) - pi -> bsub($pi); } } else { # x = 0 if ($y > 0) { # y > 0 $y -> bpi($scale) -> bmul("0.5"); # pi/2 } elsif ($y < 0) { # y < 0 $y -> bpi($scale) -> bmul("-0.5"); # -pi/2 } else { # y = 0 return $y -> bzero(@r); # 0 } } $y -> round(@r); if ($fallback) { delete $y->{_a}; delete $y->{_p}; } return $y; } sub batan { # Calculate a arcus tangens of x. my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; my (@r) = @_; # taylor: x^3 x^5 x^7 x^9 # atan = x - --- + --- - --- + --- ... # 3 5 7 9 # We need to limit the accuracy to protect against overflow. my $fallback = 0; my ($scale, @params); ($self, @params) = $self->_find_round_parameters(@r); # Constant object or error in _find_round_parameters? return $self if $self->modify('batan') || $self->is_nan(); if ($self->{sign} =~ /^[+-]inf\z/) { # +inf result is PI/2 # -inf result is -PI/2 # calculate PI/2 my $pi = $class->bpi(@r); # modify $self in place $self->{_m} = $pi->{_m}; $self->{_e} = $pi->{_e}; $self->{_es} = $pi->{_es}; # -y => -PI/2, +y => PI/2 $self->{sign} = substr($self->{sign}, 0, 1); # "+inf" => "+" $MBI->_div($self->{_m}, $MBI->_new(2)); return $self; } return $self->bzero(@r) if $self->is_zero(); # no rounding at all, so must use fallback if (scalar @params == 0) { # simulate old behaviour $params[0] = $class->div_scale(); # and round to it as accuracy $params[1] = undef; # disable P $scale = $params[0]+4; # at least four more for proper round $params[2] = $r[2]; # round mode by caller or undef $fallback = 1; # to clear a/p afterwards } else { # the 4 below is empirical, and there might be cases where it is not # enough... $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined } # 1 or -1 => PI/4 # inlined is_one() && is_one('-') if ($MBI->_is_one($self->{_m}) && $MBI->_is_zero($self->{_e})) { my $pi = $class->bpi($scale - 3); # modify $self in place $self->{_m} = $pi->{_m}; $self->{_e} = $pi->{_e}; $self->{_es} = $pi->{_es}; # leave the sign of $self alone (+1 => +PI/4, -1 => -PI/4) $MBI->_div($self->{_m}, $MBI->_new(4)); return $self; } # This series is only valid if -1 < x < 1, so for other x we need to # calculate PI/2 - atan(1/x): my $one = $MBI->_new(1); my $pi = undef; if ($self->bacmp($self->copy->bone) >= 0) { # calculate PI/2 $pi = $class->bpi($scale - 3); $MBI->_div($pi->{_m}, $MBI->_new(2)); # calculate 1/$self: my $self_copy = $self->copy(); # modify $self in place $self->bone(); $self->bdiv($self_copy, $scale); } my $fmul = 1; foreach my $k (0 .. int($scale / 20)) { $fmul *= 2; $self->bdiv($self->copy->bmul($self)->binc->bsqrt($scale + 4)->binc, $scale + 4); } # When user set globals, they would interfere with our calculation, so # disable them and later re-enable them. no strict 'refs'; my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef; my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef; # We also need to disable any set A or P on $self (_find_round_parameters # took them already into account), since these would interfere, too delete $self->{_a}; delete $self->{_p}; # Need to disable $upgrade in BigInt, to avoid deep recursion. local $Math::BigInt::upgrade = undef; my $last = 0; my $over = $self * $self; # X ^ 2 my $self2 = $over->copy(); # X ^ 2; difference between terms $over->bmul($self); # X ^ 3 as starting value my $sign = 1; # start with -= my $below = $class->new(3); my $two = $class->new(2); delete $self->{_a}; delete $self->{_p}; my $limit = $class->new("1E-". ($scale-1)); #my $steps = 0; while (1) { # We calculate the next term, and add it to the last. When the next # term is below our limit, it won't affect the outcome anymore, so we # stop: my $next = $over->copy()->bdiv($below, $scale); last if $next->bacmp($limit) <= 0; if ($sign == 0) { $self->badd($next); } else { $self->bsub($next); } $sign = 1-$sign; # alternatex # calculate things for the next term $over->bmul($self2); # $self*$self $below->badd($two); # n += 2 } $self->bmul($fmul); if (defined $pi) { my $self_copy = $self->copy(); # modify $self in place $self->{_m} = $pi->{_m}; $self->{_e} = $pi->{_e}; $self->{_es} = $pi->{_es}; # PI/2 - $self $self->bsub($self_copy); } # Shortcut to not run through _find_round_parameters again. if (defined $params[0]) { $self->bround($params[0], $params[2]); # then round accordingly } else { $self->bfround($params[1], $params[2]); # then round accordingly } if ($fallback) { # Clear a/p after round, since user did not request it. delete $self->{_a}; delete $self->{_p}; } # restore globals $$abr = $ab; $$pbr = $pb; $self; } ############################################################################### # rounding functions sub bfround { # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' # $n == 0 means round to integer # expects and returns normalized numbers! my $x = shift; my $self = ref($x) || $x; $x = $self->new(shift) if !ref($x); my ($scale,$mode) = $x->_scale_p(@_); return $x if !defined $scale || $x->modify('bfround'); # no-op # never round a 0, +-inf, NaN if ($x->is_zero()) { $x->{_p} = $scale if !defined $x->{_p} || $x->{_p} < $scale; # -3 < -2 return $x; } return $x if $x->{sign} !~ /^[+-]$/; # don't round if x already has lower precision return $x if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p}); $x->{_p} = $scale; # remember round in any case delete $x->{_a}; # and clear A if ($scale < 0) { # round right from the '.' return $x if $x->{_es} eq '+'; # e >= 0 => nothing to round $scale = -$scale; # positive for simplicity 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 = -(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"; # number bsstr len zad dad # 0.123 123e-3 3 0 3 # 0.0123 123e-4 3 1 4 # 0.001 1e-3 1 2 3 # 1.23 123e-2 3 0 2 # 1.2345 12345e-4 5 0 4 # do not round after/right of the $dad return $x if $scale > $dad; # 0.123, scale >= 3 => exit # round to zero if rounding inside the $zad, but not for last zero like: # 0.0065, scale -2, round last '0' with following '65' (scale == zad case) return $x->bzero() if $scale < $zad; if ($scale == $zad) # for 0.006, scale -3 and trunc { $scale = -$len; } else { # adjust round-point to be inside mantissa if ($zad != 0) { $scale = $scale-$zad; } else { my $dbd = $len - $dad; $dbd = 0 if $dbd < 0; # digits before dot $scale = $dbd+$scale; } } } else { # round left from the '.' # 123 => 100 means length(123) = 3 - $scale (2) => 1 my $dbt = $MBI->_len($x->{_m}); # digits before dot 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 return $x if $scale == 1 && $dbt <= $dbd; # maximum digits before dot ++$dbd; if ($scale > $dbd) { # not enough digits before dot, so round to zero return $x->bzero; } elsif ( $scale == $dbd ) { # maximum $scale = -$dbt; } else { $scale = $dbd - $scale; } } # pass sign to bround for rounding modes '+inf' and '-inf' my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt'; $m->bround($scale,$mode); $x->{_m} = $m->{value}; # get our mantissa back $x->bnorm(); } 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'); } my ($scale,$mode) = $x->_scale_a(@_); return $x if !defined $scale || $x->modify('bround'); # no-op # scale is now either $x->{_a}, $accuracy, or the user parameter # test whether $x already has lower accuracy, do nothing in this case # but do round if the accuracy is the same, since a math operation might # want to round a number with A=5 to 5 digits afterwards again return $x if defined $x->{_a} && $x->{_a} < $scale; # scale < 0 makes no sense # scale == 0 => keep all digits # never round a +-inf, NaN return $x if ($scale <= 0) || $x->{sign} !~ /^[+-]$/; # 1: never round a 0 # 2: if we should keep more digits than the mantissa has, do nothing if ($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 my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt'; $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() } sub bfloor { # round towards minus infinity my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bfloor'); return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf # if $x has digits after dot if ($x->{_es} eq '-') { $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); } sub bceil { # round towards plus infinity my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bceil'); return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf # if $x has digits after dot if ($x->{_es} eq '-') { $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot $x->{_e} = $MBI->_zero(); # trunc/norm $x->{_es} = '+'; # abs e if ($x->{sign} eq '+') { $MBI->_inc($x->{_m}); # increment if positive } else { $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # avoid -0 } } $x->round($a,$p,$r); } sub bint { # round towards zero my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bint'); return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf # if $x has digits after the decimal point if ($x->{_es} eq '-') { $x->{_m} = $MBI->_rsft($x->{_m},$x->{_e},10); # cut off digits after dot $x->{_e} = $MBI->_zero(); # truncate/normalize $x->{_es} = '+'; # abs e $x->{sign} = '+' if $MBI->_is_zero($x->{_m}); # avoid -0 } $x->round($a,$p,$r); } sub brsft { # shift right by $y (divide by power of $n) # set up parameters my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_); } return $x if $x->modify('brsft'); return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf $n = 2 if !defined $n; $n = $self->new($n); # negative amount? return $x->blsft($y->copy()->babs(),$n) if $y->{sign} =~ /^-/; # the following call to bdiv() will return either quo or (quo,remainder): $x->bdiv($n->bpow($y),$a,$p,$r,$y); } sub blsft { # shift left by $y (multiply by power of $n) # set up parameters my ($self,$x,$y,$n,$a,$p,$r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,$n,$a,$p,$r) = objectify(2,@_); } return $x if $x->modify('blsft'); return $x if $x->{sign} !~ /^[+-]$/; # nan, +inf, -inf $n = 2 if !defined $n; $n = $self->new($n); # negative amount? return $x->brsft($y->copy()->babs(),$n) if $y->{sign} =~ /^-/; $x->bmul($n->bpow($y),$a,$p,$r,$y); } ############################################################################### sub DESTROY { # going through AUTOLOAD for every DESTROY is costly, avoid it by empty sub } sub AUTOLOAD { # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx() # or falling back to MBI::bxxx() my $name = $AUTOLOAD; $name =~ s/(.*):://; # split package my $c = $1 || $class; no strict 'refs'; $c->import() if $IMPORT == 0; if (!_method_alias($name)) { if (!defined $name) { # delayed load of Carp and avoid recursion require Carp; Carp::croak ("$c: Can't call a method without name"); } if (!_method_hand_up($name)) { # delayed load of Carp and avoid recursion require Carp; Carp::croak ("Can't call $c\-\>$name, not a valid method"); } # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx() $name =~ s/^f/b/; return &{"Math::BigInt"."::$name"}(@_); } my $bname = $name; $bname =~ s/^f/b/; $c .= "::$name"; *{$c} = \&{$bname}; &{$c}; # uses @_ } sub exponent { # return a copy of the exponent my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; $s =~ s/^[+-]//; return Math::BigInt->new($s); # -inf, +inf => +inf } Math::BigInt->new( $x->{_es} . $MBI->_str($x->{_e})); } sub mantissa { # return a copy of the mantissa my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; $s =~ s/^[+]//; return Math::BigInt->new($s); # -inf, +inf => +inf } my $m = Math::BigInt->new( $MBI->_str($x->{_m})); $m->bneg() if $x->{sign} eq '-'; $m; } sub parts { # return a copy of both the exponent and the mantissa my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { 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 = Math::BigInt->bzero(); $m->{value} = $MBI->_copy($x->{_m}); $m->bneg() if $x->{sign} eq '-'; ($m, Math::BigInt->new( $x->{_es} . $MBI->_num($x->{_e}) )); } ############################################################################## # private stuff (internal use only) sub import { my $self = shift; my $l = scalar @_; my $lib = ''; my @a; my $lib_kind = 'try'; $IMPORT=1; for ( my $i = 0; $i < $l ; $i++) { if ( $_[$i] eq ':constant' ) { # This causes overlord er load to step in. 'binary' and 'integer' # are handled by BigInt. overload::constant float => sub { $self->new(shift); }; } elsif ($_[$i] eq 'upgrade') { # this causes upgrading $upgrade = $_[$i+1]; # or undef to disable $i++; } elsif ($_[$i] eq 'downgrade') { # this causes downgrading $downgrade = $_[$i+1]; # or undef to disable $i++; } elsif ($_[$i] =~ /^(lib|try|only)\z/) { # alternative library $lib = $_[$i+1] || ''; # default Calc $lib_kind = $1; # lib, try or only $i++; } elsif ($_[$i] eq 'with') { # alternative class for our private parts() # XXX: no longer supported # $MBI = $_[$i+1] || 'Math::BigInt'; $i++; } else { push @a, $_[$i]; } } $lib =~ tr/a-zA-Z0-9,://cd; # restrict to sane characters # 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::Calc')) { # MBI already loaded Math::BigInt->import( $lib_kind, "$lib,$mbilib", 'objectify'); } else { # 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 # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is # used in the same script, or eval inside import(). So we require MBI: require Math::BigInt; Math::BigInt->import( $lib_kind => $lib, 'objectify' ); } if ($@) { require Carp; Carp::croak ("Couldn't load $lib: $! $@"); } # find out which one was actually loaded $MBI = Math::BigInt->config()->{lib}; # register us with MBI to get notified of future lib changes Math::BigInt::_register_callback( $self, sub { $MBI = $_[0]; } ); $self->export_to_level(1,$self,@a); # export wanted functions } sub bnorm { # adjust m and e so that m is smallest possible my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $x if $x->{sign} !~ /^[+-]$/; # inf, nan etc my $zeros = $MBI->_zeros($x->{_m}); # correct for trailing zeros if ($zeros != 0) { 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); $x->{_es} = '+' if $MBI->_is_zero($x->{_e}); } 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->{_es} = '+', $x->{_e} = $MBI->_one() if $MBI->_is_zero($x->{_m}); } $x; # MBI bnorm is no-op, so do not call it } ############################################################################## sub as_hex { # return number as hexadecimal string (only for integers defined) my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc return '0x0' if $x->is_zero(); return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex!? my $z = $MBI->_copy($x->{_m}); if (! $MBI->_is_zero($x->{_e})) # > 0 { $MBI->_lsft( $z, $x->{_e},10); } $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z)); $z->as_hex(); } sub as_bin { # return number as binary digit string (only for integers defined) my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc return '0b0' if $x->is_zero(); return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex!? my $z = $MBI->_copy($x->{_m}); if (! $MBI->_is_zero($x->{_e})) # > 0 { $MBI->_lsft( $z, $x->{_e},10); } $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z)); $z->as_bin(); } sub as_oct { # return number as octal digit string (only for integers defined) my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc return '0' if $x->is_zero(); return $nan if $x->{_es} ne '+'; # how to do 1e-1 in hex!? my $z = $MBI->_copy($x->{_m}); if (! $MBI->_is_zero($x->{_e})) # > 0 { $MBI->_lsft( $z, $x->{_e},10); } $z = Math::BigInt->new( $x->{sign} . $MBI->_num($z)); $z->as_oct(); } sub as_number { # return copy as a bigint representation of this BigFloat number my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x if $x->modify('as_number'); if (!$x->isa('Math::BigFloat')) { # if the object can as_number(), use it return $x->as_number() if $x->can('as_number'); # otherwise, get us a float and then a number $x = $x->can('as_float') ? $x->as_float() : $self->new(0+"$x"); } return Math::BigInt->binf($x->sign()) if $x->is_inf(); return Math::BigInt->bnan() if $x->is_nan(); my $z = $MBI->_copy($x->{_m}); if ($x->{_es} eq '-') # < 0 { $MBI->_rsft( $z, $x->{_e},10); } elsif (! $MBI->_is_zero($x->{_e})) # > 0 { $MBI->_lsft( $z, $x->{_e},10); } $z = Math::BigInt->new( $x->{sign} . $MBI->_str($z)); $z; } sub length { my $x = shift; my $class = ref($x) || $x; $x = $class->new(shift) unless ref($x); 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 = 0; $t = $MBI->_num($x->{_e}) if $x->{_es} eq '-'; return ($len, $t); } $len; } sub from_hex { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; my $str = shift; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; if ($str =~ s/ ^ # sign ( [+-]? ) # optional "hex marker" (?: 0? x )? # significand using the hex digits 0..9 and a..f ( [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* (?: \. (?: [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* )? )? | \. [0-9a-fA-F]+ (?: _ [0-9a-fA-F]+ )* ) # exponent (power of 2) using decimal digits (?: [Pp] ( [+-]? ) ( \d+ (?: _ \d+ )* ) )? $ //x) { my $s_sign = $1 || '+'; my $s_value = $2; my $e_sign = $3 || '+'; my $e_value = $4 || '0'; $s_value =~ tr/_//d; $e_value =~ tr/_//d; # The significand must be multiplied by 2 raised to this exponent. my $two_expon = $class -> new($e_value); $two_expon -> bneg() if $e_sign eq '-'; # If there is a dot in the significand, remove it and adjust the # exponent according to the number of digits in the fraction part of # the significand. Since the digits in the significand are in base 16, # but the exponent is only in base 2, multiply the exponent adjustment # value by log(16) / log(2) = 4. my $idx = index($s_value, '.'); if ($idx >= 0) { substr($s_value, $idx, 1) = ''; $two_expon -= $class -> new(CORE::length($s_value)) -> bsub($idx) -> bmul("4"); } $self -> {sign} = $s_sign; $self -> {_m} = $MBI -> _from_hex('0x' . $s_value); if ($two_expon > 0) { my $factor = $class -> new("2") -> bpow($two_expon); $self -> bmul($factor); } elsif ($two_expon < 0) { my $factor = $class -> new("0.5") -> bpow(-$two_expon); $self -> bmul($factor); } return $self; } return $self->bnan(); } sub from_oct { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; my $str = shift; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; if ($str =~ s/ ^ # sign ( [+-]? ) # significand using the octal digits 0..7 ( [0-7]+ (?: _ [0-7]+ )* (?: \. (?: [0-7]+ (?: _ [0-7]+ )* )? )? | \. [0-7]+ (?: _ [0-7]+ )* ) # exponent (power of 2) using decimal digits (?: [Pp] ( [+-]? ) ( \d+ (?: _ \d+ )* ) )? $ //x) { my $s_sign = $1 || '+'; my $s_value = $2; my $e_sign = $3 || '+'; my $e_value = $4 || '0'; $s_value =~ tr/_//d; $e_value =~ tr/_//d; # The significand must be multiplied by 2 raised to this exponent. my $two_expon = $class -> new($e_value); $two_expon -> bneg() if $e_sign eq '-'; # If there is a dot in the significand, remove it and adjust the # exponent according to the number of digits in the fraction part of # the significand. Since the digits in the significand are in base 8, # but the exponent is only in base 2, multiply the exponent adjustment # value by log(8) / log(2) = 3. my $idx = index($s_value, '.'); if ($idx >= 0) { substr($s_value, $idx, 1) = ''; $two_expon -= $class -> new(CORE::length($s_value)) -> bsub($idx) -> bmul("3"); } $self -> {sign} = $s_sign; $self -> {_m} = $MBI -> _from_oct($s_value); if ($two_expon > 0) { my $factor = $class -> new("2") -> bpow($two_expon); $self -> bmul($factor); } elsif ($two_expon < 0) { my $factor = $class -> new("0.5") -> bpow(-$two_expon); $self -> bmul($factor); } return $self; } return $self->bnan(); } sub from_bin { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; my $str = shift; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; if ($str =~ s/ ^ # sign ( [+-]? ) # optional "bin marker" (?: 0? b )? # significand using the binary digits 0 and 1 ( [01]+ (?: _ [01]+ )* (?: \. (?: [01]+ (?: _ [01]+ )* )? )? | \. [01]+ (?: _ [01]+ )* ) # exponent (power of 2) using decimal digits (?: [Pp] ( [+-]? ) ( \d+ (?: _ \d+ )* ) )? $ //x) { my $s_sign = $1 || '+'; my $s_value = $2; my $e_sign = $3 || '+'; my $e_value = $4 || '0'; $s_value =~ tr/_//d; $e_value =~ tr/_//d; # The significand must be multiplied by 2 raised to this exponent. my $two_expon = $class -> new($e_value); $two_expon -> bneg() if $e_sign eq '-'; # If there is a dot in the significand, remove it and adjust the # exponent according to the number of digits in the fraction part of # the significand. my $idx = index($s_value, '.'); if ($idx >= 0) { substr($s_value, $idx, 1) = ''; $two_expon -= $class -> new(CORE::length($s_value)) -> bsub($idx); } $self -> {sign} = $s_sign; $self -> {_m} = $MBI -> _from_bin('0b' . $s_value); if ($two_expon > 0) { my $factor = $class -> new("2") -> bpow($two_expon); $self -> bmul($factor); } elsif ($two_expon < 0) { my $factor = $class -> new("0.5") -> bpow(-$two_expon); $self -> bmul($factor); } return $self; } return $self->bnan(); } 1; __END__ =pod =head1 NAME Math::BigFloat - Arbitrary size floating point math package =head1 SYNOPSIS use Math::BigFloat; # Number creation my $x = Math::BigFloat->new($str); # defaults to 0 my $y = $x->copy(); # make a true copy my $nan = Math::BigFloat->bnan(); # create a NotANumber my $zero = Math::BigFloat->bzero(); # create a +0 my $inf = Math::BigFloat->binf(); # create a +inf my $inf = Math::BigFloat->binf('-'); # create a -inf my $one = Math::BigFloat->bone(); # create a +1 my $mone = Math::BigFloat->bone('-'); # create a -1 my $x = Math::BigFloat->bone('-'); # my $x = Math::BigFloat->from_hex('0xc.afep+3'); # from hexadecimal my $x = Math::BigFloat->from_bin('0b1.1001p-4'); # from binary my $x = Math::BigFloat->from_oct('1.3267p-4'); # from octal my $pi = Math::BigFloat->bpi(100); # PI to 100 digits # the following examples compute their result to 100 digits accuracy: my $cos = Math::BigFloat->new(1)->bcos(100); # cosinus(1) my $sin = Math::BigFloat->new(1)->bsin(100); # sinus(1) my $atan = Math::BigFloat->new(1)->batan(100); # arcus tangens(1) my $atan2 = Math::BigFloat->new( 1 )->batan2( 1 ,100); # batan(1) my $atan2 = Math::BigFloat->new( 1 )->batan2( 8 ,100); # batan(1/8) my $atan2 = Math::BigFloat->new( -2 )->batan2( 1 ,100); # batan(-2) # Testing $x->is_zero(); # true if arg is +0 $x->is_nan(); # true if arg is NaN $x->is_one(); # true if arg is +1 $x->is_one('-'); # true if arg is -1 $x->is_odd(); # true if odd, false for even $x->is_even(); # true if even, false for odd $x->is_pos(); # true if >= 0 $x->is_neg(); # true if < 0 $x->is_inf(sign); # true if +inf, or -inf (default is '+') $x->bcmp($y); # compare numbers (undef,<0,=0,>0) $x->bacmp($y); # compare absolutely (undef,<0,=0,>0) $x->sign(); # return the sign, either +,- or NaN $x->digit($n); # return the nth digit, counting from right $x->digit(-$n); # return the nth digit, counting from left # The following all modify their first argument. If you want to pre- # serve $x, use $z = $x->copy()->bXXX($y); See under L for # necessary when mixing $a = $b assignments with non-overloaded math. # set $x->bzero(); # set $i to 0 $x->bnan(); # set $i to NaN $x->bone(); # set $x to +1 $x->bone('-'); # set $x to -1 $x->binf(); # set $x to inf $x->binf('-'); # set $x to -inf $x->bneg(); # negation $x->babs(); # absolute value $x->bnorm(); # normalize (no-op) $x->bnot(); # two's complement (bit wise not) $x->binc(); # increment x by 1 $x->bdec(); # decrement x by 1 $x->badd($y); # addition (add $y to $x) $x->bsub($y); # subtraction (subtract $y from $x) $x->bmul($y); # multiplication (multiply $x by $y) $x->bdiv($y); # divide, set $x to quotient # return (quo,rem) or quo if scalar $x->bmod($y); # modulus ($x % $y) $x->bpow($y); # power of arguments ($x ** $y) $x->bmodpow($exp,$mod); # modular exponentiation (($num**$exp) % $mod)) $x->blsft($y, $n); # left shift by $y places in base $n $x->brsft($y, $n); # right shift by $y places in base $n # returns (quo,rem) or quo if in scalar context $x->blog(); # logarithm of $x to base e (Euler's number) $x->blog($base); # logarithm of $x to base $base (f.i. 2) $x->bexp(); # calculate e ** $x where e is Euler's number $x->band($y); # bit-wise and $x->bior($y); # bit-wise inclusive or $x->bxor($y); # bit-wise exclusive or $x->bnot(); # bit-wise not (two's complement) $x->bsqrt(); # calculate square-root $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root) $x->bfac(); # factorial of $x (1*2*3*4*..$x) $x->bround($N); # accuracy: preserve $N digits $x->bfround($N); # precision: round to the $Nth digit $x->bfloor(); # return integer less or equal than $x $x->bceil(); # return integer greater or equal than $x $x->bint(); # round towards zero # The following do not modify their arguments: bgcd(@values); # greatest common divisor blcm(@values); # lowest common multiplicator $x->bstr(); # return string $x->bsstr(); # return string in scientific notation $x->as_int(); # return $x as BigInt $x->exponent(); # return exponent as BigInt $x->mantissa(); # return mantissa as BigInt $x->parts(); # return (mantissa,exponent) as BigInt $x->length(); # number of digits (w/o sign and '.') ($l,$f) = $x->length(); # number of digits, and length of fraction $x->precision(); # return P of $x (or global, if P of $x undef) $x->precision($n); # set P of $x to $n $x->accuracy(); # return A of $x (or global, if A of $x undef) $x->accuracy($n); # set A $x to $n # these get/set the appropriate global value for all BigFloat objects Math::BigFloat->precision(); # Precision Math::BigFloat->accuracy(); # Accuracy Math::BigFloat->round_mode(); # rounding mode =head1 DESCRIPTION All operators (including basic math operations) are overloaded if you declare your big floating point numbers as $i = Math::BigFloat -> new('12_3.456_789_123_456_789E-2'); Operations with overloaded operators preserve the arguments, which is exactly what you expect. =head2 Input Input to these routines are either BigFloat objects, or strings of the following four forms: =over =item * C =item * C =item * C =item * C =back all with optional leading and trailing zeros and/or spaces. Additionally, numbers are allowed to have an underscore between any two digits. Empty strings as well as other illegal numbers results in 'NaN'. bnorm() on a BigFloat object is now effectively a no-op, since the numbers are always stored in normalized form. On a string, it creates a BigFloat object. =head2 Output Output values are BigFloat objects (normalized), except for bstr() and bsstr(). The string output will always have leading and trailing zeros stripped and drop a plus sign. C will give you always the form with a decimal point, while C (s for scientific) gives you the scientific notation. Input bstr() bsstr() '-0' '0' '0E1' ' -123 123 123' '-123123123' '-123123123E0' '00.0123' '0.0123' '123E-4' '123.45E-2' '1.2345' '12345E-4' '10E+3' '10000' '1E4' Some routines (C, C, C, C, C) return true or false, while others (C, C) return either undef, <0, 0 or >0 and are suited for sort. Actual math is done by using the class defined with C<< with => Class; >> (which defaults to BigInts) to represent the mantissa and exponent. The sign C is stored separately. The string 'NaN' is used to represent the result when input arguments are not numbers, and 'inf' and '-inf' are used to represent positive and negative infinity, respectively. =head2 mantissa(), exponent() and parts() mantissa() and exponent() return the said parts of the BigFloat as BigInts such that: $m = $x->mantissa(); $e = $x->exponent(); $y = $m * ( 10 ** $e ); print "ok\n" if $x == $y; C<< ($m,$e) = $x->parts(); >> is just a shortcut giving you both of them. Currently the mantissa is reduced as much as possible, favouring higher exponents over lower ones (e.g. returning 1e7 instead of 10e6 or 10000000e0). This might change in the future, so do not depend on it. =head2 Accuracy vs. Precision See also: L. Math::BigFloat supports both precision (rounding to a certain place before or after the dot) and accuracy (rounding to a certain number of digits). For a full documentation, examples and tips on these topics please see the large section about rounding in L. Since things like C or C<1 / 3> must presented with a limited accuracy lest a operation consumes all resources, each operation produces no more than the requested number of digits. If there is no global precision or accuracy set, B the operation in question was not called with a requested precision or accuracy, B the input $x has no accuracy or precision set, then a fallback parameter will be used. For historical reasons, it is called C and can be accessed via: $d = Math::BigFloat->div_scale(); # query Math::BigFloat->div_scale($n); # set to $n digits The default value for C is 40. In case the result of one operation has more digits than specified, it is rounded. The rounding mode taken is either the default mode, or the one supplied to the operation after the I: $x = Math::BigFloat->new(2); Math::BigFloat->accuracy(5); # 5 digits max $y = $x->copy()->bdiv(3); # will give 0.66667 $y = $x->copy()->bdiv(3,6); # will give 0.666667 $y = $x->copy()->bdiv(3,6,undef,'odd'); # will give 0.666667 Math::BigFloat->round_mode('zero'); $y = $x->copy()->bdiv(3,6); # will also give 0.666667 Note that C<< Math::BigFloat->accuracy() >> and C<< Math::BigFloat->precision() >> set the global variables, and thus B newly created number will be subject to the global rounding B. This means that in the examples above, the C<3> as argument to C will also get an accuracy of B<5>. It is less confusing to either calculate the result fully, and afterwards round it explicitly, or use the additional parameters to the math functions like so: use Math::BigFloat; $x = Math::BigFloat->new(2); $y = $x->copy()->bdiv(3); print $y->bround(5),"\n"; # will give 0.66667 or use Math::BigFloat; $x = Math::BigFloat->new(2); $y = $x->copy()->bdiv(3,5); # will give 0.66667 print "$y\n"; =head2 Rounding =over =item bfround ( +$scale ) Rounds to the $scale'th place left from the '.', counting from the dot. The first digit is numbered 1. =item bfround ( -$scale ) Rounds to the $scale'th place right from the '.', counting from the dot. =item bfround ( 0 ) Rounds to an integer. =item bround ( +$scale ) Preserves accuracy to $scale digits from the left (aka significant digits) and pads the rest with zeros. If the number is between 1 and -1, the significant digits count from the first non-zero after the '.' =item bround ( -$scale ) and bround ( 0 ) These are effectively no-ops. =back All rounding functions take as a second parameter a rounding mode from one of the following: 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'. The default rounding mode is 'even'. By using C<< Math::BigFloat->round_mode($round_mode); >> you can get and set the default mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is no longer supported. The second parameter to the round functions then overrides the default temporarily. The C function returns a BigInt from a Math::BigFloat. It uses 'trunc' as rounding mode to make it equivalent to: $x = 2.5; $y = int($x) + 2; You can override this by passing the desired rounding mode as parameter to C: $x = Math::BigFloat->new(2.5); $y = $x->as_number('odd'); # $y = 3 =head1 METHODS Math::BigFloat supports all methods that Math::BigInt supports, except it calculates non-integer results when possible. Please see L for a full description of each method. Below are just the most important differences: =over =item accuracy() $x->accuracy(5); # local for $x CLASS->accuracy(5); # global for all members of CLASS # Note: This also applies to new()! $A = $x->accuracy(); # read out accuracy that affects $x $A = CLASS->accuracy(); # read out global accuracy Set or get the global or local accuracy, aka how many significant digits the results have. If you set a global accuracy, then this also applies to new()! Warning! The accuracy I, e.g. once you created a number under the influence of C<< CLASS->accuracy($A) >>, all results from math operations with that number will also be rounded. In most cases, you should probably round the results explicitly using one of L, L or L or by passing the desired accuracy to the math operation as additional parameter: my $x = Math::BigInt->new(30000); my $y = Math::BigInt->new(7); print scalar $x->copy()->bdiv($y, 2); # print 4300 print scalar $x->copy()->bdiv($y)->bround(2); # print 4300 =item precision() $x->precision(-2); # local for $x, round at the second # digit right of the dot $x->precision(2); # ditto, round at the second digit # left of the dot CLASS->precision(5); # Global for all members of CLASS # This also applies to new()! CLASS->precision(-5); # ditto $P = CLASS->precision(); # read out global precision $P = $x->precision(); # read out precision that affects $x Note: You probably want to use L instead. With L you set the number of digits each result should have, with L you set the place where to round! =item bdiv() $q = $x->bdiv($y); ($q, $r) = $x->bdiv($y); In scalar context, divides $x by $y and returns the result to the given or default accuracy/precision. In list context, does floored division (F-division), returning an integer $q and a remainder $r so that $x = $q * $y + $r. The remainer (modulo) is equal to what is returned by C<$x->bmod($y)>. =item bmod() $x->bmod($y); Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the result is identical to the remainder after floored division (F-division). If, in addition, both $x and $y are integers, the result is identical to the result from Perl's % operator. =item bexp() $x->bexp($accuracy); # calculate e ** X Calculates the expression C where C is Euler's number. This method was added in v1.82 of Math::BigInt (April 2007). =item bnok() $x->bnok($y); # x over y (binomial coefficient n over k) Calculates the binomial coefficient n over k, also called the "choose" function. The result is equivalent to: ( n ) n! | - | = ------- ( k ) k!(n-k)! This method was added in v1.84 of Math::BigInt (April 2007). =item bpi() print Math::BigFloat->bpi(100), "\n"; Calculate PI to N digits (including the 3 before the dot). The result is rounded according to the current rounding mode, which defaults to "even". This method was added in v1.87 of Math::BigInt (June 2007). =item bcos() my $x = Math::BigFloat->new(1); print $x->bcos(100), "\n"; Calculate the cosinus of $x, modifying $x in place. This method was added in v1.87 of Math::BigInt (June 2007). =item bsin() my $x = Math::BigFloat->new(1); print $x->bsin(100), "\n"; Calculate the sinus of $x, modifying $x in place. This method was added in v1.87 of Math::BigInt (June 2007). =item batan2() my $y = Math::BigFloat->new(2); my $x = Math::BigFloat->new(3); print $y->batan2($x), "\n"; Calculate the arcus tanges of C<$y> divided by C<$x>, modifying $y in place. See also L. This method was added in v1.87 of Math::BigInt (June 2007). =item batan() my $x = Math::BigFloat->new(1); print $x->batan(100), "\n"; Calculate the arcus tanges of $x, modifying $x in place. See also L. This method was added in v1.87 of Math::BigInt (June 2007). =item bmuladd() $x->bmuladd($y,$z); Multiply $x by $y, and then add $z to the result. This method was added in v1.87 of Math::BigInt (June 2007). =item as_float() This method is called when Math::BigFloat encounters an object it doesn't know how to handle. For instance, assume $x is a Math::BigFloat, or subclass thereof, and $y is defined, but not a Math::BigFloat, or subclass thereof. If you do $x -> badd($y); $y needs to be converted into an object that $x can deal with. This is done by first checking if $y is something that $x might be upgraded to. If that is the case, no further attempts are made. The next is to see if $y supports the method C. The method C is expected to return either an object that has the same class as $x, a subclass thereof, or a string that Cnew()> can parse to create an object. In Math::BigFloat, C has the same effect as C. =item from_hex() $x -> from_hex("0x1.921fb54442d18p+1"); $x = Math::BigFloat -> from_hex("0x1.921fb54442d18p+1"); Interpret input as a hexadecimal string.A prefix ("0x", "x", ignoring case) is optional. A single underscore character ("_") may be placed between any two digits. If the input is invalid, a NaN is returned. The exponent is in base 2 using decimal digits. If called as an instance method, the value is assigned to the invocand. =item from_bin() $x -> from_bin("0b1.1001p-4"); $x = Math::BigFloat -> from_bin("0b1.1001p-4"); Interpret input as a hexadecimal string. A prefix ("0b" or "b", ignoring case) is optional. A single underscore character ("_") may be placed between any two digits. If the input is invalid, a NaN is returned. The exponent is in base 2 using decimal digits. If called as an instance method, the value is assigned to the invocand. =item from_oct() $x -> from_oct("1.3267p-4"); $x = Math::BigFloat -> from_oct("1.3267p-4"); Interpret input as an octal string. A single underscore character ("_") may be placed between any two digits. If the input is invalid, a NaN is returned. The exponent is in base 2 using decimal digits. If called as an instance method, the value is assigned to the invocand. =back =head1 Autocreating constants After C all the floating point constants in the given scope are converted to C. This conversion happens at compile time. In particular perl -MMath::BigFloat=:constant -e 'print 2E-100,"\n"' prints the value of C<2E-100>. Note that without conversion of constants the expression 2E-100 will be calculated as normal floating point number. Please note that ':constant' does not affect integer constants, nor binary nor hexadecimal constants. Use L or L to get this to work. =head2 Math library Math with the numbers is done (by default) by a module called Math::BigInt::Calc. This is equivalent to saying: use Math::BigFloat lib => 'Calc'; You can change this by using: use Math::BigFloat lib => 'GMP'; B: General purpose packages should not be explicit about the library to use; let the script author decide which is best. Note: The keyword 'lib' will warn when the requested library could not be loaded. To suppress the warning use 'try' instead: use Math::BigFloat try => 'GMP'; If your script works with huge numbers and Calc is too slow for them, you can also for the loading of one of these libraries and if none of them can be used, the code will die: use Math::BigFloat only => 'GMP,Pari'; The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: use Math::BigFloat lib => 'Foo,Math::BigInt::Bar'; See the respective low-level library documentation for further details. Please note that Math::BigFloat does B use the denoted library itself, but it merely passes the lib argument to Math::BigInt. So, instead of the need to do: use Math::BigInt lib => 'GMP'; use Math::BigFloat; you can roll it all into one line: use Math::BigFloat lib => 'GMP'; It is also possible to just require Math::BigFloat: require Math::BigFloat; This will load the necessary things (like BigInt) when they are needed, and automatically. See L for more details than you ever wanted to know about using a different low-level library. =head2 Using Math::BigInt::Lite For backwards compatibility reasons it is still possible to request a different storage class for use with Math::BigFloat: use Math::BigFloat with => 'Math::BigInt::Lite'; However, this request is ignored, as the current code now uses the low-level math library for directly storing the number parts. =head1 EXPORTS C exports nothing by default, but can export the C method: use Math::BigFloat qw/bpi/; print bpi(10), "\n"; =head1 CAVEATS Do not try to be clever to insert some operations in between switching libraries: require Math::BigFloat; my $matter = Math::BigFloat->bone() + 4; # load BigInt and Calc Math::BigFloat->import( lib => 'Pari' ); # load Pari, too my $anti_matter = Math::BigFloat->bone()+4; # now use Pari This will create objects with numbers stored in two different backend libraries, and B will happen when you use these together: my $flash_and_bang = $matter + $anti_matter; # Don't do this! =over =item stringify, bstr() Both stringify and bstr() now drop the leading '+'. The old code would return '+1.23', the new returns '1.23'. See the documentation in L for reasoning and details. =item bdiv() The following will probably not print what you expect: print $c->bdiv(123.456),"\n"; It prints both quotient and remainder since print works in list context. Also, bdiv() will modify $c, so be careful. You probably want to use print $c / 123.456,"\n"; # or if you want to modify $c: print scalar $c->bdiv(123.456),"\n"; instead. =item brsft() The following will probably not print what you expect: my $c = Math::BigFloat->new('3.14159'); print $c->brsft(3,10),"\n"; # prints 0.00314153.1415 It prints both quotient and remainder, since print calls C in list context. Also, C<< $c->brsft() >> will modify $c, so be careful. You probably want to use print scalar $c->copy()->brsft(3,10),"\n"; # or if you really want to modify $c print scalar $c->brsft(3,10),"\n"; instead. =item Modifying and = Beware of: $x = Math::BigFloat->new(5); $y = $x; It will not do what you think, e.g. making a copy of $x. Instead it just makes a second reference to the B object and stores it in $y. Thus anything that modifies $x will modify $y (except overloaded math operators), and vice versa. See L for details and how to avoid that. =item bpow() C now modifies the first argument, unlike the old code which left it alone and only returned the result. This is to be consistent with C etc. The first will modify $x, the second one won't: print bpow($x,$i),"\n"; # modify $x print $x->bpow($i),"\n"; # ditto print $x ** $i,"\n"; # leave $x alone =item precision() vs. accuracy() A common pitfall is to use L when you want to round a result to a certain number of digits: use Math::BigFloat; Math::BigFloat->precision(4); # does not do what you # think it does my $x = Math::BigFloat->new(12345); # rounds $x to "12000"! print "$x\n"; # print "12000" my $y = Math::BigFloat->new(3); # rounds $y to "0"! print "$y\n"; # print "0" $z = $x / $y; # 12000 / 0 => NaN! print "$z\n"; print $z->precision(),"\n"; # 4 Replacing L with L is probably not what you want, either: use Math::BigFloat; Math::BigFloat->accuracy(4); # enables global rounding: my $x = Math::BigFloat->new(123456); # rounded immediately # to "12350" print "$x\n"; # print "123500" my $y = Math::BigFloat->new(3); # rounded to "3 print "$y\n"; # print "3" print $z = $x->copy()->bdiv($y),"\n"; # 41170 print $z->accuracy(),"\n"; # 4 What you want to use instead is: use Math::BigFloat; my $x = Math::BigFloat->new(123456); # no rounding print "$x\n"; # print "123456" my $y = Math::BigFloat->new(3); # no rounding print "$y\n"; # print "3" print $z = $x->copy()->bdiv($y,4),"\n"; # 41150 print $z->accuracy(),"\n"; # undef In addition to computing what you expected, the last example also does B "taint" the result with an accuracy or precision setting, which would influence any further operation. =back =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L (requires login). We will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Math::BigFloat You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =item * CPAN Testers Matrix L =item * The Bignum mailing list =over 4 =item * Post to mailing list C =item * View mailing list L =item * Subscribe/Unsubscribe L =back =back =head1 LICENSE This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L and L as well as the backends L, L, and L. The pragmas L, L and L also might be of interest because they solve the autoupgrading/downgrading issue, at least partly. =head1 AUTHORS =over 4 =item * Mark Biggar, overloaded interface by Ilya Zakharevich, 1996-2001. =item * Completely rewritten by Tels L in 2001-2008. =item * Florian Ragwitz L, 2010. =item * Peter John Acklam, L, 2011-. =back =cut Math-BigInt-1.999715/lib/Math/BigInt/0000755403072340010010000000000012642757312017057 5ustar ospjaDomain UsersMath-BigInt-1.999715/lib/Math/BigInt/Calc.pm0000644403072340010010000023664712642754705020304 0ustar ospjaDomain Userspackage Math::BigInt::Calc; use 5.006001; use strict; use warnings; our $VERSION = '1.999715'; $VERSION = eval $VERSION; # Package to store unsigned big integers in decimal and do math with them # Internally the numbers are stored in an array with at least 1 element, no # leading zero parts (except the first) and in base 1eX where X is determined # automatically at loading time to be the maximum possible value # todo: # - fully remove funky $# stuff in div() (maybe - that code scares me...) # USE_MUL: due to problems on certain os (os390, posix-bc) "* 1e-5" is used # instead of "/ 1e5" at some places, (marked with USE_MUL). Other platforms # BS2000, some Crays need USE_DIV instead. # The BEGIN block is used to determine which of the two variants gives the # correct result. # Beware of things like: # $i = $i * $y + $car; $car = int($i / $BASE); $i = $i % $BASE; # This works on x86, but fails on ARM (SA1100, iPAQ) due to who knows what # reasons. So, use this instead (slower, but correct): # $i = $i * $y + $car; $car = int($i / $BASE); $i -= $BASE * $car; ############################################################################## # global constants, flags and accessory # announce that we are compatible with MBI v1.83 and up sub api_version () { 2; } # constants for easier life my ($BASE,$BASE_LEN,$RBASE,$MAX_VAL); my ($AND_BITS,$XOR_BITS,$OR_BITS); my ($AND_MASK,$XOR_MASK,$OR_MASK); sub _base_len { # Set/get the BASE_LEN and assorted other, connected values. # Used only by the testsuite, the set variant is used only by the BEGIN # block below: shift; my ($b, $int) = @_; if (defined $b) { # avoid redefinitions undef &_mul; undef &_div; if ($] >= 5.008 && $int && $b > 7) { $BASE_LEN = $b; *_mul = \&_mul_use_div_64; *_div = \&_div_use_div_64; $BASE = int("1e".$BASE_LEN); $MAX_VAL = $BASE-1; return $BASE_LEN unless wantarray; return ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL,); } # find whether we can use mul or div in mul()/div() $BASE_LEN = $b+1; my $caught = 0; while (--$BASE_LEN > 5) { $BASE = int("1e".$BASE_LEN); $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL $caught = 0; $caught += 1 if (int($BASE * $RBASE) != 1); # should be 1 $caught += 2 if (int($BASE / $BASE) != 1); # should be 1 last if $caught != 3; } $BASE = int("1e".$BASE_LEN); $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL $MAX_VAL = $BASE-1; # ($caught & 1) != 0 => cannot use MUL # ($caught & 2) != 0 => cannot use DIV if ($caught == 2) # 2 { # must USE_MUL since we cannot use DIV *_mul = \&_mul_use_mul; *_div = \&_div_use_mul; } else # 0 or 1 { # can USE_DIV instead *_mul = \&_mul_use_div; *_div = \&_div_use_div; } } return $BASE_LEN unless wantarray; return ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL); } sub _new { # Given a string representing an integer, returns a reference to an array # of integers, where each integer represents a chunk of the original input # integer. Assumes normalized value as input. my ($proto, $str) = @_; my $input_len = length($str) - 1; # Shortcut for small numbers. return [ int($str) ] if $input_len < $BASE_LEN; my $format = "a" . (($input_len % $BASE_LEN) + 1); $format .= $] < 5.008 ? "a$BASE_LEN" x int($input_len / $BASE_LEN) : "(a$BASE_LEN)*"; [ reverse(map { 0 + $_ } unpack($format, $str)) ]; } BEGIN { # from Daniel Pfeiffer: determine largest group of digits that is precisely # multipliable with itself plus carry # Test now changed to expect the proper pattern, not a result off by 1 or 2 my ($e, $num) = 3; # lowest value we will use is 3+1-1 = 3 do { $num = '9' x ++$e; $num *= $num + 1; } while $num =~ /9{$e}0{$e}/; # must be a certain pattern $e--; # last test failed, so retract one step # the limits below brush the problems with the test above under the rug: # the test should be able to find the proper $e automatically $e = 5 if $^O =~ /^uts/; # UTS get's some special treatment $e = 5 if $^O =~ /^unicos/; # unicos is also problematic (6 seems to work # there, but we play safe) my $int = 0; if ($e > 7) { use integer; my $e1 = 7; $num = 7; do { $num = ('9' x ++$e1) + 0; $num *= $num + 1; } while ("$num" =~ /9{$e1}0{$e1}/); # must be a certain pattern $e1--; # last test failed, so retract one step if ($e1 > 7) { $int = 1; $e = $e1; } } __PACKAGE__->_base_len($e,$int); # set and store use integer; # find out how many bits _and, _or and _xor can take (old default = 16) # I don't think anybody has yet 128 bit scalars, so let's play safe. local $^W = 0; # don't warn about 'nonportable number' $AND_BITS = 15; $XOR_BITS = 15; $OR_BITS = 15; # find max bits, we will not go higher than numberofbits that fit into $BASE # to make _and etc simpler (and faster for smaller, slower for large numbers) my $max = 16; while (2 ** $max < $BASE) { $max++; } { no integer; $max = 16 if $] < 5.006; # older Perls might not take >16 too well } my ($x,$y,$z); do { $AND_BITS++; $x = CORE::oct('0b' . '1' x $AND_BITS); $y = $x & $x; $z = (2 ** $AND_BITS) - 1; } while ($AND_BITS < $max && $x == $z && $y == $x); $AND_BITS --; # retreat one step do { $XOR_BITS++; $x = CORE::oct('0b' . '1' x $XOR_BITS); $y = $x ^ 0; $z = (2 ** $XOR_BITS) - 1; } while ($XOR_BITS < $max && $x == $z && $y == $x); $XOR_BITS --; # retreat one step do { $OR_BITS++; $x = CORE::oct('0b' . '1' x $OR_BITS); $y = $x | $x; $z = (2 ** $OR_BITS) - 1; } while ($OR_BITS < $max && $x == $z && $y == $x); $OR_BITS --; # retreat one step $AND_MASK = __PACKAGE__->_new( ( 2 ** $AND_BITS )); $XOR_MASK = __PACKAGE__->_new( ( 2 ** $XOR_BITS )); $OR_MASK = __PACKAGE__->_new( ( 2 ** $OR_BITS )); # We can compute the approximate length no faster than the real length: *_alen = \&_len; } ############################################################################### sub _zero { # create a zero [ 0 ]; } sub _one { # create a one [ 1 ]; } sub _two { # create a two (used internally for shifting) [ 2 ]; } sub _ten { # create a 10 (used internally for shifting) [ 10 ]; } sub _1ex { # create a 1Ex my $rem = $_[1] % $BASE_LEN; # remainder my $parts = $_[1] / $BASE_LEN; # parts # 000000, 000000, 100 [ (0) x $parts, '1' . ('0' x $rem) ]; } sub _copy { # make a true copy [ @{$_[1]} ]; } # catch and throw away sub import { } ############################################################################## # convert back to string and number sub _str { # Convert number from internal base 1eN format to string format. Internal # format is always normalized, i.e., no leading zeros. my $ary = $_[1]; my $idx = $#$ary; # index of last element if ($idx < 0) { # should not happen require Carp; Carp::croak("$_[1] has no elements"); } # Handle first one differently, since it should not have any leading zeros. my $ret = int($ary->[$idx]); if ($idx > 0) { $idx--; # Interestingly, the pre-padd method uses more time # the old grep variant takes longer (14 vs. 10 sec) my $z = '0' x ($BASE_LEN - 1); while ($idx >= 0) { $ret .= substr($z . $ary->[$idx], -$BASE_LEN); $idx--; } } $ret; } sub _num { # Make a Perl scalar number (int/float) from a BigInt object. my $x = $_[1]; return 0 + $x->[0] if scalar @$x == 1; # below $BASE # Start with the most significant element and work towards the least # significant element. Avoid multiplying "inf" (which happens if the number # overflows) with "0" (if there are zero elements in $x) since this gives # "nan" which propagates to the output. my $num = 0; for (my $i = $#$x ; $i >= 0 ; --$i) { $num *= $BASE; $num += $x -> [$i]; } return $num; } ############################################################################## # actual math code sub _add { # (ref to int_num_array, ref to int_num_array) # # Routine to add two base 1eX numbers stolen from Knuth Vol 2 Algorithm A # pg 231. There are separate routines to add and sub as per Knuth pg 233. # This routine modifies array x, but not y. my ($c, $x, $y) = @_; return $x if @$y == 1 && $y->[0] == 0; # $x + 0 => $x if (@$x == 1 && $x->[0] == 0) { # 0 + $y => $y->copy # Twice as slow as $x = [ @$y ], but necessary to modify $x in-place. @$x = @$y; return $x; } # For each in Y, add Y to X and carry. If after that, something is left in # X, foreach in X add carry to X and then return X, carry. Trades one # "$j++" for having to shift arrays. my $i; my $car = 0; my $j = 0; for $i (@$y) { $x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0; $j++; } while ($car != 0) { $x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0; $j++; } $x; } sub _inc { # (ref to int_num_array, ref to int_num_array) # Add 1 to $x, modify $x in place my ($c, $x) = @_; for my $i (@$x) { return $x if ($i += 1) < $BASE; # early out $i = 0; # overflow, next } push @$x, 1 if $x->[-1] == 0; # last overflowed, so extend $x; } sub _dec { # (ref to int_num_array, ref to int_num_array) # Sub 1 from $x, modify $x in place my ($c, $x) = @_; my $MAX = $BASE - 1; # since MAX_VAL based on BASE for my $i (@$x) { last if ($i -= 1) >= 0; # early out $i = $MAX; # underflow, next } pop @$x if $x->[-1] == 0 && @$x > 1; # last underflowed (but leave 0) $x; } sub _sub { # (ref to int_num_array, ref to int_num_array, swap) # # Subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y # subtract Y from X by modifying x in place my ($c, $sx, $sy, $s) = @_; my $car = 0; my $i; my $j = 0; if (!$s) { for $i (@$sx) { last unless defined $sy->[$j] || $car; $i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0); $j++; } # might leave leading zeros, so fix that return __strip_zeros($sx); } for $i (@$sx) { # We can't do an early out if $x < $y, since we need to copy the high # chunks from $y. Found by Bob Mathews. #last unless defined $sy->[$j] || $car; $sy->[$j] += $BASE if $car = ($sy->[$j] = $i - ($sy->[$j] || 0) - $car) < 0; $j++; } # might leave leading zeros, so fix that __strip_zeros($sy); } sub _mul_use_mul { # (ref to int_num_array, ref to int_num_array) # multiply two numbers in internal representation # modifies first arg, second need not be different from first my ($c,$xv,$yv) = @_; if (@$yv == 1) { # shortcut for two very short numbers (improved by Nathan Zook) # works also if xv and yv are the same reference, and handles also $x == 0 if (@$xv == 1) { if (($xv->[0] *= $yv->[0]) >= $BASE) { $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $BASE; }; return $xv; } # $x * 0 => 0 if ($yv->[0] == 0) { @$xv = (0); return $xv; } # multiply a large number a by a single element one, so speed up my $y = $yv->[0]; my $car = 0; foreach my $i (@$xv) { $i = $i * $y + $car; $car = int($i * $RBASE); $i -= $car * $BASE; } push @$xv, $car if $car != 0; return $xv; } # shortcut for result $x == 0 => result = 0 return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) ); # since multiplying $x with $x fails, make copy in this case $yv = [@$xv] if $xv == $yv; # same references? my @prod = (); my ($prod,$car,$cty,$xi,$yi); for $xi (@$xv) { $car = 0; $cty = 0; # slow variant # for $yi (@$yv) # { # $prod = $xi * $yi + ($prod[$cty] || 0) + $car; # $prod[$cty++] = # $prod - ($car = int($prod * RBASE)) * $BASE; # see USE_MUL # } # $prod[$cty] += $car if $car; # need really to check for 0? # $xi = shift @prod; # faster variant # looping through this if $xi == 0 is silly - so optimize it away! $xi = (shift @prod || 0), next if $xi == 0; for $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; ## this is actually a tad slower ## $prod = $prod[$cty]; $prod += ($car + $xi * $yi); # no ||0 here $prod[$cty++] = $prod - ($car = int($prod * $RBASE)) * $BASE; # see USE_MUL } $prod[$cty] += $car if $car; # need really to check for 0? $xi = shift @prod || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; # can't have leading zeros # __strip_zeros($xv); $xv; } sub _mul_use_div_64 { # (ref to int_num_array, ref to int_num_array) # multiply two numbers in internal representation # modifies first arg, second need not be different from first # works for 64 bit integer with "use integer" my ($c,$xv,$yv) = @_; use integer; if (@$yv == 1) { # shortcut for two small numbers, also handles $x == 0 if (@$xv == 1) { # shortcut for two very short numbers (improved by Nathan Zook) # works also if xv and yv are the same reference, and handles also $x == 0 if (($xv->[0] *= $yv->[0]) >= $BASE) { $xv->[0] = $xv->[0] - ($xv->[1] = $xv->[0] / $BASE) * $BASE; }; return $xv; } # $x * 0 => 0 if ($yv->[0] == 0) { @$xv = (0); return $xv; } # multiply a large number a by a single element one, so speed up my $y = $yv->[0]; my $car = 0; foreach my $i (@$xv) { #$i = $i * $y + $car; $car = $i / $BASE; $i -= $car * $BASE; $i = $i * $y + $car; $i -= ($car = $i / $BASE) * $BASE; } push @$xv, $car if $car != 0; return $xv; } # shortcut for result $x == 0 => result = 0 return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) ); # since multiplying $x with $x fails, make copy in this case $yv = [@$xv] if $xv == $yv; # same references? my @prod = (); my ($prod,$car,$cty,$xi,$yi); for $xi (@$xv) { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! $xi = (shift @prod || 0), next if $xi == 0; for $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; $prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE; } $prod[$cty] += $car if $car; # need really to check for 0? $xi = shift @prod || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; $xv; } sub _mul_use_div { # (ref to int_num_array, ref to int_num_array) # multiply two numbers in internal representation # modifies first arg, second need not be different from first my ($c,$xv,$yv) = @_; if (@$yv == 1) { # shortcut for two small numbers, also handles $x == 0 if (@$xv == 1) { # shortcut for two very short numbers (improved by Nathan Zook) # works also if xv and yv are the same reference, and handles also $x == 0 if (($xv->[0] *= $yv->[0]) >= $BASE) { $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] / $BASE)) * $BASE; }; return $xv; } # $x * 0 => 0 if ($yv->[0] == 0) { @$xv = (0); return $xv; } # multiply a large number a by a single element one, so speed up my $y = $yv->[0]; my $car = 0; foreach my $i (@$xv) { $i = $i * $y + $car; $car = int($i / $BASE); $i -= $car * $BASE; # This (together with use integer;) does not work on 32-bit Perls #$i = $i * $y + $car; $i -= ($car = $i / $BASE) * $BASE; } push @$xv, $car if $car != 0; return $xv; } # shortcut for result $x == 0 => result = 0 return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) ); # since multiplying $x with $x fails, make copy in this case $yv = [@$xv] if $xv == $yv; # same references? my @prod = (); my ($prod,$car,$cty,$xi,$yi); for $xi (@$xv) { $car = 0; $cty = 0; # looping through this if $xi == 0 is silly - so optimize it away! $xi = (shift @prod || 0), next if $xi == 0; for $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; $prod[$cty++] = $prod - ($car = int($prod / $BASE)) * $BASE; } $prod[$cty] += $car if $car; # need really to check for 0? $xi = shift @prod || 0; # || 0 makes v5.005_3 happy } push @$xv, @prod; # can't have leading zeros # __strip_zeros($xv); $xv; } sub _div_use_mul { # ref to array, ref to array, modify first array and return remainder if # in list context # see comments in _div_use_div() for more explanations my ($c,$x,$yorg) = @_; # the general div algorithm here is about O(N*N) and thus quite slow, so # we first check for some special cases and use shortcuts to handle them. # This works, because we store the numbers in a chunked format where each # element contains 5..7 digits (depending on system). # if both numbers have only one element: if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers if (wantarray) { my $r = [ $x->[0] % $yorg->[0] ]; $x->[0] = int($x->[0] / $yorg->[0]); return ($x,$r); } else { $x->[0] = int($x->[0] / $yorg->[0]); return $x; } } # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; $rem = _mod($c,[ @$x ],$yorg) if wantarray; # shortcut, $y is < $BASE my $j = scalar @$x; my $r = 0; my $y = $yorg->[0]; my $b; while ($j-- > 0) { $b = $r * $BASE + $x->[$j]; $x->[$j] = int($b/$y); $r = $b % $y; } pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero return ($x,$rem) if wantarray; return $x; } # now x and y have more than one element # check whether y has more elements than x, if yet, the result will be 0 if (@$yorg > @$x) { my $rem; $rem = [@$x] if wantarray; # make copy splice (@$x,1); # keep ref to original array $x->[0] = 0; # set to 0 return ($x,$rem) if wantarray; # including remainder? return $x; # only x, which is [0] now } # check whether the numbers have the same number of elements, in that case # the result will fit into one element and can be computed efficiently if (@$yorg == @$x) { my $rem; # if $yorg has more digits than $x (it's leading element is longer than # the one from $x), the result will also be 0: if (length(int($yorg->[-1])) > length(int($x->[-1]))) { $rem = [@$x] if wantarray; # make copy splice (@$x,1); # keep ref to org array $x->[0] = 0; # set to 0 return ($x,$rem) if wantarray; # including remainder? return $x; } # now calculate $x / $yorg if (length(int($yorg->[-1])) == length(int($x->[-1]))) { # same length, so make full compare my $a = 0; my $j = scalar @$x - 1; # manual way (abort if unequal, good for early ne) while ($j >= 0) { last if ($a = $x->[$j] - $yorg->[$j]); $j--; } # $a contains the result of the compare between X and Y # a < 0: x < y, a == 0: x == y, a > 0: x > y if ($a <= 0) { $rem = [ 0 ]; # a = 0 => x == y => rem 0 $rem = [@$x] if $a != 0; # a < 0 => x < y => rem = x splice(@$x,1); # keep single element $x->[0] = 0; # if $a < 0 $x->[0] = 1 if $a == 0; # $x == $y return ($x,$rem) if wantarray; return $x; } # $x >= $y, so proceed normally } } # all other cases: my $y = [ @$yorg ]; # always make copy to preserve my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0); $car = $bar = $prd = 0; if (($dd = int($BASE/($y->[-1]+1))) != 1) { for $xi (@$x) { $xi = $xi * $dd + $car; $xi -= ($car = int($xi * $RBASE)) * $BASE; # see USE_MUL } push(@$x, $car); $car = 0; for $yi (@$y) { $yi = $yi * $dd + $car; $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL } } else { push(@$x, 0); } @q = (); ($v2,$v1) = @$y[-2,-1]; $v2 = 0 unless $v2; while ($#$x > $#$y) { ($u2,$u1,$u0) = @$x[-3..-1]; $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1)); --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2); if ($q) { ($car, $bar) = (0,0); for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) { $prd = $q * $y->[$yi] + $car; $prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) { $x->[$xi] -= $BASE if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); } } } pop(@$x); unshift(@q, $q); } if (wantarray) { @d = (); if ($dd != 1) { $car = 0; for $xi (reverse @$x) { $prd = $car * $BASE + $xi; $car = $prd - ($tmp = int($prd / $dd)) * $dd; # see USE_MUL unshift(@d, $tmp); } } else { @d = @$x; } @$x = @q; my $d = \@d; __strip_zeros($x); __strip_zeros($d); return ($x,$d); } @$x = @q; __strip_zeros($x); $x; } sub _div_use_div_64 { # ref to array, ref to array, modify first array and return remainder if # in list context # This version works on 64 bit integers my ($c,$x,$yorg) = @_; use integer; # the general div algorithm here is about O(N*N) and thus quite slow, so # we first check for some special cases and use shortcuts to handle them. # This works, because we store the numbers in a chunked format where each # element contains 5..7 digits (depending on system). # if both numbers have only one element: if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers if (wantarray) { my $r = [ $x->[0] % $yorg->[0] ]; $x->[0] = int($x->[0] / $yorg->[0]); return ($x,$r); } else { $x->[0] = int($x->[0] / $yorg->[0]); return $x; } } # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; $rem = _mod($c,[ @$x ],$yorg) if wantarray; # shortcut, $y is < $BASE my $j = scalar @$x; my $r = 0; my $y = $yorg->[0]; my $b; while ($j-- > 0) { $b = $r * $BASE + $x->[$j]; $x->[$j] = int($b/$y); $r = $b % $y; } pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero return ($x,$rem) if wantarray; return $x; } # now x and y have more than one element # check whether y has more elements than x, if yet, the result will be 0 if (@$yorg > @$x) { my $rem; $rem = [@$x] if wantarray; # make copy splice (@$x,1); # keep ref to original array $x->[0] = 0; # set to 0 return ($x,$rem) if wantarray; # including remainder? return $x; # only x, which is [0] now } # check whether the numbers have the same number of elements, in that case # the result will fit into one element and can be computed efficiently if (@$yorg == @$x) { my $rem; # if $yorg has more digits than $x (it's leading element is longer than # the one from $x), the result will also be 0: if (length(int($yorg->[-1])) > length(int($x->[-1]))) { $rem = [@$x] if wantarray; # make copy splice (@$x,1); # keep ref to org array $x->[0] = 0; # set to 0 return ($x,$rem) if wantarray; # including remainder? return $x; } # now calculate $x / $yorg if (length(int($yorg->[-1])) == length(int($x->[-1]))) { # same length, so make full compare my $a = 0; my $j = scalar @$x - 1; # manual way (abort if unequal, good for early ne) while ($j >= 0) { last if ($a = $x->[$j] - $yorg->[$j]); $j--; } # $a contains the result of the compare between X and Y # a < 0: x < y, a == 0: x == y, a > 0: x > y if ($a <= 0) { $rem = [ 0 ]; # a = 0 => x == y => rem 0 $rem = [@$x] if $a != 0; # a < 0 => x < y => rem = x splice(@$x,1); # keep single element $x->[0] = 0; # if $a < 0 $x->[0] = 1 if $a == 0; # $x == $y return ($x,$rem) if wantarray; # including remainder? return $x; } # $x >= $y, so proceed normally } } # all other cases: my $y = [ @$yorg ]; # always make copy to preserve my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0); $car = $bar = $prd = 0; if (($dd = int($BASE/($y->[-1]+1))) != 1) { for $xi (@$x) { $xi = $xi * $dd + $car; $xi -= ($car = int($xi / $BASE)) * $BASE; } push(@$x, $car); $car = 0; for $yi (@$y) { $yi = $yi * $dd + $car; $yi -= ($car = int($yi / $BASE)) * $BASE; } } else { push(@$x, 0); } # @q will accumulate the final result, $q contains the current computed # part of the final result @q = (); ($v2,$v1) = @$y[-2,-1]; $v2 = 0 unless $v2; while ($#$x > $#$y) { ($u2,$u1,$u0) = @$x[-3..-1]; $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1)); --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2); if ($q) { ($car, $bar) = (0,0); for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) { $prd = $q * $y->[$yi] + $car; $prd -= ($car = int($prd / $BASE)) * $BASE; $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) { $x->[$xi] -= $BASE if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); } } } pop(@$x); unshift(@q, $q); } if (wantarray) { @d = (); if ($dd != 1) { $car = 0; for $xi (reverse @$x) { $prd = $car * $BASE + $xi; $car = $prd - ($tmp = int($prd / $dd)) * $dd; unshift(@d, $tmp); } } else { @d = @$x; } @$x = @q; my $d = \@d; __strip_zeros($x); __strip_zeros($d); return ($x,$d); } @$x = @q; __strip_zeros($x); $x; } sub _div_use_div { # ref to array, ref to array, modify first array and return remainder if # in list context my ($c,$x,$yorg) = @_; # the general div algorithm here is about O(N*N) and thus quite slow, so # we first check for some special cases and use shortcuts to handle them. # This works, because we store the numbers in a chunked format where each # element contains 5..7 digits (depending on system). # if both numbers have only one element: if (@$x == 1 && @$yorg == 1) { # shortcut, $yorg and $x are two small numbers if (wantarray) { my $r = [ $x->[0] % $yorg->[0] ]; $x->[0] = int($x->[0] / $yorg->[0]); return ($x,$r); } else { $x->[0] = int($x->[0] / $yorg->[0]); return $x; } } # if x has more than one, but y has only one element: if (@$yorg == 1) { my $rem; $rem = _mod($c,[ @$x ],$yorg) if wantarray; # shortcut, $y is < $BASE my $j = scalar @$x; my $r = 0; my $y = $yorg->[0]; my $b; while ($j-- > 0) { $b = $r * $BASE + $x->[$j]; $x->[$j] = int($b/$y); $r = $b % $y; } pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero return ($x,$rem) if wantarray; return $x; } # now x and y have more than one element # check whether y has more elements than x, if yet, the result will be 0 if (@$yorg > @$x) { my $rem; $rem = [@$x] if wantarray; # make copy splice (@$x,1); # keep ref to original array $x->[0] = 0; # set to 0 return ($x,$rem) if wantarray; # including remainder? return $x; # only x, which is [0] now } # check whether the numbers have the same number of elements, in that case # the result will fit into one element and can be computed efficiently if (@$yorg == @$x) { my $rem; # if $yorg has more digits than $x (it's leading element is longer than # the one from $x), the result will also be 0: if (length(int($yorg->[-1])) > length(int($x->[-1]))) { $rem = [@$x] if wantarray; # make copy splice (@$x,1); # keep ref to org array $x->[0] = 0; # set to 0 return ($x,$rem) if wantarray; # including remainder? return $x; } # now calculate $x / $yorg if (length(int($yorg->[-1])) == length(int($x->[-1]))) { # same length, so make full compare my $a = 0; my $j = scalar @$x - 1; # manual way (abort if unequal, good for early ne) while ($j >= 0) { last if ($a = $x->[$j] - $yorg->[$j]); $j--; } # $a contains the result of the compare between X and Y # a < 0: x < y, a == 0: x == y, a > 0: x > y if ($a <= 0) { $rem = [ 0 ]; # a = 0 => x == y => rem 0 $rem = [@$x] if $a != 0; # a < 0 => x < y => rem = x splice(@$x,1); # keep single element $x->[0] = 0; # if $a < 0 $x->[0] = 1 if $a == 0; # $x == $y return ($x,$rem) if wantarray; # including remainder? return $x; } # $x >= $y, so proceed normally } } # all other cases: my $y = [ @$yorg ]; # always make copy to preserve my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0); $car = $bar = $prd = 0; if (($dd = int($BASE/($y->[-1]+1))) != 1) { for $xi (@$x) { $xi = $xi * $dd + $car; $xi -= ($car = int($xi / $BASE)) * $BASE; } push(@$x, $car); $car = 0; for $yi (@$y) { $yi = $yi * $dd + $car; $yi -= ($car = int($yi / $BASE)) * $BASE; } } else { push(@$x, 0); } # @q will accumulate the final result, $q contains the current computed # part of the final result @q = (); ($v2,$v1) = @$y[-2,-1]; $v2 = 0 unless $v2; while ($#$x > $#$y) { ($u2,$u1,$u0) = @$x[-3..-1]; $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1)); --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2); if ($q) { ($car, $bar) = (0,0); for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) { $prd = $q * $y->[$yi] + $car; $prd -= ($car = int($prd / $BASE)) * $BASE; $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) { $x->[$xi] -= $BASE if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); } } } pop(@$x); unshift(@q, $q); } if (wantarray) { @d = (); if ($dd != 1) { $car = 0; for $xi (reverse @$x) { $prd = $car * $BASE + $xi; $car = $prd - ($tmp = int($prd / $dd)) * $dd; unshift(@d, $tmp); } } else { @d = @$x; } @$x = @q; my $d = \@d; __strip_zeros($x); __strip_zeros($d); return ($x,$d); } @$x = @q; __strip_zeros($x); $x; } ############################################################################## # testing sub _acmp { # Internal absolute post-normalized compare (ignore signs) # ref to array, ref to array, return <0, 0, >0 # Arrays must have at least one entry; this is not checked for. my ($c, $cx, $cy) = @_; # shortcut for short numbers return (($cx->[0] <=> $cy->[0]) <=> 0) if @$cx == @$cy && @$cx == 1; # fast comp based on number of array elements (aka pseudo-length) my $lxy = (@$cx - @$cy) # or length of first element if same number of elements (aka difference 0) || # need int() here because sometimes the last element is '00018' vs '18' (length(int($cx->[-1])) - length(int($cy->[-1]))); return -1 if $lxy < 0; # already differs, ret return 1 if $lxy > 0; # ditto # manual way (abort if unequal, good for early ne) my $a; my $j = @$cx; while (--$j >= 0) { last if $a = $cx->[$j] - $cy->[$j]; } $a <=> 0; } sub _len { # compute number of digits in base 10 # int() because add/sub sometimes leaves strings (like '00005') instead of # '5' in this place, thus causing length() to report wrong length my $cx = $_[1]; (@$cx - 1) * $BASE_LEN + length(int($cx->[-1])); } sub _digit { # Return the nth digit. Zero is rightmost, so _digit(123,0) gives 3. # Negative values count from the left, so _digit(123, -1) gives 1. my ($c, $x, $n) = @_; my $len = _len('', $x); $n += $len if $n < 0; # -1 last, -2 second-to-last return "0" if $n < 0 || $n >= $len; # return 0 for digits out of range my $elem = int($n / $BASE_LEN); # which array element my $digit = $n % $BASE_LEN; # which digit in this element substr("$x->[$elem]", -$digit - 1, 1); } sub _zeros { # Return number of trailing zeros in decimal. # Check each array element for having 0 at end as long as elem == 0 # Upon finding a elem != 0, stop. my $x = $_[1]; return 0 if @$x == 1 && $x->[0] == 0; my $zeros = 0; my $elem; foreach my $e (@$x) { if ($e != 0) { $elem = "$e"; # preserve x $elem =~ s/.*?(0*$)/$1/; # strip anything not zero $zeros *= $BASE_LEN; # elems * 5 $zeros += length($elem); # count trailing zeros last; # early out } $zeros ++; # real else branch: 50% slower! } $zeros; } ############################################################################## # _is_* routines sub _is_zero { # return true if arg is zero @{$_[1]} == 1 && $_[1]->[0] == 0 ? 1 : 0; } sub _is_even { # return true if arg is even $_[1]->[0] & 1 ? 0 : 1; } sub _is_odd { # return true if arg is odd $_[1]->[0] & 1 ? 1 : 0; } sub _is_one { # return true if arg is one @{$_[1]} == 1 && $_[1]->[0] == 1 ? 1 : 0; } sub _is_two { # return true if arg is two @{$_[1]} == 1 && $_[1]->[0] == 2 ? 1 : 0; } sub _is_ten { # return true if arg is ten @{$_[1]} == 1 && $_[1]->[0] == 10 ? 1 : 0; } sub __strip_zeros { # Internal normalization function that strips leading zeros from the array. # Args: ref to array my $s = shift; my $cnt = @$s; # get count of parts my $i = $cnt - 1; push @$s, 0 if $i < 0; # div might return empty results, so fix it return $s if @$s == 1; # early out #print "strip: cnt $cnt i $i\n"; # '0', '3', '4', '0', '0', # 0 1 2 3 4 # cnt = 5, i = 4 # i = 4 # i = 3 # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos) # >= 1: skip first part (this can be zero) while ($i > 0) { last if $s->[$i] != 0; $i--; } $i++; splice @$s, $i if $i < $cnt; # $i cant be 0 $s; } ############################################################################### # check routine to test internal state for corruptions sub _check { # used by the test suite my $x = $_[1]; return "$x is not a reference" if !ref($x); # are all parts are valid? my $i = 0; my $j = @$x; my ($e, $try); while ($i < $j) { $e = $x->[$i]; $e = 'undef' unless defined $e; $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e)"; last if $e !~ /^[+]?[0-9]+$/; $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (stringify)"; last if "$e" !~ /^[+]?[0-9]+$/; $try = '=~ /^[\+]?[0-9]+\$/; '."($x, $e) (cat-stringify)"; last if '' . "$e" !~ /^[+]?[0-9]+$/; $try = ' < 0 || >= $BASE; '."($x, $e)"; last if $e <0 || $e >= $BASE; # This test is disabled, since new/bnorm and certain ops (like early out # in add/sub) are allowed/expected to leave '00000' in some elements. #$try = '=~ /^00+/; '."($x, $e)"; #last if $e =~ /^00+/; $i++; } return "Illegal part '$e' at pos $i (tested: $try)" if $i < $j; 0; } ############################################################################### sub _mod { # if possible, use mod shortcut my ($c, $x, $yo) = @_; # slow way since $y too big if (@$yo > 1) { my ($xo, $rem) = _div($c, $x, $yo); @$x = @$rem; return $x; } my $y = $yo->[0]; # if both are single element arrays if (scalar @$x == 1) { $x->[0] %= $y; return $x; } # if @$x has more than one element, but @$y is a single element my $b = $BASE % $y; if ($b == 0) { # when BASE % Y == 0 then (B * BASE) % Y == 0 # (B * BASE) % $y + A % Y => A % Y # so need to consider only last element: O(1) $x->[0] %= $y; } elsif ($b == 1) { # else need to go through all elements in @$x: O(N), but loop is a bit # simplified my $r = 0; foreach (@$x) { $r = ($r + $_) % $y; # not much faster, but heh... #$r += $_ % $y; $r %= $y; } $r = 0 if $r == $y; $x->[0] = $r; } else { # else need to go through all elements in @$x: O(N) my $r = 0; my $bm = 1; foreach (@$x) { $r = ($_ * $bm + $r) % $y; $bm = ($bm * $b) % $y; #$r += ($_ % $y) * $bm; #$bm *= $b; #$bm %= $y; #$r %= $y; } $r = 0 if $r == $y; $x->[0] = $r; } @$x = $x->[0]; # keep one element of @$x return $x; } ############################################################################## # shifts sub _rsft { my ($c, $x, $y, $n) = @_; if ($n != 10) { $n = _new($c, $n); return _div($c, $x, _pow($c, $n, $y)); } # shortcut (faster) for shifting by 10) # multiples of $BASE_LEN my $dst = 0; # destination my $src = _num($c, $y); # as normal int my $xlen = (@$x - 1) * $BASE_LEN + length(int($x->[-1])); if ($src >= $xlen or ($src == $xlen and !defined $x->[1])) { # 12345 67890 shifted right by more than 10 digits => 0 splice(@$x, 1); # leave only one element $x->[0] = 0; # set to zero return $x; } my $rem = $src % $BASE_LEN; # remainder to shift $src = int($src / $BASE_LEN); # source if ($rem == 0) { splice(@$x, 0, $src); # even faster, 38.4 => 39.3 } else { my $len = @$x - $src; # elems to go my $vd; my $z = '0' x $BASE_LEN; $x->[@$x] = 0; # avoid || 0 test inside loop while ($dst < $len) { $vd = $z . $x->[$src]; $vd = substr($vd, -$BASE_LEN, $BASE_LEN - $rem); $src++; $vd = substr($z . $x->[$src], -$rem, $rem) . $vd; $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN; $x->[$dst] = int($vd); $dst++; } splice(@$x, $dst) if $dst > 0; # kill left-over array elems pop @$x if $x->[-1] == 0 && @$x > 1; # kill last element if 0 } # else rem == 0 $x; } sub _lsft { my ($c, $x, $y, $n) = @_; if ($n != 10) { $n = _new($c, $n); return _mul($c, $x, _pow($c, $n, $y)); } # shortcut (faster) for shifting by 10) since we are in base 10eX # multiples of $BASE_LEN: my $src = @$x; # source my $len = _num($c, $y); # shift-len as normal int my $rem = $len % $BASE_LEN; # remainder to shift my $dst = $src + int($len / $BASE_LEN); # destination my $vd; # further speedup $x->[$src] = 0; # avoid first ||0 for speed my $z = '0' x $BASE_LEN; while ($src >= 0) { $vd = $x->[$src]; $vd = $z . $vd; $vd = substr($vd, -$BASE_LEN + $rem, $BASE_LEN - $rem); $vd .= $src > 0 ? substr($z . $x->[$src - 1], -$BASE_LEN, $rem) : '0' x $rem; $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN; $x->[$dst] = int($vd); $dst--; $src--; } # set lowest parts to 0 while ($dst >= 0) { $x->[$dst--] = 0; } # fix spurious last zero element splice @$x, -1 if $x->[-1] == 0; $x; } sub _pow { # power of $x to $y # ref to array, ref to array, return ref to array my ($c, $cx, $cy) = @_; if (@$cy == 1 && $cy->[0] == 0) { splice(@$cx, 1); $cx->[0] = 1; # y == 0 => x => 1 return $cx; } if ((@$cx == 1 && $cx->[0] == 1) || # x == 1 (@$cy == 1 && $cy->[0] == 1)) # or y == 1 { return $cx; } if (@$cx == 1 && $cx->[0] == 0) { splice (@$cx, 1); $cx->[0] = 0; # 0 ** y => 0 (if not y <= 0) return $cx; } my $pow2 = _one(); my $y_bin = _as_bin($c, $cy); $y_bin =~ s/^0b//; my $len = length($y_bin); while (--$len > 0) { _mul($c, $pow2, $cx) if substr($y_bin, $len, 1) eq '1'; # is odd? _mul($c, $cx, $cx); } _mul($c, $cx, $pow2); $cx; } sub _nok { # Return binomial coefficient (n over k). # Given refs to arrays, return ref to array. # First input argument is modified. my ($c, $n, $k) = @_; # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as # nok(n, n-k), to minimize the number if iterations in the loop. { my $twok = _mul($c, _two($c), _copy($c, $k)); # 2 * k if (_acmp($c, $twok, $n) > 0) { # if 2*k > n $k = _sub($c, _copy($c, $n), $k); # k = n - k } } # Example: # # / 7 \ 7! 1*2*3*4 * 5*6*7 5 * 6 * 7 6 7 # | | = --------- = --------------- = --------- = 5 * - * - # \ 3 / (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3 if (_is_zero($c, $k)) { @$n = 1; } else { # Make a copy of the original n, since we'll be modifying n in-place. my $n_orig = _copy($c, $n); # n = 5, f = 6, d = 2 (cf. example above) _sub($c, $n, $k); _inc($c, $n); my $f = _copy($c, $n); _inc($c, $f); my $d = _two($c); # while f <= n (the original n, that is) ... while (_acmp($c, $f, $n_orig) <= 0) { # n = (n * f / d) == 5 * 6 / 2 (cf. example above) _mul($c, $n, $f); _div($c, $n, $d); # f = 7, d = 3 (cf. example above) _inc($c, $f); _inc($c, $d); } } return $n; } my @factorials = ( 1, 1, 2, 2*3, 2*3*4, 2*3*4*5, 2*3*4*5*6, 2*3*4*5*6*7, ); sub _fac { # factorial of $x # ref to array, return ref to array my ($c,$cx) = @_; if ((@$cx == 1) && ($cx->[0] <= 7)) { $cx->[0] = $factorials[$cx->[0]]; # 0 => 1, 1 => 1, 2 => 2 etc. return $cx; } if ((@$cx == 1) && # we do this only if $x >= 12 and $x <= 7000 ($cx->[0] >= 12 && $cx->[0] < 7000)) { # Calculate (k-j) * (k-j+1) ... k .. (k+j-1) * (k + j) # See http://blogten.blogspot.com/2007/01/calculating-n.html # The above series can be expressed as factors: # k * k - (j - i) * 2 # We cache k*k, and calculate (j * j) as the sum of the first j odd integers # This will not work when N exceeds the storage of a Perl scalar, however, # in this case the algorithm would be way to slow to terminate, anyway. # As soon as the last element of $cx is 0, we split it up and remember # how many zeors we got so far. The reason is that n! will accumulate # zeros at the end rather fast. my $zero_elements = 0; # If n is even, set n = n -1 my $k = _num($c,$cx); my $even = 1; if (($k & 1) == 0) { $even = $k; $k --; } # set k to the center point $k = ($k + 1) / 2; # print "k $k even: $even\n"; # now calculate k * k my $k2 = $k * $k; my $odd = 1; my $sum = 1; my $i = $k - 1; # keep reference to x my $new_x = _new($c, $k * $even); @$cx = @$new_x; if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } # print STDERR "x = ", _str($c,$cx),"\n"; my $BASE2 = int(sqrt($BASE))-1; my $j = 1; while ($j <= $i) { my $m = ($k2 - $sum); $odd += 2; $sum += $odd; $j++; while ($j <= $i && ($m < $BASE2) && (($k2 - $sum) < $BASE2)) { $m *= ($k2 - $sum); $odd += 2; $sum += $odd; $j++; # print STDERR "\n k2 $k2 m $m sum $sum odd $odd\n"; sleep(1); } if ($m < $BASE) { _mul($c,$cx,[$m]); } else { _mul($c,$cx,$c->_new($m)); } if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } # print STDERR "Calculate $k2 - $sum = $m (x = ", _str($c,$cx),")\n"; } # multiply in the zeros again unshift @$cx, (0) x $zero_elements; return $cx; } # go forward until $base is exceeded # limit is either $x steps (steps == 100 means a result always too high) or # $base. my $steps = 100; $steps = $cx->[0] if @$cx == 1; my $r = 2; my $cf = 3; my $step = 2; my $last = $r; while ($r*$cf < $BASE && $step < $steps) { $last = $r; $r *= $cf++; $step++; } if ((@$cx == 1) && $step == $cx->[0]) { # completely done, so keep reference to $x and return $cx->[0] = $r; return $cx; } # now we must do the left over steps my $n; # steps still to do if (scalar @$cx == 1) { $n = $cx->[0]; } else { $n = _copy($c,$cx); } # Set $cx to the last result below $BASE (but keep ref to $x) $cx->[0] = $last; splice (@$cx,1); # As soon as the last element of $cx is 0, we split it up and remember # how many zeors we got so far. The reason is that n! will accumulate # zeros at the end rather fast. my $zero_elements = 0; # do left-over steps fit into a scalar? if (ref $n eq 'ARRAY') { # No, so use slower inc() & cmp() # ($n is at least $BASE here) my $base_2 = int(sqrt($BASE)) - 1; #print STDERR "base_2: $base_2\n"; while ($step < $base_2) { if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } my $b = $step * ($step + 1); $step += 2; _mul($c,$cx,[$b]); } $step = [$step]; while (_acmp($c,$step,$n) <= 0) { if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } _mul($c,$cx,$step); _inc($c,$step); } } else { # Yes, so we can speed it up slightly # print "# left over steps $n\n"; my $base_4 = int(sqrt(sqrt($BASE))) - 2; #print STDERR "base_4: $base_4\n"; my $n4 = $n - 4; while ($step < $n4 && $step < $base_4) { if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } my $b = $step * ($step + 1); $step += 2; $b *= $step * ($step + 1); $step += 2; _mul($c,$cx,[$b]); } my $base_2 = int(sqrt($BASE)) - 1; my $n2 = $n - 2; #print STDERR "base_2: $base_2\n"; while ($step < $n2 && $step < $base_2) { if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } my $b = $step * ($step + 1); $step += 2; _mul($c,$cx,[$b]); } # do what's left over while ($step <= $n) { _mul($c,$cx,[$step]); $step++; if ($cx->[0] == 0) { $zero_elements ++; shift @$cx; } } } # multiply in the zeros again unshift @$cx, (0) x $zero_elements; $cx; # return result } ############################################################################# sub _log_int { # calculate integer log of $x to base $base # ref to array, ref to array - return ref to array my ($c,$x,$base) = @_; # X == 0 => NaN return if (scalar @$x == 1 && $x->[0] == 0); # BASE 0 or 1 => NaN return if (scalar @$base == 1 && $base->[0] < 2); my $cmp = _acmp($c,$x,$base); # X == BASE => 1 if ($cmp == 0) { splice (@$x,1); $x->[0] = 1; return ($x,1) } # X < BASE if ($cmp < 0) { splice (@$x,1); $x->[0] = 0; return ($x,undef); } my $x_org = _copy($c,$x); # preserve x splice(@$x,1); $x->[0] = 1; # keep ref to $x # Compute a guess for the result based on: # $guess = int ( length_in_base_10(X) / ( log(base) / log(10) ) ) my $len = _len($c,$x_org); my $log = log($base->[-1]) / log(10); # for each additional element in $base, we add $BASE_LEN to the result, # based on the observation that log($BASE,10) is BASE_LEN and # log(x*y) == log(x) + log(y): $log += ((scalar @$base)-1) * $BASE_LEN; # calculate now a guess based on the values obtained above: my $res = int($len / $log); $x->[0] = $res; my $trial = _pow ($c, _copy($c, $base), $x); my $a = _acmp($c,$trial,$x_org); # print STDERR "# trial ", _str($c,$x)," was: $a (0 = exact, -1 too small, +1 too big)\n"; # found an exact result? return ($x,1) if $a == 0; if ($a > 0) { # or too big _div($c,$trial,$base); _dec($c, $x); while (($a = _acmp($c,$trial,$x_org)) > 0) { # print STDERR "# big _log_int at ", _str($c,$x), "\n"; _div($c,$trial,$base); _dec($c, $x); } # result is now exact (a == 0), or too small (a < 0) return ($x, $a == 0 ? 1 : 0); } # else: result was to small _mul($c,$trial,$base); # did we now get the right result? $a = _acmp($c,$trial,$x_org); if ($a == 0) # yes, exactly { _inc($c, $x); return ($x,1); } return ($x,0) if $a > 0; # Result still too small (we should come here only if the estimate above # was very off base): # Now let the normal trial run obtain the real result # Simple loop that increments $x by 2 in each step, possible overstepping # the real result my $base_mul = _mul($c, _copy($c,$base), $base); # $base * $base while (($a = _acmp($c,$trial,$x_org)) < 0) { # print STDERR "# small _log_int at ", _str($c,$x), "\n"; _mul($c,$trial,$base_mul); _add($c, $x, [2]); } my $exact = 1; if ($a > 0) { # overstepped the result _dec($c, $x); _div($c,$trial,$base); $a = _acmp($c,$trial,$x_org); if ($a > 0) { _dec($c, $x); } $exact = 0 if $a != 0; # a = -1 => not exact result, a = 0 => exact } ($x,$exact); # return result } # for debugging: use constant DEBUG => 0; my $steps = 0; sub steps { $steps }; sub _sqrt { # square-root of $x in place # Compute a guess of the result (by rule of thumb), then improve it via # Newton's method. my ($c,$x) = @_; if (scalar @$x == 1) { # fits into one Perl scalar, so result can be computed directly $x->[0] = int(sqrt($x->[0])); return $x; } my $y = _copy($c,$x); # hopefully _len/2 is < $BASE, the -1 is to always undershot the guess # since our guess will "grow" my $l = int((_len($c,$x)-1) / 2); my $lastelem = $x->[-1]; # for guess my $elems = scalar @$x - 1; # not enough digits, but could have more? if ((length($lastelem) <= 3) && ($elems > 1)) { # right-align with zero pad my $len = length($lastelem) & 1; print "$lastelem => " if DEBUG; $lastelem .= substr($x->[-2] . '0' x $BASE_LEN,0,$BASE_LEN); # former odd => make odd again, or former even to even again $lastelem = $lastelem / 10 if (length($lastelem) & 1) != $len; print "$lastelem\n" if DEBUG; } # construct $x (instead of _lsft($c,$x,$l,10) my $r = $l % $BASE_LEN; # 10000 00000 00000 00000 ($BASE_LEN=5) $l = int($l / $BASE_LEN); print "l = $l " if DEBUG; splice @$x,$l; # keep ref($x), but modify it # we make the first part of the guess not '1000...0' but int(sqrt($lastelem)) # that gives us: # 14400 00000 => sqrt(14400) => guess first digits to be 120 # 144000 000000 => sqrt(144000) => guess 379 print "$lastelem (elems $elems) => " if DEBUG; $lastelem = $lastelem / 10 if ($elems & 1 == 1); # odd or even? my $g = sqrt($lastelem); $g =~ s/\.//; # 2.345 => 2345 $r -= 1 if $elems & 1 == 0; # 70 => 7 # padd with zeros if result is too short $x->[$l--] = int(substr($g . '0' x $r,0,$r+1)); print "now ",$x->[-1] if DEBUG; print " would have been ", int('1' . '0' x $r),"\n" if DEBUG; # If @$x > 1, we could compute the second elem of the guess, too, to create # 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; my $two = _two(); my $last = _zero(); my $lastlast = _zero(); $steps = 0 if DEBUG; while (_acmp($c,$last,$x) != 0 && _acmp($c,$lastlast,$x) != 0) { $steps++ if DEBUG; $lastlast = _copy($c,$last); $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 "\nsteps in sqrt: $steps, " if DEBUG; _dec($c,$x) if _acmp($c,$y,_mul($c,_copy($c,$x),$x)) < 0; # overshot? print " final ",$x->[-1],"\n" if DEBUG; $x; } sub _root { # take n'th root of $x in place (n >= 3) my ($c,$x,$n) = @_; if (scalar @$x == 1) { if (scalar @$n > 1) { # result will always be smaller than 2 so trunc to 1 at once $x->[0] = 1; } else { # fits into one Perl scalar, so result can be computed directly # cannot use int() here, because it rounds wrongly (try # (81 ** 3) ** (1/3) to see what I mean) #$x->[0] = int( $x->[0] ** (1 / $n->[0]) ); # round to 8 digits, then truncate result to integer $x->[0] = int ( sprintf ("%.8f", $x->[0] ** (1 / $n->[0]) ) ); } return $x; } # we know now that X is more than one element long # 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+)$/) { my $count = CORE::length($1); # 0b100 => len('00') => 2 my $cnt = $count; # counter for loop unshift (@$x, 0); # add one element, together with one # more below in the loop this makes 2 while ($cnt-- > 0) { # 'inflate' $X by adding one element, basically computing # $x * $BASE * $BASE. This gives us more $BASE_LEN digits for result # since len(sqrt($X)) approx == len($x) / 2. unshift (@$x, 0); # calculate sqrt($x), $x is now one element to big, again. In the next # round we make that two, again. _sqrt($c,$x); } # $x is now one element to big, so truncate result by removing it splice (@$x,0,1); } else { # trial computation by starting with 2,4,8,16 etc until we overstep my $step; my $trial = _two(); # while still to do more than X steps do { $step = _two(); while (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) < 0) { _mul ($c, $step, [2]); _add ($c, $trial, $step); } # hit exactly? if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) == 0) { @$x = @$trial; # make copy while preserving ref to $x return $x; } # overstepped, so go back on step _sub($c, $trial, $step); } while (scalar @$step > 1 || $step->[0] > 128); # reset step to 2 $step = _two(); # add two, because $trial cannot be exactly the result (otherwise we would # already have found it) _add($c, $trial, $step); # and now add more and more (2,4,6,8,10 etc) while (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) < 0) { _add ($c, $trial, $step); } # hit not exactly? (overstepped) if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) > 0) { _dec($c,$trial); } # hit not exactly? (overstepped) # 80 too small, 81 slightly too big, 82 too big if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) > 0) { _dec ($c, $trial); } @$x = @$trial; # make copy while preserving ref to $x return $x; } $x; } ############################################################################## # binary stuff sub _and { my ($c,$x,$y) = @_; # the shortcut makes equal, large numbers _really_ fast, and makes only a # very small performance drop for small numbers (e.g. something with less # than 32 bit) Since we optimize for large numbers, this is enabled. return $x if _acmp($c,$x,$y) == 0; # shortcut my $m = _one(); my ($xr,$yr); my $mask = $AND_MASK; my $x1 = $x; my $y1 = _copy($c,$y); # make copy $x = _zero(); my ($b,$xrr,$yrr); use integer; while (!_is_zero($c,$x1) && !_is_zero($c,$y1)) { ($x1, $xr) = _div($c,$x1,$mask); ($y1, $yr) = _div($c,$y1,$mask); # make ints() from $xr, $yr # 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) ); # 0+ due to '&' doesn't work in strings _add($c,$x, _mul($c, [ 0+$xr->[0] & 0+$yr->[0] ], $m) ); _mul($c,$m,$mask); } $x; } sub _xor { my ($c,$x,$y) = @_; return _zero() if _acmp($c,$x,$y) == 0; # shortcut (see -and) my $m = _one(); my ($xr,$yr); my $mask = $XOR_MASK; my $x1 = $x; my $y1 = _copy($c,$y); # make copy $x = _zero(); my ($b,$xrr,$yrr); use integer; while (!_is_zero($c,$x1) && !_is_zero($c,$y1)) { ($x1, $xr) = _div($c,$x1,$mask); ($y1, $yr) = _div($c,$y1,$mask); # 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) ); # 0+ due to '^' doesn't work in strings _add($c,$x, _mul($c, [ 0+$xr->[0] ^ 0+$yr->[0] ], $m) ); _mul($c,$m,$mask); } # the loop stops when the shorter of the two numbers is exhausted # the remainder of the longer one will survive bit-by-bit, so we simple # multiply-add it in _add($c,$x, _mul($c, $x1, $m) ) if !_is_zero($c,$x1); _add($c,$x, _mul($c, $y1, $m) ) if !_is_zero($c,$y1); $x; } sub _or { my ($c,$x,$y) = @_; return $x if _acmp($c,$x,$y) == 0; # shortcut (see _and) my $m = _one(); my ($xr,$yr); my $mask = $OR_MASK; my $x1 = $x; my $y1 = _copy($c,$y); # make copy $x = _zero(); my ($b,$xrr,$yrr); use integer; while (!_is_zero($c,$x1) && !_is_zero($c,$y1)) { ($x1, $xr) = _div($c,$x1,$mask); ($y1, $yr) = _div($c,$y1,$mask); # 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) ); # 0+ due to '|' doesn't work in strings _add($c,$x, _mul($c, [ 0+$xr->[0] | 0+$yr->[0] ], $m) ); _mul($c,$m,$mask); } # the loop stops when the shorter of the two numbers is exhausted # the remainder of the longer one will survive bit-by-bit, so we simple # multiply-add it in _add($c,$x, _mul($c, $x1, $m) ) if !_is_zero($c,$x1); _add($c,$x, _mul($c, $y1, $m) ) if !_is_zero($c,$y1); $x; } sub _as_hex { # convert a decimal number to hex (ref to array, return ref to string) my ($c,$x) = @_; # fits into one element (handle also 0x0 case) return sprintf("0x%x",$x->[0]) if @$x == 1; my $x1 = _copy($c,$x); my $es = ''; my ($xr, $h, $x10000); if ($] >= 5.006) { $x10000 = [ 0x10000 ]; $h = 'h4'; } else { $x10000 = [ 0x1000 ]; $h = 'h3'; } while (@$x1 != 1 || $x1->[0] != 0) # _is_zero() { ($x1, $xr) = _div($c,$x1,$x10000); $es .= unpack($h,pack('V',$xr->[0])); } $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros '0x' . $es; # return result prepended with 0x } sub _as_bin { # convert a decimal number to bin (ref to array, return ref to string) my ($c,$x) = @_; # fits into one element (and Perl recent enough), handle also 0b0 case # handle zero case for older Perls if ($] <= 5.005 && @$x == 1 && $x->[0] == 0) { my $t = '0b0'; return $t; } if (@$x == 1 && $] >= 5.006) { my $t = sprintf("0b%b",$x->[0]); return $t; } my $x1 = _copy($c,$x); my $es = ''; my ($xr, $b, $x10000); if ($] >= 5.006) { $x10000 = [ 0x10000 ]; $b = 'b16'; } else { $x10000 = [ 0x1000 ]; $b = 'b12'; } while (!(@$x1 == 1 && $x1->[0] == 0)) # _is_zero() { ($x1, $xr) = _div($c,$x1,$x10000); $es .= unpack($b,pack('v',$xr->[0])); } $es = reverse $es; $es =~ s/^[0]+//; # strip leading zeros '0b' . $es; # return result prepended with 0b } sub _as_oct { # convert a decimal number to octal (ref to array, return ref to string) my ($c,$x) = @_; # fits into one element (handle also 0 case) return sprintf("0%o",$x->[0]) if @$x == 1; my $x1 = _copy($c,$x); my $es = ''; my $xr; my $x1000 = [ 0100000 ]; while (@$x1 != 1 || $x1->[0] != 0) # _is_zero() { ($x1, $xr) = _div($c,$x1,$x1000); $es .= reverse sprintf("%05o", $xr->[0]); } $es = reverse $es; $es =~ s/^0+//; # strip leading zeros '0' . $es; # return result prepended with 0 } sub _from_oct { # convert a octal number to decimal (string, return ref to array) my ($c,$os) = @_; # for older Perls, play safe my $m = [ 0100000 ]; my $d = 5; # 5 digits at a time my $mul = _one(); my $x = _zero(); my $len = int( (length($os)-1)/$d ); # $d digit parts, w/o the '0' my $val; my $i = -$d; while ($len >= 0) { $val = substr($os,$i,$d); # get oct digits $val = CORE::oct($val); $i -= $d; $len --; my $adder = [ $val ]; _add ($c, $x, _mul ($c, $adder, $mul ) ) if $val != 0; _mul ($c, $mul, $m ) if $len >= 0; # skip last mul } $x; } sub _from_hex { # convert a hex number to decimal (string, return ref to array) my ($c,$hs) = @_; my $m = _new($c, 0x10000000); # 28 bit at a time (<32 bit!) my $d = 7; # 7 digits at a time if ($] <= 5.006) { # for older Perls, play safe $m = [ 0x10000 ]; # 16 bit at a time (<32 bit!) $d = 4; # 4 digits at a time } my $mul = _one(); my $x = _zero(); my $len = int( (length($hs)-2)/$d ); # $d digit parts, w/o the '0x' my $val; my $i = -$d; while ($len >= 0) { $val = substr($hs,$i,$d); # get hex digits $val =~ s/^0x// if $len == 0; # for last part only because $val = CORE::hex($val); # hex does not like wrong chars $i -= $d; $len --; my $adder = [ $val ]; # if the resulting number was to big to fit into one element, create a # two-element version (bug found by Mark Lakata - Thanx!) if (CORE::length($val) > $BASE_LEN) { $adder = _new($c,$val); } _add ($c, $x, _mul ($c, $adder, $mul ) ) if $val != 0; _mul ($c, $mul, $m ) if $len >= 0; # skip last mul } $x; } sub _from_bin { # convert a hex number to decimal (string, return ref to array) my ($c,$bs) = @_; # 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; $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 = '0x' . unpack('H*', pack ('B*', $hs)); # repack as hex $c->_from_hex($h); } ############################################################################## # special modulus functions sub _modinv { # modular multiplicative inverse my ($c,$x,$y) = @_; # modulo zero if (_is_zero($c, $y)) { return (undef, undef); } # modulo one if (_is_one($c, $y)) { return (_zero($c), '+'); } my $u = _zero($c); my $v = _one($c); my $a = _copy($c,$y); my $b = _copy($c,$x); # Euclid's Algorithm for bgcd(), only that we calc bgcd() ($a) and the result # ($u) at the same time. See comments in BigInt for why this works. my $q; my $sign = 1; { ($a, $q, $b) = ($b, _div($c, $a, $b)); # step 1 last if _is_zero($c, $b); my $t = _add($c, # step 2: _mul($c, _copy($c, $v), $q) , # t = v * q $u ); # + u $u = $v; # u = v $v = $t; # v = t $sign = -$sign; redo; } # if the gcd is not 1, then return NaN return (undef, undef) unless _is_one($c, $a); ($v, $sign == 1 ? '+' : '-'); } sub _modpow { # modulus of power ($x ** $y) % $z my ($c,$num,$exp,$mod) = @_; # a^b (mod 1) = 0 for all a and b if (_is_one($c,$mod)) { @$num = 0; return $num; } # 0^a (mod m) = 0 if m != 0, a != 0 # 0^0 (mod m) = 1 if m != 0 if (_is_zero($c, $num)) { if (_is_zero($c, $exp)) { @$num = 1; } else { @$num = 0; } return $num; } # $num = _mod($c,$num,$mod); # this does not make it faster my $acc = _copy($c,$num); my $t = _one(); my $expbin = _as_bin($c,$exp); $expbin =~ s/^0b//; my $len = length($expbin); while (--$len >= 0) { if ( substr($expbin,$len,1) eq '1') # is_odd { _mul($c,$t,$acc); $t = _mod($c,$t,$mod); } _mul($c,$acc,$acc); $acc = _mod($c,$acc,$mod); } @$num = @$t; $num; } sub _gcd { # Greatest common divisor. my ($c, $x, $y) = @_; # gcd(0,0) = 0 # gcd(0,a) = a, if a != 0 if (@$x == 1 && $x->[0] == 0) { if (@$y == 1 && $y->[0] == 0) { @$x = 0; } else { @$x = @$y; } return $x; } # Until $y is zero ... until (@$y == 1 && $y->[0] == 0) { # Compute remainder. _mod($c, $x, $y); # Swap $x and $y. my $tmp = [ @$x ]; @$x = @$y; $y = $tmp; # no deref here; that would modify input $y } return $x; } ############################################################################## ############################################################################## 1; __END__ =pod =head1 NAME Math::BigInt::Calc - Pure Perl module to support Math::BigInt =head1 SYNOPSIS This library provides support for big integer calculations. It is not intended to be used by other modules. Other modules which support the same API (see below) can also be used to support Math::BigInt, like Math::BigInt::GMP and Math::BigInt::Pari. =head1 DESCRIPTION In this library, the numbers are represented in base B = 10**N, where N is the largest possible value that does not cause overflow in the intermediate computations. The base B elements are stored in an array, with the least significant element stored in array element zero. There are no leading zero elements, except a single zero element when the number is zero. For instance, if B = 10000, the number 1234567890 is represented internally as [3456, 7890, 12]. =head1 THE Math::BigInt API In order to allow for multiple big integer libraries, Math::BigInt was rewritten to use a plug-in library for core math routines. Any module which conforms to the API can be used by Math::BigInt by using this in your program: use Math::BigInt lib => 'libname'; 'libname' is either the long name, like 'Math::BigInt::Pari', or only the short version, like 'Pari'. =head2 General Notes A library only needs to deal with unsigned big integers. Testing of input parameter validity is done by the caller, so there is no need to worry about underflow (e.g., in C<_sub()> and C<_dec()>) nor about division by zero (e.g., in C<_div()>) or similar cases. For some methods, the first parameter can be modified. That includes the possibility that you return a reference to a completely different object instead. Although keeping the reference and just changing its contents is preferred over creating and returning a different reference. Return values are always objects, strings, Perl scalars, or true/false for comparison routines. =head2 API version 1 The following methods must be defined in order to support the use by Math::BigInt v1.70 or later. =head3 API version =over 4 =item I Return API version as a Perl scalar, 1 for Math::BigInt v1.70, 2 for Math::BigInt v1.83. =back =head3 Constructors =over 4 =item I<_new(STR)> Convert a string representing an unsigned decimal number to an object representing the same number. The input is normalize, i.e., it matches C<^(0|[1-9]\d*)$>. =item I<_zero()> Return an object representing the number zero. =item I<_one()> Return an object representing the number one. =item I<_two()> Return an object representing the number two. =item I<_ten()> Return an object representing the number ten. =item I<_from_bin(STR)> Return an object given a string representing a binary number. The input has a '0b' prefix and matches the regular expression C<^0[bB](0|1[01]*)$>. =item I<_from_oct(STR)> Return an object given a string representing an octal number. The input has a '0' prefix and matches the regular expression C<^0[1-7]*$>. =item I<_from_hex(STR)> Return an object given a string representing a hexadecimal number. The input has a '0x' prefix and matches the regular expression C<^0x(0|[1-9a-fA-F][\da-fA-F]*)$>. =back =head3 Mathematical functions Each of these methods may modify the first input argument, except I<_bgcd()>, which shall not modify any input argument, and I<_sub()> which may modify the second input argument. =over 4 =item I<_add(OBJ1, OBJ2)> Returns the result of adding OBJ2 to OBJ1. =item I<_mul(OBJ1, OBJ2)> Returns the result of multiplying OBJ2 and OBJ1. =item I<_div(OBJ1, OBJ2)> Returns the result of dividing OBJ1 by OBJ2 and truncating the result to an integer. =item I<_sub(OBJ1, OBJ2, FLAG)> =item I<_sub(OBJ1, OBJ2)> Returns the result of subtracting OBJ2 by OBJ1. If C is false or omitted, OBJ1 might be modified. If C is true, OBJ2 might be modified. =item I<_dec(OBJ)> Decrement OBJ by one. =item I<_inc(OBJ)> Increment OBJ by one. =item I<_mod(OBJ1, OBJ2)> Return OBJ1 modulo OBJ2, i.e., the remainder after dividing OBJ1 by OBJ2. =item I<_sqrt(OBJ)> Return the square root of the object, truncated to integer. =item I<_root(OBJ, N)> Return Nth root of the object, truncated to int. N is E= 3. =item I<_fac(OBJ)> Return factorial of object (1*2*3*4*...). =item I<_pow(OBJ1, OBJ2)> Return OBJ1 to the power of OBJ2. By convention, 0**0 = 1. =item I<_modinv(OBJ1, OBJ2)> Return modular multiplicative inverse, i.e., return OBJ3 so that (OBJ3 * OBJ1) % OBJ2 = 1 % OBJ2 The result is returned as two arguments. If the modular multiplicative inverse does not exist, both arguments are undefined. Otherwise, the arguments are a number (object) and its sign ("+" or "-"). The output value, with its sign, must either be a positive value in the range 1,2,...,OBJ2-1 or the same value subtracted OBJ2. For instance, if the input arguments are objects representing the numbers 7 and 5, the method must either return an object representing the number 3 and a "+" sign, since (3*7) % 5 = 1 % 5, or an object representing the number 2 and "-" sign, since (-2*7) % 5 = 1 % 5. =item I<_modpow(OBJ1, OBJ2, OBJ3)> Return modular exponentiation, (OBJ1 ** OBJ2) % OBJ3. =item I<_rsft(OBJ, N, B)> Shift object N digits right in base B and return the resulting object. This is equivalent to performing integer division by B**N and discarding the remainder, except that it might be much faster, depending on how the number is represented internally. For instance, if the object $obj represents the hexadecimal number 0xabcde, then C<_rsft($obj, 2, 16)> returns an object representing the number 0xabc. The "remainer", 0xde, is discarded and not returned. =item I<_lsft(OBJ, N, B)> Shift the object N digits left in base B. This is equivalent to multiplying by B**N, except that it might be much faster, depending on how the number is represented internally. =item I<_log_int(OBJ, B)> Return integer log of OBJ to base BASE. This method has two output arguments, the OBJECT and a STATUS. The STATUS is Perl scalar; it is 1 if OBJ is the exact result, 0 if the result was truncted to give OBJ, and undef if it is unknown whether OBJ is the exact result. =item I<_gcd(OBJ1, OBJ2)> Return the greatest common divisor of OBJ1 and OBJ2. =back =head3 Bitwise operators Each of these methods may modify the first input argument. =over 4 =item I<_and(OBJ1, OBJ2)> Return bitwise and. If necessary, the smallest number is padded with leading zeros. =item I<_or(OBJ1, OBJ2)> Return bitwise or. If necessary, the smallest number is padded with leading zeros. =item I<_xor(OBJ1, OBJ2)> Return bitwise exclusive or. If necessary, the smallest number is padded with leading zeros. =back =head3 Boolean operators =over 4 =item I<_is_zero(OBJ)> Returns a true value if OBJ is zero, and false value otherwise. =item I<_is_one(OBJ)> Returns a true value if OBJ is one, and false value otherwise. =item I<_is_two(OBJ)> Returns a true value if OBJ is two, and false value otherwise. =item I<_is_ten(OBJ)> Returns a true value if OBJ is ten, and false value otherwise. =item I<_is_even(OBJ)> Return a true value if OBJ is an even integer, and a false value otherwise. =item I<_is_odd(OBJ)> Return a true value if OBJ is an even integer, and a false value otherwise. =item I<_acmp(OBJ1, OBJ2)> Compare OBJ1 and OBJ2 and return -1, 0, or 1, if OBJ1 is less than, equal to, or larger than OBJ2, respectively. =back =head3 String conversion =over 4 =item I<_str(OBJ)> Return a string representing the object. The returned string should have no leading zeros, i.e., it should match C<^(0|[1-9]\d*)$>. =item I<_as_bin(OBJ)> Return the binary string representation of the number. The string must have a '0b' prefix. =item I<_as_oct(OBJ)> Return the octal string representation of the number. The string must have a '0x' prefix. Note: This method was required from Math::BigInt version 1.78, but the required API version number was not incremented, so there are older libraries that support API version 1, but do not support C<_as_oct()>. =item I<_as_hex(OBJ)> Return the hexadecimal string representation of the number. The string must have a '0x' prefix. =back =head3 Numeric conversion =over 4 =item I<_num(OBJ)> Given an object, return a Perl scalar number (int/float) representing this number. =back =head3 Miscellaneous =over 4 =item I<_copy(OBJ)> Return a true copy of the object. =item I<_len(OBJ)> Returns the number of the decimal digits in the number. The output is a Perl scalar. =item I<_zeros(OBJ)> Return the number of trailing decimal zeros. The output is a Perl scalar. =item I<_digit(OBJ, N)> Return the Nth digit as a Perl scalar. N is a Perl scalar, where zero refers to the rightmost (least significant) digit, and negative values count from the left (most significant digit). If $obj represents the number 123, then I<_digit($obj, 0)> is 3 and I<_digit(123, -1)> is 1. =item I<_check(OBJ)> Return a true value if the object is OK, and a false value otherwise. This is a check routine to test the internal state of the object for corruption. =back =head2 API version 2 The following methods are required for an API version of 2 or greater. =head3 Constructors =over 4 =item I<_1ex(N)> Return an object representing the number 10**N where N E= 0 is a Perl scalar. =back =head3 Mathematical functions =over 4 =item I<_nok(OBJ1, OBJ2)> Return the binomial coefficient OBJ1 over OBJ1. =back =head3 Miscellaneous =over 4 =item I<_alen(OBJ)> Return the approximate number of decimal digits of the object. The output is one Perl scalar. This estimate must be greater than or equal to what C<_len()> returns. =back =head2 API optional methods The following methods 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: =head3 Signed bitwise operators. Each of these methods may modify the first input argument. =over 4 =item I<_signed_or(OBJ1, OBJ2, SIGN1, SIGN2)> Return the signed bitwise or. =item I<_signed_and(OBJ1, OBJ2, SIGN1, SIGN2)> Return the signed bitwise and. =item I<_signed_xor(OBJ1, OBJ2, SIGN1, SIGN2)> Return the signed bitwise exclusive or. =back =head1 WRAP YOUR OWN If you want to port your own favourite c-lib for big numbers to the Math::BigInt interface, you can take any of the already existing modules as a rough guideline. You should really wrap up the latest BigInt and BigFloat testsuites with your module, and replace in them any of the following: use Math::BigInt; by this: use Math::BigInt lib => 'yourlib'; This way you ensure that your library really works 100% within Math::BigInt. =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L (requires login). We will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Math::BigInt::Calc You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =item * CPAN Testers Matrix L =item * The Bignum mailing list =over 4 =item * Post to mailing list C =item * View mailing list L =item * Subscribe/Unsubscribe L =back =back =head1 LICENSE This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS =over 4 =item * Original math code by Mark Biggar, rewritten by Tels L in late 2000. =item * Separated from BigInt and shaped API with the help of John Peacock. =item * Fixed, speed-up, streamlined and enhanced by Tels 2001 - 2007. =item * API documentation corrected and extended by Peter John Acklam, Epjacklam@online.noE =back =head1 SEE ALSO L, L, L, L and L. =cut Math-BigInt-1.999715/lib/Math/BigInt/CalcEmu.pm0000644403072340010010000002343212642754711020732 0ustar ospjaDomain Userspackage Math::BigInt::CalcEmu; use 5.006001; use strict; use warnings; our $VERSION = '1.999715'; $VERSION = eval $VERSION; package Math::BigInt; # See SYNOPSIS below. my $CALC_EMU; BEGIN { $CALC_EMU = Math::BigInt->config()->{'lib'}; # register us with MBI to get notified of future lib changes Math::BigInt::_register_callback( __PACKAGE__, sub { $CALC_EMU = $_[0]; } ); } sub __emu_band { my ($self,$x,$y,$sx,$sy,@r) = @_; return $x->bzero(@r) if $y->is_zero() || $x->is_zero(); my $sign = 0; # sign of result $sign = 1 if $sx == -1 && $sy == -1; my ($bx,$by); if ($sx == -1) # if x is negative { # two's complement: inc and flip all "bits" in $bx $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc $bx =~ s/-?0x//; $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } else { $bx = $x->as_hex(); # get binary representation $bx =~ s/-?0x//; $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } if ($sy == -1) # if y is negative { # two's complement: inc and flip all "bits" in $by $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc $by =~ s/-?0x//; $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } else { $by = $y->as_hex(); # get binary representation $by =~ s/-?0x//; $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } # now we have bit-strings from X and Y, reverse them for padding $bx = reverse $bx; $by = reverse $by; # padd the shorter string my $xx = "\x00"; $xx = "\x0f" if $sx == -1; my $yy = "\x00"; $yy = "\x0f" if $sy == -1; my $diff = CORE::length($bx) - CORE::length($by); if ($diff > 0) { # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by $by .= $yy x $diff; } elsif ($diff < 0) { # 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 # to get the characters back. if ($sign == 1) { $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; } else { $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; } # leading zeros will be stripped by _from_hex() $bx = '0x' . $bx; $x->{value} = $CALC_EMU->_from_hex( $bx ); # calculate sign of result $x->{sign} = '+'; $x->{sign} = '-' if $sign == 1 && !$x->is_zero(); $x->bdec() if $sign == 1; $x->round(@r); } sub __emu_bior { my ($self,$x,$y,$sx,$sy,@r) = @_; return $x->round(@r) if $y->is_zero(); my $sign = 0; # sign of result $sign = 1 if ($sx == -1) || ($sy == -1); my ($bx,$by); if ($sx == -1) # if x is negative { # two's complement: inc and flip all "bits" in $bx $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc $bx =~ s/-?0x//; $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } else { $bx = $x->as_hex(); # get binary representation $bx =~ s/-?0x//; $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } if ($sy == -1) # if y is negative { # two's complement: inc and flip all "bits" in $by $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc $by =~ s/-?0x//; $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } else { $by = $y->as_hex(); # get binary representation $by =~ s/-?0x//; $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } # now we have bit-strings from X and Y, reverse them for padding $bx = reverse $bx; $by = reverse $by; # padd the shorter string my $xx = "\x00"; $xx = "\x0f" if $sx == -1; my $yy = "\x00"; $yy = "\x0f" if $sy == -1; my $diff = CORE::length($bx) - CORE::length($by); if ($diff > 0) { $by .= $yy x $diff; } elsif ($diff < 0) { $bx .= $xx x abs($diff); } # or the strings together my $r = $bx | $by; # and reverse the result again $bx = reverse $r; # one of $x or $y was negative, so need to flip bits in the result # in both cases (one or two of them negative, or both positive) we need # to get the characters back. if ($sign == 1) { $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; } else { $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; } # leading zeros will be stripped by _from_hex() $bx = '0x' . $bx; $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; $x->round(@r); } sub __emu_bxor { my ($self,$x,$y,$sx,$sy,@r) = @_; return $x->round(@r) if $y->is_zero(); my $sign = 0; # sign of result $sign = 1 if $x->{sign} ne $y->{sign}; my ($bx,$by); if ($sx == -1) # if x is negative { # two's complement: inc and flip all "bits" in $bx $bx = $x->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc $bx =~ s/-?0x//; $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } else { $bx = $x->as_hex(); # get binary representation $bx =~ s/-?0x//; $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } if ($sy == -1) # if y is negative { # two's complement: inc and flip all "bits" in $by $by = $y->copy()->binc()->as_hex(); # -1 => 0, -2 => 1, -3 => 2 etc $by =~ s/-?0x//; $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } else { $by = $y->as_hex(); # get binary representation $by =~ s/-?0x//; $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/; } # now we have bit-strings from X and Y, reverse them for padding $bx = reverse $bx; $by = reverse $by; # padd the shorter string my $xx = "\x00"; $xx = "\x0f" if $sx == -1; my $yy = "\x00"; $yy = "\x0f" if $sy == -1; my $diff = CORE::length($bx) - CORE::length($by); if ($diff > 0) { $by .= $yy x $diff; } elsif ($diff < 0) { $bx .= $xx x abs($diff); } # xor the strings together my $r = $bx ^ $by; # and reverse the result again $bx = reverse $r; # one of $x or $y was negative, so need to flip bits in the result # in both cases (one or two of them negative, or both positive) we need # to get the characters back. if ($sign == 1) { $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/; } else { $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/; } # leading zeros will be stripped by _from_hex() $bx = '0x' . $bx; $x->{value} = $CALC_EMU->_from_hex( $bx ); # calculate sign of result $x->{sign} = '+'; $x->{sign} = '-' if $sx != $sy && !$x->is_zero(); $x->bdec() if $sign == 1; $x->round(@r); } ############################################################################## ############################################################################## 1; __END__ =pod =head1 NAME Math::BigInt::CalcEmu - Emulate low-level math with BigInt code =head1 SYNOPSIS use Math::BigInt::CalcEmu; =head1 DESCRIPTION Contains routines that emulate low-level math functions in BigInt, e.g. optional routines the low-level math package does not provide on its own. Will be loaded on demand and called automatically by BigInt. Stuff here is really low-priority to optimize, since it is far better to implement the operation in the low-level math library directly, possible even using a call to the native lib. =head1 METHODS =over =item __emu_bxor =item __emu_band =item __emu_bior =back =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L (requires login). We will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Math::BigInt::CalcEmu You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =item * CPAN Testers Matrix L =item * The Bignum mailing list =over 4 =item * Post to mailing list C =item * View mailing list L =item * Subscribe/Unsubscribe L =back =back =head1 LICENSE This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS (c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by Tels from 2001-2003. =head1 SEE ALSO L, L, L and L. =cut Math-BigInt-1.999715/lib/Math/BigInt.pm0000644403072340010010000053356712642754717017446 0ustar ospjaDomain Userspackage Math::BigInt; # # "Mike had an infinite amount to do and a negative amount of time in which # to do it." - Before and After # # The following hash values are used: # value: unsigned int with actual value (as a Math::BigInt::Calc or similar) # sign : +,-,NaN,+inf,-inf # _a : accuracy # _p : precision # _f : flags, used by MBF to flag parts of a float as untouchable # Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since # underlying lib might change the reference! use 5.006001; use strict; use warnings; our $VERSION = '1.999715'; $VERSION = eval $VERSION; our @ISA = qw(Exporter); our @EXPORT_OK = qw(objectify bgcd blcm); # _trap_inf and _trap_nan are internal and should never be accessed from the # outside our ($round_mode, $accuracy, $precision, $div_scale, $rnd_mode, $upgrade, $downgrade, $_trap_nan, $_trap_inf); my $class = "Math::BigInt"; # Inside overload, the first arg is always an object. If the original code had # it reversed (like $x = 2 * $y), then the third parameter is true. # In some cases (like add, $x = $x + 2 is the same as $x = 2 + $x) this makes # no difference, but in some cases it does. # For overloaded ops with only one argument we simple use $_[0]->copy() to # preserve the argument. # Thus inheritance of overload operators becomes possible and transparent for # our subclasses without the need to repeat the entire overload section there. # We register ops that are not registerable yet, so suppress warnings { no warnings; use overload '=' => sub { $_[0]->copy(); }, # some shortcuts for speed (assumes that reversed order of arguments is routed # to normal '+' and we thus can always modify first arg. If this is changed, # this breaks and must be adjusted.) '+=' => sub { $_[0]->badd($_[1]); }, '-=' => sub { $_[0]->bsub($_[1]); }, '*=' => sub { $_[0]->bmul($_[1]); }, '/=' => sub { scalar $_[0]->bdiv($_[1]); }, '%=' => sub { $_[0]->bmod($_[1]); }, '^=' => sub { $_[0]->bxor($_[1]); }, '&=' => sub { $_[0]->band($_[1]); }, '|=' => sub { $_[0]->bior($_[1]); }, '**=' => sub { $_[0]->bpow($_[1]); }, '<<=' => sub { $_[0]->blsft($_[1]); }, '>>=' => sub { $_[0]->brsft($_[1]); }, # not supported by Perl yet '..' => \&_pointpoint, '<=>' => sub { my $rc = $_[2] ? ref($_[0])->bcmp($_[1],$_[0]) : $_[0]->bcmp($_[1]); $rc = 1 unless defined $rc; $rc <=> 0; }, # we need '>=' to get things like "1 >= NaN" right: '>=' => sub { my $rc = $_[2] ? ref($_[0])->bcmp($_[1],$_[0]) : $_[0]->bcmp($_[1]); # if there was a NaN involved, return false return '' unless defined $rc; $rc >= 0; }, 'cmp' => sub { $_[2] ? "$_[1]" cmp $_[0]->bstr() : $_[0]->bstr() cmp "$_[1]" }, 'cos' => sub { $_[0]->copy->bcos(); }, 'sin' => sub { $_[0]->copy->bsin(); }, 'atan2' => sub { $_[2] ? ref($_[0])->new($_[1])->batan2($_[0]) : $_[0]->copy()->batan2($_[1]) }, # are not yet overloadable #'hex' => sub { print "hex"; $_[0]; }, #'oct' => sub { print "oct"; $_[0]; }, # log(N) is log(N, e), where e is Euler's number 'log' => sub { $_[0]->copy()->blog(); }, 'exp' => sub { $_[0]->copy()->bexp($_[1]); }, 'int' => sub { $_[0]->copy(); }, 'neg' => sub { $_[0]->copy()->bneg(); }, 'abs' => sub { $_[0]->copy()->babs(); }, 'sqrt' => sub { $_[0]->copy()->bsqrt(); }, '~' => sub { $_[0]->copy()->bnot(); }, # for subtract it's a bit tricky to not modify b: b-a => -a+b '-' => sub { my $c = $_[0]->copy; $_[2] ? $c->bneg()->badd( $_[1]) : $c->bsub( $_[1]) }, '+' => sub { $_[0]->copy()->badd($_[1]); }, '*' => sub { $_[0]->copy()->bmul($_[1]); }, '/' => sub { $_[2] ? ref($_[0])->new($_[1])->bdiv($_[0]) : $_[0]->copy->bdiv($_[1]); }, '%' => sub { $_[2] ? ref($_[0])->new($_[1])->bmod($_[0]) : $_[0]->copy->bmod($_[1]); }, '**' => sub { $_[2] ? ref($_[0])->new($_[1])->bpow($_[0]) : $_[0]->copy->bpow($_[1]); }, '<<' => sub { $_[2] ? ref($_[0])->new($_[1])->blsft($_[0]) : $_[0]->copy->blsft($_[1]); }, '>>' => sub { $_[2] ? ref($_[0])->new($_[1])->brsft($_[0]) : $_[0]->copy->brsft($_[1]); }, '&' => sub { $_[2] ? ref($_[0])->new($_[1])->band($_[0]) : $_[0]->copy->band($_[1]); }, '|' => sub { $_[2] ? ref($_[0])->new($_[1])->bior($_[0]) : $_[0]->copy->bior($_[1]); }, '^' => sub { $_[2] ? ref($_[0])->new($_[1])->bxor($_[0]) : $_[0]->copy->bxor($_[1]); }, # can modify arg of ++ and --, so avoid a copy() for speed, but don't # use $_[0]->bone(), it would modify $_[0] to be 1! '++' => sub { $_[0]->binc() }, '--' => sub { $_[0]->bdec() }, # if overloaded, O(1) instead of O(N) and twice as fast for small numbers 'bool' => sub { # this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/ # v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-( my $t = undef; $t = 1 if !$_[0]->is_zero(); $t; }, # the original qw() does not work with the TIESCALAR below, why? # Order of arguments insignificant '""' => sub { $_[0]->bstr(); }, '0+' => sub { $_[0]->numify(); } ; } # no warnings scope ############################################################################## # global constants, flags and accessory # These vars are public, but their direct usage is not recommended, use the # accessor methods instead $round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common' $accuracy = undef; $precision = undef; $div_scale = 40; $upgrade = undef; # default is no upgrade $downgrade = undef; # default is no downgrade # These are internally, and not to be used from the outside at all $_trap_nan = 0; # are NaNs ok? set w/ config() $_trap_inf = 0; # are infs ok? set w/ config() my $nan = 'NaN'; # constants for easier life my $CALC = 'Math::BigInt::Calc'; # module to do the low level math # default is Calc.pm 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 %CALLBACKS; # callbacks to notify on lib loads my $EMU_LIB = 'Math/BigInt/CalcEmu.pm'; # emulate low-level math ############################################################################## # the old code had $rnd_mode, so we need to support it, too $rnd_mode = 'even'; sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; } sub FETCH { return $round_mode; } sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); } BEGIN { # tie to enable $rnd_mode to work transparently tie $rnd_mode, 'Math::BigInt'; # set up some handy alias names *as_int = \&as_number; *is_pos = \&is_positive; *is_neg = \&is_negative; } ############################################################################## sub round_mode { no strict 'refs'; # make Class->round_mode() work my $self = shift; my $class = ref($self) || $self || __PACKAGE__; if (defined $_[0]) { my $m = shift; if ($m !~ /^(even|odd|\+inf|\-inf|zero|trunc|common)$/) { require Carp; Carp::croak ("Unknown round mode '$m'"); } return ${"${class}::round_mode"} = $m; } ${"${class}::round_mode"}; } sub upgrade { no strict 'refs'; # make Class->upgrade() work my $self = shift; my $class = ref($self) || $self || __PACKAGE__; # need to set new value? if (@_ > 0) { return ${"${class}::upgrade"} = $_[0]; } ${"${class}::upgrade"}; } sub downgrade { no strict 'refs'; # make Class->downgrade() work my $self = shift; my $class = ref($self) || $self || __PACKAGE__; # need to set new value? if (@_ > 0) { return ${"${class}::downgrade"} = $_[0]; } ${"${class}::downgrade"}; } sub div_scale { no strict 'refs'; # make Class->div_scale() work my $self = shift; my $class = ref($self) || $self || __PACKAGE__; if (defined $_[0]) { if ($_[0] < 0) { require Carp; Carp::croak ('div_scale must be greater than zero'); } ${"${class}::div_scale"} = $_[0]; } ${"${class}::div_scale"}; } sub accuracy { # $x->accuracy($a); ref($x) $a # $x->accuracy(); ref($x) # Class->accuracy(); class # Class->accuracy($a); class $a my $x = shift; my $class = ref($x) || $x || __PACKAGE__; no strict 'refs'; # need to set new value? if (@_ > 0) { my $a = shift; # convert objects to scalars to avoid deep recursion. If object doesn't # have numify(), then hopefully it will have overloading for int() and # boolean test without wandering into a deep recursion path... $a = $a->numify() if ref($a) && $a->can('numify'); if (defined $a) { # also croak on non-numerical if (!$a || $a <= 0) { require Carp; Carp::croak ('Argument to accuracy must be greater than zero'); } if (int($a) != $a) { require Carp; Carp::croak ('Argument to accuracy must be an integer'); } } if (ref($x)) { # $object->accuracy() or fallback to global $x->bround($a) if $a; # not for undef, 0 $x->{_a} = $a; # set/overwrite, even if not rounded delete $x->{_p}; # clear P $a = ${"${class}::accuracy"} unless defined $a; # proper return value } else { ${"${class}::accuracy"} = $a; # set global A ${"${class}::precision"} = undef; # clear global P } return $a; # shortcut } my $a; # $object->accuracy() or fallback to global $a = $x->{_a} if ref($x); # but don't return global undef, when $x's accuracy is 0! $a = ${"${class}::accuracy"} if !defined $a; $a; } sub precision { # $x->precision($p); ref($x) $p # $x->precision(); ref($x) # Class->precision(); class # Class->precision($p); class $p my $x = shift; my $class = ref($x) || $x || __PACKAGE__; no strict 'refs'; if (@_ > 0) { my $p = shift; # convert objects to scalars to avoid deep recursion. If object doesn't # have numify(), then hopefully it will have overloading for int() and # boolean test without wandering into a deep recursion path... $p = $p->numify() if ref($p) && $p->can('numify'); if ((defined $p) && (int($p) != $p)) { require Carp; Carp::croak ('Argument to precision must be an integer'); } if (ref($x)) { # $object->precision() or fallback to global $x->bfround($p) if $p; # not for undef, 0 $x->{_p} = $p; # set/overwrite, even if not rounded delete $x->{_a}; # clear A $p = ${"${class}::precision"} unless defined $p; # proper return value } else { ${"${class}::precision"} = $p; # set global P ${"${class}::accuracy"} = undef; # clear global A } return $p; # shortcut } my $p; # $object->precision() or fallback to global $p = $x->{_p} if ref($x); # but don't return global undef, when $x's precision is 0! $p = ${"${class}::precision"} if !defined $p; $p; } sub config { # return (or set) configuration data as hash ref my $class = shift || 'Math::BigInt'; no strict 'refs'; if (@_ > 1 || (@_ == 1 && (ref($_[0]) eq 'HASH'))) { # try to set given options as arguments from hash my $args = $_[0]; if (ref($args) ne 'HASH') { $args = { @_ }; } # these values can be "set" my $set_args = {}; foreach my $key ( qw/trap_inf trap_nan upgrade downgrade precision accuracy round_mode div_scale/ ) { $set_args->{$key} = $args->{$key} if exists $args->{$key}; delete $args->{$key}; } if (keys %$args > 0) { require Carp; Carp::croak ("Illegal key(s) '", join("','",keys %$args),"' passed to $class\->config()"); } foreach my $key (keys %$set_args) { if ($key =~ /^trap_(inf|nan)\z/) { ${"${class}::_trap_$1"} = ($set_args->{"trap_$1"} ? 1 : 0); next; } # use a call instead of just setting the $variable to check argument $class->$key($set_args->{$key}); } } # now return actual configuration my $cfg = { lib => $CALC, lib_version => ${"${CALC}::VERSION"}, class => $class, trap_nan => ${"${class}::_trap_nan"}, trap_inf => ${"${class}::_trap_inf"}, version => ${"${class}::VERSION"}, }; foreach my $key (qw/ upgrade downgrade precision accuracy round_mode div_scale /) { $cfg->{$key} = ${"${class}::$key"}; }; if (@_ == 1 && (ref($_[0]) ne 'HASH')) { # calls of the style config('lib') return just this value return $cfg->{$_[0]}; } $cfg; } sub _scale_a { # select accuracy parameter based on precedence, # used by bround() and bfround(), may return undef for scale (means no op) my ($x,$scale,$mode) = @_; $scale = $x->{_a} unless defined $scale; no strict 'refs'; my $class = ref($x); $scale = ${ $class . '::accuracy' } unless defined $scale; $mode = ${ $class . '::round_mode' } unless defined $mode; if (defined $scale) { $scale = $scale->can('numify') ? $scale->numify() : "$scale" if ref($scale); $scale = int($scale); } ($scale,$mode); } sub _scale_p { # select precision parameter based on precedence, # used by bround() and bfround(), may return undef for scale (means no op) my ($x,$scale,$mode) = @_; $scale = $x->{_p} unless defined $scale; no strict 'refs'; my $class = ref($x); $scale = ${ $class . '::precision' } unless defined $scale; $mode = ${ $class . '::round_mode' } unless defined $mode; if (defined $scale) { $scale = $scale->can('numify') ? $scale->numify() : "$scale" if ref($scale); $scale = int($scale); } ($scale,$mode); } ############################################################################## # constructors sub copy { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; # If called as a class method, the object to copy is the next argument. $self = shift() unless $selfref; my $copy = bless {}, $class; $copy->{sign} = $self->{sign}; $copy->{value} = $CALC->_copy($self->{value}); $copy->{_a} = $self->{_a} if exists $self->{_a}; $copy->{_p} = $self->{_p} if exists $self->{_p}; return $copy; } sub new { # Create a new Math::BigInt object from a string or another Math::BigInt # object. See hash keys documented at top. # The argument could be an object, so avoid ||, && etc. on it. This would # cause costly overloaded code to be called. The only allowed ops are ref() # and defined. my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; my ($wanted, $a, $p, $r) = @_; # If called as a class method, initialize a new object. $self = bless {}, $class unless $selfref; unless (defined $wanted) { require Carp; Carp::carp("Use of uninitialized value in new"); return $self->bzero($a, $p, $r); } if (ref($wanted) && $wanted->isa($class)) { # MBI or subclass # Using "$copy = $wanted -> copy()" here fails some tests. Fixme! my $copy = $class -> copy($wanted); if ($selfref) { %$self = %$copy; } else { $self = $copy; } return $self; } $class->import() if $IMPORT == 0; # make require work # Shortcut for non-zero scalar integers with no non-zero exponent. if (!ref($wanted) && $wanted =~ / ^ ([+-]?) # optional sign ([1-9][0-9]*) # non-zero significand (\.0*)? # ... with optional zero fraction ([Ee][+-]?0+)? # optional zero exponent \z /x) { my $sgn = $1; my $abs = $2; $self->{sign} = $sgn || '+'; $self->{value} = $CALC->_new($abs); no strict 'refs'; if (defined($a) || defined($p) || defined(${"${class}::precision"}) || defined(${"${class}::accuracy"})) { $self->round($a, $p, $r) unless @_ == 4 && !defined $a && !defined $p; } return $self; } # Handle Infs. if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) { my $sgn = $1 || '+'; $self->{sign} = $sgn . 'inf'; # set a default sign for bstr() return $self->binf($sgn); } # Handle explicit NaNs (not the ones returned due to invalid input). if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) { return $self->bnan(); } if ($wanted =~ /^\s*[+-]?0[Xx]/) { return $class -> from_hex($wanted); } if ($wanted =~ /^\s*[+-]?0[Bb]/) { return $class -> from_bin($wanted); } # Split string into mantissa, exponent, integer, fraction, value, and sign. my ($mis, $miv, $mfv, $es, $ev) = _split($wanted); if (!ref $mis) { if ($_trap_nan) { require Carp; Carp::croak("$wanted is not a number in $class"); } $self->{value} = $CALC->_zero(); $self->{sign} = $nan; return $self; } if (!ref $miv) { # _from_hex or _from_bin $self->{value} = $mis->{value}; $self->{sign} = $mis->{sign}; return $self; # throw away $mis } # Make integer from mantissa by adjusting exponent, then convert to a # Math::BigInt. $self->{sign} = $$mis; # store sign $self->{value} = $CALC->_zero(); # for all the NaN cases my $e = int("$$es$$ev"); # exponent (avoid recursion) if ($e > 0) { my $diff = $e - CORE::length($$mfv); if ($diff < 0) { # Not integer if ($_trap_nan) { require Carp; Carp::croak("$wanted not an integer in $class"); } #print "NOI 1\n"; return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; $self->{sign} = $nan; } else { # diff >= 0 # adjust fraction and add it to value #print "diff > 0 $$miv\n"; $$miv = $$miv . ($$mfv . '0' x $diff); } } else { if ($$mfv ne '') { # e <= 0 # fraction and negative/zero E => NOI if ($_trap_nan) { require Carp; Carp::croak("$wanted not an integer in $class"); } #print "NOI 2 \$\$mfv '$$mfv'\n"; return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; $self->{sign} = $nan; } elsif ($e < 0) { # xE-y, and empty mfv # Split the mantissa at the decimal point. E.g., if # $$miv = 12345 and $e = -2, then $frac = 45 and $$miv = 123. my $frac = substr($$miv, $e); # $frac is fraction part substr($$miv, $e) = ""; # $$miv is now integer part if ($frac =~ /[^0]/) { if ($_trap_nan) { require Carp; Carp::croak("$wanted not an integer in $class"); } #print "NOI 3\n"; return $upgrade->new($wanted, $a, $p, $r) if defined $upgrade; $self->{sign} = $nan; } } } unless ($self->{sign} eq $nan) { $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0 $self->{value} = $CALC->_new($$miv) if $self->{sign} =~ /^[+-]$/; } # If any of the globals are 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. $self->round($a, $p, $r) unless @_ == 4 && !defined $a && !defined $p; $self; } sub bnan { # create a bigint 'NaN', if given a BigInt, set it to 'NaN' my $self = shift; $self = $class if !defined $self; if (!ref($self)) { my $c = $self; $self = {}; bless $self, $c; } no strict 'refs'; if (${"${class}::_trap_nan"}) { require Carp; Carp::croak ("Tried to set $self to NaN in $class\::bnan()"); } $self->import() if $IMPORT == 0; # make require work return if $self->modify('bnan'); if ($self->can('_bnan')) { # use subclass to initialize $self->_bnan(); } else { # otherwise do our own thing $self->{value} = $CALC->_zero(); } $self->{sign} = $nan; delete $self->{_a}; delete $self->{_p}; # rounding NaN is silly $self; } sub binf { # create a bigint '+-inf', if given a BigInt, set it to '+-inf' # the sign is either '+', or if given, used from there my $self = shift; my $sign = shift; $sign = '+' if !defined $sign || $sign !~ /^-(inf)?$/; $self = $class if !defined $self; if (!ref($self)) { my $c = $self; $self = {}; bless $self, $c; } no strict 'refs'; if (${"${class}::_trap_inf"}) { require Carp; Carp::croak ("Tried to set $self to +-inf in $class\::binf()"); } $self->import() if $IMPORT == 0; # make require work return if $self->modify('binf'); if ($self->can('_binf')) { # use subclass to initialize $self->_binf(); } else { # otherwise do our own thing $self->{value} = $CALC->_zero(); } $sign = $sign . 'inf' if $sign !~ /inf$/; # - => -inf $self->{sign} = $sign; ($self->{_a},$self->{_p}) = @_; # take over requested rounding $self; } sub bzero { # create a bigint '+0', if given a BigInt, set it to 0 my $self = shift; $self = __PACKAGE__ if !defined $self; if (!ref($self)) { my $c = $self; $self = {}; bless $self, $c; } $self->import() if $IMPORT == 0; # make require work return if $self->modify('bzero'); if ($self->can('_bzero')) { # use subclass to initialize $self->_bzero(); } else { # otherwise do our own thing $self->{value} = $CALC->_zero(); } $self->{sign} = '+'; if (@_ > 0) { if (@_ > 3) { # call like: $x->bzero($a,$p,$r,$y); ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_); } else { $self->{_a} = $_[0] if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a})); $self->{_p} = $_[1] if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p})); } } $self; } sub bone { # create a bigint '+1' (or -1 if given sign '-'), # if given a BigInt, set it to +1 or -1, respectively my $self = shift; my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-'; $self = $class if !defined $self; if (!ref($self)) { my $c = $self; $self = {}; bless $self, $c; } $self->import() if $IMPORT == 0; # make require work return if $self->modify('bone'); if ($self->can('_bone')) { # use subclass to initialize $self->_bone(); } else { # otherwise do our own thing $self->{value} = $CALC->_one(); } $self->{sign} = $sign; if (@_ > 0) { if (@_ > 3) { # call like: $x->bone($sign,$a,$p,$r,$y); ($self,$self->{_a},$self->{_p}) = $self->_find_round_parameters(@_); } else { # call like: $x->bone($sign,$a,$p,$r); $self->{_a} = $_[0] if ( (!defined $self->{_a}) || (defined $_[0] && $_[0] > $self->{_a})); $self->{_p} = $_[1] if ( (!defined $self->{_p}) || (defined $_[1] && $_[1] > $self->{_p})); } } $self; } ############################################################################## # string conversion sub bsstr { # (ref to BFLOAT or num_str ) return num_str # Convert number from internal format to scientific string format. # internal format is always normalized (no leading zeros, "-0E0" => "+0E0") my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } 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}); } sub bstr { # make a string from bigint object my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN return 'inf'; # +inf } my $es = ''; $es = $x->{sign} if $x->{sign} eq '-'; $es.$CALC->_str($x->{value}); } sub numify { # Make a Perl scalar number from a Math::BigInt object. my $x = shift; $x = $class->new($x) unless ref $x; if ($x -> is_nan()) { require Math::Complex; my $inf = Math::Complex::Inf(); return $inf - $inf; } if ($x -> is_inf()) { require Math::Complex; my $inf = Math::Complex::Inf(); return $x -> is_negative() ? -$inf : $inf; } my $num = 0 + $CALC->_num($x->{value}); return $x->{sign} eq '-' ? -$num : $num; } ############################################################################## # public stuff (usually prefixed with "b") sub sign { # return the sign of the number: +/-/-inf/+inf/NaN my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); $x->{sign}; } sub _find_round_parameters { # After any operation or when calling round(), the result is rounded by # regarding the A & P from arguments, local parameters, or globals. # !!!!!!! If you change this, remember to change round(), too! !!!!!!!!!! # This procedure finds the round parameters, but it is for speed reasons # duplicated in round. Otherwise, it is tested by the testsuite and used # by bdiv(). # returns ($self) or ($self,$a,$p,$r) - sets $self to NaN of both A and P # were requested/defined (locally or globally or both) my ($self, $a, $p, $r, @args) = @_; # $a accuracy, if given by caller # $p precision, if given by caller # $r round_mode, if given by caller # @args all 'other' arguments (0 for unary, 1 for binary ops) my $class = ref($self); # find out class of argument(s) no strict 'refs'; # convert to normal scalar for speed and correctness in inner parts $a = $a->can('numify') ? $a->numify() : "$a" if defined $a && ref($a); $p = $p->can('numify') ? $p->numify() : "$p" if defined $p && ref($p); # now pick $a or $p, but only if we have got "arguments" if (!defined $a) { foreach ($self, @args) { # take the defined one, or if both defined, the one that is smaller $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a); } } if (!defined $p) { # even if $a is defined, take $p, to signal error for both defined foreach ($self, @args) { # take the defined one, or if both defined, the one that is bigger # -2 > -3, and 3 > 2 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); } } # if still none defined, use globals (#2) $a = ${"$class\::accuracy"} unless defined $a; $p = ${"$class\::precision"} unless defined $p; # A == 0 is useless, so undef it to signal no rounding $a = undef if defined $a && $a == 0; # no rounding today? return ($self) unless defined $a || defined $p; # early out # set A and set P is an fatal error return ($self->bnan()) if defined $a && defined $p; # error $r = ${"$class\::round_mode"} unless defined $r; if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) { require Carp; Carp::croak ("Unknown round mode '$r'"); } $a = int($a) if defined $a; $p = int($p) if defined $p; ($self, $a, $p, $r); } sub round { # Round $self according to given parameters, or given second argument's # parameters or global defaults # for speed reasons, _find_round_parameters is embedded here: my ($self, $a, $p, $r, @args) = @_; # $a accuracy, if given by caller # $p precision, if given by caller # $r round_mode, if given by caller # @args all 'other' arguments (0 for unary, 1 for binary ops) my $class = ref($self); # find out class of argument(s) no strict 'refs'; # now pick $a or $p, but only if we have got "arguments" if (!defined $a) { foreach ($self, @args) { # take the defined one, or if both defined, the one that is smaller $a = $_->{_a} if (defined $_->{_a}) && (!defined $a || $_->{_a} < $a); } } if (!defined $p) { # even if $a is defined, take $p, to signal error for both defined foreach ($self, @args) { # take the defined one, or if both defined, the one that is bigger # -2 > -3, and 3 > 2 $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); } } # if still none defined, use globals (#2) $a = ${"$class\::accuracy"} unless defined $a; $p = ${"$class\::precision"} unless defined $p; # A == 0 is useless, so undef it to signal no rounding $a = undef if defined $a && $a == 0; # no rounding today? return $self unless defined $a || defined $p; # early out # set A and set P is an fatal error return $self->bnan() if defined $a && defined $p; $r = ${"$class\::round_mode"} unless defined $r; if ($r !~ /^(even|odd|[+-]inf|zero|trunc|common)$/) { require Carp; Carp::croak ("Unknown round mode '$r'"); } # now round, by calling either bround or bfround: if (defined $a) { $self->bround(int($a), $r) if !defined $self->{_a} || $self->{_a} >= $a; } else { # both can't be undefined due to early out $self->bfround(int($p), $r) if !defined $self->{_p} || $self->{_p} <= $p; } # bround() or bfround() already called bnorm() if nec. $self; } sub bnorm { # (numstr or BINT) return BINT # Normalize number -- no-op here my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); $x; } sub babs { # (BINT or num_str) return BINT # make number absolute, or return absolute BINT from string my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $x if $x->modify('babs'); # post-normalized abs for internal use (does nothing for NaN) $x->{sign} =~ s/^-/+/; $x; } sub bsgn { # Signum function. my $self = shift; return $self if $self->modify('bsgn'); return $self -> bone("+") if $self -> is_pos(); return $self -> bone("-") if $self -> is_neg(); return $self; # zero or NaN } sub bneg { # (BINT or num_str) return BINT # negate number or make a negated number from string my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return $x if $x->modify('bneg'); # for +0 do not negate (to have always normalized +0). Does nothing for 'NaN' $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $CALC->_is_zero($x->{value})); $x; } sub bcmp { # Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort) # (BINT or num_str, BINT or num_str) return cond_code # 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,@_); } return $upgrade->bcmp($x,$y) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); return 0 if $x->{sign} eq $y->{sign} && $x->{sign} =~ /^[+-]inf$/; return +1 if $x->{sign} eq '+inf'; return -1 if $x->{sign} eq '-inf'; return -1 if $y->{sign} eq '+inf'; return +1; } # check sign for speed first return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # does also 0 <=> -y return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # does also -x <=> 0 # have same sign, so compare absolute values. Don't make tests for zero # here because it's actually slower than testing in Calc (especially w/ Pari # et al) # post-normalized compare for internal use (honors signs) if ($x->{sign} eq '+') { # $x and $y both > 0 return $CALC->_acmp($x->{value},$y->{value}); } # $x && $y both < 0 $CALC->_acmp($y->{value},$x->{value}); # swapped acmp (lib returns 0,1,-1) } sub bacmp { # Compares 2 values, ignoring their signs. # Returns one of undef, <0, =0, >0. (suitable for sort) # (BINT, BINT) return cond_code # 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,@_); } return $upgrade->bacmp($x,$y) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # handle +-inf and NaN return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); return 0 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/; return 1 if $x->{sign} =~ /^[+-]inf$/ && $y->{sign} !~ /^[+-]inf$/; return -1; } $CALC->_acmp($x->{value},$y->{value}); # lib does only 0,1,-1 } sub badd { # add second arg (BINT or string) to first (BINT) (modifies first) # return result as BINT # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('badd'); return $upgrade->badd($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); $r[3] = $y; # no push! # inf and NaN handling if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) { # NaN first return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); # inf handling if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) { # +inf++inf or -inf+-inf => same, rest is NaN return $x if $x->{sign} eq $y->{sign}; return $x->bnan(); } # +-inf + something => +inf # something +-inf => +-inf $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/; return $x; } my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs if ($sx eq $sy) { $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add } else { my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare if ($a > 0) { $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap $x->{sign} = $sy; } elsif ($a == 0) { # speedup, if equal, set result to 0 $x->{value} = $CALC->_zero(); $x->{sign} = '+'; } else # a < 0 { $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub } } $x->round(@r); } sub bsub { # (BINT or num_str, BINT or num_str) return BINT # subtract second arg from first, modify first # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bsub'); return $upgrade->new($x)->bsub($upgrade->new($y),@r) if defined $upgrade && ((!$x->isa($self)) || (!$y->isa($self))); return $x->round(@r) if $y->is_zero(); # To correctly handle the lone special case $x->bsub($x), we note the sign # of $x, then flip the sign from $y, and if the sign of $x did change, too, # then we caught the special case: my $xsign = $x->{sign}; $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN if ($xsign ne $x->{sign}) { # special case of $x->bsub($x) results in 0 return $x->bzero(@r) if $xsign =~ /^[+-]$/; return $x->bnan(); # NaN, -inf, +inf } $x->badd($y,@r); # badd does not leave internal zeros $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN) $x; # already rounded by badd() or no round nec. } sub binc { # increment arg by one my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('binc'); if ($x->{sign} eq '+') { $x->{value} = $CALC->_inc($x->{value}); return $x->round($a,$p,$r); } elsif ($x->{sign} eq '-') { $x->{value} = $CALC->_dec($x->{value}); $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0 return $x->round($a,$p,$r); } # inf, nan handling etc $x->badd($self->bone(),$a,$p,$r); # badd does round } sub bdec { # decrement arg by one my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bdec'); if ($x->{sign} eq '-') { # x already < 0 $x->{value} = $CALC->_inc($x->{value}); } else { return $x->badd($self->bone('-'),@r) unless $x->{sign} eq '+'; # inf or NaN # >= 0 if ($CALC->_is_zero($x->{value})) { # == 0 $x->{value} = $CALC->_one(); $x->{sign} = '-'; # 0 => -1 } else { # > 0 $x->{value} = $CALC->_dec($x->{value}); } } $x->round(@r); } sub blog { # Return the logarithm of the operand. If a second operand is defined, that # value is used as the base, otherwise the base is assumed to be Euler's # constant. # Don't objectify the base, since an undefined base, as in $x->blog() or # $x->blog(undef) signals that the base is Euler's number. # set up parameters my ($self,$x,$base,@r) = (undef,@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$base,@r) = objectify(1,@_); } return $x if $x->modify('blog'); # Handle all exception cases and all trivial cases. I have used Wolfram Alpha # (http://www.wolframalpha.com) as the reference for these cases. return $x -> bnan() if $x -> is_nan(); if (defined $base) { $base = $self -> new($base) unless ref $base; if ($base -> is_nan() || $base -> is_one()) { return $x -> bnan(); } elsif ($base -> is_inf() || $base -> is_zero()) { return $x -> bnan() if $x -> is_inf() || $x -> is_zero(); return $x -> bzero(); } elsif ($base -> is_negative()) { # -inf < base < 0 return $x -> bzero() if $x -> is_one(); # x = 1 return $x -> bone() if $x == $base; # x = base return $x -> bnan(); # otherwise } return $x -> bone() if $x == $base; # 0 < base && 0 < x < inf } # We now know that the base is either undefined or >= 2 and finite. return $x -> binf('+') if $x -> is_inf(); # x = +/-inf return $x -> bnan() if $x -> is_neg(); # -inf < x < 0 return $x -> bzero() if $x -> is_one(); # x = 1 return $x -> binf('-') if $x -> is_zero(); # x = 0 # At this point we are done handling all exception cases and trivial cases. return $upgrade -> blog($upgrade -> new($x), $base, @r) if defined $upgrade; # fix for bug #24969: # the default base is e (Euler's number) which is not an integer if (!defined $base) { require Math::BigFloat; my $u = Math::BigFloat->blog(Math::BigFloat->new($x))->as_int(); # modify $x in place $x->{value} = $u->{value}; $x->{sign} = $u->{sign}; return $x; } 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 bnok { # Calculate n over k (binomial coefficient or "choose" function) as integer. # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bnok'); return $x->bnan() if $x->{sign} eq 'NaN' || $y->{sign} eq 'NaN'; return $x->binf() if $x->{sign} eq '+inf'; # k > n or k < 0 => 0 my $cmp = $x->bacmp($y); return $x->bzero() if $cmp < 0 || $y->{sign} =~ /^-/; # k == n => 1 return $x->bone(@r) if $cmp == 0; if ($CALC->can('_nok')) { $x->{value} = $CALC->_nok($x->{value},$y->{value}); } else { # ( 7 ) 7! 1*2*3*4 * 5*6*7 5 * 6 * 7 6 7 # ( - ) = --------- = --------------- = --------- = 5 * - * - # ( 3 ) (7-3)! 3! 1*2*3*4 * 1*2*3 1 * 2 * 3 2 3 if (!$y->is_zero()) { my $z = $x - $y; $z->binc(); my $r = $z->copy(); $z->binc(); my $d = $self->new(2); while ($z->bacmp($x) <= 0) # f <= x ? { $r->bmul($z); $r->bdiv($d); $z->binc(); $d->binc(); } $x->{value} = $r->{value}; $x->{sign} = '+'; } else { $x->bone(); } } $x->round(@r); } sub bexp { # Calculate e ** $x (Euler's number to the power of X), truncated to # an integer value. my ($self,$x,@r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bexp'); # inf, -inf, NaN, <0 => NaN return $x->bnan() if $x->{sign} eq 'NaN'; return $x->bone() if $x->is_zero(); return $x if $x->{sign} eq '+inf'; return $x->bzero() if $x->{sign} eq '-inf'; my $u; { # run through Math::BigFloat unless told otherwise require Math::BigFloat unless defined $upgrade; local $upgrade = 'Math::BigFloat' unless defined $upgrade; # calculate result, truncate it to integer $u = $upgrade->bexp($upgrade->new($x),@r); } if (!defined $upgrade) { $u = $u->as_int(); # modify $x in place $x->{value} = $u->{value}; $x->round(@r); } else { $x = $u; } } sub blcm { # (BINT or num_str, BINT or num_str) return BINT # does not modify arguments, but returns new object # Lowest Common Multiple my $y = shift; my ($x); if (ref($y)) { $x = $y->copy(); } else { $x = $class->new($y); } my $self = ref($x); while (@_) { my $y = shift; $y = $self->new($y) if !ref ($y); $x = __lcm($x,$y); } $x; } sub bgcd { # (BINT or num_str, BINT or num_str) return BINT # does not modify arguments, but returns new object # GCD -- Euclid's algorithm, variant C (Knuth Vol 3, pg 341 ff) my $y = shift; $y = $class->new($y) if !ref($y); my $self = ref($y); my $x = $y->copy()->babs(); # keep arguments return $x->bnan() if $x->{sign} !~ /^[+-]$/; # x NaN? while (@_) { $y = shift; $y = $self->new($y) if !ref($y); return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN? $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $CALC->_is_one($x->{value}); } $x; } sub bnot { # (num_str or BINT) return BINT # represent ~x as twos-complement number # we don't need $self, so undef instead of ref($_[0]) make it slightly faster my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); return $x if $x->modify('bnot'); $x->binc()->bneg(); # binc already does round } ############################################################################## # is_foo test routines # we don't need $self, so undef instead of ref($_[0]) make it slightly faster sub is_zero { # return true if arg (BINT or num_str) is zero (array '+', '0') my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't $CALC->_is_zero($x->{value}); } sub is_nan { # return true if arg (BINT or num_str) is NaN my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); $x->{sign} eq $nan ? 1 : 0; } sub is_inf { # return true if arg (BINT or num_str) is +-inf my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); if (defined $sign) { $sign = '[+-]inf' if $sign eq ''; # +- doesn't matter, only that's inf $sign = "[$1]inf" if $sign =~ /^([+-])(inf)?$/; # extract '+' or '-' return $x->{sign} =~ /^$sign$/ ? 1 : 0; } $x->{sign} =~ /^[+-]inf$/ ? 1 : 0; # only +-inf is infinity } sub is_one { # return true if arg (BINT or num_str) is +1, or -1 if sign is given my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $sign = '+' if !defined $sign || $sign ne '-'; return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either $CALC->_is_one($x->{value}); } sub is_odd { # return true when arg (BINT or num_str) is odd, false for even my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't $CALC->_is_odd($x->{value}); } sub is_even { # return true when arg (BINT or num_str) is even, false for odd my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't $CALC->_is_even($x->{value}); } sub is_positive { # return true when arg (BINT or num_str) is positive (> 0) my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 1 if $x->{sign} eq '+inf'; # +inf is positive # 0+ is neither positive nor negative ($x->{sign} eq '+' && !$x->is_zero()) ? 1 : 0; } sub is_negative { # return true when arg (BINT or num_str) is negative (< 0) my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); $x->{sign} =~ /^-/ ? 1 : 0; # -inf is negative, but NaN is not } sub is_int { # return true when arg (BINT or num_str) is an integer # always true for BigInt, but different for BigFloats my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); $x->{sign} =~ /^[+-]$/ ? 1 : 0; # inf/-inf/NaN aren't } ############################################################################### sub bmul { # multiply the first number by the second number # (BINT or num_str, BINT or num_str) return BINT # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bmul'); return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); # inf handling if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { return $x->bnan() if $x->is_zero() || $y->is_zero(); # result will always be +-inf: # +inf * +/+inf => +inf, -inf * -/-inf => +inf # +inf * -/-inf => -inf, -inf * +/+inf => -inf return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); return $x->binf('-'); } return $upgrade->bmul($x,$upgrade->new($y),@r) if defined $upgrade && !$y->isa($self); $r[3] = $y; # no push here $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0 $x->round(@r); } sub bmuladd { # multiply two numbers and then add the third to the result # (BINT or num_str, BINT or num_str, BINT or num_str) return BINT # set up parameters my ($self,$x,$y,$z,@r) = objectify(3,@_); return $x if $x->modify('bmuladd'); return $x->bnan() if ($x->{sign} eq $nan) || ($y->{sign} eq $nan) || ($z->{sign} eq $nan); # inf handling of x and y if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { return $x->bnan() if $x->is_zero() || $y->is_zero(); # result will always be +-inf: # +inf * +/+inf => +inf, -inf * -/-inf => +inf # +inf * -/-inf => -inf, -inf * +/+inf => -inf return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/); return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/); return $x->binf('-'); } # inf handling x*y and z if (($z->{sign} =~ /^[+-]inf$/)) { # something +-inf => +-inf $x->{sign} = $z->{sign}, return $x if $z->{sign} =~ /^[+-]inf$/; } return $upgrade->bmuladd($x,$upgrade->new($y),$upgrade->new($z),@r) if defined $upgrade && (!$y->isa($self) || !$z->isa($self) || !$x->isa($self)); # TODO: what if $y and $z have A or P set? $r[3] = $z; # no push here $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # no -0 my ($sx, $sz) = ( $x->{sign}, $z->{sign} ); # get signs if ($sx eq $sz) { $x->{value} = $CALC->_add($x->{value},$z->{value}); # same sign, abs add } else { my $a = $CALC->_acmp ($z->{value},$x->{value}); # absolute compare if ($a > 0) { $x->{value} = $CALC->_sub($z->{value},$x->{value},1); # abs sub w/ swap $x->{sign} = $sz; } elsif ($a == 0) { # speedup, if equal, set result to 0 $x->{value} = $CALC->_zero(); $x->{sign} = '+'; } else # a < 0 { $x->{value} = $CALC->_sub($x->{value}, $z->{value}); # abs sub } } $x->round(@r); } sub bdiv { # This does floored division, where the quotient is floored toward negative # infinity and the remainder has the same sign as the divisor. # Set up parameters. my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify() is costly, so avoid it if we can. if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bdiv'); my $wantarray = wantarray; # call only once # At least one argument is NaN. Return NaN for both quotient and the # modulo/remainder. if ($x -> is_nan() || $y -> is_nan()) { return $wantarray ? ($x -> bnan(), $self -> bnan()) : $x -> bnan(); } # Divide by zero and modulo zero. # # Division: Use the common convention that x / 0 is inf with the same sign # as x, except when x = 0, where we return NaN. This is also what earlier # versions did. # # Modulo: In modular arithmetic, the congruence relation z = x (mod y) # means that there is some integer k such that z - x = k y. If y = 0, we # get z - x = 0 or z = x. This is also what earlier versions did, except # that 0 % 0 returned NaN. # # inf / 0 = inf inf % 0 = inf # 5 / 0 = inf 5 % 0 = 5 # 0 / 0 = NaN 0 % 0 = 0 (before: NaN) # -5 / 0 = -inf -5 % 0 = -5 # -inf / 0 = -inf -inf % 0 = -inf if ($y -> is_zero()) { my ($quo, $rem); if ($wantarray) { $rem = $x -> copy(); } if ($x -> is_zero()) { $quo = $x -> bnan(); } else { $quo = $x -> binf($x -> {sign}); } return $wantarray ? ($quo, $rem) : $quo; } # Numerator (dividend) is +/-inf, and denominator is finite and non-zero. # The divide by zero cases are covered above. In all of the cases listed # below we return the same as core Perl. # # inf / -inf = NaN inf % -inf = NaN # inf / -5 = -inf inf % -5 = NaN (before: 0) # inf / 5 = inf inf % 5 = NaN (before: 0) # inf / inf = NaN inf % inf = NaN # # -inf / -inf = NaN -inf % -inf = NaN # -inf / -5 = inf -inf % -5 = NaN (before: 0) # -inf / 5 = -inf -inf % 5 = NaN (before: 0) # -inf / inf = NaN -inf % inf = NaN if ($x -> is_inf()) { my ($quo, $rem); $rem = $self -> bnan() if $wantarray; if ($y -> is_inf()) { $quo = $x -> bnan(); } else { my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-'; $quo = $x -> binf($sign); } return $wantarray ? ($quo, $rem) : $quo; } # Denominator (divisor) is +/-inf. The cases when the numerator is +/-inf # are covered above. In the modulo cases (in the right column) we return # the same as core Perl, which does floored division, so for consistency we # also do floored division in the division cases (in the left column). # # -5 / inf = -1 (before: 0) -5 % inf = inf (before: -5) # 0 / inf = 0 0 % inf = 0 # 5 / inf = 0 5 % inf = 5 # # -5 / -inf = 0 -5 % -inf = -5 # 0 / -inf = 0 0 % -inf = 0 # 5 / -inf = -1 (before: 0) 5 % -inf = -inf (before: 5) if ($y -> is_inf()) { my ($quo, $rem); if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { $rem = $x -> copy() if $wantarray; $quo = $x -> bzero(); } else { $rem = $self -> binf($y -> {sign}) if $wantarray; $quo = $x -> bone('-'); } return $wantarray ? ($quo, $rem) : $quo; } # At this point, both the numerator and denominator are finite numbers, and # the denominator (divisor) is non-zero. return $upgrade->bdiv($upgrade->new($x),$upgrade->new($y),@r) if defined $upgrade; $r[3] = $y; # no push! # Inialize remainder. my $rem = $self->bzero(); # Are both operands the same object, i.e., like $x -> bdiv($x)? # If so, flipping the sign of $y also flips the sign of $x. my $xsign = $x->{sign}; my $ysign = $y->{sign}; $y->{sign} =~ tr/+-/-+/; # Flip the sign of $y, and see ... my $same = $xsign ne $x->{sign}; # ... if that changed the sign of $x. $y->{sign} = $ysign; # Re-insert the original sign. if ($same) { $x -> bone(); } else { ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value}); if ($CALC -> _is_zero($rem->{value})) { if ($xsign eq $ysign || $CALC -> _is_zero($x->{value})) { $x->{sign} = '+'; } else { $x->{sign} = '-'; } } else { if ($xsign eq $ysign) { $x->{sign} = '+'; } else { if ($xsign eq '+') { $x -> badd(1); } else { $x -> bsub(1); } $x->{sign} = '-'; } } } $x->round(@r); if ($wantarray) { unless ($CALC -> _is_zero($rem->{value})) { if ($xsign ne $ysign) { $rem = $y -> copy() -> babs() -> bsub($rem); } $rem->{sign} = $ysign; } $rem->{_a} = $x->{_a}; $rem->{_p} = $x->{_p}; $rem->round(@r); return ($x,$rem); } return $x; } ############################################################################### # modulus functions sub bmod { # This is the remainder after floored division, where the quotient is # floored toward negative infinity and the remainder has the same sign as # the divisor. # Set up parameters. my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bmod'); $r[3] = $y; # no push! # At least one argument is NaN. if ($x -> is_nan() || $y -> is_nan()) { return $x -> bnan(); } # Modulo zero. See documentation for bdiv(). if ($y -> is_zero()) { return $x; } # Numerator (dividend) is +/-inf. if ($x -> is_inf()) { return $x -> bnan(); } # Denominator (divisor) is +/-inf. if ($y -> is_inf()) { if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) { return $x; } else { return $x -> binf($y -> sign()); } } # Calc new sign and in case $y == +/- 1, return $x. $x->{value} = $CALC->_mod($x->{value},$y->{value}); if ($CALC -> _is_zero($x->{value})) { $x->{sign} = '+'; # do not leave -0 } else { $x->{value} = $CALC->_sub($y->{value},$x->{value},1) # $y-$x if ($x->{sign} ne $y->{sign}); $x->{sign} = $y->{sign}; } $x->round(@r); } sub bmodinv { # Return modular multiplicative inverse: # # z is the modular inverse of x (mod y) if and only if # # x*z ≡ 1 (mod y) # # If the modulus y is larger than one, x and z are relative primes (i.e., # their greatest common divisor is one). # # If no modular multiplicative inverse exists, NaN is returned. # set up parameters my ($self,$x,$y,@r) = (undef,@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bmodinv'); # Return NaN if one or both arguments is +inf, -inf, or nan. return $x->bnan() if ($y->{sign} !~ /^[+-]$/ || $x->{sign} !~ /^[+-]$/); # Return NaN if $y is zero; 1 % 0 makes no sense. return $x->bnan() if $y->is_zero(); # Return 0 in the trivial case. $x % 1 or $x % -1 is zero for all finite # integers $x. return $x->bzero() if ($y->is_one() || $y->is_one('-')); # Return NaN if $x = 0, or $x modulo $y is zero. The only valid case when # $x = 0 is when $y = 1 or $y = -1, but that was covered above. # # Note that computing $x modulo $y here affects the value we'll feed to # $CALC->_modinv() below when $x and $y have opposite signs. E.g., if $x = # 5 and $y = 7, those two values are fed to _modinv(), but if $x = -5 and # $y = 7, the values fed to _modinv() are $x = 2 (= -5 % 7) and $y = 7. # The value if $x is affected only when $x and $y have opposite signs. $x->bmod($y); return $x->bnan() if $x->is_zero(); # Compute the modular multiplicative inverse of the absolute values. We'll # correct for the signs of $x and $y later. Return NaN if no GCD is found. ($x->{value}, $x->{sign}) = $CALC->_modinv($x->{value}, $y->{value}); return $x->bnan() if !defined $x->{value}; # Library inconsistency workaround: _modinv() in Math::BigInt::GMP versions # <= 1.32 return undef rather than a "+" for the sign. $x->{sign} = '+' unless defined $x->{sign}; # When one or both arguments are negative, we have the following # relations. If x and y are positive: # # modinv(-x, -y) = -modinv(x, y) # modinv(-x, y) = y - modinv(x, y) = -modinv(x, y) (mod y) # modinv( x, -y) = modinv(x, y) - y = modinv(x, y) (mod -y) # We must swap the sign of the result if the original $x is negative. # However, we must compensate for ignoring the signs when computing the # inverse modulo. The net effect is that we must swap the sign of the # result if $y is negative. $x -> bneg() if $y->{sign} eq '-'; # Compute $x modulo $y again after correcting the sign. $x -> bmod($y) if $x->{sign} ne $y->{sign}; return $x; } sub bmodpow { # Modular exponentiation. Raises a very large number to a very large exponent # in a given very large modulus quickly, thanks to binary exponentiation. # Supports negative exponents. my ($self,$num,$exp,$mod,@r) = objectify(3,@_); return $num if $num->modify('bmodpow'); # When the exponent 'e' is negative, use the following relation, which is # based on finding the multiplicative inverse 'd' of 'b' modulo 'm': # # b^(-e) (mod m) = d^e (mod m) where b*d = 1 (mod m) $num->bmodinv($mod) if ($exp->{sign} eq '-'); # Check for valid input. All operands must be finite, and the modulus must be # non-zero. return $num->bnan() if ($num->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf $exp->{sign} =~ /NaN|inf/ || # NaN, -inf, +inf $mod->{sign} =~ /NaN|inf/); # NaN, -inf, +inf # Modulo zero. See documentation for Math::BigInt's bmod() method. if ($mod -> is_zero()) { if ($num -> is_zero()) { return $self -> bnan(); } else { return $num -> copy(); } } # Compute 'a (mod m)', ignoring the signs on 'a' and 'm'. If the resulting # value is zero, the output is also zero, regardless of the signs on 'a' and # 'm'. my $value = $CALC->_modpow($num->{value}, $exp->{value}, $mod->{value}); my $sign = '+'; # If the resulting value is non-zero, we have four special cases, depending # on the signs on 'a' and 'm'. unless ($CALC->_is_zero($value)) { # There is a negative sign on 'a' (= $num**$exp) only if the number we # are exponentiating ($num) is negative and the exponent ($exp) is odd. if ($num->{sign} eq '-' && $exp->is_odd()) { # When both the number 'a' and the modulus 'm' have a negative sign, # use this relation: # # -a (mod -m) = -(a (mod m)) if ($mod->{sign} eq '-') { $sign = '-'; } # When only the number 'a' has a negative sign, use this relation: # # -a (mod m) = m - (a (mod m)) else { # Use copy of $mod since _sub() modifies the first argument. my $mod = $CALC->_copy($mod->{value}); $value = $CALC->_sub($mod, $value); $sign = '+'; } } else { # When only the modulus 'm' has a negative sign, use this relation: # # a (mod -m) = (a (mod m)) - m # = -(m - (a (mod m))) if ($mod->{sign} eq '-') { # Use copy of $mod since _sub() modifies the first argument. my $mod = $CALC->_copy($mod->{value}); $value = $CALC->_sub($mod, $value); $sign = '-'; } # When neither the number 'a' nor the modulus 'm' have a negative # sign, directly return the already computed value. # # (a (mod m)) } } $num->{value} = $value; $num->{sign} = $sign; return $num; } ############################################################################### sub bfac { # (BINT or num_str, BINT or num_str) return BINT # compute factorial number from $x, modify $x in place my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); return $x if $x->modify('bfac') || $x->{sign} eq '+inf'; # inf => inf return $x->bnan() if $x->{sign} ne '+'; # NaN, <0 etc => NaN $x->{value} = $CALC->_fac($x->{value}); $x->round(@r); } sub bpow { # (BINT or num_str, BINT or num_str) return BINT # compute power of two numbers -- stolen from Knuth Vol 2 pg 233 # modifies first argument # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bpow'); return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; # inf handling if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) { if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) { # +-inf ** +-inf return $x->bnan(); } # +-inf ** Y if ($x->{sign} =~ /^[+-]inf/) { # +inf ** 0 => NaN return $x->bnan() if $y->is_zero(); # -inf ** -1 => 1/inf => 0 return $x->bzero() if $y->is_one('-') && $x->is_negative(); # +inf ** Y => inf return $x if $x->{sign} eq '+inf'; # -inf ** Y => -inf if Y is odd return $x if $y->is_odd(); return $x->babs(); } # X ** +-inf # 1 ** +inf => 1 return $x if $x->is_one(); # 0 ** inf => 0 return $x if $x->is_zero() && $y->{sign} =~ /^[+]/; # 0 ** -inf => inf return $x->binf() if $x->is_zero(); # -1 ** -inf => NaN return $x->bnan() if $x->is_one('-') && $y->{sign} =~ /^[-]/; # -X ** -inf => 0 return $x->bzero() if $x->{sign} eq '-' && $y->{sign} =~ /^[-]/; # -1 ** inf => NaN return $x->bnan() if $x->{sign} eq '-'; # X ** inf => inf return $x->binf() if $y->{sign} =~ /^[+]/; # X ** -inf => 0 return $x->bzero(); } return $upgrade->bpow($upgrade->new($x),$y,@r) if defined $upgrade && (!$y->isa($self) || $y->{sign} eq '-'); $r[3] = $y; # no push! # cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu 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 '-' && !$CALC->_is_one($x->{value}); $x->{value} = $CALC->_pow($x->{value},$y->{value}); $x->{sign} = $new_sign; $x->{sign} = '+' if $CALC->_is_zero($y->{value}); $x->round(@r); } sub blsft { # (BINT or num_str, BINT or num_str) return BINT # compute x << y, base n, y >= 0 # set up parameters my ($self,$x,$y,$n,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,$n,@r) = objectify(2,@_); } return $x if $x->modify('blsft'); return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); return $x->round(@r) if $y->is_zero(); $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; $x->{value} = $CALC->_lsft($x->{value},$y->{value},$n); $x->round(@r); } sub brsft { # (BINT or num_str, BINT or num_str) return BINT # compute x >> y, base n, y >= 0 # set up parameters my ($self,$x,$y,$n,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,$n,@r) = objectify(2,@_); } return $x if $x->modify('brsft'); return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); return $x->round(@r) if $y->is_zero(); return $x->bzero(@r) if $x->is_zero(); # 0 => 0 $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; # this only works for negative numbers when shifting in base 2 if (($x->{sign} eq '-') && ($n == 2)) { return $x->round(@r) if $x->is_one('-'); # -1 => -1 if (!$y->is_one()) { # although this is O(N*N) in calc (as_bin!) it is O(N) in Pari et al # but perhaps there is a better emulation for two's complement shift... # if $y != 1, we must simulate it by doing: # convert to bin, flip all bits, shift, and be done $x->binc(); # -3 => -2 my $bin = $x->as_bin(); $bin =~ s/^-0b//; # strip '-0b' prefix $bin =~ tr/10/01/; # flip bits # now shift if ($y >= CORE::length($bin)) { $bin = '0'; # shifting to far right creates -1 # 0, because later increment makes # that 1, attached '-' makes it '-1' # because -1 >> x == -1 ! } else { $bin =~ s/.{$y}$//; # cut off at the right side $bin = '1' . $bin; # extend left side by one dummy '1' $bin =~ tr/10/01/; # flip bits back } my $res = $self->new('0b'.$bin); # add prefix and convert back $res->binc(); # remember to increment $x->{value} = $res->{value}; # take over value return $x->round(@r); # we are done now, magic, isn't? } # x < 0, n == 2, y == 1 $x->bdec(); # n == 2, but $y == 1: this fixes it } $x->{value} = $CALC->_rsft($x->{value},$y->{value},$n); $x->round(@r); } sub band { #(BINT or num_str, BINT or num_str) return BINT # compute x & y # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('band'); $r[3] = $y; # no push! return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); my $sx = $x->{sign} eq '+' ? 1 : -1; my $sy = $y->{sign} eq '+' ? 1 : -1; if ($sx == 1 && $sy == 1) { $x->{value} = $CALC->_and($x->{value},$y->{value}); return $x->round(@r); } if ($CAN{signed_and}) { $x->{value} = $CALC->_signed_and($x->{value},$y->{value},$sx,$sy); return $x->round(@r); } require $EMU_LIB; __emu_band($self,$x,$y,$sx,$sy,@r); } sub bior { #(BINT or num_str, BINT or num_str) return BINT # compute x | y # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bior'); $r[3] = $y; # no push! return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); my $sx = $x->{sign} eq '+' ? 1 : -1; my $sy = $y->{sign} eq '+' ? 1 : -1; # 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 ($sx == 1 && $sy == 1) { $x->{value} = $CALC->_or($x->{value},$y->{value}); return $x->round(@r); } # if lib can do negative values, let it handle this if ($CAN{signed_or}) { $x->{value} = $CALC->_signed_or($x->{value},$y->{value},$sx,$sy); return $x->round(@r); } require $EMU_LIB; __emu_bior($self,$x,$y,$sx,$sy,@r); } sub bxor { #(BINT or num_str, BINT or num_str) return BINT # compute x ^ y # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$x,$y,@r) = objectify(2,@_); } return $x if $x->modify('bxor'); $r[3] = $y; # no push! return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); my $sx = $x->{sign} eq '+' ? 1 : -1; my $sy = $y->{sign} eq '+' ? 1 : -1; # don't use lib for negative values if ($sx == 1 && $sy == 1) { $x->{value} = $CALC->_xor($x->{value},$y->{value}); return $x->round(@r); } # if lib can do negative values, let it handle this if ($CAN{signed_xor}) { $x->{value} = $CALC->_signed_xor($x->{value},$y->{value},$sx,$sy); return $x->round(@r); } require $EMU_LIB; __emu_bxor($self,$x,$y,$sx,$sy,@r); } sub length { my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); my $e = $CALC->_len($x->{value}); wantarray ? ($e,0) : $e; } sub digit { # return the nth decimal digit, negative values count backward, 0 is right my ($self,$x,$n) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $n = $n->numify() if ref($n); $CALC->_digit($x->{value},$n||0); } sub _trailing_zeros { # return the amount of trailing zeros in $x (as scalar) my $x = shift; $x = $class->new($x) unless ref $x; return 0 if $x->{sign} !~ /^[+-]$/; # NaN, inf, -inf etc $CALC->_zeros($x->{value}); # must handle odd values, 0 etc } sub bsqrt { # calculate square root of $x my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); return $x if $x->modify('bsqrt'); return $x->bnan() if $x->{sign} !~ /^\+/; # -x or -inf or NaN => NaN return $x if $x->{sign} eq '+inf'; # sqrt(+inf) == inf return $upgrade->bsqrt($x,@r) if defined $upgrade; $x->{value} = $CALC->_sqrt($x->{value}); $x->round(@r); } sub broot { # calculate $y'th root of $x # set up parameters my ($self,$x,$y,@r) = (ref($_[0]),@_); $y = $self->new(2) unless defined $y; # objectify is costly, so avoid it if ((!ref($x)) || (ref($x) ne ref($y))) { ($self,$x,$y,@r) = objectify(2,$self || $class,@_); } return $x if $x->modify('broot'); # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0 return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() || $y->{sign} !~ /^\+$/; return $x->round(@r) if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one(); return $upgrade->new($x)->broot($upgrade->new($y),@r) if defined $upgrade; $x->{value} = $CALC->_root($x->{value},$y->{value}); $x->round(@r); } sub exponent { # return a copy of the exponent (here always 0, NaN or 1 for $m == 0) my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { my $s = $x->{sign}; $s =~ s/^[+-]//; # NaN, -inf,+inf => NaN or inf return $self->new($s); } return $self->bzero() if $x->is_zero(); # 12300 => 2 trailing zeros => exponent is 2 $self->new( $CALC->_zeros($x->{value}) ); } sub mantissa { # return the mantissa (compatible to Math::BigFloat, e.g. reduced) my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { # for NaN, +inf, -inf: keep the sign return $self->new($x->{sign}); } my $m = $x->copy(); delete $m->{_p}; delete $m->{_a}; # that's a bit inefficient: my $zeros = $CALC->_zeros($m->{value}); $m->brsft($zeros,10) if $zeros != 0; $m; } sub parts { # return a copy of both the exponent and the mantissa my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); ($x->mantissa(),$x->exponent()); } ############################################################################## # rounding functions sub bfround { # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' # $n == 0 || $n == 1 => round to integer my $x = shift; my $self = ref($x) || $x; $x = $self->new($x) unless ref $x; my ($scale,$mode) = $x->_scale_p(@_); return $x if !defined $scale || $x->modify('bfround'); # no-op # no-op for BigInts if $n <= 0 $x->bround( $x->length()-$scale, $mode) if $scale > 0; delete $x->{_a}; # delete to save memory $x->{_p} = $scale; # store new _p $x; } sub _scan_for_nonzero { # internal, used by bround() to scan for non-zeros after a '5' my ($x,$pad,$xs,$len) = @_; return 0 if $len == 1; # "5" is trailed by invisible zeros my $follow = $pad - 1; return 0 if $follow > $len || $follow < 1; # use the string form to check whether only '0's follow or not substr ($xs,-$follow) =~ /[^0]/ ? 1 : 0; } sub fround { # Exists to make life easier for switch between MBF and MBI (should we # autoload fxxx() like MBF does for bxxx()?) my $x = shift; $x = $class->new($x) unless ref $x; $x->bround(@_); } sub bround { # accuracy: +$n preserve $n digits from left, # -$n preserve $n digits from right (f.i. for 0.1234 style in MBF) # no-op for $n == 0 # and overwrite the rest with 0's, return normalized number # do not return $x->bnorm(), but $x my $x = shift; $x = $class->new($x) unless ref $x; my ($scale,$mode) = $x->_scale_a(@_); return $x if !defined $scale || $x->modify('bround'); # no-op if ($x->is_zero() || $scale == 0) { $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2 return $x; } return $x if $x->{sign} !~ /^[+-]$/; # inf, NaN # we have fewer digits than we want to scale to my $len = $x->length(); # convert $scale to a scalar in case it is an object (put's a limit on the # number length, but this would already limited by memory constraints), makes # it faster $scale = $scale->numify() if ref ($scale); # scale < 0, but > -len (not >=!) if (($scale < 0 && $scale < -$len-1) || ($scale >= $len)) { $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale; # 3 > 2 return $x; } # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6 my ($pad,$digit_round,$digit_after); $pad = $len - $scale; $pad = abs($scale-1) if $scale < 0; # do not use digit(), it is very costly for binary => decimal # getting the entire string is also costly, but we need to do it only once my $xs = $CALC->_str($x->{value}); my $pl = -$pad-1; # 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; $pl++; $pl ++ if $pad >= $len; $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 my $round_up = 1; # default round up $round_up -- if ($mode eq 'trunc') || # trunc by round down ($digit_after =~ /[01234]/) || # round down anyway, # 6789 => round up ($digit_after eq '5') && # not 5000...0000 ($x->_scan_for_nonzero($pad,$xs,$len) == 0) && ( ($mode eq 'even') && ($digit_round =~ /[24680]/) || ($mode eq 'odd') && ($digit_round =~ /[13579]/) || ($mode eq '+inf') && ($x->{sign} eq '-') || ($mode eq '-inf') && ($x->{sign} eq '+') || ($mode eq 'zero') # round down if zero, sign adjusted below ); my $put_back = 0; # not yet modified if (($pad > 0) && ($pad <= $len)) { substr($xs,-$pad,$pad) = '0' x $pad; # replace with '00...' $put_back = 1; # need to put back } elsif ($pad > $len) { $x->bzero(); # round to '0' } if ($round_up) # what gave test above? { $put_back = 1; # need to put back $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++; last if $c != 0; # no overflow => early out } $xs = '1'.$xs if $c == 0; } $x->{value} = $CALC->_new($xs) if $put_back == 1; # put back, if needed $x->{_a} = $scale if $scale >= 0; if ($scale < 0) { $x->{_a} = $len+$scale; $x->{_a} = 0 if $scale < -$len; } $x; } sub bfloor { # round towards minus infinity; no-op since it's already integer my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $x->round(@r); } sub bceil { # round towards plus infinity; no-op since it's already int my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $x->round(@r); } sub bint { # round towards zero; no-op since it's already integer my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); $x->round(@r); } sub as_number { # An object might be asked to return itself as bigint on certain overloaded # operations. This does exactly this, so that sub classes can simple inherit # it or override with their own integer conversion routine. $_[0]->copy(); } sub as_hex { # return as hex string, with prefixed 0x my $x = shift; $x = $class->new($x) if !ref($x); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc my $s = ''; $s = $x->{sign} if $x->{sign} eq '-'; $s . $CALC->_as_hex($x->{value}); } sub as_bin { # return as binary string, with prefixed 0b my $x = shift; $x = $class->new($x) if !ref($x); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc my $s = ''; $s = $x->{sign} if $x->{sign} eq '-'; return $s . $CALC->_as_bin($x->{value}); } sub as_oct { # return as octal string, with prefixed 0 my $x = shift; $x = $class->new($x) if !ref($x); return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc my $oct = $CALC->_as_oct($x->{value}); return $x->{sign} eq '-' ? "-$oct" : $oct; } ############################################################################## # private stuff (internal use only) sub objectify { # Convert strings and "foreign objects" to the objects we want. # The first argument, $count, is the number of following arguments that # objectify() looks at and converts to objects. The first is a classname. # If the given count is 0, all arguments will be used. # After the count is read, objectify obtains the name of the class to which # the following arguments are converted. If the second argument is a # reference, use the reference type as the class name. Otherwise, if it is # a string that looks like a class name, use that. Otherwise, use $class. # Caller: Gives us: # # $x->badd(1); => ref x, scalar y # Class->badd(1,2); => classname x (scalar), scalar x, scalar y # Class->badd(Class->(1),2); => classname x (scalar), ref x, scalar y # Math::BigInt::badd(1,2); => scalar x, scalar y # A shortcut for the common case $x->unary_op(): return (ref($_[1]), $_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]); # Check the context. unless (wantarray) { require Carp; Carp::croak ("${class}::objectify() needs list context"); } # Get the number of arguments to objectify. my $count = shift; $count ||= @_; # Initialize the output array. my @a = @_; # If the first argument is a reference, use that reference type as our # class name. Otherwise, if the first argument looks like a class name, # then use that as our class name. Otherwise, use the default class name. { if (ref($a[0])) { # reference? unshift @a, ref($a[0]); last; } if ($a[0] =~ /^[A-Z].*::/) { # string with class name? last; } unshift @a, $class; # default class name } no strict 'refs'; # What we upgrade to, if anything. my $up = ${"$a[0]::upgrade"}; # Disable downgrading, because Math::BigFloat -> foo('1.0','2.0') needs # floats. my $down; if (defined ${"$a[0]::downgrade"}) { $down = ${"$a[0]::downgrade"}; ${"$a[0]::downgrade"} = undef; } for my $i (1 .. $count) { my $ref = ref $a[$i]; # Perl scalars are fed to the appropriate constructor. unless ($ref) { $a[$i] = $a[0] -> new($a[$i]); next; } # If it is an object of the right class, all is fine. next if $ref -> isa($a[0]); # Upgrading is OK, so skip further tests if the argument is upgraded. if (defined $up && $ref -> isa($up)) { next; } # See if we can call one of the as_xxx() methods. We don't know whether # the as_xxx() method returns an object or a scalar, so re-check # afterwards. my $recheck = 0; if ($a[0] -> isa('Math::BigInt')) { if ($a[$i] -> can('as_int')) { $a[$i] = $a[$i] -> as_int(); $recheck = 1; } elsif ($a[$i] -> can('as_number')) { $a[$i] = $a[$i] -> as_number(); $recheck = 1; } } elsif ($a[0] -> isa('Math::BigFloat')) { if ($a[$i] -> can('as_float')) { $a[$i] = $a[$i] -> as_float(); $recheck = $1; } } # If we called one of the as_xxx() methods, recheck. if ($recheck) { $ref = ref($a[$i]); # Perl scalars are fed to the appropriate constructor. unless ($ref) { $a[$i] = $a[0] -> new($a[$i]); next; } # If it is an object of the right class, all is fine. next if $ref -> isa($a[0]); } # Last resort. $a[$i] = $a[0] -> new($a[$i]); } # Reset the downgrading. ${"$a[0]::downgrade"} = $down; return @a; } sub _register_callback { my ($class,$callback) = @_; if (ref($callback) ne 'CODE') { require Carp; Carp::croak ("$callback is not a coderef"); } $CALLBACKS{$class} = $callback; } sub import { my $self = shift; $IMPORT++; # remember we did import() my @a; my $l = scalar @_; my $warn_or_die = 0; # 0 - no warn, 1 - warn, 2 - die for ( my $i = 0; $i < $l ; $i++ ) { if ($_[$i] eq ':constant') { # this causes overlord er load to step in overload::constant integer => sub { $self->new(shift) }, binary => sub { $self->new(shift) }; } elsif ($_[$i] eq 'upgrade') { # this causes upgrading $upgrade = $_[$i+1]; # or undef to disable $i++; } elsif ($_[$i] =~ /^(lib|try|only)\z/) { # this causes a different low lib to take care... $CALC = $_[$i+1] || ''; # lib => 1 (warn on fallback), try => 0 (no warn), only => 2 (die on fallback) $warn_or_die = 1 if $_[$i] eq 'lib'; $warn_or_die = 2 if $_[$i] eq 'only'; $i++; } else { push @a, $_[$i]; } } # any non :constant stuff is handled by our parent, Exporter if (@a > 0) { require Exporter; $self->SUPER::import(@a); # need it for subclasses $self->export_to_level(1,$self,@a); # need it for MBF } # try to load core math lib my @c = split /\s*,\s*/,$CALC; foreach (@c) { $_ =~ tr/a-zA-Z0-9://cd; # limit to sane characters } push @c, \'Calc' # if all fail, try these if $warn_or_die < 2; # but not for "only" $CALC = ''; # signal error foreach my $l (@c) { # fallback libraries are "marked" as \'string', extract string if nec. my $lib = $l; $lib = $$l if ref($l); next if ($lib || '') eq ''; $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i; $lib =~ s/\.pm$//; if ($] < 5.006) { # 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 /::/, $lib; # 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"; $lib->import( @c ); } } else { eval "use $lib qw/@c/;"; } 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 zeros new copy check from_hex from_oct from_bin as_hex as_bin as_oct 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; if ($warn_or_die > 0 && ref($l)) { require Carp; my $msg = "Math::BigInt: couldn't load specified math lib(s), fallback to $lib"; Carp::carp ($msg) if $warn_or_die == 1; Carp::croak ($msg) if $warn_or_die == 2; } last; # found a usable one, break } else { if (($WARN{$lib}||0) < 2) { my $ver = eval "\$$lib\::VERSION" || 'unknown'; require Carp; Carp::carp ("Cannot load outdated $lib v$ver, please upgrade"); $WARN{$lib} = 2; # never warn again } } } } if ($CALC eq '') { require Carp; if ($warn_or_die == 2) { Carp::croak( "Couldn't load specified math lib(s) and fallback disallowed"); } else { Carp::croak( "Couldn't load any math lib(s), not even fallback to Calc.pm"); } } # notify callbacks foreach my $class (keys %CALLBACKS) { &{$CALLBACKS{$class}}($CALC); } # Fill $CAN with the results of $CALC->can(...) for emulating lower math lib # functions %CAN = (); for my $method (qw/ signed_and signed_or signed_xor /) { $CAN{$method} = $CALC->can("_$method") ? 1 : 0; } # import done } # Create a Math::BigInt from a hexadecimal string. sub from_hex { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; my $str = shift; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; if ($str =~ s/ ^ ( [+-]? ) (0?x)? ( [0-9a-fA-F]* ( _ [0-9a-fA-F]+ )* ) $ //x) { # Get a "clean" version of the string, i.e., non-emtpy and with no # underscores or invalid characters. my $sign = $1; my $chrs = $3; $chrs =~ tr/_//d; $chrs = '0' unless CORE::length $chrs; # The library method requires a prefix. $self->{value} = $CALC->_from_hex('0x' . $chrs); # Place the sign. if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) { $self->{sign} = '-'; } return $self; } # CORE::hex() parses as much as it can, and ignores any trailing garbage. # For backwards compatibility, we return NaN. return $self->bnan(); } # Create a Math::BigInt from an octal string. sub from_oct { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; my $str = shift; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; if ($str =~ s/ ^ ( [+-]? ) ( [0-7]* ( _ [0-7]+ )* ) $ //x) { # Get a "clean" version of the string, i.e., non-emtpy and with no # underscores or invalid characters. my $sign = $1; my $chrs = $2; $chrs =~ tr/_//d; $chrs = '0' unless CORE::length $chrs; # The library method requires a prefix. $self->{value} = $CALC->_from_oct('0' . $chrs); # Place the sign. if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) { $self->{sign} = '-'; } return $self; } # CORE::oct() parses as much as it can, and ignores any trailing garbage. # For backwards compatibility, we return NaN. return $self->bnan(); } # Create a Math::BigInt from a binary string. sub from_bin { my $self = shift; my $selfref = ref $self; my $class = $selfref || $self; my $str = shift; # If called as a class method, initialize a new object. $self = $class -> bzero() unless $selfref; if ($str =~ s/ ^ ( [+-]? ) (0?b)? ( [01]* ( _ [01]+ )* ) $ //x) { # Get a "clean" version of the string, i.e., non-emtpy and with no # underscores or invalid characters. my $sign = $1; my $chrs = $3; $chrs =~ tr/_//d; $chrs = '0' unless CORE::length $chrs; # The library method requires a prefix. $self->{value} = $CALC->_from_bin('0b' . $chrs); # Place the sign. if ($sign eq '-' && ! $CALC->_is_zero($self->{value})) { $self->{sign} = '-'; } return $self; } # For consistency with from_hex() and from_oct(), we return NaN when the # input is invalid. return $self->bnan(); } sub _split_dec_string { my $str = shift; if ($str =~ s/ ^ # leading whitespace ( \s* ) # optional sign ( [+-]? ) # significand ( \d+ (?: _ \d+ )* (?: \. (?: \d+ (?: _ \d+ )* )? )? | \. \d+ (?: _ \d+ )* ) # optional exponent (?: [Ee] ( [+-]? ) ( \d+ (?: _ \d+ )* ) )? # trailing stuff ( \D .*? )? \z //x) { my $leading = $1; my $significand_sgn = $2 || '+'; my $significand_abs = $3; my $exponent_sgn = $4 || '+'; my $exponent_abs = $5 || '0'; my $trailing = $6; # Remove underscores and leading zeros. $significand_abs =~ tr/_//d; $exponent_abs =~ tr/_//d; $significand_abs =~ s/^0+(.)/$1/; $exponent_abs =~ s/^0+(.)/$1/; # If the significand contains a dot, remove it and adjust the exponent # accordingly. E.g., "1234.56789e+3" -> "123456789e-2" my $idx = index $significand_abs, '.'; if ($idx > -1) { $significand_abs =~ s/0+\z//; substr($significand_abs, $idx, 1) = ''; my $exponent = $exponent_sgn . $exponent_abs; $exponent .= $idx - CORE::length($significand_abs); $exponent_abs = abs $exponent; $exponent_sgn = $exponent < 0 ? '-' : '+'; } return($leading, $significand_sgn, $significand_abs, $exponent_sgn, $exponent_abs, $trailing); } return undef; } sub _split { # input: num_str; output: undef for invalid or # (\$mantissa_sign,\$mantissa_value,\$mantissa_fraction, # \$exp_sign,\$exp_value) # Internal, take apart a string and return the pieces. # Strip leading/trailing whitespace, leading zeros, underscore and reject # invalid input. my $x = shift; # strip white space at front, also extraneous 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 # shortcut, if nothing to split, return early if ($x =~ /^[+-]?[0-9]+\z/) { $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 Math::BigInt->from_hex($x) if $x =~ /^[+-]?0x/; # hex string return Math::BigInt->from_bin($x) if $x =~ /^[+-]?0b/; # binary string # strip underscores between digits $x =~ s/([0-9])_([0-9])/$1$2/g; $x =~ s/([0-9])_([0-9])/$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 my ($m,$e,$last) = split /[Ee]/,$x; return if defined $last; # last defined => 1e2E3 or others $e = '0' if !defined $e || $e eq ""; # sign,value for exponent,mantint,mantfrac my ($es,$ev,$mis,$miv,$mfv); # valid exponent? if ($e =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros { $es = $1; $ev = $2; # valid mantissa? return if $m eq '.' || $m eq ''; my ($mi,$mf,$lastf) = split /\./,$m; return if defined $lastf; # lastf defined => 1.2.3 or others $mi = '0' if !defined $mi; $mi .= '0' if $mi =~ /^[\-\+]?$/; $mf = '0' if !defined $mf || $mf eq ''; if ($mi =~ /^([+-]?)0*([0-9]+)$/) # strip leading zeros { $mis = $1||'+'; $miv = $2; return unless ($mf =~ /^([0-9]*?)0*$/); # strip trailing zeros $mfv = $1; # handle the 0e999 case here $ev = 0 if $miv eq '0' && $mfv eq ''; return (\$mis,\$miv,\$mfv,\$es,\$ev); } } return; # NaN, not a number } ############################################################################## # internal calculation routines (others are in Math::BigInt::Calc etc) sub __lcm { # (BINT or num_str, BINT or num_str) return BINT # does modify first argument # LCM my ($x,$ty) = @_; return $x->bnan() if ($x->{sign} eq $nan) || ($ty->{sign} eq $nan); my $method = ref($x) . '::bgcd'; no strict 'refs'; $x * $ty / &$method($x,$ty); } ############################################################################### # trigonometric functions sub bpi { # Calculate PI to N digits. Unless upgrading is in effect, returns the # result truncated to an integer, that is, always returns '3'. my ($self,$n) = @_; if (@_ == 1) { # called like Math::BigInt::bpi(10); $n = $self; $self = $class; } $self = ref($self) if ref($self); return $upgrade->new($n) if defined $upgrade; # hard-wired to "3" $self->new(3); } sub bcos { # Calculate cosinus(x) to N digits. Unless upgrading is in effect, returns the # result truncated to an integer. my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); return $x if $x->modify('bcos'); return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN return $upgrade->new($x)->bcos(@r) if defined $upgrade; require Math::BigFloat; # calculate the result and truncate it to integer my $t = Math::BigFloat->new($x)->bcos(@r)->as_int(); $x->bone() if $t->is_one(); $x->bzero() if $t->is_zero(); $x->round(@r); } sub bsin { # Calculate sinus(x) to N digits. Unless upgrading is in effect, returns the # result truncated to an integer. my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); return $x if $x->modify('bsin'); return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN return $upgrade->new($x)->bsin(@r) if defined $upgrade; require Math::BigFloat; # calculate the result and truncate it to integer my $t = Math::BigFloat->new($x)->bsin(@r)->as_int(); $x->bone() if $t->is_one(); $x->bzero() if $t->is_zero(); $x->round(@r); } sub batan2 { # calculate arcus tangens of ($y/$x) # set up parameters my ($self,$y,$x,@r) = (ref($_[0]),@_); # objectify is costly, so avoid it if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) { ($self,$y,$x,@r) = objectify(2,@_); } return $y if $y->modify('batan2'); return $y->bnan() if ($y->{sign} eq $nan) || ($x->{sign} eq $nan); # Y X # != 0 -inf result is +- pi if ($x->is_inf() || $y->is_inf()) { # upgrade to BigFloat etc. return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade; if ($y->is_inf()) { if ($x->{sign} eq '-inf') { # calculate 3 pi/4 => 2.3.. => 2 $y->bone( substr($y->{sign},0,1) ); $y->bmul($self->new(2)); } elsif ($x->{sign} eq '+inf') { # calculate pi/4 => 0.7 => 0 $y->bzero(); } else { # calculate pi/2 => 1.5 => 1 $y->bone( substr($y->{sign},0,1) ); } } else { if ($x->{sign} eq '+inf') { # calculate pi/4 => 0.7 => 0 $y->bzero(); } else { # PI => 3.1415.. => 3 $y->bone( substr($y->{sign},0,1) ); $y->bmul($self->new(3)); } } return $y; } return $upgrade->new($y)->batan2($upgrade->new($x),@r) if defined $upgrade; require Math::BigFloat; my $r = Math::BigFloat->new($y) ->batan2(Math::BigFloat->new($x),@r) ->as_int(); $x->{value} = $r->{value}; $x->{sign} = $r->{sign}; $x; } sub batan { # Calculate arcus tangens of x to N digits. Unless upgrading is in effect, returns the # result truncated to an integer. my ($self,$x,@r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); return $x if $x->modify('batan'); return $x->bnan() if $x->{sign} !~ /^[+-]\z/; # -inf +inf or NaN => NaN return $upgrade->new($x)->batan(@r) if defined $upgrade; # calculate the result and truncate it to integer my $t = Math::BigFloat->new($x)->batan(@r); $x->{value} = $CALC->_new( $x->as_int()->bstr() ); $x->round(@r); } ############################################################################### # this method returns 0 if the object can be modified, or 1 if not. # We use a fast constant sub() here, to avoid costly calls. Subclasses # may override it with special code (f.i. Math::BigInt::Constant does so) sub modify () { 0; } 1; __END__ =pod =head1 NAME Math::BigInt - Arbitrary size integer/float math package =head1 SYNOPSIS use Math::BigInt; # or make it faster with huge numbers: install (optional) # Math::BigInt::GMP and always use (it will fall back to # pure Perl if the GMP library is not installed): # (See also the L section!) # will warn if Math::BigInt::GMP cannot be found use Math::BigInt lib => 'GMP'; # to suppress the warning use this: # use Math::BigInt try => 'GMP'; # dies if GMP cannot be loaded: # use Math::BigInt only => 'GMP'; my $str = '1234567890'; my @values = (64,74,18); my $n = 1; my $sign = '-'; # Number creation my $x = Math::BigInt->new($str); # defaults to 0 my $y = $x->copy(); # make a true copy my $nan = Math::BigInt->bnan(); # create a NotANumber my $zero = Math::BigInt->bzero(); # create a +0 my $inf = Math::BigInt->binf(); # create a +inf my $inf = Math::BigInt->binf('-'); # create a -inf my $one = Math::BigInt->bone(); # create a +1 my $mone = Math::BigInt->bone('-'); # create a -1 my $pi = Math::BigInt->bpi(); # returns '3' # see Math::BigFloat::bpi() $h = Math::BigInt->new('0x123'); # from hexadecimal $b = Math::BigInt->new('0b101'); # from binary $o = Math::BigInt->from_oct('0101'); # from octal $h = Math::BigInt->from_hex('cafe'); # from hexadecimal $b = Math::BigInt->from_bin('0101'); # from binary # Testing (don't modify their arguments) # (return true if the condition is met, otherwise false) $x->is_zero(); # if $x is +0 $x->is_nan(); # if $x is NaN $x->is_one(); # if $x is +1 $x->is_one('-'); # if $x is -1 $x->is_odd(); # if $x is odd $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_int(); # if $x is an integer (not a float) # comparing and digit/sign extraction $x->bcmp($y); # compare numbers (undef,<0,=0,>0) $x->bacmp($y); # compare absolutely (undef,<0,=0,>0) $x->sign(); # return the sign, either +,- or NaN $x->digit($n); # return the nth digit, counting from right $x->digit(-$n); # return the nth digit, counting from left # The following all modify their first argument. If you want to pre- # serve $x, use $z = $x->copy()->bXXX($y); See under L for # why this is necessary when mixing $a = $b assignments with non-over- # loaded math. $x->bzero(); # set $x to 0 $x->bnan(); # set $x to NaN $x->bone(); # set $x to +1 $x->bone('-'); # set $x to -1 $x->binf(); # set $x to inf $x->binf('-'); # set $x to -inf $x->bneg(); # negation $x->babs(); # absolute value $x->bsgn(); # sign function (-1, 0, 1, or NaN) $x->bnorm(); # normalize (no-op in BigInt) $x->bnot(); # two's complement (bit wise not) $x->binc(); # increment $x by 1 $x->bdec(); # decrement $x by 1 $x->badd($y); # addition (add $y to $x) $x->bsub($y); # subtraction (subtract $y from $x) $x->bmul($y); # multiplication (multiply $x by $y) $x->bdiv($y); # divide, set $x to quotient # return (quo,rem) or quo if scalar $x->bmuladd($y,$z); # $x = $x * $y + $z $x->bmod($y); # modulus (x % y) $x->bmodpow($y,$mod); # modular exponentiation (($x ** $y) % $mod) $x->bmodinv($mod); # modular multiplicative inverse $x->bpow($y); # power of arguments (x ** y) $x->blsft($y); # left shift in base 2 $x->brsft($y); # right shift in base 2 # returns (quo,rem) or quo if in sca- # lar context $x->blsft($y,$n); # left shift by $y places in base $n $x->brsft($y,$n); # right shift by $y places in base $n # returns (quo,rem) or quo if in sca- # lar context $x->band($y); # bitwise and $x->bior($y); # bitwise inclusive or $x->bxor($y); # bitwise exclusive or $x->bnot(); # bitwise not (two's complement) $x->bsqrt(); # calculate square-root $x->broot($y); # $y'th root of $x (e.g. $y == 3 => cubic root) $x->bfac(); # factorial of $x (1*2*3*4*..$x) $x->bnok($y); # x over y (binomial coefficient n over k) $x->blog(); # logarithm of $x to base e (Euler's number) $x->blog($base); # logarithm of $x to base $base (f.i. 2) $x->bexp(); # calculate e ** $x where e is Euler's number $x->round($A,$P,$mode); # round to accuracy or precision using # mode $mode $x->bround($n); # accuracy: preserve $n digits $x->bfround($n); # $n > 0: round $nth digits, # $n < 0: round to the $nth digit after the # dot, no-op for BigInts # The following do not modify their arguments in BigInt (are no-ops), # but do so in BigFloat: $x->bfloor(); # round towards minus infinity $x->bceil(); # round towards plus infinity $x->bint(); # round towards zero # The following do not modify their arguments: # greatest common divisor (no OO style) my $gcd = Math::BigInt::bgcd(@values); # lowest common multiple (no OO style) my $lcm = Math::BigInt::blcm(@values); $x->length(); # return number of digits in number ($xl,$f) = $x->length(); # length of number and length of fraction # part, latter is always 0 digits long # for BigInts $x->exponent(); # return exponent as BigInt $x->mantissa(); # return (signed) mantissa as BigInt $x->parts(); # return (mantissa,exponent) as BigInt $x->copy(); # make a true copy of $x (unlike $y = $x;) $x->as_int(); # return as BigInt (in BigInt: same as copy()) $x->numify(); # return as scalar (might overflow!) # conversion to string (do not modify their argument) $x->bstr(); # normalized string (e.g. '3') $x->bsstr(); # norm. string in scientific notation (e.g. '3E0') $x->as_hex(); # as signed hexadecimal string with prefixed 0x $x->as_bin(); # as signed binary string with prefixed 0b $x->as_oct(); # as signed octal string with prefixed 0 # precision and accuracy (see section about rounding for more) $x->precision(); # return P of $x (or global, if P of $x undef) $x->precision($n); # set P of $x to $n $x->accuracy(); # return A of $x (or global, if A of $x undef) $x->accuracy($n); # set A $x to $n # Global methods Math::BigInt->precision(); # get/set global P for all BigInt objects Math::BigInt->accuracy(); # get/set global A for all BigInt objects Math::BigInt->round_mode(); # get/set global round mode, one of # 'even', 'odd', '+inf', '-inf', 'zero', # 'trunc' or 'common' Math::BigInt->config(); # return hash containing configuration =head1 DESCRIPTION All operators (including basic math operations) are overloaded if you declare your big integers as $i = Math::BigInt -> new('123_456_789_123_456_789'); Operations with overloaded operators preserve the arguments which is exactly what you expect. =head2 Input Input values to these routines may be any string, that looks like a number and results in an integer, including hexadecimal and binary numbers. Scalars holding numbers may also be passed, but note that non-integer numbers may already have lost precision due to the conversion to float. Quote your input if you want BigInt to see all the digits: $x = Math::BigInt->new(12345678890123456789); # bad $x = Math::BigInt->new('12345678901234567890'); # good You can include one underscore between any two digits. This means integer values like 1.01E2 or even 1000E-2 are also accepted. Non-integer values result in NaN. Hexadecimal (prefixed with "0x") and binary numbers (prefixed with "0b") are accepted, too. Please note that octal numbers are not recognized by new(), so the following will print "123": perl -MMath::BigInt -le 'print Math::BigInt->new("0123")' To convert an octal number, use from_oct(); perl -MMath::BigInt -le 'print Math::BigInt->from_oct("0123")' Currently, Math::BigInt::new() defaults to 0, while Math::BigInt::new('') results in 'NaN'. This might change in the future, so use always the following explicit forms to get a zero or NaN: $zero = Math::BigInt->bzero(); $nan = Math::BigInt->bnan(); C on a BigInt object is now effectively a no-op, since the numbers are always stored in normalized form. If passed a string, creates a BigInt object from the input. =head2 Output Output values are BigInt objects (normalized), except for the methods which return a string (see L). Some routines (C, C, C, C, C, etc.) return true or false, while others (C, C) return either undef (if NaN is involved), <0, 0 or >0 and are suited for sort. =head1 METHODS Each of the methods below (except config(), accuracy() and precision()) accepts three additional parameters. These arguments C<$A>, C<$P> and C<$R> are C, C and C. Please see the section about L for more information. =over =item config() use Data::Dumper; print Dumper ( Math::BigInt->config() ); print Math::BigInt->config()->{lib},"\n"; Returns a hash containing the configuration, e.g. the version number, lib loaded etc. The following hash keys are currently filled in with the appropriate information. key Description Example ============================================================ lib Name of the low-level math library Math::BigInt::Calc lib_version Version of low-level math library (see 'lib') 0.30 class The class name of config() you just called Math::BigInt upgrade To which class math operations might be upgraded Math::BigFloat downgrade To which class math operations might be downgraded undef precision Global precision undef accuracy Global accuracy undef round_mode Global round mode even version version number of the class you used 1.61 div_scale Fallback accuracy for div 40 trap_nan If true, traps creation of NaN via croak() 1 trap_inf If true, traps creation of +inf/-inf via croak() 1 The following values can be set by passing C a reference to a hash: trap_inf trap_nan upgrade downgrade precision accuracy round_mode div_scale Example: $new_cfg = Math::BigInt->config( { trap_inf => 1, precision => 5 } ); =item accuracy() $x->accuracy(5); # local for $x CLASS->accuracy(5); # global for all members of CLASS # Note: This also applies to new()! $A = $x->accuracy(); # read out accuracy that affects $x $A = CLASS->accuracy(); # read out global accuracy Set or get the global or local accuracy, aka how many significant digits the results have. If you set a global accuracy, then this also applies to new()! Warning! The accuracy I, e.g. once you created a number under the influence of C<< CLASS->accuracy($A) >>, all results from math operations with that number will also be rounded. In most cases, you should probably round the results explicitly using one of L, L or L or by passing the desired accuracy to the math operation as additional parameter: my $x = Math::BigInt->new(30000); my $y = Math::BigInt->new(7); print scalar $x->copy()->bdiv($y, 2); # print 4300 print scalar $x->copy()->bdiv($y)->bround(2); # print 4300 Please see the section about L for further details. Value must be greater than zero. Pass an undef value to disable it: $x->accuracy(undef); Math::BigInt->accuracy(undef); Returns the current accuracy. For C<< $x->accuracy() >> it will return either the local accuracy, or if not defined, the global. This means the return value represents the accuracy that will be in effect for $x: $y = Math::BigInt->new(1234567); # unrounded print Math::BigInt->accuracy(4),"\n"; # set 4, print 4 $x = Math::BigInt->new(123456); # $x will be automatic- # ally rounded! print "$x $y\n"; # '123500 1234567' print $x->accuracy(),"\n"; # will be 4 print $y->accuracy(),"\n"; # also 4, since # global is 4 print Math::BigInt->accuracy(5),"\n"; # set to 5, print 5 print $x->accuracy(),"\n"; # still 4 print $y->accuracy(),"\n"; # 5, since global is 5 Note: Works also for subclasses like Math::BigFloat. Each class has it's own globals separated from Math::BigInt, but it is possible to subclass Math::BigInt and make the globals of the subclass aliases to the ones from Math::BigInt. =item precision() $x->precision(-2); # local for $x, round at the second # digit right of the dot $x->precision(2); # ditto, round at the second digit # left of the dot CLASS->precision(5); # Global for all members of CLASS # This also applies to new()! CLASS->precision(-5); # ditto $P = CLASS->precision(); # read out global precision $P = $x->precision(); # read out precision that affects $x Note: You probably want to use L instead. With L you set the number of digits each result should have, with L you set the place where to round! C sets or gets the global or local precision, aka at which digit before or after the dot to round all results. A set global precision also applies to all newly created numbers! In Math::BigInt, passing a negative number precision has no effect since no numbers have digits after the dot. In L, it will round all results to P digits after the dot. Please see the section about L for further details. Pass an undef value to disable it: $x->precision(undef); Math::BigInt->precision(undef); Returns the current precision. For C<< $x->precision() >> it will return either the local precision of $x, or if not defined, the global. This means the return value represents the prevision that will be in effect for $x: $y = Math::BigInt->new(1234567); # unrounded print Math::BigInt->precision(4),"\n"; # set 4, print 4 $x = Math::BigInt->new(123456); # will be automatically rounded print $x; # print "120000"! Note: Works also for subclasses like L. Each class has its own globals separated from Math::BigInt, but it is possible to subclass Math::BigInt and make the globals of the subclass aliases to the ones from Math::BigInt. =item brsft() $x->brsft($y,$n); Shifts $x right by $y in base $n. Default is base 2, used are usually 10 and 2, but others work, too. Right shifting usually amounts to dividing $x by $n ** $y and truncating the result: $x = Math::BigInt->new(10); $x->brsft(1); # same as $x >> 1: 5 $x = Math::BigInt->new(1234); $x->brsft(2,10); # result 12 There is one exception, and that is base 2 with negative $x: $x = Math::BigInt->new(-5); print $x->brsft(1); This will print -3, not -2 (as it would if you divide -5 by 2 and truncate the result). =item new() $x = Math::BigInt->new($str,$A,$P,$R); Creates a new BigInt object from a scalar or another BigInt object. The input is accepted as decimal, hex (with leading '0x') or binary (with leading '0b'). See L for more info on accepted input formats. =item from_oct() $x = Math::BigInt->from_oct("0775"); # input is octal Interpret the input as an octal string and return the corresponding value. A "0" (zero) prefix is optional. A single underscore character may be placed right after the prefix, if present, or between any two digits. If the input is invalid, a NaN is returned. =item from_hex() $x = Math::BigInt->from_hex("0xcafe"); # input is hexadecimal Interpret input as a hexadecimal string. A "0x" or "x" prefix is optional. A single underscore character may be placed right after the prefix, if present, or between any two digits. If the input is invalid, a NaN is returned. =item from_bin() $x = Math::BigInt->from_bin("0b10011"); # input is binary Interpret the input as a binary string. A "0b" or "b" prefix is optional. A single underscore character may be placed right after the prefix, if present, or between any two digits. If the input is invalid, a NaN is returned. =item bnan() $x = Math::BigInt->bnan(); Creates a new BigInt object representing NaN (Not A Number). If used on an object, it will set it to NaN: $x->bnan(); =item bzero() $x = Math::BigInt->bzero(); Creates a new BigInt object representing zero. If used on an object, it will set it to zero: $x->bzero(); =item binf() $x = Math::BigInt->binf($sign); Creates a new BigInt object representing infinity. The optional argument is either '-' or '+', indicating whether you want infinity or minus infinity. If used on an object, it will set it to infinity: $x->binf(); $x->binf('-'); =item bone() $x = Math::BigInt->binf($sign); Creates a new BigInt object representing one. The optional argument is either '-' or '+', indicating whether you want one or minus one. If used on an object, it will set it to one: $x->bone(); # +1 $x->bone('-'); # -1 =item is_one()/is_zero()/is_nan()/is_inf() $x->is_zero(); # true if arg is +0 $x->is_nan(); # true if arg is NaN $x->is_one(); # true if arg is +1 $x->is_one('-'); # true if arg is -1 $x->is_inf(); # true if +inf $x->is_inf('-'); # true if -inf (sign is default '+') These methods all test the BigInt for being one specific value and return true or false depending on the input. These are faster than doing something like: if ($x == 0) =item is_pos()/is_neg()/is_positive()/is_negative() $x->is_pos(); # true if > 0 $x->is_neg(); # true if < 0 The methods return true if the argument is positive or negative, respectively. C is neither positive nor negative, while C<+inf> counts as positive, and C<-inf> is negative. A C is neither positive nor negative. These methods are only testing the sign, and not the value. C and C are aliases to C and C, respectively. C and C were introduced in v1.36, while C and C were only introduced in v1.68. =item is_odd()/is_even()/is_int() $x->is_odd(); # true if odd, false for even $x->is_even(); # true if even, false for odd $x->is_int(); # true if $x is an integer The return true when the argument satisfies the condition. C, C<+inf>, C<-inf> are not integers and are neither odd nor even. In BigInt, all numbers except C, C<+inf> and C<-inf> are integers. =item bcmp() $x->bcmp($y); Compares $x with $y and takes the sign into account. Returns -1, 0, 1 or undef. =item bacmp() $x->bacmp($y); Compares $x with $y while ignoring their sign. Returns -1, 0, 1 or undef. =item sign() $x->sign(); Return the sign, of $x, meaning either C<+>, C<->, C<-inf>, C<+inf> or NaN. If you want $x to have a certain sign, use one of the following methods: $x->babs(); # '+' $x->babs()->bneg(); # '-' $x->bnan(); # 'NaN' $x->binf(); # '+inf' $x->binf('-'); # '-inf' =item digit() $x->digit($n); # return the nth digit, counting from right If C<$n> is negative, returns the digit counting from left. =item bneg() $x->bneg(); Negate the number, e.g. change the sign between '+' and '-', or between '+inf' and '-inf', respectively. Does nothing for NaN or zero. =item babs() $x->babs(); Set the number to its absolute value, e.g. change the sign from '-' to '+' and from '-inf' to '+inf', respectively. Does nothing for NaN or positive numbers. =item bsgn() $x->bsgn(); Signum function. Set the number to -1, 0, or 1, depending on whether the number is negative, zero, or positive, respectively. Does not modify NaNs. =item bnorm() $x->bnorm(); # normalize (no-op) =item bnot() $x->bnot(); Two's complement (bitwise not). This is equivalent to $x->binc()->bneg(); but faster. =item binc() $x->binc(); # increment x by 1 =item bdec() $x->bdec(); # decrement x by 1 =item badd() $x->badd($y); # addition (add $y to $x) =item bsub() $x->bsub($y); # subtraction (subtract $y from $x) =item bmul() $x->bmul($y); # multiplication (multiply $x by $y) =item bmuladd() $x->bmuladd($y,$z); Multiply $x by $y, and then add $z to the result, This method was added in v1.87 of Math::BigInt (June 2007). =item bdiv() $x->bdiv($y); # divide, set $x to quotient Returns $x divided by $y. In list context, does floored division (F-division), where the quotient is the greatest integer less than or equal to the quotient of the two operands. Consequently, the remainder is either zero or has the same sign as the second operand. In scalar context, only the quotient is returned. =item bmod() $x->bmod($y); # modulus (x % y) Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the result is identical to the remainder after floored division (F-division), i.e., identical to the result from Perl's % operator. =item bmodinv() $x->bmodinv($mod); # modular multiplicative inverse Returns the multiplicative inverse of C<$x> modulo C<$mod>. If $y = $x -> copy() -> bmodinv($mod) then C<$y> is the number closest to zero, and with the same sign as C<$mod>, satisfying ($x * $y) % $mod = 1 % $mod If C<$x> and C<$y> are non-zero, they must be relative primes, i.e., C. 'C' is returned when no modular multiplicative inverse exists. =item bmodpow() $num->bmodpow($exp,$mod); # modular exponentiation # ($num**$exp % $mod) Returns the value of C<$num> taken to the power C<$exp> in the modulus C<$mod> using binary exponentiation. C is far superior to writing $num ** $exp % $mod because it is much faster - it reduces internal variables into the modulus whenever possible, so it operates on smaller numbers. C also supports negative exponents. bmodpow($num, -1, $mod) is exactly equivalent to bmodinv($num, $mod) =item bpow() $x->bpow($y); # power of arguments (x ** y) =item blog() $x->blog($base, $accuracy); # logarithm of x to the base $base If C<$base> is not defined, Euler's number (e) is used: print $x->blog(undef, 100); # log(x) to 100 digits =item bexp() $x->bexp($accuracy); # calculate e ** X Calculates the expression C where C is Euler's number. This method was added in v1.82 of Math::BigInt (April 2007). See also L. =item bnok() $x->bnok($y); # x over y (binomial coefficient n over k) Calculates the binomial coefficient n over k, also called the "choose" function. The result is equivalent to: ( n ) n! | - | = ------- ( k ) k!(n-k)! This method was added in v1.84 of Math::BigInt (April 2007). =item bpi() print Math::BigInt->bpi(100), "\n"; # 3 Returns PI truncated to an integer, with the argument being ignored. This means under BigInt this always returns C<3>. If upgrading is in effect, returns PI, rounded to N digits with the current rounding mode: use Math::BigFloat; use Math::BigInt upgrade => Math::BigFloat; print Math::BigInt->bpi(3), "\n"; # 3.14 print Math::BigInt->bpi(100), "\n"; # 3.1415.... This method was added in v1.87 of Math::BigInt (June 2007). =item bcos() my $x = Math::BigInt->new(1); print $x->bcos(100), "\n"; Calculate the cosinus of $x, modifying $x in place. In BigInt, unless upgrading is in effect, the result is truncated to an integer. This method was added in v1.87 of Math::BigInt (June 2007). =item bsin() my $x = Math::BigInt->new(1); print $x->bsin(100), "\n"; Calculate the sinus of $x, modifying $x in place. In BigInt, unless upgrading is in effect, the result is truncated to an integer. This method was added in v1.87 of Math::BigInt (June 2007). =item batan2() my $x = Math::BigInt->new(1); my $y = Math::BigInt->new(1); print $y->batan2($x), "\n"; Calculate the arcus tangens of C<$y> divided by C<$x>, modifying $y in place. In BigInt, unless upgrading is in effect, the result is truncated to an integer. This method was added in v1.87 of Math::BigInt (June 2007). =item batan() my $x = Math::BigFloat->new(0.5); print $x->batan(100), "\n"; Calculate the arcus tangens of $x, modifying $x in place. In BigInt, unless upgrading is in effect, the result is truncated to an integer. This method was added in v1.87 of Math::BigInt (June 2007). =item blsft() $x->blsft($y); # left shift in base 2 $x->blsft($y,$n); # left shift, in base $n (like 10) =item brsft() $x->brsft($y); # right shift in base 2 $x->brsft($y,$n); # right shift, in base $n (like 10) =item band() $x->band($y); # bitwise and =item bior() $x->bior($y); # bitwise inclusive or =item bxor() $x->bxor($y); # bitwise exclusive or =item bnot() $x->bnot(); # bitwise not (two's complement) =item bsqrt() $x->bsqrt(); # calculate square-root =item broot() $x->broot($N); Calculates the N'th root of C<$x>. =item bfac() $x->bfac(); # factorial of $x (1*2*3*4*..$x) =item round() $x->round($A,$P,$round_mode); Round $x to accuracy C<$A> or precision C<$P> using the round mode C<$round_mode>. =item bround() $x->bround($N); # accuracy: preserve $N digits =item bfround() $x->bfround($N); If N is > 0, rounds to the Nth digit from the left. If N < 0, rounds to the Nth digit after the dot. Since BigInts are integers, the case N < 0 is a no-op for them. Examples: Input N Result =================================================== 123456.123456 3 123500 123456.123456 2 123450 123456.123456 -2 123456.12 123456.123456 -3 123456.123 =item bfloor() $x->bfloor(); Round $x towards minus infinity (i.e., set $x to the largest integer less than or equal to $x). This is a no-op in BigInt, but changes $x in BigFloat, if $x is not an integer. =item bceil() $x->bceil(); Round $x towards plus infinity (i.e., set $x to the smallest integer greater than or equal to $x). This is a no-op in BigInt, but changes $x in BigFloat, if $x is not an integer. =item bint() $x->bint(); Round $x towards zero. This is a no-op in BigInt, but changes $x in BigFloat, if $x is not an integer. =item bgcd() bgcd(@values); # greatest common divisor (no OO style) =item blcm() blcm(@values); # lowest common multiple (no OO style) =item length() $x->length(); ($xl,$fl) = $x->length(); Returns the number of digits in the decimal representation of the number. In list context, returns the length of the integer and fraction part. For BigInt's, the length of the fraction part will always be 0. =item exponent() $x->exponent(); Return the exponent of $x as BigInt. =item mantissa() $x->mantissa(); Return the signed mantissa of $x as BigInt. =item parts() $x->parts(); # return (mantissa,exponent) as BigInt =item copy() $x->copy(); # make a true copy of $x (unlike $y = $x;) =item as_int() =item as_number() These methods are called when Math::BigInt encounters an object it doesn't know how to handle. For instance, assume $x is a Math::BigInt, or subclass thereof, and $y is defined, but not a Math::BigInt, or subclass thereof. If you do $x -> badd($y); $y needs to be converted into an object that $x can deal with. This is done by first checking if $y is something that $x might be upgraded to. If that is the case, no further attempts are made. The next is to see if $y supports the method C. If it does, C is called, but if it doesn't, the next thing is to see if $y supports the method C. If it does, C is called. The method C (and C) is expected to return either an object that has the same class as $x, a subclass thereof, or a string that Cnew()> can parse to create an object. C is an alias to C. C was introduced in v1.22, while C was introduced in v1.68. In Math::BigInt, C has the same effect as C. =item bstr() $x->bstr(); Returns a normalized string representation of C<$x>. =item bsstr() $x->bsstr(); # normalized string in scientific notation =item as_hex() $x->as_hex(); # as signed hexadecimal string with prefixed 0x =item as_bin() $x->as_bin(); # as signed binary string with prefixed 0b =item as_oct() $x->as_oct(); # as signed octal string with prefixed 0 =item numify() print $x->numify(); This returns a normal Perl scalar from $x. It is used automatically whenever a scalar is needed, for instance in array index operations. This loses precision, to avoid this use L instead. =item modify() $x->modify('bpowd'); This method returns 0 if the object can be modified with the given operation, or 1 if not. This is used for instance by L. =item upgrade()/downgrade() Set/get the class for downgrade/upgrade operations. Thuis is used for instance by L. The defaults are '', thus the following operation will create a BigInt, not a BigFloat: my $i = Math::BigInt->new(123); my $f = Math::BigFloat->new('123.1'); print $i + $f,"\n"; # print 246 =item div_scale() Set/get the number of digits for the default precision in divide operations. =item round_mode() Set/get the current round mode. =back =head1 ACCURACY and PRECISION Since version v1.33, Math::BigInt and Math::BigFloat have full support for accuracy and precision based rounding, both automatically after every operation, as well as manually. This section describes the accuracy/precision handling in Math::Big* as it used to be and as it is now, complete with an explanation of all terms and abbreviations. Not yet implemented things (but with correct description) are marked with '!', things that need to be answered are marked with '?'. In the next paragraph follows a short description of terms used here (because these may differ from terms used by others people or documentation). During the rest of this document, the shortcuts A (for accuracy), P (for precision), F (fallback) and R (rounding mode) will be used. =head2 Precision P A fixed number of digits before (positive) or after (negative) the decimal point. For example, 123.45 has a precision of -2. 0 means an integer like 123 (or 120). A precision of 2 means two digits to the left of the decimal point are zero, so 123 with P = 1 becomes 120. Note that numbers with zeros before the decimal point may have different precisions, because 1200 can have p = 0, 1 or 2 (depending on what the initial value was). It could also have p < 0, when the digits after the decimal point are zero. The string output (of floating point numbers) will be padded with zeros: Initial value P A Result String ------------------------------------------------------------ 1234.01 -3 1000 1000 1234 -2 1200 1200 1234.5 -1 1230 1230 1234.001 1 1234 1234.0 1234.01 0 1234 1234 1234.01 2 1234.01 1234.01 1234.01 5 1234.01 1234.01000 For BigInts, no padding occurs. =head2 Accuracy A Number of significant digits. Leading zeros are not counted. A number may have an accuracy greater than the non-zero digits when there are zeros in it or trailing zeros. For example, 123.456 has A of 6, 10203 has 5, 123.0506 has 7, 123.450000 has 8 and 0.000123 has 3. The string output (of floating point numbers) will be padded with zeros: Initial value P A Result String ------------------------------------------------------------ 1234.01 3 1230 1230 1234.01 6 1234.01 1234.01 1234.1 8 1234.1 1234.1000 For BigInts, no padding occurs. =head2 Fallback F When both A and P are undefined, this is used as a fallback accuracy when dividing numbers. =head2 Rounding mode R When rounding a number, different 'styles' or 'kinds' of rounding are possible. (Note that random rounding, as in Math::Round, is not implemented.) =over =item 'trunc' truncation invariably removes all digits following the rounding place, replacing them with zeros. Thus, 987.65 rounded to tens (P=1) becomes 980, and rounded to the fourth sigdig becomes 987.6 (A=4). 123.456 rounded to the second place after the decimal point (P=-2) becomes 123.46. All other implemented styles of rounding attempt to round to the "nearest digit." If the digit D immediately to the right of the rounding place (skipping the decimal point) is greater than 5, the number is incremented at the rounding place (possibly causing a cascade of incrementation): e.g. when rounding to units, 0.9 rounds to 1, and -19.9 rounds to -20. If D < 5, the number is similarly truncated at the rounding place: e.g. when rounding to units, 0.4 rounds to 0, and -19.4 rounds to -19. However the results of other styles of rounding differ if the digit immediately to the right of the rounding place (skipping the decimal point) is 5 and if there are no digits, or no digits other than 0, after that 5. In such cases: =item 'even' rounds the digit at the rounding place to 0, 2, 4, 6, or 8 if it is not already. E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5. =item 'odd' rounds the digit at the rounding place to 1, 3, 5, 7, or 9 if it is not already. E.g., when rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5, but 0.5501 becomes 0.6. =item '+inf' round to plus infinity, i.e. always round up. E.g., when rounding to the first sigdig, 0.45 becomes 0.5, -0.55 becomes -0.5, and 0.4501 also becomes 0.5. =item '-inf' round to minus infinity, i.e. always round down. E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.6, but 0.4501 becomes 0.5. =item 'zero' round to zero, i.e. positive numbers down, negative ones up. E.g., when rounding to the first sigdig, 0.45 becomes 0.4, -0.55 becomes -0.5, but 0.4501 becomes 0.5. =item 'common' round up if the digit immediately to the right of the rounding place is 5 or greater, otherwise round down. E.g., 0.15 becomes 0.2 and 0.149 becomes 0.1. =back The handling of A & P in MBI/MBF (the old core code shipped with Perl versions <= 5.7.2) is like this: =over =item Precision * bfround($p) is able to round to $p number of digits after the decimal point * otherwise P is unused =item Accuracy (significant digits) * bround($a) rounds to $a significant digits * only bdiv() and bsqrt() take A as (optional) parameter + other operations simply create the same number (bneg etc), or more (bmul) of digits + rounding/truncating is only done when explicitly calling one of bround or bfround, and never for BigInt (not implemented) * bsqrt() simply hands its accuracy argument over to bdiv. * the documentation and the comment in the code indicate two different ways on how bdiv() determines the maximum number of digits it should calculate, and the actual code does yet another thing POD: max($Math::BigFloat::div_scale,length(dividend)+length(divisor)) Comment: result has at most max(scale, length(dividend), length(divisor)) digits Actual code: scale = max(scale, length(dividend)-1,length(divisor)-1); scale += length(divisor) - length(dividend); So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10 So for lx = 3, ly = 9, scale = 10, scale will actually be 16 (10+9-3). Actually, the 'difference' added to the scale is cal- culated from the number of "significant digits" in dividend and divisor, which is derived by looking at the length of the man- tissa. Which is wrong, since it includes the + sign (oops) and actually gets 2 for '+100' and 4 for '+101'. Oops again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange assumption that 124 has 3 significant digits, while 120/7 will get you '17', not '17.1' since 120 is thought to have 2 signif- icant digits. The rounding after the division then uses the remainder and $y to determine whether it must round up or down. ? I have no idea which is the right way. That's why I used a slightly more ? simple scheme and tweaked the few failing testcases to match it. =back This is how it works now: =over =item Setting/Accessing * You can set the A global via Math::BigInt->accuracy() or Math::BigFloat->accuracy() or whatever class you are using. * You can also set P globally by using Math::SomeClass->precision() likewise. * Globals are classwide, and not inherited by subclasses. * to undefine A, use Math::SomeCLass->accuracy(undef); * to undefine P, use Math::SomeClass->precision(undef); * Setting Math::SomeClass->accuracy() clears automatically Math::SomeClass->precision(), and vice versa. * To be valid, A must be > 0, P can have any value. * If P is negative, this means round to the P'th place to the right of the decimal point; positive values mean to the left of the decimal point. P of 0 means round to integer. * to find out the current global A, use Math::SomeClass->accuracy() * to find out the current global P, use Math::SomeClass->precision() * use $x->accuracy() respective $x->precision() for the local setting of $x. * Please note that $x->accuracy() respective $x->precision() return eventually defined global A or P, when $x's A or P is not set. =item Creating numbers * When you create a number, you can give the desired A or P via: $x = Math::BigInt->new($number,$A,$P); * Only one of A or P can be defined, otherwise the result is NaN * If no A or P is give ($x = Math::BigInt->new($number) form), then the globals (if set) will be used. Thus changing the global defaults later on will not change the A or P of previously created numbers (i.e., A and P of $x will be what was in effect when $x was created) * If given undef for A and P, NO rounding will occur, and the globals will NOT be used. This is used by subclasses to create numbers without suffering rounding in the parent. Thus a subclass is able to have its own globals enforced upon creation of a number by using $x = Math::BigInt->new($number,undef,undef): use Math::BigInt::SomeSubclass; use Math::BigInt; Math::BigInt->accuracy(2); Math::BigInt::SomeSubClass->accuracy(3); $x = Math::BigInt::SomeSubClass->new(1234); $x is now 1230, and not 1200. A subclass might choose to implement this otherwise, e.g. falling back to the parent's A and P. =item Usage * If A or P are enabled/defined, they are used to round the result of each operation according to the rules below * Negative P is ignored in Math::BigInt, since BigInts never have digits after the decimal point * Math::BigFloat uses Math::BigInt internally, but setting A or P inside Math::BigInt as globals does not tamper with the parts of a BigFloat. A flag is used to mark all Math::BigFloat numbers as 'never round'. =item Precedence * It only makes sense that a number has only one of A or P at a time. If you set either A or P on one object, or globally, the other one will be automatically cleared. * If two objects are involved in an operation, and one of them has A in effect, and the other P, this results in an error (NaN). * A takes precedence over P (Hint: A comes before P). If neither of them is defined, nothing is used, i.e. the result will have as many digits as it can (with an exception for bdiv/bsqrt) and will not be rounded. * There is another setting for bdiv() (and thus for bsqrt()). If neither of A or P is defined, bdiv() will use a fallback (F) of $div_scale digits. If either the dividend's or the divisor's mantissa has more digits than the value of F, the higher value will be used instead of F. This is to limit the digits (A) of the result (just consider what would happen with unlimited A and P in the case of 1/3 :-) * bdiv will calculate (at least) 4 more digits than required (determined by A, P or F), and, if F is not used, round the result (this will still fail in the case of a result like 0.12345000000001 with A or P of 5, but this can not be helped - or can it?) * Thus you can have the math done by on Math::Big* class in two modi: + never round (this is the default): This is done by setting A and P to undef. No math operation will round the result, with bdiv() and bsqrt() as exceptions to guard against overflows. You must explicitly call bround(), bfround() or round() (the latter with parameters). Note: Once you have rounded a number, the settings will 'stick' on it and 'infect' all other numbers engaged in math operations with it, since local settings have the highest precedence. So, to get SaferRound[tm], use a copy() before rounding like this: $x = Math::BigFloat->new(12.34); $y = Math::BigFloat->new(98.76); $z = $x * $y; # 1218.6984 print $x->copy()->bround(3); # 12.3 (but A is now 3!) $z = $x * $y; # still 1218.6984, without # copy would have been 1210! + round after each op: After each single operation (except for testing like is_zero()), the method round() is called and the result is rounded appropriately. By setting proper values for A and P, you can have all-the-same-A or all-the-same-P modes. For example, Math::Currency might set A to undef, and P to -2, globally. ?Maybe an extra option that forbids local A & P settings would be in order, ?so that intermediate rounding does not 'poison' further math? =item Overriding globals * you will be able to give A, P and R as an argument to all the calculation routines; the second parameter is A, the third one is P, and the fourth is R (shift right by one for binary operations like badd). P is used only if the first parameter (A) is undefined. These three parameters override the globals in the order detailed as follows, i.e. the first defined value wins: (local: per object, global: global default, parameter: argument to sub) + parameter A + parameter P + local A (if defined on both of the operands: smaller one is taken) + local P (if defined on both of the operands: bigger one is taken) + global A + global P + global F * bsqrt() will hand its arguments to bdiv(), as it used to, only now for two arguments (A and P) instead of one =item Local settings * You can set A or P locally by using $x->accuracy() or $x->precision() and thus force different A and P for different objects/numbers. * Setting A or P this way immediately rounds $x to the new value. * $x->accuracy() clears $x->precision(), and vice versa. =item Rounding * the rounding routines will use the respective global or local settings. bround() is for accuracy rounding, while bfround() is for precision * the two rounding functions take as the second parameter one of the following rounding modes (R): 'even', 'odd', '+inf', '-inf', 'zero', 'trunc', 'common' * you can set/get the global R by using Math::SomeClass->round_mode() or by setting $Math::SomeClass::round_mode * after each operation, $result->round() is called, and the result may eventually be rounded (that is, if A or P were set either locally, globally or as parameter to the operation) * to manually round a number, call $x->round($A,$P,$round_mode); this will round the number by using the appropriate rounding function and then normalize it. * rounding modifies the local settings of the number: $x = Math::BigFloat->new(123.456); $x->accuracy(5); $x->bround(4); Here 4 takes precedence over 5, so 123.5 is the result and $x->accuracy() will be 4 from now on. =item Default values * R: 'even' * F: 40 * A: undef * P: undef =item Remarks * The defaults are set up so that the new code gives the same results as the old code (except in a few cases on bdiv): + Both A and P are undefined and thus will not be used for rounding after each operation. + round() is thus a no-op, unless given extra parameters A and P =back =head1 Infinity and Not a Number While BigInt has extensive handling of inf and NaN, certain quirks remain. =over =item oct()/hex() These perl routines currently (as of Perl v.5.8.6) cannot handle passed inf. te@linux:~> perl -wle 'print 2 ** 3333' Inf te@linux:~> perl -wle 'print 2 ** 3333 == 2 ** 3333' 1 te@linux:~> perl -wle 'print oct(2 ** 3333)' 0 te@linux:~> perl -wle 'print hex(2 ** 3333)' Illegal hexadecimal digit 'I' ignored at -e line 1. 0 The same problems occur if you pass them Math::BigInt->binf() objects. Since overloading these routines is not possible, this cannot be fixed from BigInt. =item ==, !=, <, >, <=, >= with NaNs BigInt's bcmp() routine currently returns undef to signal that a NaN was involved in a comparison. However, the overload code turns that into either 1 or '' and thus operations like C<< NaN != NaN >> might return wrong values. =item log(-inf) C<< log(-inf) >> is highly weird. Since log(-x)=pi*i+log(x), then log(-inf)=pi*i+inf. However, since the imaginary part is finite, the real infinity "overshadows" it, so the number might as well just be infinity. However, the result is a complex number, and since BigInt/BigFloat can only have real numbers as results, the result is NaN. =item exp(), cos(), sin(), atan2() These all might have problems handling infinity right. =back =head1 INTERNALS The actual numbers are stored as unsigned big integers (with separate sign). You should neither care about nor depend on the internal representation; it might change without notice. Use B method calls like C<< $x->sign(); >> instead relying on the internal representation. =head2 MATH LIBRARY Math with the numbers is done (by default) by a module called C. This is equivalent to saying: use Math::BigInt try => 'Calc'; You can change this backend library by using: use Math::BigInt try => 'GMP'; B: General purpose packages should not be explicit about the library to use; let the script author decide which is best. If your script works with huge numbers and Calc is too slow for them, you can also for the loading of one of these libraries and if none of them can be used, the code will die: use Math::BigInt only => 'GMP,Pari'; The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: use Math::BigInt try => 'Foo,Math::BigInt::Bar'; The library that is loaded last will be used. Note that this can be overwritten at any time by loading a different library, and numbers constructed with different libraries cannot be used in math operations together. =head3 What library to use? B: General purpose packages should not be explicit about the library to use; let the script author decide which is best. L and L are in cases involving big numbers much faster than Calc, however it is slower when dealing with very small numbers (less than about 20 digits) and when converting very large numbers to decimal (for instance for printing, rounding, calculating their length in decimal etc). So please select carefully what library you want to use. Different low-level libraries use different formats to store the numbers. However, you should B depend on the number having a specific format internally. See the respective math library module documentation for further details. =head2 SIGN The sign is either '+', '-', 'NaN', '+inf' or '-inf'. A sign of 'NaN' is used to represent the result when input arguments are not numbers or as a result of 0/0. '+inf' and '-inf' represent plus respectively minus infinity. You will get '+inf' when dividing a positive number by 0, and '-inf' when dividing any negative number by 0. =head2 mantissa(), exponent() and parts() C and C return the said parts of the BigInt such that: $m = $x->mantissa(); $e = $x->exponent(); $y = $m * ( 10 ** $e ); print "ok\n" if $x == $y; C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them in one go. Both the returned mantissa and exponent have a sign. Currently, for BigInts C<$e> is always 0, except +inf and -inf, where it is C<+inf>; and for NaN, where it is C; and for C<$x == 0>, where it is C<1> (to be compatible with Math::BigFloat's internal representation of a zero as C<0E1>). C<$m> is currently just a copy of the original number. The relation between C<$e> and C<$m> will stay always the same, though their real values might change. =head1 EXAMPLES use Math::BigInt; sub bigint { Math::BigInt->new(shift); } $x = Math::BigInt->bstr("1234") # string "1234" $x = "$x"; # same as bstr() $x = Math::BigInt->bneg("1234"); # BigInt "-1234" $x = Math::BigInt->babs("-12345"); # BigInt "12345" $x = Math::BigInt->bnorm("-0.00"); # BigInt "0" $x = bigint(1) + bigint(2); # BigInt "3" $x = bigint(1) + "2"; # ditto (auto-BigIntify of "2") $x = bigint(1); # BigInt "1" $x = $x + 5 / 2; # BigInt "3" $x = $x ** 3; # BigInt "27" $x *= 2; # BigInt "54" $x = Math::BigInt->new(0); # BigInt "0" $x--; # BigInt "-1" $x = Math::BigInt->badd(4,5) # BigInt "9" print $x->bsstr(); # 9e+0 Examples for rounding: use Math::BigFloat; use Test::More; $x = Math::BigFloat->new(123.4567); $y = Math::BigFloat->new(123.456789); Math::BigFloat->accuracy(4); # no more A than 4 is ($x->copy()->bround(),123.4); # even rounding print $x->copy()->bround(),"\n"; # 123.4 Math::BigFloat->round_mode('odd'); # round to odd print $x->copy()->bround(),"\n"; # 123.5 Math::BigFloat->accuracy(5); # no more A than 5 Math::BigFloat->round_mode('odd'); # round to odd print $x->copy()->bround(),"\n"; # 123.46 $y = $x->copy()->bround(4),"\n"; # A = 4: 123.4 print "$y, ",$y->accuracy(),"\n"; # 123.4, 4 Math::BigFloat->accuracy(undef); # A not important now Math::BigFloat->precision(2); # P important print $x->copy()->bnorm(),"\n"; # 123.46 print $x->copy()->bround(),"\n"; # 123.46 Examples for converting: my $x = Math::BigInt->new('0b1'.'01' x 123); print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n"; =head1 Autocreating constants After C all the B decimal, hexadecimal and binary constants in the given scope are converted to C. This conversion happens at compile time. In particular, perl -MMath::BigInt=:constant -e 'print 2**100,"\n"' prints the integer value of C<2**100>. Note that without conversion of constants the expression 2**100 will be calculated as perl scalar. Please note that strings and floating point constants are not affected, so that use Math::BigInt qw/:constant/; $x = 1234567890123456789012345678901234567890 + 123456789123456789; $y = '1234567890123456789012345678901234567890' + '123456789123456789'; do not work. You need an explicit Math::BigInt->new() around one of the operands. You should also quote large constants to protect loss of precision: use Math::BigInt; $x = Math::BigInt->new('1234567889123456789123456789123456789'); Without the quotes Perl would convert the large number to a floating point constant at compile time and then hand the result to BigInt, which results in an truncated result or a NaN. This also applies to integers that look like floating point constants: use Math::BigInt ':constant'; print ref(123e2),"\n"; print ref(123.2e2),"\n"; will print nothing but newlines. Use either L or L to get this to work. =head1 PERFORMANCE Using the form $x += $y; etc over $x = $x + $y is faster, since a copy of $x must be made in the second case. For long numbers, the copy can eat up to 20% of the work (in the case of addition/subtraction, less for multiplication/division). If $y is very small compared to $x, the form $x += $y is MUCH faster than $x = $x + $y since making the copy of $x takes more time then the actual addition. With a technique called copy-on-write, the cost of copying with overload could be minimized or even completely avoided. A test implementation of COW did show performance gains for overloaded math, but introduced a performance loss due to a constant overhead for all other operations. So Math::BigInt does currently not COW. The rewritten version of this module (vs. v0.01) is slower on certain operations, like C, C and C. The reason are that it does now more work and handles much more cases. The time spent in these operations is usually gained in the other math operations so that code on the average should get (much) faster. If they don't, please contact the author. Some operations may be slower for small numbers, but are significantly faster for big numbers. Other operations are now constant (O(1), like C, C etc), instead of O(N) and thus nearly always take much less time. These optimizations were done on purpose. If you find the Calc module to slow, try to install any of the replacement modules and see if they help you. =head2 Alternative math libraries You can use an alternative library to drive Math::BigInt. See the section L for more information. For more benchmark results see L. =head1 SUBCLASSING =head2 Subclassing Math::BigInt The basic design of Math::BigInt allows simple subclasses with very little work, as long as a few simple rules are followed: =over =item * The public API must remain consistent, i.e. if a sub-class is overloading addition, the sub-class must use the same name, in this case badd(). The reason for this is that Math::BigInt is optimized to call the object methods directly. =item * The private object hash keys like C<< $x->{sign} >> may not be changed, but additional keys can be added, like C<< $x->{_custom} >>. =item * Accessor functions are available for all existing object hash keys and should be used instead of directly accessing the internal hash keys. The reason for this is that Math::BigInt itself has a pluggable interface which permits it to support different storage methods. =back More complex sub-classes may have to replicate more of the logic internal of Math::BigInt if they need to change more basic behaviors. A subclass that needs to merely change the output only needs to overload C. All other object methods and overloaded functions can be directly inherited from the parent class. At the very minimum, any subclass will need to provide its own C and can store additional hash keys in the object. There are also some package globals that must be defined, e.g.: # Globals $accuracy = undef; $precision = -2; # round to 2 decimal places $round_mode = 'even'; $div_scale = 40; Additionally, you might want to provide the following two globals to allow auto-upgrading and auto-downgrading to work correctly: $upgrade = undef; $downgrade = undef; This allows Math::BigInt to correctly retrieve package globals from the subclass, like C<$SubClass::precision>. See t/Math/BigInt/Subclass.pm or t/Math/BigFloat/SubClass.pm completely functional subclass examples. Don't forget to use overload; in your subclass to automatically inherit the overloading from the parent. If you like, you can change part of the overloading, look at Math::String for an example. =head1 UPGRADING When used like this: use Math::BigInt upgrade => 'Foo::Bar'; certain operations will 'upgrade' their calculation and thus the result to the class Foo::Bar. Usually this is used in conjunction with Math::BigFloat: use Math::BigInt upgrade => 'Math::BigFloat'; As a shortcut, you can use the module L: use bignum; Also good for one-liners: perl -Mbignum -le 'print 2 ** 255' This makes it possible to mix arguments of different classes (as in 2.5 + 2) as well es preserve accuracy (as in sqrt(3)). Beware: This feature is not fully implemented yet. =head2 Auto-upgrade The following methods upgrade themselves unconditionally; that is if upgrade is in effect, they will always hand up their work: =over =item bsqrt() =item div() =item blog() =item bexp() =item bpi() =item bcos() =item bsin() =item batan2() =item batan() =back All other methods upgrade themselves only when one (or all) of their arguments are of the class mentioned in $upgrade. =head1 EXPORTS C exports nothing by default, but can export the following methods: bgcd blcm =head1 CAVEATS Some things might not work as you expect them. Below is documented what is known to be troublesome: =over =item bstr(), bsstr() and 'cmp' Both C and C as well as automated stringify via overload now drop the leading '+'. The old code would return '+3', the new returns '3'. This is to be consistent with Perl and to make C (especially with overloading) to work as you expect. It also solves problems with C and L, which stringify arguments before comparing them. Mark Biggar said, when asked about to drop the '+' altogether, or make only C work: I agree (with the first alternative), don't add the '+' on positive numbers. It's not as important anymore with the new internal form for numbers. It made doing things like abs and neg easier, but those have to be done differently now anyway. So, the following examples will now work all as expected: use Test::More tests => 1; use Math::BigInt; my $x = Math::BigInt -> new(3*3); my $y = Math::BigInt -> new(3*3); is ($x,3*3, 'multiplication'); print "$x eq 9" if $x eq $y; print "$x eq 9" if $x eq '9'; print "$x eq 9" if $x eq 3*3; Additionally, the following still works: print "$x == 9" if $x == $y; print "$x == 9" if $x == 9; print "$x == 9" if $x == 3*3; There is now a C method to get the string in scientific notation aka C<1e+2> instead of C<100>. Be advised that overloaded 'eq' always uses bstr() for comparison, but Perl will represent some numbers as 100 and others as 1e+308. If in doubt, convert both arguments to Math::BigInt before comparing them as strings: use Test::More tests => 3; use Math::BigInt; $x = Math::BigInt->new('1e56'); $y = 1e56; is ($x,$y); # will fail is ($x->bsstr(),$y); # okay $y = Math::BigInt->new($y); is ($x,$y); # okay Alternatively, simply use C<< <=> >> for comparisons, this will get it always right. There is not yet a way to get a number automatically represented as a string that matches exactly the way Perl represents it. See also the section about L for problems in comparing NaNs. =item int() C will return (at least for Perl v5.7.1 and up) another BigInt, not a Perl scalar: $x = Math::BigInt->new(123); $y = int($x); # BigInt 123 $x = Math::BigFloat->new(123.45); $y = int($x); # BigInt 123 In all Perl versions you can use C or C for the same effect: $x = Math::BigFloat->new(123.45); $y = $x->as_number(); # BigInt 123 $y = $x->as_int(); # ditto This also works for other subclasses, like Math::String. If you want a real Perl scalar, use C: $y = $x->numify(); # 123 as scalar This is seldom necessary, though, because this is done automatically, like when you access an array: $z = $array[$x]; # does work automatically =item length() The following will probably not do what you expect: $c = Math::BigInt->new(123); print $c->length(),"\n"; # prints 30 It prints both the number of digits in the number and in the fraction part since print calls C in list context. Use something like: print scalar $c->length(),"\n"; # prints 3 =item bdiv() The following will probably not do what you expect: print $c->bdiv(10000),"\n"; It prints both quotient and remainder since print calls C in list context. Also, C will modify $c, so be careful. You probably want to use print $c / 10000,"\n"; or, if you want to modify $c instead, print scalar $c->bdiv(10000),"\n"; The quotient is always the greatest integer less than or equal to the real-valued quotient of the two operands, and the remainder (when it is non-zero) always has the same sign as the second operand; so, for example, 1 / 4 => ( 0, 1) 1 / -4 => (-1,-3) -3 / 4 => (-1, 1) -3 / -4 => ( 0,-3) -11 / 2 => (-5,1) 11 /-2 => (-5,-1) As a consequence, the behavior of the operator % agrees with the behavior of Perl's built-in % operator (as documented in the perlop manpage), and the equation $x == ($x / $y) * $y + ($x % $y) holds true for any $x and $y, which justifies calling the two return values of bdiv() the quotient and remainder. The only exception to this rule are when $y == 0 and $x is negative, then the remainder will also be negative. See below under "infinity handling" for the reasoning behind this. Perl's 'use integer;' changes the behaviour of % and / for scalars, but will not change BigInt's way to do things. This is because under 'use integer' Perl will do what the underlying C thinks is right and this is different for each system. If you need BigInt's behaving exactly like Perl's 'use integer', bug the author to implement it ;) =item infinity handling Here are some examples that explain the reasons why certain results occur while handling infinity: The following table shows the result of the division and the remainder, so that the equation above holds true. Some "ordinary" cases are strewn in to show more clearly the reasoning: A / B = C, R so that C * B + R = A ========================================================= 5 / 8 = 0, 5 0 * 8 + 5 = 5 0 / 8 = 0, 0 0 * 8 + 0 = 0 0 / inf = 0, 0 0 * inf + 0 = 0 0 /-inf = 0, 0 0 * -inf + 0 = 0 5 / inf = 0, 5 0 * inf + 5 = 5 5 /-inf = 0, 5 0 * -inf + 5 = 5 -5/ inf = 0, -5 0 * inf + -5 = -5 -5/-inf = 0, -5 0 * -inf + -5 = -5 inf/ 5 = inf, 0 inf * 5 + 0 = inf -inf/ 5 = -inf, 0 -inf * 5 + 0 = -inf inf/ -5 = -inf, 0 -inf * -5 + 0 = inf -inf/ -5 = inf, 0 inf * -5 + 0 = -inf 5/ 5 = 1, 0 1 * 5 + 0 = 5 -5/ -5 = 1, 0 1 * -5 + 0 = -5 inf/ inf = 1, 0 1 * inf + 0 = inf -inf/-inf = 1, 0 1 * -inf + 0 = -inf inf/-inf = -1, 0 -1 * -inf + 0 = inf -inf/ inf = -1, 0 1 * -inf + 0 = -inf 8/ 0 = inf, 8 inf * 0 + 8 = 8 inf/ 0 = inf, inf inf * 0 + inf = inf 0/ 0 = NaN These cases below violate the "remainder has the sign of the second of the two arguments", since they wouldn't match up otherwise. A / B = C, R so that C * B + R = A ======================================================== -inf/ 0 = -inf, -inf -inf * 0 + inf = -inf -8/ 0 = -inf, -8 -inf * 0 + 8 = -8 =item Modifying and = Beware of: $x = Math::BigFloat->new(5); $y = $x; It will not do what you think, e.g. making a copy of $x. Instead it just makes a second reference to the B object and stores it in $y. Thus anything that modifies $x (except overloaded operators) will modify $y, and vice versa. Or in other words, C<=> is only safe if you modify your BigInts only via overloaded math. As soon as you use a method call it breaks: $x->bmul(2); print "$x, $y\n"; # prints '10, 10' If you want a true copy of $x, use: $y = $x->copy(); You can also chain the calls like this, this will make first a copy and then multiply it by 2: $y = $x->copy()->bmul(2); See also the documentation for overload.pm regarding C<=>. =item bpow C (and the rounding functions) now modifies the first argument and returns it, unlike the old code which left it alone and only returned the result. This is to be consistent with C etc. The first three will modify $x, the last one won't: print bpow($x,$i),"\n"; # modify $x print $x->bpow($i),"\n"; # ditto print $x **= $i,"\n"; # the same print $x ** $i,"\n"; # leave $x alone The form C<$x **= $y> is faster than C<$x = $x ** $y;>, though. =item Overloading -$x The following: $x = -$x; is slower than $x->bneg(); since overload calls C instead of C. The first variant needs to preserve $x since it does not know that it later will get overwritten. This makes a copy of $x and takes O(N), but $x->bneg() is O(1). =item Mixing different object types With overloaded operators, it is the first (dominating) operand that determines which method is called. Here are some examples showing what actually gets called in various cases. use Math::BigInt; use Math::BigFloat; $mbf = Math::BigFloat->new(5); $mbi2 = Math::BigInt->new(5); $mbi = Math::BigInt->new(2); # what actually gets called: $float = $mbf + $mbi; # $mbf->badd($mbi) $float = $mbf / $mbi; # $mbf->bdiv($mbi) $integer = $mbi + $mbf; # $mbi->badd($mbf) $integer = $mbi2 / $mbi; # $mbi2->bdiv($mbi) $integer = $mbi2 / $mbf; # $mbi2->bdiv($mbf) For instance, Math::BigInt->bdiv() will always return a Math::BigInt, regardless of whether the second operant is a Math::BigFloat. To get a Math::BigFloat you either need to call the operation manually, make sure each operand already is a Math::BigFloat, or cast to that type via Math::BigFloat->new(): $float = Math::BigFloat->new($mbi2) / $mbi; # = 2.5 Beware of casting the entire expression, as this would cast the result, at which point it is too late: $float = Math::BigFloat->new($mbi2 / $mbi); # = 2 Beware also of the order of more complicated expressions like: $integer = ($mbi2 + $mbi) / $mbf; # int / float => int $integer = $mbi2 / Math::BigFloat->new($mbi); # ditto If in doubt, break the expression into simpler terms, or cast all operands to the desired resulting type. Scalar values are a bit different, since: $float = 2 + $mbf; $float = $mbf + 2; will both result in the proper type due to the way the overloaded math works. This section also applies to other overloaded math packages, like Math::String. One solution to you problem might be autoupgrading|upgrading. See the pragmas L, L and L for an easy way to do this. =item bsqrt() C works only good if the result is a big integer, e.g. the square root of 144 is 12, but from 12 the square root is 3, regardless of rounding mode. The reason is that the result is always truncated to an integer. If you want a better approximation of the square root, then use: $x = Math::BigFloat->new(12); Math::BigFloat->precision(0); Math::BigFloat->round_mode('even'); print $x->copy->bsqrt(),"\n"; # 4 Math::BigFloat->precision(2); print $x->bsqrt(),"\n"; # 3.46 print $x->bsqrt(3),"\n"; # 3.464 =item brsft() For negative numbers in base see also L. =back =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L (requires login). We will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Math::BigInt You can also look for information at: =over 4 =item * RT: CPAN's request tracker L =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * Search CPAN L =item * CPAN Testers Matrix L =item * The Bignum mailing list =over 4 =item * Post to mailing list C =item * View mailing list L =item * Subscribe/Unsubscribe L =back =back =head1 LICENSE This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L and L as well as the backends L, L, and L. The pragmas L, L and L also might be of interest because they solve the autoupgrading/downgrading issue, at least partly. =head1 AUTHORS =over 4 =item * Mark Biggar, overloaded interface by Ilya Zakharevich, 1996-2001. =item * Completely rewritten by Tels L, 2001-2008. =item * Florian Ragwitz Eflora@cpan.orgE, 2010. =item * Peter John Acklam Epjacklam@online.noE, 2011-. =back Many people contributed in one or more ways to the final beast, see the file CREDITS for an (incomplete) list. If you miss your name, please drop me a mail. Thank you! =cut Math-BigInt-1.999715/LICENSE0000644403072340010010000000021312626121061015231 0ustar ospjaDomain UsersThis program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. Tels Math-BigInt-1.999715/Makefile.PL0000644403072340010010000000124312632044031016200 0ustar ospjaDomain Users#!perl # We need at least Perl 5.6.1 require 5.006001; use strict; # Load the Module::Install bundled in ./inc/ use inc::Module::Install; # The name of your distribution name 'Math-BigInt'; # Get most of the details from the primary module all_from 'lib/Math/BigInt.pm'; # Required versions. requires 'perl' => 5.006001; requires 'Math::Complex' => 1.39, test_requires 'Test::More' => 0.9301; install_as_core(); license 'perl'; author 'Peter John Acklam '; # Do not index these no_index directory => 'examples'; sign; # Generate the Makefile WriteAll; 1; Math-BigInt-1.999715/MANIFEST0000644403072340010010000000332412642757323015401 0ustar ospjaDomain UsersBENCHMARK BUGS CHANGES CREDITS examples/1000.txt examples/bigprimes.pl examples/prime.pl GOALS HISTORY inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Math/BigFloat.pm lib/Math/BigInt.pm lib/Math/BigInt/Calc.pm lib/Math/BigInt/CalcEmu.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP NEW README t/00sig.t t/01load.t t/02pod.t t/03podcov.t t/_e_math.t t/alias.inc t/author-batan-mbf.t t/author-batan2-mbf.t t/author-bexp-mbf.t t/author-blog-mbf.t t/author-blog-mbi.t t/author-bpi-mbf.t t/bare_mbf.t t/bare_mbi.t t/bare_mif.t t/big_pi_e.t t/bigfltpm.inc t/bigfltpm.t t/bigintc.t t/bigintpm.inc t/bigintpm.t t/bigints.t t/biglog.t t/bigroot.t t/calling.t t/config.t t/const_mbf.t t/constant.t t/downgrade.t t/from_hex-mbf.t t/inf_nan.t t/isa.t t/lib_load.t t/Math/BigFloat/Subclass.pm t/Math/BigInt/BareCalc.pm t/Math/BigInt/Scalar.pm t/Math/BigInt/Subclass.pm t/mbf_ali.t t/mbi_ali.t t/mbi_rand.t t/mbimbf.inc t/mbimbf.t t/nan_cmp.t t/new_overloaded.t t/objectify_mbf.t t/objectify_mbi.t t/req_mbf0.t t/req_mbf1.t t/req_mbfa.t t/req_mbfi.t t/req_mbfn.t t/req_mbfw.t t/require.t t/round.t t/rt-16221.t t/sub_ali.t t/sub_mbf.t t/sub_mbi.t t/sub_mif.t t/trap.t t/upgrade.inc t/upgrade.t t/upgrade2.t t/upgradef.t t/use.t t/use_lib1.t t/use_lib2.t t/use_lib3.t t/use_lib4.t t/use_mbfw.t t/with_sub.t TODO META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) SIGNATURE Public-key signature (added by MakeMaker) Math-BigInt-1.999715/MANIFEST.SKIP0000644403072340010010000000030012626121061016117 0ustar ospjaDomain Users.*\.tar\.gz ^blib.* ^\w+\.(html|txt|png|dot|pl|svg|old|bak|org) ^Makefile\z ^Makefile.(old|bak)\z ^MANIFEST.(old|bak)\z ^MYMETA\.(yml|json)\z pm_to_blib \.git \.*tmp .*\.patch\z ^Math-BigInt- Math-BigInt-1.999715/META.json0000644403072340010010000000207112642757322015666 0ustar ospjaDomain Users{ "abstract" : "Arbitrary size integer/float math package", "author" : [ "=over 4, Peter John Acklam " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.1, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Math-BigInt", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "6.59", "Test::More" : "0.9301" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Math::Complex" : "1.39", "Test::More" : "0.9301", "perl" : "5.006001" } } }, "release_status" : "stable", "version" : "1.999715", "x_serialization_backend" : "JSON::PP version 2.27300" } Math-BigInt-1.999715/META.yml0000644403072340010010000000122412642757315015517 0ustar ospjaDomain Users--- abstract: 'Arbitrary size integer/float math package' author: - '=over 4, Peter John Acklam ' build_requires: ExtUtils::MakeMaker: '6.59' Test::More: '0.9301' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.1, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Math-BigInt no_index: directory: - t - inc requires: Math::Complex: '1.39' Test::More: '0.9301' perl: '5.006001' version: '1.999715' x_serialization_backend: 'CPAN::Meta::YAML version 0.016' Math-BigInt-1.999715/NEW0000644403072340010010000000010012626121062014574 0ustar ospjaDomain UsersFor the list of recent changes see the end of the CHANGES file. Math-BigInt-1.999715/README0000644403072340010010000000214612626121062015114 0ustar ospjaDomain UsersMath-BigInt Math::BigInt and Math::BigFloat are modules for arbitrary precision arithmetic. INSTALLATION To install this module, unpack the distribution file, and run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for these modules with the perldoc command. perldoc Math::BigInt perldoc Math::BigFloat You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Math-BigInt AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Math-BigInt CPAN Ratings http://cpanratings.perl.org/d/Math-BigInt Search CPAN http://search.cpan.org/dist/Math-BigInt COPYRIGHT AND LICENCE Copyright 1996-2001 Mark Biggar, Ilya Zakharevich. Copyright 2001-2008 Tels, L. Copyright 2010 Florian Ragwitz L. Copyright 2011- Peter John Acklam L. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Math-BigInt-1.999715/SIGNATURE0000644403072340010010000001575412642757326015551 0ustar ospjaDomain UsersThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.79. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 f6ef98e8f3f6a4f670d569f279ef5a3c05c16d0c BENCHMARK SHA1 d681b992c9e027633a59fbd52530805ee4e1621c BUGS SHA1 56305ead4acbfba4cd2ad75bd300348880d7e84e CHANGES SHA1 f27c8bd98e754f96c9825fa6ce9f1244c93bdbe6 CREDITS SHA1 bc2db74538d3acd53f71b5512a144fe18c253ecd GOALS SHA1 fe61299e80a1dca48fbaa33f0869e3238ec07c70 HISTORY SHA1 d6a6c30ee6d9ba6b9afab8bbf6a25e1b23c744e0 LICENSE SHA1 528e7714188e2467c521b4a42cdef9af57ae84a2 MANIFEST SHA1 86df44fbe1ea7a68897113f0e327d0f0c25b91e3 MANIFEST.SKIP SHA1 24b4f9de847ad57e5279ed66a02d18ae39658f24 META.json SHA1 68078ebf5d437da92e7ea68bf2dff17f9d52ffcc META.yml SHA1 2b614d9027b35fcc411dbb248c0ab3338ee3430f Makefile.PL SHA1 4e2191d1724e699862efc5350f480c8e02755112 NEW SHA1 813c62e6d3edd18b7b634765ecbd75b2cd6389a0 README SHA1 f1500916b488220b707bc10a0388d7dbcfd52e99 TODO SHA1 c2bbe82659480de8710b9e64a62d47b64dddd2d2 examples/1000.txt SHA1 3c8ec158cb48b0766212aab46c96adc3be1d92e7 examples/bigprimes.pl SHA1 8ca42793d8769ec8d0928f11c30f38d96dd54efb examples/prime.pl SHA1 bce3c51bb369419603298064b78e14077b93af66 inc/Module/Install.pm SHA1 fe220f215f645500ce8f14ff5e19d9a28692af56 inc/Module/Install/Base.pm SHA1 b56ed8e42c600e08007d152cf0b1438a7c3b7f6e inc/Module/Install/Can.pm SHA1 99c531a17a67ce5250df2ae151cc48c80d914cde inc/Module/Install/Fetch.pm SHA1 76efdca3603159e0ae0e18f19fe72a0211a69529 inc/Module/Install/Makefile.pm SHA1 2e33e87882d60db3913da6284dd5295e5315e18a inc/Module/Install/Metadata.pm SHA1 c830b819e61bda5eca077c6291293bba61b3b9f2 inc/Module/Install/Win32.pm SHA1 cb52b9d6f88d512d448a6f35ed0af0d1201a134b inc/Module/Install/WriteAll.pm SHA1 6c40c07f32ee38ddb3e900f10f4751fa6dacf035 lib/Math/BigFloat.pm SHA1 27a66c373f3c0a5ae198afe788b559cd361fa1a7 lib/Math/BigInt.pm SHA1 0807737d74be329e4251a2abd4914587a5c34e2a lib/Math/BigInt/Calc.pm SHA1 9e774f501bd57f96b27d18cd4342708738e46ee4 lib/Math/BigInt/CalcEmu.pm SHA1 385cc7ed3bf3e6290640b9880445ca9a3dea629e t/00sig.t SHA1 551efa40942b38f7f521b5a511d08f29ef7b4a1b t/01load.t SHA1 b2ed9206ca5b69ec3b8bbf850bf4b6dfde518e7e t/02pod.t SHA1 70791ee5e7358a9605f95a1aa02a566210bec223 t/03podcov.t SHA1 a323fbde83f97abdedc14ff923a2ecabb1333e2d t/Math/BigFloat/Subclass.pm SHA1 15416b7a23df32dd90736a4311a6afc69e281c41 t/Math/BigInt/BareCalc.pm SHA1 54f99a0bf52a848dbf34e459daef0df4694e543a t/Math/BigInt/Scalar.pm SHA1 69c77dbdb12adb852836eaebb0c6957154de4e19 t/Math/BigInt/Subclass.pm SHA1 6d11459530fb13a9e3c490cc3cb9040f9b78cdb4 t/_e_math.t SHA1 0d67c764487923bd2427c7ac20778308bea548d6 t/alias.inc SHA1 bcf4632983c6b52fcc7d694a60899576a4ec8fbe t/author-batan-mbf.t SHA1 d6dd884fbd6cc3f8967dc5426e0c2c6f81f21e5b t/author-batan2-mbf.t SHA1 4c66c320be87292fb55149be8dd8545fb3a13d2c t/author-bexp-mbf.t SHA1 843080d13c065d28a7186d1fc46a982b84b9f753 t/author-blog-mbf.t SHA1 a904010b47c4ad7e9f117d4a3ff80a3dbee493c0 t/author-blog-mbi.t SHA1 1b60e86b66129b2fd448e004a5f59451b875aa97 t/author-bpi-mbf.t SHA1 bcf026322605f19424ffe38652f0d13900d5d93f t/bare_mbf.t SHA1 b79615b536dc8573dc1d37fe4f3bfb31632879e4 t/bare_mbi.t SHA1 78f469179800adf4a43ac18997b15c345b186911 t/bare_mif.t SHA1 d280a166a98ea682d019e0d83699590812a374a9 t/big_pi_e.t SHA1 9b9b6a30c74d5134a6ad4a04b71732d9802dfd64 t/bigfltpm.inc SHA1 84294919a46d123df0d0c581c17a079503d46636 t/bigfltpm.t SHA1 6b9090d78157541f539b2bfbd8bf25a9066857a7 t/bigintc.t SHA1 8196aa86f15868a91cde4ca849b1035cfee856dd t/bigintpm.inc SHA1 e69dbf31bd6a8ca43ae6a6746b53a1b8bec9c9e7 t/bigintpm.t SHA1 9aac2eda0e723298c8f9ddadffde39a8c16fb171 t/bigints.t SHA1 89e6c8b733ae772b7096a9edab565c4034686951 t/biglog.t SHA1 1ff35e339b269f853106accb80c5d7ecc46e10e4 t/bigroot.t SHA1 7edc2e0f720f997fe98fb33b117e64736646051b t/calling.t SHA1 c403d1c64ae6c3b803fc8cd0d10a1df15219057f t/config.t SHA1 af01ecfb6f43bb518c67185eb063c196e2dbdc48 t/const_mbf.t SHA1 17eb15c35392945a5b3ed2b711f7d166fca294de t/constant.t SHA1 f25f71e2cdcd5e4a5888f7cea455204d84560afa t/downgrade.t SHA1 821c32704699d1f0e059b22af7f0ac65b380e7ae t/from_hex-mbf.t SHA1 2dbc417043f25c141ea9a45f860b31a07b9c29be t/inf_nan.t SHA1 e870ac55d1583cdae6efa043628ece5fb725820e t/isa.t SHA1 3dcc5482e16ef304a284abfa6096841311e0373f t/lib_load.t SHA1 4c0b5c5a3fd90fe4721e635832429f7bc9ef690c t/mbf_ali.t SHA1 8e79bcafca4c99f23509a7671fbaa36efb951eaf t/mbi_ali.t SHA1 913f9ffd3af21b7147b088c953140701e73a6589 t/mbi_rand.t SHA1 e365a6ca9f254e32d89a65a96c087bdb62c4a267 t/mbimbf.inc SHA1 77bf40b01227091f454dacf9ac3b66e3f7524e08 t/mbimbf.t SHA1 29abb7f181a69a2a190ffa2cb3f81d89b54f45d2 t/nan_cmp.t SHA1 0508889106487ca934d2e7ddc144d9a67c0a1889 t/new_overloaded.t SHA1 a8e527e0c4077bbb595cf9cc203136f54cf535fb t/objectify_mbf.t SHA1 60ea1d88c9a13cb40247e96af6a8e0c7f8d01e8f t/objectify_mbi.t SHA1 964e103d142644126c27fccf92da930c324d66b2 t/req_mbf0.t SHA1 45283b0a455bb1931ad878a56c8d494edb6199b9 t/req_mbf1.t SHA1 98ddfde850cdaa071298221589ac89d6a39fcf59 t/req_mbfa.t SHA1 21e37b2e7fc377975dadc1dd0d65cc1b340518dc t/req_mbfi.t SHA1 38f551e6ac99a71d5064b2b2d566f205eac66ac2 t/req_mbfn.t SHA1 19e6c5c606d7097843d57711075a4a40f572a747 t/req_mbfw.t SHA1 abd2976a775e8ae3c5408b4bcc9d85e3894a63e5 t/require.t SHA1 10c532f2fbf6cfc4d13d56d7ef908babc84546ec t/round.t SHA1 d4dc89382fcdc28f4a2a70eacb8204445b327072 t/rt-16221.t SHA1 ab253275ec4288308f6ea6ecf0744e24cb3c356a t/sub_ali.t SHA1 34553ea2c707f8b5fc9034772f779aac7b016b72 t/sub_mbf.t SHA1 09bb3e7ff5b8b6fb42aceb0bd12117c47a52fab1 t/sub_mbi.t SHA1 071d33db8604633797b69de80bad101c88995985 t/sub_mif.t SHA1 e0e51c7818998491720933075be68817cc7aa55f t/trap.t SHA1 1540d1deeab9339aac365df76a3dd2d8f976e5a2 t/upgrade.inc SHA1 6e13f422ecb196c2d00b3b2f1355a70333443048 t/upgrade.t SHA1 df0e45b746691e397ed8e80d88df15459b349483 t/upgrade2.t SHA1 12b27f15d45fd7dd1c69b5b678373fcba7e6a04d t/upgradef.t SHA1 69b741efceefd35226a10e8daccf30805bbfb447 t/use.t SHA1 dd1b708e8b431598e2cb8d53a718255cd43d516e t/use_lib1.t SHA1 76aa88ab0694bd79c476a80105815335ab483fcc t/use_lib2.t SHA1 121fa9e1674756d3301938aba12cc9346d3d7d48 t/use_lib3.t SHA1 ab18e2d41140409d5e3740ae5cab986411651c43 t/use_lib4.t SHA1 1c44b96dea3e068a41e0a8f28977e3c3193f859c t/use_mbfw.t SHA1 3c213bb219bcbfbfba0f0455ab69e5895e25dfe2 t/with_sub.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1 iQEcBAEBAgAGBQJWi97UAAoJEGcmPl2fr166IhMH/Rpijmbg4Ewdr/QhbyWlR6yM fiyDkXj/zl+pz7QbDtk5mOnZq/e4Vg5ue/VilaYt80Ocr+TFL6dtSM1PVIg2r5ac 0nDqnN+r10L9lwFX593gJxFv8QPlCgu2sSiEqT9XWAQ+KfIC/EwX3NvTetSQB8Fk +lEP4sMDeGRDEYH/B37SK4gicOX76aggTEuEz3XQba8TXSoHUnwSR8XbdyzfrgpZ lDDZVGB87CglhoqYtxs9S9Vw3lNXIF7LcU9cC/lReZpmjKedq3E8P90LPIJe2r9r k4lrmriHo5r7dU/THeAh1mTbzfkFhdxyU+WyW9m3Nd2DgDfAcMWGRW/RlxqEnz4= =agTs -----END PGP SIGNATURE----- Math-BigInt-1.999715/t/0000755403072340010010000000000012642757312014507 5ustar ospjaDomain UsersMath-BigInt-1.999715/t/00sig.t0000644403072340010010000000203212626121062015600 0ustar ospjaDomain Users#!perl use strict; # restrict unsafe constructs use warnings; # enable optional warnings use Test::More; if (!$ENV{TEST_SIGNATURE}) { plan skip_all => "Set the environment variable TEST_SIGNATURE to enable this test."; } elsif (!eval { require Module::Signature; 1 }) { plan skip_all => "Next time around, consider installing Module::Signature, ". "so you can verify the integrity of this distribution."; } elsif (!-e 'SIGNATURE') { plan skip_all => "SIGNATURE not found"; } elsif (!-s 'SIGNATURE') { plan skip_all => "SIGNATURE file empty"; } elsif (!eval { require Socket; Socket::inet_aton('pool.sks-keyservers.net') }) { plan skip_all => "Cannot connect to the keyserver to check module ". "signature"; } else { plan tests => 1; } my $ret = Module::Signature::verify(); SKIP: { skip "Module::Signature cannot verify", 1 if $ret eq Module::Signature::CANNOT_VERIFY(); cmp_ok $ret, '==', Module::Signature::SIGNATURE_OK(), "Valid signature"; } Math-BigInt-1.999715/t/01load.t0000644403072340010010000000106312630643017015745 0ustar ospjaDomain Users#!perl use strict; # restrict unsafe constructs use warnings; # enable optional warnings use Test::More tests => 2; BEGIN { use_ok('Math::BigInt'); use_ok('Math::BigFloat'); }; my @mods = ('Math::BigInt', 'Math::BigFloat', 'Math::BigInt::Calc', ); diag(""); diag("Testing with Perl $], $^X"); diag(""); diag(sprintf("%12s %s\n", 'Version', 'Module')); diag(sprintf("%12s %s\n", '-------', '------')); for my $mod (@mods) { diag(sprintf("%12s %s\n", $mod -> VERSION(), $mod)); } diag(""); Math-BigInt-1.999715/t/02pod.t0000644403072340010010000000046512626121062015612 0ustar ospjaDomain Users#!perl use strict; # restrict unsafe constructs use warnings; # enable optional warnings use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Math-BigInt-1.999715/t/03podcov.t0000644403072340010010000000205212622703131016314 0ustar ospjaDomain Users#!perl use strict; # restrict unsafe constructs use warnings; # enable optional warnings use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; plan tests => 2; my $trustme; $trustme = { trustme => [ 'fround', 'objectify' ], }; pod_coverage_ok('Math::BigInt', $trustme, "Math::BigInt is covered"); $trustme = { trustme => [ 'DEBUG', 'isa' ], coverage_class => 'Pod::Coverage::CountParents', }; pod_coverage_ok('Math::BigFloat', $trustme, "Math::BigFloat is covered"); Math-BigInt-1.999715/t/alias.inc0000644403072340010010000000103412632015300016250 0ustar ospjaDomain Users#!perl use strict; use warnings; our $CLASS; # alias subroutine testing, included by sub_ali.t, mbi_ali.t, and mbf_ali.t our $x = $CLASS->new(123); is($x->is_pos(), 1, "$CLASS -> new(123) -> is_pos()"); is($x->is_neg(), 0, "$CLASS -> new(123) -> is_neg()"); is($x->as_int(), 123, "$CLASS -> new(123) -> as_int()"); is(ref($x->as_int()), 'Math::BigInt', "ref($CLASS -> new(123) -> as_int())"); $x->bneg(); is($x->is_pos(), 0, "$CLASS -> new(123) -> bneg() -> is_pos()"); is($x->is_neg(), 1, "$CLASS -> new(123) -> bneg() -> is_neg()"); Math-BigInt-1.999715/t/author-batan-mbf.t0000644403072340010010000000416012641524704020020 0ustar ospjaDomain Users#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } use strict; use warnings; use Test::More tests => 42; use Math::Complex (); use Math::BigFloat; my $inf = Math::Complex::Inf(); # most portable way to get infinity my $nan = $inf - $inf; my $class = 'Math::BigFloat'; # atan X sub atan { atan2($_[0], 1) } # isnan X #sub isnan { !defined($_[0] <=> 0) } sub isnan { !($_[0] <= 0 || $_[0] > 0) } # linspace MIN, MAX, N # # Returns N linearly spaced elements from MIN to MAX. sub linspace { my ($xmin, $xmax, $n) = @_; if ($n == 0) { return (); } elsif ($n == 1) { return ($xmin); } else { my $c = ($xmax - $xmin) / ($n - 1); return map { $xmin + $c * $_ } 0 .. ($n - 1); } } # logspace MIN, MAX, N # # Returns N logarithmically spaced elements from MIN to MAX. sub logspace { my ($xmin, $xmax, $n) = @_; if ($n == 0) { return (); } elsif ($n == 1) { return ($xmin); } else { my @lin = linspace(log($xmin), log($xmax), $n); my @log = map { exp } @lin; $log[ 0 ] = $xmin; $log[ $#log ] = $xmax; return @log; } } my @x; @x = logspace(0.01, 12, 20); @x = map { sprintf "%.3g", $_ } @x; @x = (reverse(map( { -$_ } @x)), 0, @x, $nan); my $accu = 16; my $tol = 1e-14; my $max_relerr = 0; for (my $i = 0; $i <= $#x ; ++$i) { my $x = $x[$i]; my $pl = atan($x); my $bf = $class -> new("$x") -> batan($accu); my $desc = qq|$class->new("$x")->batan($accu) vs. CORE::atan2("$x", 1)|; if (isnan($x)) { is($bf, "NaN", $desc); } elsif ($x == 0) { cmp_ok($bf, '==', $pl, $desc); } else { my $relerr = abs(($bf - $pl) / $pl); # relative error #printf("# %23.15e %23.15e %23.15e %23.15e\n", $x, $pl, $bf, $relerr); cmp_ok($relerr, '<', $tol, "relative error of $desc"); $max_relerr = $relerr if $relerr > $max_relerr; } } diag("Maximum relative error = ", $max_relerr -> numify(), "\n"); Math-BigInt-1.999715/t/author-batan2-mbf.t0000644403072340010010000000665012641524704020110 0ustar ospjaDomain Users#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } use strict; use warnings; use Test::More tests => 3528; use Math::Complex (); use Math::BigFloat; my $inf = Math::Complex::Inf(); my $nan = $inf - $inf; my $class = 'Math::BigFloat'; # isnan X #sub isnan { !($_[0] <= 0 || $_[0] > 0) } sub isnan { !defined($_[0] <=> 0) } # linspace MIN, MAX, N # # Returns N linearly spaced elements from MIN to MAX. sub linspace { my ($xmin, $xmax, $n) = @_; if ($n == 0) { return (); } elsif ($n == 1) { return ($xmin); } else { my $c = ($xmax - $xmin) / ($n - 1); return map { $xmin + $c * $_ } 0 .. ($n - 1); } } # logspace MIN, MAX, N # # Returns N logarithmically spaced elements from MIN to MAX. sub logspace { my ($xmin, $xmax, $n) = @_; if ($n == 0) { return (); } elsif ($n == 1) { return ($xmin); } else { my @lin = linspace(log($xmin), log($xmax), $n); my @log = map { exp } @lin; $log[ 0 ] = $xmin; $log[ $#log ] = $xmax; return @log; } } my @x; @x = logspace(0.01, 12, 20); @x = map { sprintf "%.3g", $_ } @x; @x = (reverse(map( { -$_ } @x)), 0, @x, $nan); my $accu = 16; my $tol = 1e-14; my $max_relerr = 0; for my $ply (@x) { for my $plx (@x) { my $plz = CORE::atan2($ply, $plx); # $y -> batan2($x) where $x is a scalar { my $y = $class -> new($ply); $y -> batan2($plx, $accu); my $desc = qq|\$y = $class->new("$ply");| . qq| \$y->batan2("$plx", $accu)| . qq| vs. CORE::atan2($ply, $plx)|; if (isnan($plz)) { is($y, "NaN", $desc); } elsif ($plz == 0) { cmp_ok($y, '==', $plz, $desc); } else { my $relerr = abs(($y - $plz) / $plz); if (!cmp_ok($relerr, '<', $tol, "relative error of $desc")) { diag(sprintf(" CORE::atan2(...): %.15g\n" . " Math::BigFloat->batan2(...): %.15g\n", $plz, $y)); } $max_relerr = $relerr if $relerr > $max_relerr; } } # $y -> batan2($x) where $x is an object { my $x = $class -> new($plx); my $y = $class -> new($ply); $y -> batan2($plx, $accu); my $desc = qq|\$y = $class->new("$ply");| . qq| \$x = $class->new("$plx");| . qq| \$y->batan2(\$x, $accu)| . qq| vs. CORE::atan2($ply, $plx)|; if (isnan($plz)) { is($y, "NaN", $desc); } elsif ($plz == 0) { cmp_ok($y, '==', $plz, $desc); } else { my $relerr = abs(($y - $plz) / $plz); if (!cmp_ok($relerr, '<', $tol, "relative error of $desc")) { diag(sprintf(" CORE::atan2(...): %.15g\n" . " Math::BigFloat->batan2(...): %.15g\n", $plz, $y)); } $max_relerr = $relerr if $relerr > $max_relerr; } } } } diag("Maximum relative error = ", $max_relerr -> numify(), "\n"); Math-BigInt-1.999715/t/author-bexp-mbf.t0000644403072340010010000007414412642747366017716 0ustar ospjaDomain Users#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } use strict; use warnings; use Test::More tests => 961; use Math::BigFloat; my $class = 'Math::BigFloat'; my $accu = 16; my $tol = 1e-14; my $max_relerr = 0; while () { s/#.*$//; # remove comments s/\s+$//; # remove trailing whitespace next unless length; # skip empty lines my ($x, $wanted) = split /:/; my $test = qq|$class->new("$x", 20)->bexp()->bsstr()|; my $got = eval $test; die $@ if $@; # this should never be true is($got, $wanted, $test); } __DATA__ -120.00:76676480737219996324e-72 -119.75:9845455012875848912e-71 -119.50:12641814475388325097e-71 -119.25:16232411099449616144e-71 -119.00:20842828425817513239e-71 -118.75:26762721454411435331e-71 -118.50:34364014567198602057e-71 -118.25:44124268123710803338e-71 -118.00:56656681763589393363e-71 -117.75:72748619409637634865e-71 -117.50:93411076350917881994e-71 -117.25:11994219623473776769e-70 -117.00:15400882849875201985e-70 -116.75:19775125018670097804e-70 -116.50:25391763142150053927e-70 -116.25:32603669249035658995e-70 -116.00:41863939993042315515e-70 -115.75:53754362993756764505e-70 -115.50:69021968341842640327e-70 -115.25:88625961660742597394e-70 -115.00:11379798735078681489e-69 -114.75:14611950812632037462e-69 -114.50:18762116230810634694e-69 -114.25:24091034111210462891e-69 -114.00:3093350011308560843e-68 -113.75:39719400372315046683e-69 -113.50:51000719613649062059e-69 -113.25:65486220253290406784e-69 -113.00:84085971248036430243e-69 -112.75:10796852426935342718e-68 -112.50:1386343293641170635e-67 -112.25:17801000252898600736e-68 -112.00:22856936767186717347e-68 -111.75:29348887756692283505e-68 -111.50:37684717831108563734e-68 -111.25:48388135515849135057e-68 -111.00:62131595868481088366e-68 -110.75:79778548274500786728e-68 -110.50:10243768369090897206e-67 -110.25:13153258948574645287e-67 -110.00:16889118802245323352e-67 -109.75:2168605780754182068e-66 -109.50:27845449412643335817e-67 -109.25:35754264784926785636e-67 -109.00:4590938473882945758e-66 -108.75:58948816869153334016e-67 -108.50:75691779143663974075e-67 -108.25:97190168254779634597e-67 -108.00:12479464629129512485e-66 -107.75:16023949770457953511e-66 -107.50:20575158780995713264e-66 -107.25:26419026827184463853e-66 -107.00:33922701930260152026e-66 -106.75:43557611481176344062e-66 -106.50:55929080232040207716e-66 -106.25:71814360549907552883e-66 -106.00:92211464229258749255e-66 -105.75:11840186378036073414e-65 -105.50:1520310024771828978e-64 -105.25:19521167130521982812e-65 -105.00:25065674758999531731e-65 -104.75:32184963476983777833e-65 -104.50:41326311139613836304e-65 -104.25:53064033881209908793e-65 -104.00:68135568215452985134e-65 -103.75:87487801369103053668e-65 -103.50:11233656060805690838e-64 -103.25:14424299904402799765e-64 -103.00:18521167695179754623e-64 -102.75:23781650067346720982e-64 -102.50:30536243137246928736e-64 -102.25:39209312318381673938e-64 -102.00:50345753587649823968e-64 -101.75:64645227228840420972e-64 -101.50:83006114829385553249e-64 -101.25:10658196118143230263e-63 -101.00:13685394711738530002e-63 -100.75:17572394647276279739e-63 -100.50:22563401359170363132e-63 -100.25:28971980832101478072e-63 -100.00:3720075976020835963e-62 -99.75:47766721052202104946e-63 -99.50:61333683902860921145e-63 -99.25:78754009030365216655e-63 -99.00:10112214926104485299e-62 -98.75:12984340984127310697e-62 -98.50:16672223842559789452e-62 -98.25:21407559166554132125e-62 -98.00:274878500791021493e-60 -97.75:35295098151669304968e-62 -97.50:4531980311123191359e-61 -97.25:58191779074105960769e-62 -97.00:74719723373429901606e-62 -96.75:95942023939361106199e-62 -96.50:12319199726660341309e-61 -96.25:15818165562284555743e-61 -96.00:20310926627348109257e-61 -95.75:26079746025994799787e-61 -95.50:33487056758138442847e-61 -95.25:42998232007514763574e-61 -95.00:55210822770285327317e-61 -94.75:70892099713288663036e-61 -94.50:91027257874224394149e-61 -94.25:1168813127218934748e-59 -94.00:15007857627073948875e-60 -93.75:19270470643193926345e-60 -93.50:24743774097395970922e-60 -93.25:31771634845836206e-57 -93.00:40795586671775601577e-60 -92.75:52382570175247539595e-60 -92.50:67260551496447081483e-60 -92.25:86364257661872757829e-60 -92.00:11089390193121363795e-59 -91.75:14239058863535613154e-59 -91.50:18283313490492594385e-59 -91.25:23476239223062358704e-59 -91.00:30144087850653745533e-59 -90.75:38705774963107561194e-59 -90.50:4969919882522613803e-58 -90.25:63815034480607903936e-59 -90.00:81940126239905154304e-59 -89.75:10521320473864035558e-58 -89.50:13509642905558533942e-58 -89.25:17346724861112387118e-58 -89.00:22273635617957437392e-58 -88.75:28599914255498718833e-58 -88.50:36723016819150420212e-58 -88.25:47153286973240557166e-58 -88.00:60546018954011858845e-58 -87.75:77742627216208970853e-58 -87.50:9982350930569247556e-57 -87.25:12817592313147442053e-57 -87.00:16458114310822736512e-57 -86.75:21132637085848645513e-57 -86.50:27134843139867625959e-57 -86.25:34841828269425031899e-57 -86.00:44737793061811207346e-57 -85.75:57444463377882085421e-57 -85.50:73760151025188750427e-57 -85.25:94709908655068727477e-57 -85.00:12160992992528255644e-56 -84.75:15615024094567797714e-56 -84.50:20050087819616539644e-56 -84.25:2574482236720893743e-55 -84.00:33057006267607342985e-56 -83.75:4244603624721380045e-55 -83.50:54501789379071678925e-56 -83.25:69981682817690035738e-56 -83.00:89858259440493806697e-56 -82.75:11538028902091524009e-55 -82.50:14815122368763273507e-55 -82.25:19022993672831141914e-55 -82.00:24426007377405276794e-55 -81.75:313636143007906581e-53 -81.50:40271677921406332541e-55 -81.25:51709858023748284986e-55 -81.00:66396771995807344007e-55 -80.75:85255142828637489655e-55 -80.50:10946977029531416782e-54 -80.25:14056196741815211947e-54 -80.00:18048513878454151723e-54 -79.75:23174750553376577323e-54 -79.50:29756968735933827241e-54 -79.25:38208704180521528511e-54 -79.00:49060947306492805661e-54 -78.75:62995503308314753001e-54 -78.50:80887827384912847916e-54 -78.25:10386202626287882612e-53 -78.00:13336148155022613415e-53 -77.75:17123953191762366003e-53 -77.50:21987591132394052761e-53 -77.25:28232625865731963229e-53 -77.00:36251409191435592242e-53 -76.75:46547730792550907923e-53 -76.50:59768469426773994703e-53 -76.25:76744233860502015951e-53 -76.00:98541546861112580289e-53 -75.75:12652985076939468481e-52 -75.50:16246754435760975758e-52 -75.25:20861245634201399181e-52 -75.00:26786369618080779443e-52 -74.75:34394379410408031541e-52 -74.50:44163257354165448968e-52 -74.25:56706744926470254098e-52 -74.00:72812901783216438343e-52 -73.75:93493616552438082193e-52 -73.50:1200481799513882329e-50 -73.25:15414491428468624897e-51 -73.00:19792598779469045537e-51 -72.75:25414199895141024714e-51 -72.50:32632478610144010189e-51 -72.25:41900931944943973771e-51 -72.00:53801861600211384138e-51 -71.75:69082957759787620349e-51 -71.50:88704273623532943184e-51 -71.25:11389854190144032355e-50 -71.00:14624862272512309468e-50 -70.75:18778694873463448014e-50 -70.50:24112321509750858678e-50 -70.25:3096083367386663815e-49 -70.00:39754497359086468078e-50 -69.75:51045785036712720566e-50 -69.50:65544085401917930254e-50 -69.25:84160271569614584159e-50 -69.00:10806392777072784945e-49 -68.75:13875682988472282558e-49 -68.50:17816729631100128627e-49 -68.25:22877133688586173275e-49 -68.00:29374821117108029466e-49 -67.75:37718016925022505322e-49 -67.50:48430892398787308141e-49 -67.25:62186496792912045045e-49 -67.00:79849042456869788084e-49 -66.75:10252820001279939066e-48 -66.50:13164881474367883936e-48 -66.25:1690404242076995063e-47 -66.00:2170522011303639412e-47 -65.75:27870054299940703276e-48 -65.50:35785858085591342804e-48 -65.25:45949951339879806699e-48 -65.00:59000905415970613914e-48 -64.75:75758662161695690827e-48 -64.50:97276047749877143426e-48 -64.25:12490491774577263648e-47 -64.00:1603810890548637853e-46 -63.75:20593339470250524694e-47 -63.50:26442371294280543444e-47 -63.25:33952676819350548893e-47 -63.00:43596100000630809736e-47 -62.75:55978500469270422248e-47 -62.50:71877817390609886133e-47 -62.25:92292944425583250339e-47 -62.00:11850648642339810063e-46 -61.75:15216534061000392514e-46 -61.50:19538416488219240091e-46 -61.25:25087823372704348409e-46 -61.00:3221340285992516089e-45 -60.75:41362828030145487931e-46 -60.50:53110922496790953416e-46 -60.25:68195774389612347283e-46 -60.00:87565107626965203385e-46 -59.75:11243582380802092517e-45 -59.50:1443704555157235529e-44 -59.25:18537533430097598089e-45 -59.00:23802664086944006059e-45 -58.75:30563225672516617073e-45 -58.50:39243958579474627186e-45 -58.25:50390240267486375548e-45 -58.00:64702349256454603262e-45 -57.75:83079460964694902339e-45 -57.50:10667613948338532507e-44 -57.25:13697487445079347359e-44 -57.00:1758792202424311649e-43 -56.75:2258333890585027333e-43 -56.50:28997581148784881061e-44 -56.25:37233631217505104293e-44 -56.00:47808928838854690813e-44 -55.75:61387879773704975006e-44 -55.50:78823597906008507933e-44 -55.25:1012115031460895615e-42 -55.00:12995814250075030736e-43 -54.75:16686955807649079951e-43 -54.50:21426475384166537618e-43 -54.25:27512138983304074257e-43 -54.00:35326285722008070297e-43 -53.75:45359848744231624988e-43 -53.50:58243198684704939568e-43 -53.25:74785747460355176767e-43 -53.00:96026800545086760302e-43 -52.75:12330085258309566847e-42 -52.50:15832142861596320162e-42 -52.25:20328873834921066848e-42 -52.00:26102790696677048047e-42 -51.75:33516646701013648448e-42 -51.50:43036226246244865914e-42 -51.25:55259608338502480501e-42 -51.00:7095474162284704139e-41 -50.75:91107691678247206731e-42 -50.50:11698459177061964686e-41 -50.25:15021118919431522539e-41 -50.00:1928749847963917783e-40 -49.75:24765638272182875672e-41 -49.50:31799709001977494982e-41 -49.25:40831634601813076879e-41 -49.00:52428856633634639372e-41 -48.75:67319984485464577081e-41 -48.50:86440571130360945577e-41 -48.25:11099189036438807005e-40 -48.00:14251640827409351063e-40 -47.75:18299469051898320814e-40 -47.50:23496983374528170976e-40 -47.25:30170723868383468759e-40 -47.00:38739976286871871129e-40 -46.75:4974311419422387845e-39 -46.50:63871422930584223502e-40 -46.25:82012530442882373902e-40 -46.00:10530617357553812379e-39 -45.75:13521580340512197092e-39 -45.50:17362052831002947254e-39 -45.25:22293317120883141026e-39 -45.00:28625185805493936445e-39 -44.75:36755466131663374597e-39 -44.50:47194952715261234164e-39 -44.25:60599518825771562567e-39 -44.00:77811322411337965157e-39 -43.75:9991171568224242818e-38 -43.50:12828918236087848928e-38 -43.25:16472657083745665699e-38 -43.00:21151310375910804866e-38 -42.75:27158820118920621185e-38 -42.50:34872615319944467343e-38 -42.25:4477732441718301199e-37 -42.00:57495222642935598067e-38 -41.75:73825327211649850516e-38 -41.50:94793596535047559454e-38 -41.25:12171738729024408987e-37 -41.00:15628821893349887681e-37 -40.75:20067804543947086326e-37 -40.50:25767571091549809481e-37 -40.25:33086216207858245787e-37 -40.00:42483542552915889953e-37 -39.75:54549948428879222214e-37 -39.50:70043520261686452206e-37 -39.25:8993766029028821023e-36 -39.00:11548224173015785986e-36 -38.75:14828213355760043407e-36 -38.50:19039802832864523191e-36 -38.25:24447590766121310119e-36 -38.00:31391327920480296287e-36 -37.75:40307262913476245811e-36 -37.50:51755550058018685349e-36 -37.25:66455441729150705396e-36 -37.00:85330476257440657943e-36 -36.75:10956650033262367229e-35 -36.50:14068617124461467672e-35 -36.25:18064461965456931424e-35 -36.00:23195228302435693883e-35 -35.75:29783262686202286388e-35 -35.50:38242466280971353519e-35 -35.25:49104298701591145602e-35 -35.00:63051167601469893856e-35 -34.75:80959301752126006249e-35 -34.50:1039538011670221944e-33 -34.25:13347932285976030013e-34 -34.00:17139084315420129663e-34 -33.75:22007019879753666488e-34 -33.50:28257572871156112102e-34 -33.25:36283441780470446345e-34 -33.00:46588861451033973642e-34 -32.75:59821282237671354351e-34 -32.50:76812046852020949067e-34 -32.25:98628620465804520664e-34 -32.00:12664165549094175723e-33 -31.75:16261110446178189415e-33 -31.50:20879679116459335505e-33 -31.25:26810038677818032222e-33 -31.00:34424771084699764584e-33 -30.75:4420228103641172961e-32 -30.50:56756852326327224619e-33 -30.25:72877240958196924193e-33 -30.00:93576229688401746049e-33 -29.75:12015425731771785743e-32 -29.50:1542811203191887833e-31 -29.25:19810087980489795691e-32 -29.00:25436656473769229103e-32 -28.75:3266131342787447136e-31 -28.50:41937956583795444253e-32 -28.25:53849402177540356665e-32 -28.00:69144001069402030094e-32 -27.75:88782654784596584473e-32 -27.50:11399918530443553453e-31 -27.25:14637785141259089276e-31 -27.00:18795288165390832948e-31 -26.75:24133627718332140455e-31 -26.50:30988191387218254416e-31 -26.25:39789625358372400943e-31 -26.00:51090890280633247199e-31 -25.75:65602001681537786682e-31 -25.50:84234637544686474059e-31 -25.25:10815941557285692308e-30 -25.00:13887943864964020595e-30 -24.75:17832472908146389494e-30 -24.50:22897348456455528941e-30 -24.25:29400777392844724843e-30 -24.00:37751345442790977516e-30 -23.75:48473687062702555447e-30 -23.50:62241446229077832321e-30 -23.25:79919598929539319543e-30 -23.00:10261879631701890304e-29 -22.75:13176514270095466813e-29 -22.50:16918979226151303613e-29 -22.25:21724399350790169583e-29 -22.00:27894680928689248077e-29 -21.75:35817479302831807357e-29 -21.50:45990553786523167791e-29 -21.25:59053039989440397431e-29 -21.00:75825604279119067279e-29 -20.75:97362003130095654095e-29 -20.50:12501528663867426289e-28 -20.25:16052280551856116087e-28 -20.00:2061153622438557828e-27 -19.75:26465736389091170007e-28 -19.50:33982678194950712251e-28 -19.25:43634622529437014933e-28 -19.00:560279643753726754e-26 -18.75:71941330303253835055e-28 -18.50:92374496619705948979e-28 -18.25:11861120151343829833e-27 -18.00:15229979744712628436e-27 -17.75:195556810878504954e-25 -17.50:25109991557439818035e-27 -17.25:32241867372567333107e-27 -17.00:41399377187851666597e-27 -16.75:53157852544244215455e-27 -16.50:68256033763348697554e-27 -16.25:87642482194436362887e-27 -16.00:11253517471925911451e-26 -15.75:1444980246109244758e-25 -15.50:18553913626159782407e-26 -15.25:2382369667501817918e-25 -15.00:30590232050182578837e-26 -14.75:39278635454810390256e-26 -14.50:50434766256788807589e-26 -14.25:64759521758422092483e-26 -14.00:83152871910356788406e-26 -13.75:10677040100347826947e-25 -13.50:13709590863840843645e-25 -13.25:17603463121561692986e-25 -13.00:22603294069810543258e-25 -12.75:29023204086504038856e-25 -12.50:37266531720786709929e-25 -12.25:47851173921290090896e-25 -12.00:61442123533282097587e-25 -11.75:78893248272002232423e-25 -11.50:10130093598630710729e-24 -11.25:13007297654067620979e-24 -11.00:16701700790245659313e-24 -10.75:21445408316589163929e-24 -10.50:27536449349747157857e-24 -10.25:35357500850409982405e-24 -10.00:45399929762484851536e-24 -9.75:58294663730868807758e-24 -9.50:74851829887700591471e-24 -9.25:9611165206139469382e-23 -9.00:1234098040866795495e-22 -8.75:15846132511575125041e-23 -8.50:20346836901064417437e-23 -8.25:26125855730166753249e-23 -8.00:33546262790251183882e-23 -7.75:43074254057568753685e-23 -7.50:5530843701478335831e-22 -7.25:71017438884254906358e-23 -7.00:911881965554516208e-21 -6.75:1170879620791174401e-21 -6.50:15034391929775724474e-22 -6.25:19304541362277092422e-22 -6.00:2478752176666358423e-21 -5.75:3182780796509667068e-21 -5.50:40867714384640669935e-22 -5.25:52475183991813842765e-22 -5.00:67379469990854670966e-22 -4.75:86516952031206341771e-22 -4.50:11108996538242306496e-21 -4.25:14264233908999255273e-21 -4.00:18315638888734180294e-21 -3.75:23517745856009108236e-21 -3.50:3019738342231850074e-20 -3.25:38774207831722009887e-21 -3.00:49787068367863942979e-21 -2.75:63927861206707572702e-21 -2.50:8208499862389879517e-20 -2.25:10539922456186433678e-20 -2.00:13533528323661269189e-20 -1.75:17377394345044512668e-20 -1.50:22313016014842982893e-20 -1.25:28650479686019010032e-20 -1.00:3678794411714423216e-19 -0.75:47236655274101470714e-20 -0.50:6065306597126334236e-19 -0.25:77880078307140486825e-20 0.00:1e+0 0.25:12840254166877414841e-19 0.50:16487212707001281468e-19 0.75:21170000166126746685e-19 1.00:27182818284590452354e-19 1.25:34903429574618413761e-19 1.50:44816890703380648226e-19 1.75:57546026760057304369e-19 2.00:73890560989306502272e-19 2.25:94877358363585257206e-19 2.50:12182493960703473438e-18 2.75:1564263188418817161e-17 3.00:20085536923187667741e-18 3.25:25790339917193062089e-18 3.50:33115451958692313751e-18 3.75:42521082000062783056e-18 4.00:54598150033144239078e-18 4.25:70105412346687858102e-18 4.50:9001713130052181355e-17 4.75:11558428452718765813e-17 5.00:14841315910257660342e-17 5.25:19056626845862999618e-17 5.50:24469193226422038792e-17 5.75:31419066028569419814e-17 6.00:40342879349273512261e-17 6.25:51801282466834202594e-17 6.50:66514163304436184069e-17 6.75:85405876252615155278e-17 7.00:10966331584284585993e-16 7.25:1408104848204695575e-15 7.50:18080424144560632069e-16 7.75:23215724146110567464e-16 8.00:29809579870417282747e-16 8.25:38276258214399062273e-16 8.50:49147688402991343754e-16 8.75:6310688108089023997e-15 9.00:81030839275753840077e-16 9.25:10404565716560723288e-15 9.50:13359726829661872276e-15 9.75:17154228809290985045e-15 10.00:22026465794806716517e-15 10.25:2828254192033497909e-14 10.50:36315502674246637739e-15 10.75:46630028453524329213e-15 11.00:59874141715197818455e-15 11.25:76879919764677763445e-15 11.50:98715771010760497428e-15 11.75:12675355900574341904e-14 12.00:16275479141900392081e-14 12.25:20898128886971296151e-14 12.50:26833728652087445696e-14 12.75:34455189613782370094e-14 13.00:44241339200892050333e-14 13.25:56807004002249126779e-14 13.50:72941636984770133186e-14 13.75:93658915823255445599e-14 14.00:12026042841647767777e-13 14.25:15441744670851405697e-13 14.50:19827592635375687671e-13 14.75:25459132895553061663e-13 15.00:32690173724721106393e-13 15.25:41975013938479676712e-13 15.50:53896984762830123678e-13 15.75:69205098318305803181e-13 16.00:88861105205078726368e-13 16.25:11409991763828444531e-12 16.50:1465071942895351691e-11 16.75:18811896119537229518e-12 17.00:24154952753575298215e-12 17.25:31015573274482230832e-12 17.50:39824784397576225022e-12 17.75:5113603538059727805e-11 18.00:65659969137330511139e-12 18.25:84309069231265055313e-12 18.50:10825498775023075725e-11 18.75:13900215575451639811e-11 19.00:17848230096318726084e-11 19.25:22917581086564340584e-11 19.50:29426756604150880657e-11 19.75:3778470341041358312e-10 20.00:48516519540979027797e-11 20.25:62296444219844548365e-11 20.50:7999021774755054067e-10 20.75:10270947267424175703e-10 21.00:13188157344832146972e-10 21.25:16933929230041595871e-10 21.50:21743595535764885455e-10 21.75:27919329318100222587e-10 22.00:35849128461315915617e-10 22.25:46031192110433541268e-10 22.50:59105220630232906143e-10 22.75:7589260554815570164e-9 23.00:97448034462489026e-7 23.25:12512575305609886385e-9 23.50:16066464720622478609e-9 23.75:20629749057596176166e-9 24.00:26489122129843472294e-9 24.25:34012706080464738693e-9 24.50:4367317909764641453e-8 24.75:56077471988933799045e-9 25.00:72004899337385872524e-9 25.25:92456120875245775651e-9 25.50:11871600913216965097e-8 25.75:15243437309343985937e-8 26.00:19572960942883876427e-8 26.25:25132179330499358875e-8 26.50:32270357037115483078e-8 26.75:4143595864124439884e-7 27.00:53204824060179861668e-8 27.25:68316346383670420573e-8 27.50:87719925131876492831e-8 27.75:11263461341927520006e-7 28.00:14462570642914751737e-7 28.25:18570308296144511349e-7 28.50:23844747847976778768e-7 28.75:30617262291312510388e-7 29.00:39313342971440420744e-7 29.25:50479331590291879204e-7 29.50:64816744779343202179e-7 29.75:83226347723639147632e-7 30.00:10686474581524462147e-6 30.25:13721704977464905311e-6 30.50:17619017951355631412e-6 30.75:22623266866618211942e-6 31.00:29048849665247425231e-6 31.25:37299461295718884905e-6 31.50:47893456332463727075e-6 31.75:61496415223907888198e-6 32.00:78962960182680695161e-6 32.25:10139044785146411902e-5 32.50:13018791205063293871e-5 32.75:16716458801852100004e-5 33.00:21464357978591606462e-5 33.25:27560781197395935993e-5 33.50:35388743561225987393e-5 33.75:45440046197258826949e-5 34.00:5834617425274548814e-4 34.25:74917970707017099022e-5 34.50:96196578554477641049e-5 34.75:12351885186234820941e-4 35.00:15860134523134307281e-4 35.25:20364815839791162985e-4 35.50:26148941144456966074e-4 35.75:33575905048954583547e-4 36.00:43112315471151952271e-4 36.25:55357308837219249338e-4 36.50:71080191546422440649e-4 36.75:91268772568639554088e-4 37.00:11719142372802611309e-3 37.25:15047676668460840439e-3 37.50:19321599304402836208e-3 37.75:24809424597909427774e-3 38.00:3185593175711375622e-2 38.25:40903826048404247573e-3 38.50:52521552285925158157e-3 38.75:67439008059022052463e-3 39.00:86593400423993746954e-3 39.25:11118812706182702103e-2 39.50:14276838118129198592e-2 39.75:18331823013614275199e-2 40.00:23538526683701998541e-2 40.25:30224066533255980371e-2 40.50:38808469624362032402e-2 40.75:49831061380435016884e-2 41.00:63984349353005494922e-2 41.25:82157530839486902849e-2 41.50:10549235777020814185e-1 41.75:13545486864326381243e-1 42.00:17392749415205010474e-1 42.25:22332732315204085594e-1 42.50:28675795916805715596e-1 42.75:368204508009290948e+1 43.00:47278394682293465615e-1 43.25:60706660432259368343e-1 43.50:77948894957253063996e-1 43.75:10008836232783585641e+0 44.00:12851600114359308276e+0 44.25:16501781191944436918e+0 44.50:21188706471076390949e+0 44.75:2720683765559810729e+1 45.00:34934271057485095348e+0 45.25:4485649195126980689e+1 45.50:57596875768879535865e+0 45.75:73955852409047626713e+0 46.00:94961194206024488745e+0 46.25:1219325869595561365e+2 46.50:15656454077855834166e+1 46.75:20103284971171326815e+1 47.00:25813128861900673962e+1 47.25:33144713542916378987e+1 47.50:42558654617939031863e+1 47.75:54646394229468838738e+1 48.00:70167359120976317387e+1 48.25:90096672533190013954e+1 48.50:11568641749160830075e+2 48.75:14854430042477437334e+2 49.00:19073465724950996905e+2 49.25:24490814775159559005e+2 49.50:31446828646696548517e+2 49.75:40378527256582541339e+2 50.00:51847055285870724641e+2 50.25:66572936767472526876e+2 50.50:85481342872980576923e+2 50.75:10976021690150658605e+3 51.00:14093490824269387964e+3 51.25:18096400428217362072e+3 51.50:2323623810039002176e+4 51.75:29835920309108872329e+3 52.00:38310080007165768493e+3 52.25:49191116444541740149e+3 52.50:63162643790037920251e+3 52.75:81102440011602827585e+3 53.00:10413759433029087797e+4 53.25:13371531795281072966e+4 53.50:17169386685189163673e+4 53.75:22045928892722976404e+4 54.00:28307533032746939004e+4 54.25:36347591897774894756e+4 54.50:46671231832136385508e+4 54.75:59927047900589106814e+4 55.00:76947852651420171382e+4 55.25:98802998563966718928e+4 55.50:12686556140109568975e+5 55.75:16289860534136614536e+5 56.00:20916594960129961539e+5 56.25:26857439559369587339e+5 56.50:34485635021385366422e+5 56.75:44280431878075715825e+5 57.00:56857199993359322226e+5 57.25:73006089913171456063e+5 57.50:93741675021502699374e+5 57.75:12036669333049185121e+6 58.00:15455389355901039304e+6 58.25:19845112757782116459e+6 58.50:25481629178026396623e+6 58.75:32719059523197855451e+6 59.00:4201210403790514255e+7 59.25:53944609393199897211e+6 59.50:69266249554160951309e+6 59.75:889396249461786033e+8 60.00:11420073898156842837e+7 60.25:14663665145685640327e+7 60.50:18828518748858515756e+7 60.75:24176296632116008646e+7 61.00:31042979357019199087e+7 61.25:39859974504125534321e+7 61.50:51181220371822540943e+7 61.75:65717987814516561268e+7 62.00:84383566687414544891e+7 62.25:10835064437740528235e+8 62.50:13912498129508311164e+8 62.75:17864001207909333228e+8 63.00:22937831594696098791e+8 63.25:29452758771292899986e+8 63.50:3781809085391289879e+9 63.75:48559389867030375025e+8 64.00:62351490808116168829e+8 64.25:8006089896599324668e+9 64.50:10280022915520464989e+9 64.75:13199810707660696131e+9 65.00:16948892444103337141e+9 65.25:21762808682935500663e+9 65.50:27943999487401854681e+9 65.75:35880805585733200894e+9 66.00:46071866343312915427e+9 66.25:59157447379054298782e+9 66.50:75959666021073336335e+9 66.75:97534141814170368893e+9 67.00:12523631708422137805e+10 67.25:16080661422850547256e+10 67.50:20647977984090163798e+10 67.75:26512528534780684974e+10 68.00:34042760499317405214e+10 68.25:43711769735337017573e+10 68.50:56127023348574721279e+10 68.75:72068524542596251832e+10 69.00:92537817255877876002e+10 69.25:11882090936135266395e+11 69.50:1525690676539272172e+12 69.75:19590256066799411611e+11 70.00:25154386709191670063e+11 70.25:32298871875794420422e+11 70.50:41472572418860905091e+11 70.75:53251837081240408409e+11 71.00:68376712297627438668e+11 71.25:8779743649969888934e+12 71.50:11273413998564138954e+12 71.75:14475350106999736396e+12 72.00:18586717452841279803e+12 72.25:23865817622241841327e+12 72.50:30644316416992723992e+12 72.75:39348081156440079544e+12 73.00:50523936302761041946e+12 73.25:64874018363857655767e+12 73.50:83299888461860519478e+12 73.75:10695917399228284257e+13 74.00:13733829795401761878e+13 74.25:17634586525759266668e+13 74.50:22643257311854073807e+13 74.75:2907451790502117624e+14 75.00:37332419967990016403e+13 75.25:47935776105360141408e+13 75.50:615507548879353372e+15 75.75:79032733692426212242e+13 76.00:10148003881138887278e+14 76.25:13030294912028177541e+14 76.50:16731229853981138431e+14 76.75:21483324384956511381e+14 77.00:27585134545231702063e+14 77.25:35420013878828548428e+14 77.50:45480198079848413399e+14 77.75:58397730290518379155e+14 78.00:74984169969901204347e+14 78.25:96281580090586825727e+14 78.50:12362799599516990337e+15 78.75:1587414890719684706e+16 79.00:20382810665126687668e+15 79.25:26172046957556636282e+15 79.50:33605573500247796662e+15 79.75:43150410516686200204e+15 80.00:55406223843935100526e+15 80.25:71142999658303045143e+15 80.50:9134941978066841756e+16 80.75:11729497679805617914e+16 81.00:15060973145850305484e+16 81.25:19338672319323323195e+16 81.50:24831346783006822105e+16 81.75:31884080399968143772e+16 82.00:40939969621274546967e+16 82.25:52567961552140528084e+16 82.50:67498598736412415156e+16 82.75:86669916368360612187e+16 83.00:11128637547917594121e+17 83.25:14289453464631734428e+17 83.50:18348021439163854018e+17 83.75:23559325873817981842e+17 84.00:30250773222011423383e+17 84.25:38842761691519589936e+17 84.50:49875093266256083711e+17 84.75:6404088741354443731e+18 85.00:82230127146229135103e+17 85.25:10558557327322282771e+18 85.50:13557455971836400187e+18 85.75:17408118053462942925e+18 86.00:22352466037347150474e+18 86.25:2870113451760326459e+19 86.50:36852986208376451985e+18 86.75:47320170972398163873e+18 87.00:60760302250568721495e+18 87.25:78017772415359619297e+18 87.50:10017680273468151854e+19 87.75:12862956087384511746e+19 88.00:16516362549940018555e+19 88.25:21207429305352540792e+19 88.50:27230878250681116121e+19 88.75:34965139792603977031e+19 89.00:44896128191743452463e+19 89.25:57647769709069644146e+19 89.50:7402120152180711149e+20 89.75:95045104127765660391e+19 90.00:1220403294317840802e+21 90.25:15670288485135579448e+20 90.50:20121048701743329676e+20 90.75:25835937943450318708e+20 91.00:33174000983357426258e+20 91.25:42596260435855064996e+20 91.50:54694681055488356515e+20 91.75:70229360632876557178e+20 92.00:90176284050342989314e+20 92.25:11578864070309379322e+21 92.50:14867555762649719192e+21 92.75:19090319483264537812e+21 93.00:24512455429200857856e+21 93.25:31474615796519322531e+21 93.50:40414206663212293443e+21 93.75:51892868550835663453e+21 94.00:66631762164108958342e+21 94.25:85556876177408492502e+21 94.50:10985720358419844238e+22 94.75:14105944160835045224e+22 95.00:18112390828890232822e+22 95.25:23256770181277008566e+22 95.50:29862284022825251975e+22 95.75:38343931685655879194e+22 96.00:49234582860120583998e+22 96.25:63218455772413467762e+22 96.50:8117410401552875886e+23 96.75:10422961273279338382e+23 97.00:13383347192042695005e+23 97.25:17184557954939336403e+23 97.50:2206540918868562407e+24 97.75:28332546227887578202e+23 98.00:36379709476088045793e+23 98.25:46712471619012930437e+23 98.50:5998000083511737607e+24 98.75:77015845565242671006e+23 99.00:98890303193469467706e+23 99.25:12697766276437172563e+24 99.50:16304254634105792122e+24 99.75:20935077350340729796e+24 100.00:26881171418161354484e+24 100.25:34516107331259239871e+24 100.50:4431955909845895416e+25 100.75:56907440338815742922e+24 101.00:73070599793680672726e+24 101.25:93824507347704022713e+24 101.50:12047305214265772033e+25 101.75:15469046097712008637e+25 102.00:19862648361376543259e+25 102.25:25504145338738601552e+25 102.50:32747970845838552539e+25 102.75:42049226911005857362e+25 103.00:53992276105801688698e+25 103.25:69327454824671601441e+25 103.50:89018214069149526772e+25 103.75:11430164941293829253e+26 104.00:14676622301554423285e+26 104.25:18845156066322017808e+26 104.50:24197659370604648107e+26 104.75:31070409656208665623e+26 105.00:39895195705472158508e+26 105.25:51226445289557882906e+26 105.50:65776057758356352562e+26 105.75:84458129971250466654e+26 106.00:10844638552900230813e+27 106.25:13924791536715664689e+27 106.50:17879786255221267423e+27 106.75:22958099996648240809e+27 107.00:29478783914555093774e+27 107.25:37851507799334495336e+27 107.50:48602298074299772045e+27 107.75:62406586036834580316e+27 108.00:80131642640005911411e+27 108.25:10289106583070678347e+28 108.50:13211474367671911753e+28 108.75:16963868880009342429e+28 109.00:21782038807290206356e+28 109.25:27968691455839362744e+28 109.50:35912510700795012746e+28 109.75:46112576516891291178e+28 110.00:5920972027664670299e+29 110.25:76026785750185898786e+28 110.50:97620325252312095227e+28 110.75:1253469788092928904e+30 111.00:16094870669615180549e+29 111.25:20666223018087941005e+29 111.50:26535955622162162862e+29 111.75:34072841474954187489e+29 112.00:43750394472613410735e+29 112.25:56176618492950496549e+29 112.50:72132205968519045371e+29 112.75:92619585825333660519e+29 113.00:1189259022828200882e+31 113.25:15270388123366368993e+30 113.50:19607566473089040657e+30 113.75:251766137108407451e+32 114.00:32327411910848593114e+30 114.25:4150921854926362193e+31 114.50:53298891644100750211e+30 114.75:68437131552311248574e+30 115.00:87875016358370231131e+30 115.25:11283375449599843527e+31 115.50:14488140863316671496e+31 115.75:18603141109050883756e+31 116.00:23886906014249914255e+31 116.25:30671394448328164271e+31 116.50:39382850036908651969e+31 116.75:5056858042899246693e+32 117.00:64931342556644621362e+31 117.25:83373494182390091402e+31 117.50:10705368560825642761e+32 117.75:13745965327109993311e+32 118.00:17650168856917655833e+32 118.25:22663265421112690832e+32 118.50:29100208825849105824e+32 118.75:37365407763311190463e+32 119.00:4797813327299302186e+33 119.25:61605142567754859039e+32 119.50:7910256885566915324e+33 119.75:10156970893597134655e+33 120.00:13041808783936322797e+33 Math-BigInt-1.999715/t/author-blog-mbf.t0000644403072340010010000001450412632346417017664 0ustar ospjaDomain Users#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } use strict; use warnings; use Test::More tests => 139; use Scalar::Util qw< refaddr >; my $class; BEGIN { $class = 'Math::BigFloat'; } BEGIN { use_ok($class) } while () { s/#.*$//; # remove comments s/\s+$//; # remove trailing whitespace next unless length; # skip empty lines # $in0 - the x value # $in1 - the base # $out0 - the wanted output value # $type - the type of the wanted number (real, non-real, ...) # $expr - mathematical expression of the wanted number my ($in0, $in1, $out0, $type, $expr) = split /:/; # Some of the test data use rational numbers. # - with Math::BigInt, we skip them # - with Math::BigFloat, we convert them to floats # - with Math::BigRat, we use them as they are $in0 = eval $in0 if $in0 =~ m|/|; $in1 = eval $in1 if $in1 =~ m|/|; $out0 = eval $out0 if $out0 =~ m|/|; my ($x, $y); # input values as objects my ($yo); # copy of input value my ($got); # test output my $test = qq|\$x = $class -> new("$in0"); | . qq|\$y = $class -> new("$in1"); | . qq|\$yo = \$y -> copy(); | . qq|\$got = \$x -> blog(\$y);|; my $desc = "logarithm of $in0 to base $in1"; print("#\n", "# Now about to execute the following test.\n", "#\n", "# $test\n", "#\n"); if ($in0 ne 'NaN' && $in1 ne 'NaN') { print("# Enter log($in1, $in0) into Wolfram Alpha", " (http://www.wolframalpha.com/), and it says that the result", " is ", length($type) ? $type : "real", length($expr) ? ": $expr" : "", ".", "\n", "#\n"); } eval $test; die $@ if $@; # this should never happen subtest $desc, sub { plan tests => 5, # Check output. is(ref($got), $class, "output arg is a $class"); is($got, $out0, 'output arg has the right value'); is(refaddr($got), refaddr($x), 'output arg is the invocand'); # The second argument (if the invocand is the first) shall *not* be # modified. is(ref($y), $class, "second input arg is still a $class"); is_deeply($y, $yo, 'second output arg is unmodified'); }; } __END__ # base = -inf -inf:-inf:NaN:undefined: -4:-inf:0:: -2:-inf:0:: -1:-inf:0:: -1/2:-inf:0:: 0:-inf:NaN:undefined: 1/2:-inf:0:: 1:-inf:0:: 2:-inf:0:: 4:-inf:0:: inf:-inf:NaN:undefined: NaN:-inf:NaN:undefined: # base = -4 -4:-4:1:: -2:-4:NaN:non-real and finite:(log(2)+i pi)/(log(4)+i pi) 0:-4:NaN:non-real (directed) infinity:(-sqrt(pi^2+log^2(4))/(log(4)+i pi))infinity 1/2:-4:NaN:non-real and finite:-(log(2))/(log(4)+i pi) 1:-4:0:: 2:-4:NaN:non-real and finite:(log(2))/(log(4)+i pi) 4:-4:NaN:non-real and finite:(log(4))/(log(4)+i pi) NaN:-4:NaN:undefined: # base = -2 -inf:-2:NaN:non-real (directed) infinity:sqrt(pi^2+log^2(2))/(log(2)+i pi)infinity -4:-2:NaN:non-real and finite:(log(4)+i pi)/(log(2)+i pi) -2:-2:1:: -1:-2:NaN:non-real and finite:(i pi)/(log(2)+i pi) -1/2:-2:NaN:non-real and finite:(-log(2)+i pi)/(log(2)+i pi) 0:-2:NaN:complex infinity: 1/2:-2:NaN:non-real and finite:-(log(2))/(log(2)+i pi) 1:-2:0:: 2:-2:NaN:non-real and finite:(log(2))/(log(2)+i pi) 4:-2:NaN:non-real and finite:(log(4))/(log(2)+i pi) inf:-2:NaN:non-real (directed) infinity: NaN:-2:NaN:undefined: # base = -1 -inf:-1:NaN:non-real (directed) infinity: -4:-1:NaN:non-real and finite:-(i (log(4)+i pi))/pi -2:-1:NaN:non-real and finite:-(i (log(2)+i pi))/pi -1:-1:1:: -1/2:-1:NaN:non-real and finite:-(i (-log(2)+i pi))/pi 0:-1:NaN:complex infinity: 1:-1:0:: 1/2:-1:NaN:non-real and finite:(i log(2))/pi 2:-1:NaN:non-real and finite:-(i log(2))/pi 4:-1:NaN:non-real and finite:-(i log(4))/pi inf:-1:NaN:non-real (directed) infinity: NaN:-1:NaN:undefined: # base = -1/2 -inf:-1/2:NaN:non-real (directed) infinity: -4:-1/2:NaN:non-real and finite:(log(4)+i pi)/(-log(2)+i pi) -2:-1/2:NaN:non-real and finite:(log(2)+i pi)/(-log(2)+i pi) -1:-1/2:NaN:non-real and finite:(i pi)/(-log(2)+i pi) -1/2:-1/2:1:: 0:-1/2:NaN:complex infinity: 1:-1/2:0:: 1/2:-1/2:NaN:non-real and finite:-(log(2))/(-log(2)+i pi) 2:-1/2:NaN:non-real and finite:(log(2))/(-log(2)+i pi) 4:-1/2:NaN:non-real and finite:(log(4))/(-log(2)+i pi) inf:-1/2:NaN:non-real (directed) infinity: NaN:-1/2:NaN:undefined: # base = 0 -inf:0:NaN:undefined: -4:0:0:: -2:0:0:: -1:0:0:: -1/2:0:0:: 0:0:NaN:undefined: 1/2:0:0:: 1:0:0:: 2:0:0:: 4:0:0:: inf:0:NaN:undefined: NaN:0:NaN:undefined: # base = 1/2 -inf:1/2:-inf:: -2:-1/2:NaN:non-real and finite:(log(2)+i pi)/(-log(2)+i pi) -1:1/2:NaN:non-real and finite:-(i pi)/(log(2)) -1/2:1/2:NaN:non-real and finite:-(-log(2)+i pi)/(log(2)) 0:1/2:inf:: 1/2:1/2:1:: 1:1/2:0:: 2:1/2:-1:: inf:1/2:-inf:: NaN:1/2:NaN:undefined: # base = 1 -inf:1:NaN:complex infinity: -4:1:NaN:complex infinity: -2:1:NaN:complex infinity: -1:1:NaN:complex infinity: -1/2:1:NaN:complex infinity: 0:1:NaN:complex infinity: 1/2:1:NaN:complex infinity: 1:1:NaN:undefined: 2:1:NaN:complex infinity: 4:1:NaN:complex infinity: inf:1:NaN:complex infinity: NaN:1:NaN:undefined: # base = 2 -inf:2:inf:: -4:2:NaN:non-real and finite:(log(4)+i pi)/(log(2)) -2:2:NaN:non-real and finite:(log(2)+i pi)/(log(2)) -1:2:NaN:non-real and finite:(i pi)/(log(2)) -1/2:2:NaN:non-real and finite:(-log(2)+i pi)/(log(2)) 0:2:-inf:: 1/2:2:-1:: 1:2:0:: 2:2:1:: 4:2:2:: 4:4:1:: inf:2:inf:: NaN:2:NaN:undefined: # base = 4 -inf:4:inf:: -4:4:NaN:non-real and finite:(log(4)+i pi)/(log(4)) -2:4:NaN:non-real and finite:(log(2)+i pi)/(log(4)) -1/2:4:NaN:non-real and finite:(-log(2)+i pi)/(log(4)) 0:4:-inf:: 1:4:0:: 1/2:4:-1/2:: 2:4:1/2:: 4:4:1:: inf:4:inf:: NaN:4:NaN:undefined: # base = inf -inf:inf:NaN:undefined: -4:inf:0:: -2:inf:0:: -1:inf:0:: -1/2:inf:0:: 0:inf:NaN:undefined: 1:inf:0:: 1/2:inf:0:: 2:inf:0:: 4:inf:0:: inf:inf:NaN:undefined: NaN:inf:NaN:undefined: # base is NaN -inf:NaN:NaN:undefined: -4:NaN:NaN:undefined: -2:NaN:NaN:undefined: -1:NaN:NaN:undefined: -1/2:NaN:NaN:undefined: 0:NaN:NaN:undefined: 1:NaN:NaN:undefined: 1/2:NaN:NaN:undefined: 2:NaN:NaN:undefined: 4:NaN:NaN:undefined: inf:NaN:NaN:undefined: NaN:NaN:NaN:undefined: Math-BigInt-1.999715/t/author-blog-mbi.t0000644403072340010010000001443712632346321017666 0ustar ospjaDomain Users#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } use strict; use warnings; use Test::More tests => 97; use Scalar::Util qw< refaddr >; my $class; BEGIN { $class = 'Math::BigInt'; } BEGIN { use_ok($class) } while () { s/#.*$//; # remove comments s/\s+$//; # remove trailing whitespace next unless length; # skip empty lines # $in0 - the x value # $in1 - the base # $out0 - the wanted output value # $type - the type of the wanted number (real, non-real, ...) # $expr - mathematical expression of the wanted number my ($in0, $in1, $out0, $type, $expr) = split /:/; # Some of the test data use rational numbers. # - with Math::BigInt, we skip them # - with Math::BigFloat, we convert them to floats # - with Math::BigRat, we use them as they are next if ($in0 =~ m|/| || $in1 =~ m|/| || $out0 =~ m|/|); my ($x, $y); # input values as objects my ($yo); # copy of input value my ($got); # test output my $test = qq|\$x = $class -> new("$in0"); | . qq|\$y = $class -> new("$in1"); | . qq|\$yo = \$y -> copy(); | . qq|\$got = \$x -> blog(\$y);|; my $desc = "logarithm of $in0 to base $in1"; print("#\n", "# Now about to execute the following test.\n", "#\n", "# $test\n", "#\n"); if ($in0 ne 'NaN' && $in1 ne 'NaN') { print("# Enter log($in1, $in0) into Wolfram Alpha", " (http://www.wolframalpha.com/), and it says that the result", " is ", length($type) ? $type : "real", length($expr) ? ": $expr" : "", ".", "\n", "#\n"); } eval $test; die $@ if $@; # this should never happen subtest $desc, sub { plan tests => 5, # Check output. is(ref($got), $class, "output arg is a $class"); is($got, $out0, 'output arg has the right value'); is(refaddr($got), refaddr($x), 'output arg is the invocand'); # The second argument (if the invocand is the first) shall *not* be # modified. is(ref($y), $class, "second input arg is still a $class"); is_deeply($y, $yo, 'second output arg is unmodified'); }; } __END__ # base = -inf -inf:-inf:NaN:undefined: -4:-inf:0:: -2:-inf:0:: -1:-inf:0:: -1/2:-inf:0:: 0:-inf:NaN:undefined: 1/2:-inf:0:: 1:-inf:0:: 2:-inf:0:: 4:-inf:0:: inf:-inf:NaN:undefined: NaN:-inf:NaN:undefined: # base = -4 -4:-4:1:: -2:-4:NaN:non-real and finite:(log(2)+i pi)/(log(4)+i pi) 0:-4:NaN:non-real (directed) infinity:(-sqrt(pi^2+log^2(4))/(log(4)+i pi))infinity 1/2:-4:NaN:non-real and finite:-(log(2))/(log(4)+i pi) 1:-4:0:: 2:-4:NaN:non-real and finite:(log(2))/(log(4)+i pi) 4:-4:NaN:non-real and finite:(log(4))/(log(4)+i pi) NaN:-4:NaN:undefined: # base = -2 -inf:-2:NaN:non-real (directed) infinity:sqrt(pi^2+log^2(2))/(log(2)+i pi)infinity -4:-2:NaN:non-real and finite:(log(4)+i pi)/(log(2)+i pi) -2:-2:1:: -1:-2:NaN:non-real and finite:(i pi)/(log(2)+i pi) -1/2:-2:NaN:non-real and finite:(-log(2)+i pi)/(log(2)+i pi) 0:-2:NaN:complex infinity: 1/2:-2:NaN:non-real and finite:-(log(2))/(log(2)+i pi) 1:-2:0:: 2:-2:NaN:non-real and finite:(log(2))/(log(2)+i pi) 4:-2:NaN:non-real and finite:(log(4))/(log(2)+i pi) inf:-2:NaN:non-real (directed) infinity: NaN:-2:NaN:undefined: # base = -1 -inf:-1:NaN:non-real (directed) infinity: -4:-1:NaN:non-real and finite:-(i (log(4)+i pi))/pi -2:-1:NaN:non-real and finite:-(i (log(2)+i pi))/pi -1:-1:1:: -1/2:-1:NaN:non-real and finite:-(i (-log(2)+i pi))/pi 0:-1:NaN:complex infinity: 1:-1:0:: 1/2:-1:NaN:non-real and finite:(i log(2))/pi 2:-1:NaN:non-real and finite:-(i log(2))/pi 4:-1:NaN:non-real and finite:-(i log(4))/pi inf:-1:NaN:non-real (directed) infinity: NaN:-1:NaN:undefined: # base = -1/2 -inf:-1/2:NaN:non-real (directed) infinity: -4:-1/2:NaN:non-real and finite:(log(4)+i pi)/(-log(2)+i pi) -2:-1/2:NaN:non-real and finite:(log(2)+i pi)/(-log(2)+i pi) -1:-1/2:NaN:non-real and finite:(i pi)/(-log(2)+i pi) -1/2:-1/2:1:: 0:-1/2:NaN:complex infinity: 1:-1/2:0:: 1/2:-1/2:NaN:non-real and finite:-(log(2))/(-log(2)+i pi) 2:-1/2:NaN:non-real and finite:(log(2))/(-log(2)+i pi) 4:-1/2:NaN:non-real and finite:(log(4))/(-log(2)+i pi) inf:-1/2:NaN:non-real (directed) infinity: NaN:-1/2:NaN:undefined: # base = 0 -inf:0:NaN:undefined: -4:0:0:: -2:0:0:: -1:0:0:: -1/2:0:0:: 0:0:NaN:undefined: 1/2:0:0:: 1:0:0:: 2:0:0:: 4:0:0:: inf:0:NaN:undefined: NaN:0:NaN:undefined: # base = 1/2 -inf:1/2:-inf:: -2:-1/2:NaN:non-real and finite:(log(2)+i pi)/(-log(2)+i pi) -1:1/2:NaN:non-real and finite:-(i pi)/(log(2)) -1/2:1/2:NaN:non-real and finite:-(-log(2)+i pi)/(log(2)) 0:1/2:inf:: 1/2:1/2:1:: 1:1/2:0:: 2:1/2:-1:: inf:1/2:-inf:: NaN:1/2:NaN:undefined: # base = 1 -inf:1:NaN:complex infinity: -4:1:NaN:complex infinity: -2:1:NaN:complex infinity: -1:1:NaN:complex infinity: -1/2:1:NaN:complex infinity: 0:1:NaN:complex infinity: 1/2:1:NaN:complex infinity: 1:1:NaN:undefined: 2:1:NaN:complex infinity: 4:1:NaN:complex infinity: inf:1:NaN:complex infinity: NaN:1:NaN:undefined: # base = 2 -inf:2:inf:: -4:2:NaN:non-real and finite:(log(4)+i pi)/(log(2)) -2:2:NaN:non-real and finite:(log(2)+i pi)/(log(2)) -1:2:NaN:non-real and finite:(i pi)/(log(2)) -1/2:2:NaN:non-real and finite:(-log(2)+i pi)/(log(2)) 0:2:-inf:: 1/2:2:-1:: 1:2:0:: 2:2:1:: 4:2:2:: 4:4:1:: inf:2:inf:: NaN:2:NaN:undefined: # base = 4 -inf:4:inf:: -4:4:NaN:non-real and finite:(log(4)+i pi)/(log(4)) -2:4:NaN:non-real and finite:(log(2)+i pi)/(log(4)) -1/2:4:NaN:non-real and finite:(-log(2)+i pi)/(log(4)) 0:4:-inf:: 1:4:0:: 1/2:4:-1/2:: 2:4:1/2:: 4:4:1:: inf:4:inf:: NaN:4:NaN:undefined: # base = inf -inf:inf:NaN:undefined: -4:inf:0:: -2:inf:0:: -1:inf:0:: -1/2:inf:0:: 0:inf:NaN:undefined: 1:inf:0:: 1/2:inf:0:: 2:inf:0:: 4:inf:0:: inf:inf:NaN:undefined: NaN:inf:NaN:undefined: # base is NaN -inf:NaN:NaN:undefined: -4:NaN:NaN:undefined: -2:NaN:NaN:undefined: -1:NaN:NaN:undefined: -1/2:NaN:NaN:undefined: 0:NaN:NaN:undefined: 1:NaN:NaN:undefined: 1/2:NaN:NaN:undefined: 2:NaN:NaN:undefined: 4:NaN:NaN:undefined: inf:NaN:NaN:undefined: NaN:NaN:NaN:undefined: Math-BigInt-1.999715/t/author-bpi-mbf.t0000644403072340010010000000514712641524264017514 0ustar ospjaDomain Users#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for testing by the author'); } } use strict; use warnings; use Test::More tests => 19; use Math::BigFloat; my $pi = { 16 => '3.141592653589793', 40 => '3.141592653589793238462643383279502884197', }; # Called as class method without argument. { my $x = Math::BigFloat -> bpi(); isa_ok($x, 'Math::BigFloat'); is($x, $pi -> {40}, 'Math::BigFloat -> bpi()'); } # Called as class method with scalar argument. { my $x = Math::BigFloat -> bpi(16); isa_ok($x, 'Math::BigFloat'); is($x, $pi -> {16}, '$x = Math::BigFloat->bpi(16)'); } # Called as class method with class argument. { my $n = Math::BigFloat -> new("16"); my $x = Math::BigFloat -> bpi($n); isa_ok($x, 'Math::BigFloat'); is($x, $pi -> {16}, '$n = Math::BigFloat->new("16"); $x = Math::BigFloat->bpi($n)'); } # Called as instance method without argument. { my $x = Math::BigFloat -> bnan(); $x -> bpi(); isa_ok($x, 'Math::BigFloat'); is($x, $pi -> {40}, '$x = Math::BigFloat -> bnan(); $x->bpi()'); } # Called as instance method with scalar argument. { my $x = Math::BigFloat -> bnan(); $x -> bpi(16); isa_ok($x, 'Math::BigFloat'); is($x, $pi -> {16}, '$x = Math::BigFloat -> bnan(); $x->bpi(16)'); } # Called as instance method with instance argument. { my $n = Math::BigFloat -> new("16"); my $x = Math::BigFloat -> bnan(); $x -> bpi($n); isa_ok($x, 'Math::BigFloat'); is($x, $pi -> {16}, '$n = Math::BigFloat->new("16"); $x -> bpi($n)'); } # Called as function without argument. { my $x = Math::BigFloat::bpi(); isa_ok($x, 'Math::BigFloat'); is($x, $pi -> {40}, '$x = Math::BigFloat::bpi()'); } # Called as function with scalar argument. { my $x = Math::BigFloat::bpi(16); isa_ok($x, 'Math::BigFloat'); is($x, $pi -> {16}, '$x = Math::BigFloat::bpi(16)'); } # Called as function with instance argument. # # This is an ambiguous case. The argument list to bpi() is ($n), which is # assumed to mean $n->bpi(), since we favour the OO-style. So in the test # below, $n is assigned the value of pi with the default number of digits, and # then $n is assigned to $x. { my $n = Math::BigFloat -> new("16"); my $x = Math::BigFloat::bpi($n); isa_ok($x, 'Math::BigFloat'); is($x, $pi -> {40}, '$n = Math::BigFloat->new("16"); $x = Math::BigFloat::bpi($n)'); is($n, $pi -> {40}, '$n = Math::BigFloat->new("16"); $x = Math::BigFloat::bpi($n)'); } Math-BigInt-1.999715/t/bare_mbf.t0000644403072340010010000000043112641541031016413 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 2409; use lib 't'; use Math::BigFloat lib => 'BareCalc'; our ($CLASS, $CALC); $CLASS = "Math::BigFloat"; $CALC = "Math::BigInt::BareCalc"; # backend require 't/bigfltpm.inc'; # all tests here for sharing Math-BigInt-1.999715/t/bare_mbi.t0000644403072340010010000000056712641213026016430 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 3724; # tests in require'd file use lib 't'; use Math::BigInt lib => 'BareCalc'; print "# ", Math::BigInt->config()->{lib}, "\n"; our ($CLASS, $CALC); $CLASS = "Math::BigInt"; $CALC = "Math::BigInt::BareCalc"; # backend require 't/bigintpm.inc'; # perform same tests as bigintpm.t Math-BigInt-1.999715/t/bare_mif.t0000644403072340010010000000105712632034713016433 0ustar ospjaDomain Users#!perl # test rounding, accuracy, precision and fallback, round_mode and mixing # of classes under Math::BigInt::BareCalc use strict; use warnings; use Test::More tests => 684 # tests in require'd file + 1; # tests in this file use lib 't'; use Math::BigInt lib => 'BareCalc'; use Math::BigFloat lib => 'BareCalc'; our ($mbi, $mbf); $mbi = 'Math::BigInt'; $mbf = 'Math::BigFloat'; is(Math::BigInt->config()->{lib}, 'Math::BigInt::BareCalc', 'Math::BigInt->config()->{lib}'); require 't/mbimbf.inc'; Math-BigInt-1.999715/t/bigfltpm.inc0000644403072340010010000012104312641721332016777 0ustar ospjaDomain Users#include this file into another test for subclass testing... use strict; use warnings; our ($CLASS, $CALC); is($CLASS->config()->{lib}, $CALC, "$CLASS->config()->{lib}"); my ($x, $y, $z, @args, $try, $want, $got); my ($f, $setup); while () { s/#.*$//; # remove comments s/\s+$//; # remove trailing whitespace next unless length; # skip empty lines if (s/^&//) { $f = $_; next; } if (/^\$/) { $setup = $_; $setup =~ s/\$/\$${CLASS}::/g; # round_mode, div_scale #print "\$setup== $setup\n"; next; } if (m|^(.*?):(/.+)$|) { $want = $2; @args = split(/:/, $1, 99); } else { @args = split(/:/, $_, 99); $want = pop(@args); } $try = qq|\$x = $CLASS->new("$args[0]");|; if ($f eq "bnorm") { $try .= qq| \$x;|; } elsif ($f =~ /^is_(zero|one|negative|positive|odd|even|nan|int)$/) { $try .= qq| \$x->$f();|; } elsif ($f eq "is_inf") { $try .= qq| \$x->is_inf("$args[1]");|; } elsif ($f eq "binf") { $try .= qq| \$x->binf("$args[1]");|; } elsif ($f eq "bone") { $try .= qq| \$x->bone("$args[1]");|; } elsif ($f eq "bstr") { $try .= qq| \$x->accuracy($args[1]); \$x->precision($args[2]);|; $try .= ' $x->bstr();'; # some unary ops } elsif ($f =~ /^b(nan|sstr|neg|floor|ceil|int|abs)$/) { $try .= qq| \$x->$f();|; # overloaded functions } elsif ($f =~ /^(log|exp|sin|cos|atan2|int|neg|abs|sqrt)$/) { $try .= qq| \$x = $f(\$x);|; } elsif ($f eq "parts") { # ->bstr() to see if an object is returned $try .= ' ($a, $b) = $x->parts(); $a = $a->bstr(); $b = $b->bstr();'; $try .= ' "$a $b";'; } elsif ($f eq "exponent") { # ->bstr() to see if an object is returned $try .= ' $x->exponent()->bstr();'; } elsif ($f eq "mantissa") { # ->bstr() to see if an object is returned $try .= ' $x->mantissa()->bstr();'; } elsif ($f =~ /^(numify|length|as_number|as_hex|as_bin)$/) { $try .= qq| \$x->$f();|; } elsif ($f eq "bpi") { $try .= qq| $CLASS->bpi(\$x);|; } elsif ($f eq "binc") { $try .= ' ++$x;'; } elsif ($f eq "bdec") { $try .= ' --$x;'; } elsif ($f eq "bround") { $try .= qq| $setup; \$x->bround($args[1]);|; } elsif ($f eq "bfround") { $try .= qq| $setup; \$x->bfround($args[1]);|; } elsif ($f eq "bsqrt") { $try .= qq| $setup; \$x->bsqrt();|; } elsif ($f eq "bfac") { $try .= qq| $setup; \$x->bfac();|; } elsif ($f eq "blog") { if (defined $args[1] && $args[1] ne '') { $try .= qq| \$y = $CLASS->new($args[1]);|; $try .= qq| $setup; \$x->blog(\$y);|; } else { $try .= qq| $setup; \$x->blog();|; } } else { # binary operators $try .= qq| \$y = $CLASS->new("$args[1]");|; if ($f eq "bgcd") { if (defined $args[2]) { $try .= qq| \$z = $CLASS->new("$args[2]");|; } $try .= qq| $CLASS\::bgcd(\$x, \$y|; $try .= qq|, \$z| if defined $args[2]; $try .= qq|);|; } elsif ($f eq "blcm") { if (defined $args[2]) { $try .= qq| \$z = $CLASS->new("$args[2]");|; } $try .= qq| $CLASS\::blcm(\$x, \$y|; $try .= qq|, \$z| if defined $args[2]; $try .= qq|);|; } elsif ($f eq "bcmp") { $try .= ' $x->bcmp($y);'; } elsif ($f eq "bacmp") { $try .= ' $x->bacmp($y);'; } elsif ($f eq "bpow") { $try .= ' $x ** $y;'; } elsif ($f eq "bnok") { $try .= ' $x->bnok($y);'; } elsif ($f eq "bcos") { $try .= ' $x->bcos($y);'; } elsif ($f eq "bsin") { $try .= ' $x->bsin($y);'; } elsif ($f eq "batan") { $try .= ' $x->batan($y);'; } elsif ($f eq "broot") { $try .= qq| $setup; \$x->broot(\$y);|; } elsif ($f eq "badd") { $try .= ' $x + $y;'; } elsif ($f eq "bsub") { $try .= ' $x - $y;'; } elsif ($f eq "bmul") { $try .= ' $x * $y;'; } elsif ($f eq "bdiv") { $try .= qq| $setup; \$x / \$y;|; } elsif ($f eq "bdiv-list") { $try .= qq| $setup; join(",", \$x->bdiv(\$y));|; } elsif ($f eq "brsft") { $try .= ' $x >> $y;'; } elsif ($f eq "blsft") { $try .= ' $x << $y;'; } elsif ($f eq "bmod") { $try .= ' $x % $y;'; } else { # Functions with three arguments $try .= qq| \$z = $CLASS->new("$args[2]");|; if ($f eq "bmodpow") { $try .= ' $x->bmodpow($y, $z);'; } elsif ($f eq "bmuladd") { $try .= ' $x->bmuladd($y, $z);'; } elsif ($f eq "batan2") { $try .= ' $x->batan2($y, $z);'; } else { warn qq|Unknown op "$f"|; } } } $got = eval $try; print "# Error: $@\n" if $@; if ($want =~ m|^/(.*)$|) { my $pat = $1; like($got, qr/$pat/, $try); } else { if ($want eq "") { is($got, undef, $try); } else { is($got, $want, $try); if (ref($got) eq $CLASS) { # float numbers are normalized (for now), so mantissa shouldn't # have trailing zeros print $got->_trailing_zeros(), "\n"; is($CALC->_zeros($got->{_m}), 0, $try); } } } # end pattern or string } # end while # check whether $CLASS->new(Math::BigInt->new()) destroys it # ($y == 12 in this case) $x = Math::BigInt->new(1200); $y = $CLASS->new($x); is($y, 1200, q|$x = Math::BigInt->new(1200); $y = $CLASS->new($x); # check $y|); is($x, 1200, q|$x = Math::BigInt->new(1200); $y = $CLASS->new($x); # check $x|); ############################################################################### # Really huge, big, ultra-mega-biggy-monster exponents. Technically, the # exponents should not be limited (they are Math::BigInt objects), 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 and exponent is($CLASS->new($monster)->bsstr(), '1e+1234567890123456789012345678901234567890', qq|$CLASS->new("$monster")->bsstr()|); is($CLASS->new($monster)->exponent(), '1234567890123456789012345678901234567890', qq|$CLASS->new("$monster")->exponent()|); # cmp is($CLASS->new($monster) > 0, 1, qq|$CLASS->new("$monster") > 0|); # sub/mul is($CLASS->new($monster)->bsub($monster), 0, qq|$CLASS->new("$monster")->bsub("$monster")|); is($CLASS->new($monster)->bmul(2)->bsstr(), '2e+1234567890123456789012345678901234567890', qq|$CLASS->new("$monster")->bmul(2)->bsstr()|); # mantissa $monster = '1234567890123456789012345678901234567890e2'; is($CLASS->new($monster)->mantissa(), '123456789012345678901234567890123456789', qq|$CLASS->new("$monster")->mantissa()|); ############################################################################### # zero, inf, one, nan $x = $CLASS->new(2); $x->bzero(); is($x->{_a}, undef, qq|\$x = $CLASS->new(2); \$x->bzero(); \$x->{_a}|); is($x->{_p}, undef, qq|\$x = $CLASS->new(2); \$x->bzero(); \$x->{_p}|); $x = $CLASS->new(2); $x->binf(); is($x->{_a}, undef, qq|\$x = $CLASS->new(2); \$x->binf(); \$x->{_a}|); is($x->{_p}, undef, qq|\$x = $CLASS->new(2); \$x->binf(); \$x->{_p}|); $x = $CLASS->new(2); $x->bone(); is($x->{_a}, undef, qq|\$x = $CLASS->new(2); \$x->bone(); \$x->{_a}|); is($x->{_p}, undef, qq|\$x = $CLASS->new(2); \$x->bone(); \$x->{_p}|); $x = $CLASS->new(2); $x->bnan(); is($x->{_a}, undef, qq|\$x = $CLASS->new(2); \$x->bnan(); \$x->{_a}|); is($x->{_p}, undef, qq|\$x = $CLASS->new(2); \$x->bnan(); \$x->{_p}|); ############################################################################### # bone/binf etc as plain calls (Lite failed them) is($CLASS->bzero(), 0, qq|$CLASS->bzero()|); is($CLASS->bone(), 1, qq|$CLASS->bone()|); is($CLASS->bone("+"), 1, qq|$CLASS->bone("+")|); is($CLASS->bone("-"), -1, qq|$CLASS->bone("-")|); is($CLASS->bnan(), "NaN", qq|$CLASS->bnan()|); is($CLASS->binf(), "inf", qq|$CLASS->binf()|); is($CLASS->binf("+"), "inf", qq|$CLASS->binf("+")|); is($CLASS->binf("-"), "-inf", qq|$CLASS->binf("-")|); is($CLASS->binf("-inf"), "-inf", qq|$CLASS->binf("-inf")|); $CLASS->accuracy(undef); # reset $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); is($x, "0.0027", qq|\$x = $CLASS->new("0.008"); \$y = $CLASS->new(2); \$x->bdiv(3, \$y);|); ############################################################################### # Verify that numify() returns a normalized value, and underflows and # overflows when given "extreme" values. like($CLASS->new("12345e67")->numify(), qr/^1\.2345e\+?0*71$/, qq|$CLASS->new("12345e67")->numify()|); # underflow like($CLASS->new("1e-9999")->numify(), qr/^\+?0$/, qq|$CLASS->new("1e-9999")->numify()|); # overflow unlike($CLASS->new("1e9999")->numify(), qr/^1(\.0*)?e\+?9+$/, qq|$CLASS->new("1e9999")->numify()|); ############################################################################### # Check numify on non-finite objects. { require Math::Complex; my $inf = Math::Complex::Inf(); my $nan = $inf - $inf; is($CLASS -> binf("+") -> numify(), $inf, "numify of +Inf"); is($CLASS -> binf("-") -> numify(), -$inf, "numify of -Inf"); is($CLASS -> bnan() -> numify(), $nan, "numify of NaN"); } ############################################################################### # bsqrt() with set global A/P or A/P enabled on $x, also a test whether bsqrt() # correctly modifies $x $x = $CLASS->new(12); $CLASS->precision(-2); $x->bsqrt(); is($x, '3.46', qq|\$x = $CLASS->new(12); $CLASS->precision(-2); \$x->bsqrt();|); $CLASS->precision(undef); $x = $CLASS->new(12); $CLASS->precision(0); $x->bsqrt(); is($x, '3', qq|$CLASS->precision(undef); \$x = $CLASS->new(12);| . qq| $CLASS->precision(0); \$x->bsqrt();|); $CLASS->precision(-3); $x = $CLASS->new(12); $x->bsqrt(); is($x, '3.464', qq|$CLASS->precision(-3); \$x = $CLASS->new(12); \$x->bsqrt();|); { no strict 'refs'; # A and P set => NaN ${${CLASS}.'::accuracy'} = 4; $x = $CLASS->new(12); $x->bsqrt(3); is($x, 'NaN', "A and P set => NaN"); # supplied arg overrides set global $CLASS->precision(undef); $x = $CLASS->new(12); $x->bsqrt(3); is($x, '3.46', "supplied arg overrides set global"); # reset for further tests $CLASS->accuracy(undef); $CLASS->precision(undef); } ############################################################################# # can we call objectify (broken until v1.52) { no strict; $try = '@args' . " = $CLASS" . "::objectify(2, $CLASS, 4, 5);" . ' join(" ", @args);'; $want = eval $try; is($want, "$CLASS 4 5", $try); } ############################################################################# # is_one('-') (broken until v1.64) is($CLASS->new(-1)->is_one(), 0, qq|$CLASS->new(-1)->is_one()|); is($CLASS->new(-1)->is_one("-"), 1, qq|$CLASS->new(-1)->is_one("-")|); ############################################################################# # bug 1/0.5 leaving 2e-0 instead of 2e0 is($CLASS->new(1)->bdiv("0.5")->bsstr(), "2e+0", qq|$CLASS->new(1)->bdiv("0.5")->bsstr()|); ############################################################################### # [perl #30609] bug with $x -= $x not being 0, but 2*$x $x = $CLASS->new(3); $x -= $x; is($x, 0, qq|\$x = $CLASS->new(3); \$x -= \$x;|); $x = $CLASS->new(-3); $x -= $x; is($x, 0, qq|\$x = $CLASS->new(-3); \$x -= \$x;|); $x = $CLASS->new(3); $x += $x; is($x, 6, qq|\$x = $CLASS->new(3); \$x += \$x;|); $x = $CLASS->new(-3); $x += $x; is($x, -6, qq|\$x = $CLASS->new(-3); \$x += \$x;|); $x = $CLASS->new("NaN"); $x -= $x; is($x->is_nan(), 1, qq|\$x = $CLASS->new("NaN"); \$x -= \$x;|); $x = $CLASS->new("inf"); $x -= $x; is($x->is_nan(), 1, qq|\$x = $CLASS->new("inf"); \$x -= \$x;|); $x = $CLASS->new("-inf"); $x -= $x; is($x->is_nan(), 1, qq|\$x = $CLASS->new("-inf"); \$x -= \$x;|); $x = $CLASS->new("NaN"); $x += $x; is($x->is_nan(), 1, qq|\$x = $CLASS->new("NaN"); \$x += \$x;|); $x = $CLASS->new("inf"); $x += $x; is($x->is_inf(), 1, qq|\$x = $CLASS->new("inf"); \$x += \$x;|); $x = $CLASS->new("-inf"); $x += $x; is($x->is_inf("-"), 1, qq|\$x = $CLASS->new("-inf"); \$x += \$x;|); $x = $CLASS->new("3.14"); $x -= $x; is($x, 0, qq|\$x = $CLASS->new("3.14"); \$x -= \$x;|); $x = $CLASS->new("-3.14"); $x -= $x; is($x, 0, qq|\$x = $CLASS->new("-3.14"); \$x -= \$x;|); $x = $CLASS->new("3.14"); $x += $x; is($x, "6.28", qq|$x = $CLASS->new("3.14"); $x += $x;|); $x = $CLASS->new("-3.14"); $x += $x; is($x, "-6.28", qq|$x = $CLASS->new("-3.14"); $x += $x;|); $x = $CLASS->new("3.14"); $x *= $x; is($x, "9.8596", qq|$x = $CLASS->new("3.14"); $x *= $x;|); $x = $CLASS->new("-3.14"); $x *= $x; is($x, "9.8596", qq|$x = $CLASS->new("-3.14"); $x *= $x;|); $x = $CLASS->new("3.14"); $x /= $x; is($x, "1", qq|$x = $CLASS->new("3.14"); $x /= $x;|); $x = $CLASS->new("-3.14"); $x /= $x; is($x, "1", qq|$x = $CLASS->new("-3.14"); $x /= $x;|); $x = $CLASS->new("3.14"); $x %= $x; is($x, "0", qq|$x = $CLASS->new("3.14"); $x %= $x;|); $x = $CLASS->new("-3.14"); $x %= $x; is($x, "0", qq|$x = $CLASS->new("-3.14"); $x %= $x;|); ############################################################################### # the following two were reported by "kenny" via hotmail.com: #perl -MMath::BigFloat -wle 'print Math::BigFloat->new(0)->bpow(".1")' #Use of uninitialized value in numeric le (<=) at BigFloat.pm line 1851. $x = $CLASS->new(0); $y = $CLASS->new("0.1"); is($x ** $y, 0, qq|\$x = $CLASS->new(0); \$y = $CLASS->new("0.1"); \$x ** \$y|); #perl -MMath::BigFloat -lwe 'print Math::BigFloat->new(".222222222222222222222222222222222222222222")->bceil()' #Use of uninitialized value in numeric le (<=) at BigFloat.pm line 1851. $x = $CLASS->new(".222222222222222222222222222222222222222222"); is($x->bceil(), 1, qq|$x = $CLASS->new(".222222222222222222222222222222222222222222");| . qq| $x->bceil();|); ############################################################################### # test **=, <<=, >>= # ((2**148)+1)/17 $x = $CLASS->new(2); $x **= 148; $x++; $x->bdiv(17, 60)->bfloor(); $x->accuracy(undef); is($x, "20988936657440586486151264256610222593863921", "value of ((2**148)+1)/17"); is($x->length(), length("20988936657440586486151264256610222593863921"), "number of digits in ((2**148)+1)/17"); $x = $CLASS->new("2"); $y = $CLASS->new("18"); is($x <<= $y, 2 << 18, qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18");| . q| $x <<= $y|); is($x, 2 << 18, qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18");| . q| $x <<= $y; $x|); is($x >>= $y, 2, qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18");| . q| $x <<= $y; $x >>= $y|); is($x, 2, qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18");| . q| $x <<= $y; $x >>= $y; $x|); $x = $CLASS->new("2"); $y = $CLASS->new("18.2"); # 2 * (2 ** 18.2); $x <<= $y; is($x->copy()->bfround(-9), "602248.763144685", qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18.2");| . q| $x <<= $y; $x->copy()->bfround(-9);|); # 2 * (2 ** 18.2) / (2 ** 18.2) => 2 is($x >>= $y, 2, qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18.2");| . q| $x <<= $y; $x->copy()->bfround(-9); $x >>= $y|); is($x, 2, qq|\$x = $CLASS->new("2"); \$y = $CLASS->new("18.2");| . q| $x <<= $y; $x->copy()->bfround(-9); $x >>= $y; $x|); __DATA__ &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 +0:+0:0 +0:+1:1 +1:+0:1 +1:+1:1 +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 27:90:56:1 27:90:54:9 &blcm abc:abc:NaN abc:+0:NaN +0:abc:NaN +0:+0:NaN +1:+0:0 +0:+1:0 +27:+90:270 +1034:+804:415668 $div_scale = 40 &bcos 1.2:10:0.3623577545 2.4:12:-0.737393715541 0:10:1 0:20:1 1:10:0.5403023059 1:12:0.540302305868 &bsin 1:10:0.8414709848 0:10:0 0:20:0 2.1:12:0.863209366649 1.2:13:0.9320390859672 0.2:13:0.1986693307951 3.2:12:-0.0583741434276 &batan NaN:10:NaN inf:14:1.5707963267949 -inf:14:-1.5707963267949 0:14:0 0:10:0 0.1:14:0.099668652491162 0.2:13:0.1973955598499 0.2:14:0.19739555984988 0.5:14:0.46364760900081 1:14:0.78539816339744 -1:14:-0.78539816339744 1.5:14:0.98279372324732 2.0:14:1.1071487177941 2.5:14:1.1902899496825 3.0:14:1.2490457723982 6.0:14:1.4056476493803 12:14:1.4876550949064 24:14:1.5291537476963 48:14:1.5499660067587 &batan2 NaN:1:10:NaN NaN:NaN:10:NaN 1:NaN:10:NaN -inf:-inf:14:-2.3561944901923 -inf:-1:14:-1.5707963267949 -inf:0:14:-1.5707963267949 -inf:+1:14:-1.5707963267949 -inf:+inf:14:-0.78539816339745 -1:-inf:14:-3.1415926535898 -1:-1:14:-2.3561944901923 -1:0:14:-1.5707963267949 -1:+1:14:-0.78539816339745 -1:+inf:14:0 0:-inf:14:3.1415926535898 0:-1:14:3.1415926535898 0:0:14:0 0:+1:14:0 0:+inf:14:0 +1:-inf:14:3.1415926535898 +1:-1:14:2.3561944901923 +1:0:14:1.5707963267949 +1:+1:14:0.78539816339745 +1:+inf:14:0 +inf:-inf:14:2.3561944901923 +inf:-1:14:1.5707963267949 +inf:0:14:1.5707963267949 +inf:+1:14:1.5707963267949 +inf:+inf:14:0.78539816339745 1:5:13:0.1973955598499 1:5:14:0.19739555984988 0:2:14:0 5:0:14:1.5707963267949 -1:0:11:-1.5707963268 -2:0:77:-1.5707963267948966192313216916397514420985846996875529104874722961539082031431 2:0:77:1.5707963267948966192313216916397514420985846996875529104874722961539082031431 -1:5:14:-0.19739555984988 1:5:14:0.19739555984988 -1:8:14:-0.12435499454676 1:8:14:0.12435499454676 # test an argument X > 1 and one X < 1 1:2:24:0.463647609000806116214256 2:1:14:1.1071487177941 -2:1:14:-1.1071487177941 &bpi 150:3.14159265358979323846264338327950288419716939937510582097494459230781640628620899862803482534211706798214808651328230664709384460955058223172535940813 77:3.1415926535897932384626433832795028841971693993751058209749445923078164062862 +0:3.141592653589793238462643383279502884197 11:3.1415926536 &bnok +inf:10:inf NaN:NaN:NaN NaN:1:NaN 1:NaN:NaN 1:1:1 # k > n 1:2:0 2:3:0 # k < 0 1:-2:0 # 7 over 3 = 35 7:3:35 7:6:7 100:90:17310309456440 100:95:75287520 2:0:1 7:0:1 2:1:2 &blog 0::-inf -1::NaN -2::NaN # base > 0, base != 1 2:-1:NaN 2:0:0 2:1:NaN # log(1) 1::0 1:1:NaN 1:2:0 2::0.6931471805599453094172321214581765680755 2.718281828::0.9999999998311266953289851340574956564911 $div_scale = 20 2.718281828::0.99999999983112669533 $div_scale = 15 123::4.81218435537242 10::2.30258509299405 1000::6.90775527898214 100::4.60517018598809 2::0.693147180559945 3.1415::1.14470039286086 12345::9.42100640177928 0.001::-6.90775527898214 # bug until v1.71: 10:10:1 100:100:1 # reset for further tests $div_scale = 40 1::0 &brsft NaNbrsft:2:NaN 0:2:0 1:1:0.5 2:1:1 4:1:2 123:1:61.5 32:3:4 &blsft NaNblsft:0:NaN 2:1:4 4:3:32 5:3:40 1:2:4 0:5:0 &bnorm 1:1 -0:0 bnormNaN:NaN +inf:inf -inf:-inf 123:123 -123.4567:-123.4567 # invalid inputs 1__2:NaN 1E1__2:NaN 11__2E2:NaN .2E-3.:NaN 1e3e4:NaN # strange, but valid .2E2:20 1.E3:1000 # some inputs that result in zero 0e0:0 +0e0:0 +0e+0:0 -0e+0:0 0e-0:0 -0e-0:0 +0e-0:0 000:0 00e2:0 00e02:0 000e002:0 000e1230:0 00e-3:0 00e+3:0 00e-03:0 00e+03:0 -000:0 -00e2:0 -00e02:0 -000e002:0 -000e1230:0 -00e-3:0 -00e+3:0 -00e-03:0 -00e+03:0 &as_number 0:0 1:1 1.2:1 2.345:2 -2:-2 -123.456:-123 -200:-200 -inf:-inf inf:inf NaN:NaN 71243225429896467497217836789578596379:71243225429896467497217836789578596379 # 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 &binf 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:0 +1:1 1234:1234 -5:-5 100:100 -100:-100 &bnan abc:NaN 2:NaN -2:NaN 0:NaN &bone 2:+:1 -2:-:-1 -2:+:1 2:-:-1 0::1 -2::1 abc::1 2:abc:1 &bsstr +inf:inf -inf:-inf abcfsstr:NaN -abcfsstr:NaN 1234.567:1234567e-3 123:123e+0 -5:-5e+0 -100:-1e+2 &bstr +inf:::inf -inf:::-inf abcfstr:::NaN 1234.567:9::1234.56700 1234.567::-6:1234.567000 12345:5::12345 0.001234:6::0.00123400 0.001234::-8:0.00123400 0:4::0 0::-4:0.0000 &bnorm inf:inf +inf:inf -inf:-inf +infinity:inf +-inf:NaN abc:NaN 1 a:NaN 1bcd2:NaN 11111b:NaN +1z:NaN -1z:NaN 0e999:0 0e-999:0 -0e999:0 -0e-999:0 0:0 +0:0 +00:0 +0_0_0:0 000000_0000000_00000:0 -0:0 -0000:0 +1:1 +01:1 +001:1 +00000100000:100000 123456789:123456789 -1:-1 -01:-1 -001:-1 -123456789:-123456789 -00000100000:-100000 123.456a:NaN 123.456:123.456 0.01:0.01 .002:0.002 +.2:0.2 -0.0003:-0.0003 -.0000000004:-0.0000000004 123456E2:12345600 123456E-2:1234.56 -123456E2:-12345600 -123456E-2:-1234.56 1e1:10 2e-11:0.00000000002 # exercise _split .02e-1:0.002 000001:1 -00001:-1 -1:-1 000.01:0.01 -000.0023:-0.0023 1.1e1:11 -3e111:-3000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 -4e-1111:-0.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004 &bpow 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 -1:2:1 -1:3:-1 123.456:2:15241.383936 2:-2:0.25 2:-3:0.125 128:-2:0.00006103515625 abc:123.456:NaN 123.456:abc:NaN +inf:123.45:inf -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 #2:0.2:1.148698354997035006798626946777927589444 #6:1.5:14.6969384566990685891837044482353483518 $div_scale = 20 #62.5:12.5:26447206647554886213592.3959144 $div_scale = 40 &bneg bnegNaN:NaN +inf:-inf -inf:inf +0:0 +1:-1 -1:1 +123456789:-123456789 -123456789:123456789 +123.456789:-123.456789 -123456.789:123456.789 &babs babsNaN:NaN +inf:inf -inf:inf +0:0 +1:1 -1:1 +123456789:123456789 -123456789:123456789 +123.456789:123.456789 -123456.789:123456.789 &bround $round_mode = "trunc" +inf:5:inf -inf:5:-inf 0:5:0 NaNfround:5:NaN +10123456789:5:10123000000 -10123456789:5:-10123000000 +10123456789.123:5:10123000000 -10123456789.123:5:-10123000000 +10123456789:9:10123456700 -10123456789:9:-10123456700 +101234500:6:101234000 -101234500:6:-101234000 $round_mode = "zero" +20123456789:5:20123000000 -20123456789:5:-20123000000 +20123456789.123:5:20123000000 -20123456789.123:5:-20123000000 +20123456789:9:20123456800 -20123456789:9:-20123456800 +201234500:6:201234000 -201234500:6:-201234000 $round_mode = "+inf" +30123456789:5:30123000000 -30123456789:5:-30123000000 +30123456789.123:5:30123000000 -30123456789.123:5:-30123000000 +30123456789:9:30123456800 -30123456789:9:-30123456800 +301234500:6:301235000 -301234500:6:-301234000 $round_mode = "-inf" +40123456789:5:40123000000 -40123456789:5:-40123000000 +40123456789.123:5:40123000000 -40123456789.123:5:-40123000000 +40123456789:9:40123456800 -40123456789:9:-40123456800 +401234500:6:401234000 -401234500:6:-401235000 $round_mode = "odd" +50123456789:5:50123000000 -50123456789:5:-50123000000 +50123456789.123:5:50123000000 -50123456789.123:5:-50123000000 +50123456789:9:50123456800 -50123456789:9:-50123456800 +501234500:6:501235000 -501234500:6:-501235000 $round_mode = "even" +60123456789:5:60123000000 -60123456789:5:-60123000000 +60123456789:9:60123456800 -60123456789:9:-60123456800 +601234500:6:601234000 -601234500:6:-601234000 +60123456789.0123:5:60123000000 -60123456789.0123:5:-60123000000 $round_mode = "common" +60123456789:5:60123000000 -60123456789:5:-60123000000 +60123456789:6:60123500000 -60123456789:6:-60123500000 +60123456789:9:60123456800 -60123456789:9:-60123456800 +601234500:6:601235000 -601234500:6:-601235000 +601234400:6:601234000 -601234400:6:-601234000 +601234600:6:601235000 -601234600:6:-601235000 +601234300:6:601234000 +60123456789.0123:5:60123000000 -60123456789.0123:5:-60123000000 &bfround $round_mode = "trunc" +inf:5:inf -inf:5:-inf 0:5:0 NaNffround:5:NaN +1.23:-1:1.2 +1.234:-1:1.2 +1.2345:-1:1.2 +1.23:-2:1.23 +1.234:-2:1.23 +1.2345:-2:1.23 +1.23:-3:1.230 +1.234:-3:1.234 +1.2345:-3:1.234 -1.23:-1:-1.2 +1.27:-1:1.2 -1.27:-1:-1.2 +1.25:-1:1.2 -1.25:-1:-1.2 +1.35:-1:1.3 -1.35:-1:-1.3 -0.0061234567890:-1:0.0 -0.0061:-1:0.0 -0.00612:-1:0.0 -0.00612:-2:0.00 -0.006:-1:0.0 -0.006:-2:0.00 -0.0006:-2:0.00 -0.0006:-3:0.000 -0.0065:-3:/-0\.006|-6e-03 -0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 0.05:0:0 0.5:0:0 0.51:0:0 0.41:0:0 $round_mode = "zero" +2.23:-1:/2.2(?:0{5}\d+)? -2.23:-1:/-2.2(?:0{5}\d+)? +2.27:-1:/2.(?:3|29{5}\d+) -2.27:-1:/-2.(?:3|29{5}\d+) +2.25:-1:/2.2(?:0{5}\d+)? -2.25:-1:/-2.2(?:0{5}\d+)? +2.35:-1:/2.(?:3|29{5}\d+) -2.35:-1:/-2.(?:3|29{5}\d+) -0.0065:-1:0.0 -0.0065:-2:/-0\.01|-1e-02 -0.0065:-3:/-0\.006|-6e-03 -0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 0.05:0:0 0.5:0:0 0.51:0:1 0.41:0:0 $round_mode = "+inf" +3.23:-1:/3.2(?:0{5}\d+)? -3.23:-1:/-3.2(?:0{5}\d+)? +3.27:-1:/3.(?:3|29{5}\d+) -3.27:-1:/-3.(?:3|29{5}\d+) +3.25:-1:/3.(?:3|29{5}\d+) -3.25:-1:/-3.2(?:0{5}\d+)? +3.35:-1:/3.(?:4|39{5}\d+) -3.35:-1:/-3.(?:3|29{5}\d+) -0.0065:-1:0.0 -0.0065:-2:/-0\.01|-1e-02 -0.0065:-3:/-0\.006|-6e-03 -0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 0.05:0:0 0.5:0:1 0.51:0:1 0.41:0:0 $round_mode = "-inf" +4.23:-1:/4.2(?:0{5}\d+)? -4.23:-1:/-4.2(?:0{5}\d+)? +4.27:-1:/4.(?:3|29{5}\d+) -4.27:-1:/-4.(?:3|29{5}\d+) +4.25:-1:/4.2(?:0{5}\d+)? -4.25:-1:/-4.(?:3|29{5}\d+) +4.35:-1:/4.(?:3|29{5}\d+) -4.35:-1:/-4.(?:4|39{5}\d+) -0.0065:-1:0.0 -0.0065:-2:/-0\.01|-1e-02 -0.0065:-3:/-0\.007|-7e-03 -0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 0.05:0:0 0.5:0:0 0.51:0:1 0.41:0:0 $round_mode = "odd" +5.23:-1:/5.2(?:0{5}\d+)? -5.23:-1:/-5.2(?:0{5}\d+)? +5.27:-1:/5.(?:3|29{5}\d+) -5.27:-1:/-5.(?:3|29{5}\d+) +5.25:-1:/5.(?:3|29{5}\d+) -5.25:-1:/-5.(?:3|29{5}\d+) +5.35:-1:/5.(?:3|29{5}\d+) -5.35:-1:/-5.(?:3|29{5}\d+) -0.0065:-1:0.0 -0.0065:-2:/-0\.01|-1e-02 -0.0065:-3:/-0\.007|-7e-03 -0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 0.05:0:0 0.5:0:1 0.51:0:1 0.41:0:0 $round_mode = "even" +6.23:-1:/6.2(?:0{5}\d+)? -6.23:-1:/-6.2(?:0{5}\d+)? +6.27:-1:/6.(?:3|29{5}\d+) -6.27:-1:/-6.(?:3|29{5}\d+) +6.25:-1:/6.(?:2(?:0{5}\d+)?|29{5}\d+) -6.25:-1:/-6.(?:2(?:0{5}\d+)?|29{5}\d+) +6.35:-1:/6.(?:4|39{5}\d+|29{8}\d+) -6.35:-1:/-6.(?:4|39{5}\d+|29{8}\d+) -0.0065:-1:0.0 -0.0065:-2:/-0\.01|-1e-02 -0.0065:-3:/-0\.006|-7e-03 -0.0065:-4:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 -0.0065:-5:/-0\.006(?:5|49{5}\d+)|-6\.5e-03 0.05:0:0 0.5:0:0 0.51:0:1 0.41:0:0 0.01234567:-3:0.012 0.01234567:-4:0.0123 0.01234567:-5:0.01235 0.01234567:-6:0.012346 0.01234567:-7:0.0123457 0.01234567:-8:0.01234567 0.01234567:-9:0.012345670 0.01234567:-12:0.012345670000 &bcmp bcmpNaN:bcmpNaN: bcmpNaN:+0: +0:bcmpNaN: +0:+0:0 -1:+0:-1 +0:-1:1 +1:+0:1 +0:+1:-1 -1:+1:-1 +1:-1:1 -1:-1:0 +1:+1:0 -1.1:0:-1 +0:-1.1:1 +1.1:+0:1 +0:+1.1:-1 +123:+123:0 +123:+12:1 +12:+123:-1 -123:-123:0 -123:-12:-1 -12:-123:1 +123:+124:-1 +124:+123:1 -123:-124:1 -124:-123:-1 0:0.01:-1 0:0.0001:-1 0:-0.0001:1 0:-0.1:1 0.1:0:1 0.00001:0:1 -0.0001:0:-1 -0.1:0:-1 0:0.0001234:-1 0:-0.0001234:1 0.0001234:0:1 -0.0001234:0:-1 0.0001:0.0005:-1 0.0005:0.0001:1 0.005:0.0001:1 0.001:0.0005:1 0.000001:0.0005:-1 0.00000123:0.0005:-1 0.00512:0.0001:1 0.005:0.000112:1 0.00123:0.0005:1 1.5:2:-1 2:1.5:1 1.54321:234:-1 234:1.54321:1 1e1234567890987654321:1e1234567890987654320:1 1e-1234567890987654321:1e-1234567890987654320:-1 # infinity -inf:5432112345:-1 +inf:5432112345:1 -inf:-5432112345:-1 +inf:-5432112345:1 -inf:54321.12345:-1 +inf:54321.12345:1 -inf:-54321.12345:-1 +inf:-54321.12345:1 +inf:+inf:0 -inf:-inf:0 +inf:-inf:1 -inf:+inf:-1 # return undef +inf:NaN: NaN:inf: -inf:NaN: NaN:-inf: &bacmp bcmpNaN:bcmpNaN: bcmpNaN:+0: +0:bcmpNaN: +0:+0:0 -1:+0:1 +0:-1:-1 +1:+0:1 +0:+1:-1 -1:+1:0 +1:-1:0 -1:-1:0 +1:+1:0 -1.1:0:1 +0:-1.1:-1 +1.1:+0:1 +0:+1.1:-1 +123:+123:0 +123:+12:1 +12:+123:-1 -123:-123:0 -123:-12:1 -12:-123:-1 +123:+124:-1 +124:+123:1 -123:-124:-1 -124:-123:1 0:0.01:-1 0:0.0001:-1 0:-0.0001:-1 0:-0.1:-1 0.1:0:1 0.00001:0:1 -0.0001:0:1 -0.1:0:1 0:0.0001234:-1 0:-0.0001234:-1 0.0001234:0:1 -0.0001234:0:1 0.0001:0.0005:-1 0.0005:0.0001:1 0.005:0.0001:1 0.001:0.0005:1 0.000001:0.0005:-1 0.00000123:0.0005:-1 0.00512:0.0001:1 0.005:0.000112:1 0.00123:0.0005:1 1.5:2:-1 2:1.5:1 1.54321:234:-1 234:1.54321:1 # infinity -inf:5432112345:1 +inf:5432112345:1 -inf:-5432112345:1 +inf:-5432112345:1 -inf:54321.12345:1 +inf:54321.12345:1 -inf:-54321.12345:1 +inf:-54321.12345:1 +inf:+inf:0 -inf:-inf:0 +inf:-inf:0 -inf:+inf:0 5:inf:-1 -1:inf:-1 5:-inf:-1 -1:-inf:-1 # return undef +inf:bacmpNaN: bacmpNaN:inf: -inf:bacmpNaN: bacmpNaN:-inf: &bdec bdecNaN:NaN +inf:inf -inf:-inf +0:-1 +1:0 -1:-2 1.23:0.23 -1.23:-2.23 100:99 101:100 -100:-101 -99:-100 -98:-99 99:98 &binc bincNaN:NaN +inf:inf -inf:-inf +0:1 +1:2 -1:0 1.23:2.23 -1.23:-0.23 100:101 -100:-99 -99:-98 -101:-100 99:100 &badd abc:abc:NaN abc:+0:NaN +0:abc:NaN +inf:-inf:NaN -inf:+inf:NaN +inf:+inf:inf -inf:-inf:-inf baddNaN:+inf:NaN baddNaN:+inf:NaN +inf:baddNaN:NaN -inf:baddNaN:NaN +0:+0:0 +1:+0:1 +0:+1:1 +1:+1:2 -1:+0:-1 +0:-1:-1 -1:-1:-2 -1:+1:0 +1:-1:0 +9:+1:10 +99:+1:100 +999:+1:1000 +9999:+1:10000 +99999:+1:100000 +999999:+1:1000000 +9999999:+1:10000000 +99999999:+1:100000000 +999999999:+1:1000000000 +9999999999:+1:10000000000 +99999999999:+1:100000000000 +10:-1:9 +100:-1:99 +1000:-1:999 +10000:-1:9999 +100000:-1:99999 +1000000:-1:999999 +10000000:-1:9999999 +100000000:-1:99999999 +1000000000:-1:999999999 +10000000000:-1:9999999999 +123456789:+987654321:1111111110 -123456789:+987654321:864197532 -123456789:-987654321:-1111111110 +123456789:-987654321:-864197532 0.001234:0.0001234:0.0013574 &bsub abc:abc:NaN abc:+0:NaN +0:abc:NaN +inf:-inf:inf -inf:+inf:-inf +inf:+inf:NaN -inf:-inf:NaN baddNaN:+inf:NaN baddNaN:+inf:NaN +inf:baddNaN:NaN -inf:baddNaN:NaN +0:+0:0 +1:+0:1 +0:+1:-1 +1:+1:0 -1:+0:-1 +0:-1:1 -1:-1:0 -1:+1:-2 +1:-1:2 +9:+1:8 +99:+1:98 +999:+1:998 +9999:+1:9998 +99999:+1:99998 +999999:+1:999998 +9999999:+1:9999998 +99999999:+1:99999998 +999999999:+1:999999998 +9999999999:+1:9999999998 +99999999999:+1:99999999998 +10:-1:11 +100:-1:101 +1000:-1:1001 +10000:-1:10001 +100000:-1:100001 +1000000:-1:1000001 +10000000:-1:10000001 +100000000:-1:100000001 +1000000000:-1:1000000001 +10000000000:-1:10000000001 +123456789:+987654321:-864197532 -123456789:+987654321:-1111111110 -123456789:-987654321:864197532 +123456789:-987654321:1111111110 &bmuladd abc:abc:0:NaN abc:+0:0:NaN +0:abc:0:NaN +0:0:abc:NaN NaNmul:+inf:0:NaN NaNmul:-inf:0:NaN -inf:NaNmul:0:NaN +inf:NaNmul:0:NaN +inf:+inf:0:inf +inf:-inf:0:-inf -inf:+inf:0:-inf -inf:-inf:0:inf +0:+0:0:0 +0:+1:0:0 +1:+0:0:0 +0:-1:0:0 -1:+0:0:0 123456789123456789:0:0:0 0:123456789123456789:0:0 -1:-1:0:1 -1:-1:0:1 -1:+1:0:-1 +1:-1:0:-1 +1:+1:0:1 +2:+3:0:6 -2:+3:0:-6 +2:-3:0:-6 -2:-3:0:6 111:111:0:12321 10101:10101:0:102030201 1001001:1001001:0:1002003002001 100010001:100010001:0:10002000300020001 10000100001:10000100001:0:100002000030000200001 11111111111:9:0:99999999999 22222222222:9:0:199999999998 33333333333:9:0:299999999997 44444444444:9:0:399999999996 55555555555:9:0:499999999995 66666666666:9:0:599999999994 77777777777:9:0:699999999993 88888888888:9:0:799999999992 99999999999:9:0:899999999991 11111111111:9:1:100000000000 22222222222:9:1:199999999999 33333333333:9:1:299999999998 44444444444:9:1:399999999997 55555555555:9:1:499999999996 66666666666:9:1:599999999995 77777777777:9:1:699999999994 88888888888:9:1:799999999993 99999999999:9:1:899999999992 -3:-4:-5:7 3:-4:-5:-17 -3:4:-5:-17 3:4:-5:7 -3:4:5:-7 3:-4:5:-7 9999999999999999999:10000000000000000000:1234567890:99999999999999999990000000001234567890 3.2:5.7:8.9:27.14 -3.2:5.197:6.05:-10.5804 &bmodpow 3:4:8:1 3:4:7:4 3:4:7:4 77777:777:123456789:99995084 3.2:6.2:5.2:2.970579856718063040273642739529400818 &bmul abc:abc:NaN abc:+0:NaN +0:abc:NaN +inf:NaNmul:NaN +inf:NaNmul:NaN NaNmul:+inf:NaN NaNmul:-inf:NaN +inf:+inf:inf +inf:-inf:-inf +inf:-inf:-inf +inf:+inf:inf +inf:123.34:inf +inf:-123.34:-inf -inf:123.34:-inf -inf:-123.34:inf 123.34:+inf:inf -123.34:+inf:-inf 123.34:-inf:-inf -123.34:-inf:inf +0:+0:0 +0:+1:0 +1:+0:0 +0:-1:0 -1:+0:0 +123456789123456789:+0:0 +0:+123456789123456789:0 -1:-1:1 -1:+1:-1 +1:-1:-1 +1:+1:1 +2:+3:6 -2:+3:-6 +2:-3:-6 -2:-3:6 +111:+111:12321 +10101:+10101:102030201 +1001001:+1001001:1002003002001 +100010001:+100010001:10002000300020001 +10000100001:+10000100001:100002000030000200001 +11111111111:+9:99999999999 +22222222222:+9:199999999998 +33333333333:+9:299999999997 +44444444444:+9:399999999996 +55555555555:+9:499999999995 +66666666666:+9:599999999994 +77777777777:+9:699999999993 +88888888888:+9:799999999992 +99999999999:+9:899999999991 6:120:720 10:10000:100000 &bdiv-list 0:0:NaN,0 0:1:0,0 9:4:2,1 9:5:1,4 # bug in v1.74 with bdiv in list context, when $y is 1 or -1 2.1:-1:-2.1,0 2.1:1:2.1,0 -2.1:-1:2.1,0 -2.1:1:-2.1,0 &bdiv $div_scale = 40; $round_mode = "even" abc:abc:NaN abc:+1:abc:NaN +1:abc:NaN -1:abc:NaN 0:abc:NaN +0:+0:NaN +0:+1:0 +1:+0:inf +3214:+0:inf +0:-1:0 -1:+0:-inf -3214:+0:-inf +1:+1:1 -1:-1:1 +1:-1:-1 -1:+1:-1 +1:+2:0.5 +2:+1:2 123:+inf:0 123:-inf:0 +10:+5:2 +100:+4:25 +1000:+8:125 +10000:+16:625 +10000:-16:-625 +999999999999:+9:111111111111 +999999999999:+99:10101010101 +999999999999:+999:1001001001 +999999999999:+9999:100010001 +999999999999999:+99999:10000100001 +1000000000:+9:111111111.1111111111111111111111111111111 +2000000000:+9:222222222.2222222222222222222222222222222 +3000000000:+9:333333333.3333333333333333333333333333333 +4000000000:+9:444444444.4444444444444444444444444444444 +5000000000:+9:555555555.5555555555555555555555555555556 +6000000000:+9:666666666.6666666666666666666666666666667 +7000000000:+9:777777777.7777777777777777777777777777778 +8000000000:+9:888888888.8888888888888888888888888888889 +9000000000:+9:1000000000 +35500000:+113:314159.2920353982300884955752212389380531 +71000000:+226:314159.2920353982300884955752212389380531 +106500000:+339:314159.2920353982300884955752212389380531 +1000000000:+3:333333333.3333333333333333333333333333333 2:25.024996000799840031993601279744051189762:0.07992009269196593320152084692285869265447 123456:1:123456 $div_scale = 20 +1000000000:+9:111111111.11111111111 +2000000000:+9:222222222.22222222222 +3000000000:+9:333333333.33333333333 +4000000000:+9:444444444.44444444444 +5000000000:+9:555555555.55555555556 +6000000000:+9:666666666.66666666667 +7000000000:+9:777777777.77777777778 +8000000000:+9:888888888.88888888889 +9000000000:+9:1000000000 1:10:0.1 1:100:0.01 1:1000:0.001 1:10000:0.0001 1:504:0.001984126984126984127 2:1.987654321:1.0062111801179738436 123456789.123456789123456789123456789:1:123456789.12345678912 # the next two cases are the "old" behaviour, but are now (>v0.01) different #+35500000:+113:314159.292035398230088 #+71000000:+226:314159.292035398230088 +35500000:+113:314159.29203539823009 +71000000:+226:314159.29203539823009 +106500000:+339:314159.29203539823009 +1000000000:+3:333333333.33333333333 $div_scale = 1 # round to accuracy 1 after bdiv +124:+3:40 123456789.1234:1:100000000 # reset scale for further tests $div_scale = 40 &bmod +9:4:1 +9:5:4 +9000:56:40 +56:9000:56 # inf handling, see table in doc 0:inf:0 0:-inf:0 5:inf:5 5:-inf:-inf -5:inf:inf -5:-inf:-5 inf:5:NaN -inf:5:NaN inf:-5:NaN -inf:-5:NaN 5:5:0 -5:-5:0 inf:inf:NaN -inf:-inf:NaN -inf:inf:NaN inf:-inf:NaN 8:0:8 inf:0:inf -inf:0:-inf -8:0:-8 0:0:0 abc:abc:NaN abc:1:abc:NaN 1:abc:NaN 0:1:0 1:0:1 0:-1:0 -1:0:-1 1:1:0 -1:-1:0 1:-1:0 -1:1:0 1:2:1 2:1:0 1000000000:9:1 2000000000:9:2 3000000000:9:3 4000000000:9:4 5000000000:9:5 6000000000:9:6 7000000000:9:7 8000000000:9:8 9000000000:9:0 35500000:113:33 71000000:226:66 106500000:339:99 1000000000:3:1 10:5:0 100:4:0 1000:8:0 10000:16:0 999999999999:9:0 999999999999:99:0 999999999999:999:0 999999999999:9999:0 999999999999999:99999:0 -9:+5:1 +9:-5:-1 -9:-5:-4 -5:3:1 -2:3:1 4:3:1 1:3:1 -5:-3:-2 -2:-3:-2 4:-3:-2 1:-3:-2 4095:4095:0 100041000510123:3:0 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 -2.1:1:0.9 2.1:1:0.1 -2.1:-1:-0.1 2.1:-1:-0.9 -3:1:0 3:1:0 -3:-1:0 3:-1:0 &bfac Nanfac:NaN -1:NaN +inf:inf -inf:NaN 0:1 1:1 2:2 3:6 4:24 5:120 6:720 10:3628800 11:39916800 12:479001600 &broot # sqrt() +0:2:0 +1:2:1 -1:2:NaN # -$x ** (1/2) => -$y, but not in broot() -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 &bsqrt +0:0 -1:NaN -2:NaN -16:NaN -123.45:NaN nanbsqrt:NaN +inf:inf -inf:NaN 1:1 2:1.41421356237309504880168872420969807857 4:2 9:3 16:4 100:10 123.456:11.11107555549866648462149404118219234119 15241.38393:123.4559999756998444766131352122991626468 1.44:1.2 # sqrt(1.44) = 1.2, sqrt(e10) = e5 => 12e4 1.44E10:120000 2e10:141421.356237309504880168872420969807857 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 NaN:1 -123:0 &is_inf +inf::1 -inf::1 abc::0 1::0 NaN::0 -1::0 +inf:-:0 +inf:+:1 -inf:-:1 -inf:+:0 -inf:-inf:1 -inf:+inf:0 +inf:-inf:0 +inf:+inf:1 +iNfInItY::1 -InFiNiTy::1 &is_odd abc:0 0:0 -1:1 -3:1 1:1 3:1 1000001:1 1000002:0 +inf:0 -inf:0 123.45:0 -123.45:0 2:0 &is_int NaNis_int:0 0:1 1:1 2:1 -2:1 -1:1 -inf:0 +inf:0 123.4567:0 -0.1:0 -0.002:0 &is_even abc:0 0:1 -1:0 -3:0 1:0 3:0 1000001:0 1000002:1 2:1 +inf:0 -inf:0 123.456:0 -123.456:0 0.01:0 -0.01:0 120:1 1200:1 -1200:1 &is_positive 0:0 1:1 -1:0 -123:0 NaN:0 -inf:0 +inf:1 &is_negative 0:0 1:0 -1:1 -123:1 NaN:0 -inf:1 +inf:0 &parts 0:0 0 1:1 0 123:123 0 -123:-123 0 -1200:-12 2 NaNparts:NaN NaN +inf:inf inf -inf:-inf inf &exponent 0:0 1:0 123:0 -123:0 -1200:2 +inf:inf -inf:inf NaNexponent:NaN &mantissa 0:0 1:1 123:123 -123:-123 -1200:-12 +inf:inf -inf:-inf NaNmantissa:NaN &length 123:3 -123:3 0:1 1:1 12345678901234567890:20 &is_zero NaNzero:0 +inf:0 -inf:0 0:1 -1:0 1:0 &is_one NaNone:0 +inf:0 -inf:0 0:0 2:0 1:1 -1:0 -2:0 &bfloor 0:0 abc:NaN +inf:inf -inf:-inf 1:1 -51:-51 -51.2:-52 12.2:12 0.12345:0 0.123456:0 0.1234567:0 0.12345678:0 0.123456789:0 &bceil 0:0 abc:NaN +inf:inf -inf:-inf 1:1 -51:-51 -51.2:-51 12.2:13 -0.4:0 &bint 0:0 NaN:NaN +inf:inf -inf:-inf 1:1 -51:-51 -51.2:-51 12.2:12 -0.4:0 # overloaded functions &log -1:NaN 0:-inf 1:0 2:0.6931471805599453094172321214581765680755 3:1.098612288668109691395245236922525704647 123456789:18.63140176616801803319393334796320420971 1234567890987654321:41.657252696908474880343847955484513481 -inf:inf inf:inf NaN:NaN &exp &sin &cos &atan2 &int &neg &abs &sqrt Math-BigInt-1.999715/t/bigfltpm.t0000644403072340010010000000211312641541031016461 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 2409 # tests in require'd file + 5; # tests in this file use Math::BigInt lib => 'Calc'; use Math::BigFloat; our $CLASS = "Math::BigFloat"; our $CALC = "Math::BigInt::Calc"; # backend is($CLASS->config()->{class}, $CLASS, "$CLASS->config()->{class}"); is($CLASS->config()->{with}, $CALC, "$CLASS->config()->{with}"); # bug #17447: Can't call method Math::BigFloat->bsub, not a valid method my $c = Math::BigFloat->new('123.3'); is($c->bsub(123), '0.3', qq|\$c = Math::BigFloat -> new("123.3"); \$y = \$c -> bsub("123")|); # Bug until Math::BigInt v1.86, the scale wasn't treated as a scalar: $c = Math::BigFloat->new('0.008'); my $d = Math::BigFloat->new(3); my $e = $c->bdiv(Math::BigFloat->new(3), $d); is($e, '0.00267', '0.008 / 3 = 0.0027'); SKIP: { skip("skipping test which is not for this backend", 1) unless $CALC eq 'Math::BigInt::Calc'; is(ref($e->{_e}->[0]), '', '$e->{_e}->[0] is a scalar'); } require 't/bigfltpm.inc'; # all tests here for sharing Math-BigInt-1.999715/t/bigintc.t0000644403072340010010000006144712632033721016315 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 379; use Math::BigInt::Calc; my ($BASE_LEN, undef, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL) = Math::BigInt::Calc->_base_len(); print "# BASE_LEN = $BASE_LEN\n"; print "# MAX_VAL = $MAX_VAL\n"; print "# AND_BITS = $AND_BITS\n"; print "# XOR_BITS = $XOR_BITS\n"; print "# IOR_BITS = $OR_BITS\n"; # testing of Math::BigInt::Calc my $CALC = 'Math::BigInt::Calc'; # pass classname to sub's # _new and _str my $x = $CALC->_new("123"); my $y = $CALC->_new("321"); is(ref($x), "ARRAY", q|ref($x) is an ARRAY|); is($CALC->_str($x), 123, qq|$CALC->_str(\$x) = 123|); is($CALC->_str($y), 321, qq|$CALC->_str(\$y) = 321|); ############################################################################### # _add, _sub, _mul, _div is($CALC->_str($CALC->_add($x, $y)), 444, qq|$CALC->_str($CALC->_add(\$x, \$y)) = 444|); is($CALC->_str($CALC->_sub($x, $y)), 123, qq|$CALC->_str($CALC->_sub(\$x, \$y)) = 123|); is($CALC->_str($CALC->_mul($x, $y)), 39483, qq|$CALC->_str($CALC->_mul(\$x, \$y)) = 39483|); is($CALC->_str($CALC->_div($x, $y)), 123, qq|$CALC->_str($CALC->_div(\$x, \$y)) = 123|); ############################################################################### # check that mul/div doesn't change $y # and returns the same reference, not something new is($CALC->_str($CALC->_mul($x, $y)), 39483, qq|$CALC->_str($CALC->_mul(\$x, \$y)) = 39483|); is($CALC->_str($x), 39483, qq|$CALC->_str(\$x) = 39483|); is($CALC->_str($y), 321, qq|$CALC->_str(\$y) = 321|); is($CALC->_str($CALC->_div($x, $y)), 123, qq|$CALC->_str($CALC->_div(\$x, \$y)) = 123|); is($CALC->_str($x), 123, qq|$CALC->_str(\$x) = 123|); is($CALC->_str($y), 321, qq|$CALC->_str(\$y) = 321|); $x = $CALC->_new("39483"); my ($x1, $r1) = $CALC->_div($x, $y); is("$x1", "$x", q|"$x1" = "$x"|); $CALC->_inc($x1); is("$x1", "$x", q|"$x1" = "$x"|); is($CALC->_str($r1), "0", qq|$CALC->_str(\$r1) = "0"|); $x = $CALC->_new("39483"); # reset ############################################################################### my $z = $CALC->_new("2"); is($CALC->_str($CALC->_add($x, $z)), 39485, qq|$CALC->_str($CALC->_add(\$x, \$z)) = 39485|); my ($re, $rr) = $CALC->_div($x, $y); is($CALC->_str($re), 123, qq|$CALC->_str(\$re) = 123|); is($CALC->_str($rr), 2, qq|$CALC->_str(\$rr) = 2|); # is_zero, _is_one, _one, _zero is($CALC->_is_zero($x) || 0, 0, qq/$CALC->_is_zero(\$x) || 0 = 0/); is($CALC->_is_one($x) || 0, 0, qq/$CALC->_is_one(\$x) || 0 = 0/); is($CALC->_str($CALC->_zero()), "0", qq|$CALC->_str($CALC->_zero()) = "0"|); is($CALC->_str($CALC->_one()), "1", qq|$CALC->_str($CALC->_one()) = "1"|); # _two() and _ten() is($CALC->_str($CALC->_two()), "2", qq|$CALC->_str($CALC->_two()) = "2"|); is($CALC->_str($CALC->_ten()), "10", qq|$CALC->_str($CALC->_ten()) = "10"|); is($CALC->_is_ten($CALC->_two()), 0, qq|$CALC->_is_ten($CALC->_two()) = 0|); is($CALC->_is_two($CALC->_two()), 1, qq|$CALC->_is_two($CALC->_two()) = 1|); is($CALC->_is_ten($CALC->_ten()), 1, qq|$CALC->_is_ten($CALC->_ten()) = 1|); is($CALC->_is_two($CALC->_ten()), 0, qq|$CALC->_is_two($CALC->_ten()) = 0|); is($CALC->_is_one($CALC->_one()), 1, qq|$CALC->_is_one($CALC->_one()) = 1|); is($CALC->_is_one($CALC->_two()), 0, qq|$CALC->_is_one($CALC->_two()) = 0|); is($CALC->_is_one($CALC->_ten()), 0, qq|$CALC->_is_one($CALC->_ten()) = 0|); is($CALC->_is_one($CALC->_zero()) || 0, 0, qq/$CALC->_is_one($CALC->_zero()) || 0 = 0/); is($CALC->_is_zero($CALC->_zero()), 1, qq|$CALC->_is_zero($CALC->_zero()) = 1|); is($CALC->_is_zero($CALC->_one()) || 0, 0, qq/$CALC->_is_zero($CALC->_one()) || 0 = 0/); # is_odd, is_even is($CALC->_is_odd($CALC->_one()), 1, qq/$CALC->_is_odd($CALC->_one()) = 1/); is($CALC->_is_odd($CALC->_zero()) || 0, 0, qq/$CALC->_is_odd($CALC->_zero()) || 0 = 0/); is($CALC->_is_even($CALC->_one()) || 0, 0, qq/$CALC->_is_even($CALC->_one()) || 0 = 0/); is($CALC->_is_even($CALC->_zero()), 1, qq/$CALC->_is_even($CALC->_zero()) = 1/); # _len for my $method (qw/_alen _len/) { $x = $CALC->_new("1"); is($CALC->$method($x), 1, qq|$CALC->$method(\$x) = 1|); $x = $CALC->_new("12"); is($CALC->$method($x), 2, qq|$CALC->$method(\$x) = 2|); $x = $CALC->_new("123"); is($CALC->$method($x), 3, qq|$CALC->$method(\$x) = 3|); $x = $CALC->_new("1234"); is($CALC->$method($x), 4, qq|$CALC->$method(\$x) = 4|); $x = $CALC->_new("12345"); is($CALC->$method($x), 5, qq|$CALC->$method(\$x) = 5|); $x = $CALC->_new("123456"); is($CALC->$method($x), 6, qq|$CALC->$method(\$x) = 6|); $x = $CALC->_new("1234567"); is($CALC->$method($x), 7, qq|$CALC->$method(\$x) = 7|); $x = $CALC->_new("12345678"); is($CALC->$method($x), 8, qq|$CALC->$method(\$x) = 8|); $x = $CALC->_new("123456789"); is($CALC->$method($x), 9, qq|$CALC->$method(\$x) = 9|); $x = $CALC->_new("8"); is($CALC->$method($x), 1, qq|$CALC->$method(\$x) = 1|); $x = $CALC->_new("21"); is($CALC->$method($x), 2, qq|$CALC->$method(\$x) = 2|); $x = $CALC->_new("321"); is($CALC->$method($x), 3, qq|$CALC->$method(\$x) = 3|); $x = $CALC->_new("4321"); is($CALC->$method($x), 4, qq|$CALC->$method(\$x) = 4|); $x = $CALC->_new("54321"); is($CALC->$method($x), 5, qq|$CALC->$method(\$x) = 5|); $x = $CALC->_new("654321"); is($CALC->$method($x), 6, qq|$CALC->$method(\$x) = 6|); $x = $CALC->_new("7654321"); is($CALC->$method($x), 7, qq|$CALC->$method(\$x) = 7|); $x = $CALC->_new("87654321"); is($CALC->$method($x), 8, qq|$CALC->$method(\$x) = 8|); $x = $CALC->_new("987654321"); is($CALC->$method($x), 9, qq|$CALC->$method(\$x) = 9|); $x = $CALC->_new("0"); is($CALC->$method($x), 1, qq|$CALC->$method(\$x) = 1|); $x = $CALC->_new("20"); is($CALC->$method($x), 2, qq|$CALC->$method(\$x) = 2|); $x = $CALC->_new("320"); is($CALC->$method($x), 3, qq|$CALC->$method(\$x) = 3|); $x = $CALC->_new("4320"); is($CALC->$method($x), 4, qq|$CALC->$method(\$x) = 4|); $x = $CALC->_new("54320"); is($CALC->$method($x), 5, qq|$CALC->$method(\$x) = 5|); $x = $CALC->_new("654320"); is($CALC->$method($x), 6, qq|$CALC->$method(\$x) = 6|); $x = $CALC->_new("7654320"); is($CALC->$method($x), 7, qq|$CALC->$method(\$x) = 7|); $x = $CALC->_new("87654320"); is($CALC->$method($x), 8, qq|$CALC->$method(\$x) = 8|); $x = $CALC->_new("987654320"); is($CALC->$method($x), 9, qq|$CALC->$method(\$x) = 9|); for (my $i = 1; $i < 9; $i++) { my $a = "$i" . '0' x ($i - 1); $x = $CALC->_new($a); is($CALC->_len($x), $i, qq|$CALC->_len(\$x) = $i|); } } # _digit $x = $CALC->_new("123456789"); is($CALC->_digit($x, 0), 9, qq|$CALC->_digit(\$x, 0) = 9|); is($CALC->_digit($x, 1), 8, qq|$CALC->_digit(\$x, 1) = 8|); is($CALC->_digit($x, 2), 7, qq|$CALC->_digit(\$x, 2) = 7|); is($CALC->_digit($x, 8), 1, qq|$CALC->_digit(\$x, 8) = 1|); is($CALC->_digit($x, 9), 0, qq|$CALC->_digit(\$x, 9) = 0|); is($CALC->_digit($x, -1), 1, qq|$CALC->_digit(\$x, -1) = 1|); is($CALC->_digit($x, -2), 2, qq|$CALC->_digit(\$x, -2) = 2|); is($CALC->_digit($x, -3), 3, qq|$CALC->_digit(\$x, -3) = 3|); is($CALC->_digit($x, -9), 9, qq|$CALC->_digit(\$x, -9) = 9|); is($CALC->_digit($x, -10), 0, qq|$CALC->_digit(\$x, -10) = 0|); # _copy foreach (qw/ 1 12 123 1234 12345 123456 1234567 12345678 123456789/) { $x = $CALC->_new("$_"); is($CALC->_str($CALC->_copy($x)), "$_", qq|$CALC->_str($CALC->_copy(\$x)) = "$_"|); is($CALC->_str($x), "$_", # did _copy destroy original x? qq|$CALC->_str(\$x) = "$_"|); } # _zeros $x = $CALC->_new("1256000000"); is($CALC->_zeros($x), 6, qq|$CALC->_zeros(\$x) = 6|); $x = $CALC->_new("152"); is($CALC->_zeros($x), 0, qq|$CALC->_zeros(\$x) = 0|); $x = $CALC->_new("123000"); is($CALC->_zeros($x), 3, qq|$CALC->_zeros(\$x) = 3|); $x = $CALC->_new("0"); is($CALC->_zeros($x), 0, qq|$CALC->_zeros(\$x) = 0|); # _lsft, _rsft $x = $CALC->_new("10"); $y = $CALC->_new("3"); is($CALC->_str($CALC->_lsft($x, $y, 10)), 10000, qq|$CALC->_str($CALC->_lsft(\$x, \$y, 10)) = 10000|); $x = $CALC->_new("20"); $y = $CALC->_new("3"); is($CALC->_str($CALC->_lsft($x, $y, 10)), 20000, qq|$CALC->_str($CALC->_lsft(\$x, \$y, 10)) = 20000|); $x = $CALC->_new("128"); $y = $CALC->_new("4"); is($CALC->_str($CALC->_lsft($x, $y, 2)), 128 << 4, qq|$CALC->_str($CALC->_lsft(\$x, \$y, 2)) = 128 << 4|); $x = $CALC->_new("1000"); $y = $CALC->_new("3"); is($CALC->_str($CALC->_rsft($x, $y, 10)), 1, qq|$CALC->_str($CALC->_rsft(\$x, \$y, 10)) = 1|); $x = $CALC->_new("20000"); $y = $CALC->_new("3"); is($CALC->_str($CALC->_rsft($x, $y, 10)), 20, qq|$CALC->_str($CALC->_rsft(\$x, \$y, 10)) = 20|); $x = $CALC->_new("256"); $y = $CALC->_new("4"); is($CALC->_str($CALC->_rsft($x, $y, 2)), 256 >> 4, qq|$CALC->_str($CALC->_rsft(\$x, \$y, 2)) = 256 >> 4|); $x = $CALC->_new("6411906467305339182857313397200584952398"); $y = $CALC->_new("45"); is($CALC->_str($CALC->_rsft($x, $y, 10)), 0, qq|$CALC->_str($CALC->_rsft(\$x, \$y, 10)) = 0|); # _acmp $x = $CALC->_new("123456789"); $y = $CALC->_new("987654321"); is($CALC->_acmp($x, $y), -1, qq|$CALC->_acmp(\$x, \$y) = -1|); is($CALC->_acmp($y, $x), 1, qq|$CALC->_acmp(\$y, \$x) = 1|); is($CALC->_acmp($x, $x), 0, qq|$CALC->_acmp(\$x, \$x) = 0|); is($CALC->_acmp($y, $y), 0, qq|$CALC->_acmp(\$y, \$y) = 0|); $x = $CALC->_new("12"); $y = $CALC->_new("12"); is($CALC->_acmp($x, $y), 0, qq|$CALC->_acmp(\$x, \$y) = 0|); $x = $CALC->_new("21"); is($CALC->_acmp($x, $y), 1, qq|$CALC->_acmp(\$x, \$y) = 1|); is($CALC->_acmp($y, $x), -1, qq|$CALC->_acmp(\$y, \$x) = -1|); $x = $CALC->_new("123456789"); $y = $CALC->_new("1987654321"); is($CALC->_acmp($x, $y), -1, qq|$CALC->_acmp(\$x, \$y) = -1|); is($CALC->_acmp($y, $x), +1, qq|$CALC->_acmp(\$y, \$x) = +1|); $x = $CALC->_new("1234567890123456789"); $y = $CALC->_new("987654321012345678"); is($CALC->_acmp($x, $y), 1, qq|$CALC->_acmp(\$x, \$y) = 1|); is($CALC->_acmp($y, $x), -1, qq|$CALC->_acmp(\$y, \$x) = -1|); is($CALC->_acmp($x, $x), 0, qq|$CALC->_acmp(\$x, \$x) = 0|); is($CALC->_acmp($y, $y), 0, qq|$CALC->_acmp(\$y, \$y) = 0|); $x = $CALC->_new("1234"); $y = $CALC->_new("987654321012345678"); is($CALC->_acmp($x, $y), -1, qq|$CALC->_acmp(\$x, \$y) = -1|); is($CALC->_acmp($y, $x), 1, qq|$CALC->_acmp(\$y, \$x) = 1|); is($CALC->_acmp($x, $x), 0, qq|$CALC->_acmp(\$x, \$x) = 0|); is($CALC->_acmp($y, $y), 0, qq|$CALC->_acmp(\$y, \$y) = 0|); # _modinv $x = $CALC->_new("8"); $y = $CALC->_new("5033"); my ($xmod, $sign) = $CALC->_modinv($x, $y); is($CALC->_str($xmod), "629", # -629 % 5033 == 4404 qq|$CALC->_str(\$xmod) = "629"|); is($sign, "-", q|$sign = "-"|); # _div $x = $CALC->_new("3333"); $y = $CALC->_new("1111"); is($CALC->_str(scalar($CALC->_div($x, $y))), 3, qq|$CALC->_str(scalar($CALC->_div(\$x, \$y))) = 3|); $x = $CALC->_new("33333"); $y = $CALC->_new("1111"); ($x, $y) = $CALC->_div($x, $y); is($CALC->_str($x), 30, qq|$CALC->_str(\$x) = 30|); is($CALC->_str($y), 3, qq|$CALC->_str(\$y) = 3|); $x = $CALC->_new("123"); $y = $CALC->_new("1111"); ($x, $y) = $CALC->_div($x, $y); is($CALC->_str($x), 0, qq|$CALC->_str(\$x) = 0|); is($CALC->_str($y), 123, qq|$CALC->_str(\$y) = 123|); # _num foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/) { $x = $CALC->_new("$_"); is(ref($x), "ARRAY", q|ref($x) = "ARRAY"|); is($CALC->_str($x), "$_", qq|$CALC->_str(\$x) = "$_"|); $x = $CALC->_num($x); is(ref($x), "", q|ref($x) = ""|); is($x, $_, qq|\$x = $_|); } # _sqrt $x = $CALC->_new("144"); is($CALC->_str($CALC->_sqrt($x)), "12", qq|$CALC->_str($CALC->_sqrt(\$x)) = "12"|); $x = $CALC->_new("144000000000000"); is($CALC->_str($CALC->_sqrt($x)), "12000000", qq|$CALC->_str($CALC->_sqrt(\$x)) = "12000000"|); # _root $x = $CALC->_new("81"); my $n = $CALC->_new("3"); # 4*4*4 = 64, 5*5*5 = 125 is($CALC->_str($CALC->_root($x, $n)), "4", qq|$CALC->_str($CALC->_root(\$x, \$n)) = "4"|); # 4.xx => 4.0 $x = $CALC->_new("81"); $n = $CALC->_new("4"); # 3*3*3*3 == 81 is($CALC->_str($CALC->_root($x, $n)), "3", qq|$CALC->_str($CALC->_root(\$x, \$n)) = "3"|); # _pow (and _root) $x = $CALC->_new("0"); $n = $CALC->_new("3"); # 0 ** y => 0 is($CALC->_str($CALC->_pow($x, $n)), 0, qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 0|); $x = $CALC->_new("3"); $n = $CALC->_new("0"); # x ** 0 => 1 is($CALC->_str($CALC->_pow($x, $n)), 1, qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 1|); $x = $CALC->_new("1"); $n = $CALC->_new("3"); # 1 ** y => 1 is($CALC->_str($CALC->_pow($x, $n)), 1, qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 1|); $x = $CALC->_new("5"); $n = $CALC->_new("1"); # x ** 1 => x is($CALC->_str($CALC->_pow($x, $n)), 5, qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 5|); $x = $CALC->_new("81"); $n = $CALC->_new("3"); # 81 ** 3 == 531441 is($CALC->_str($CALC->_pow($x, $n)), 81 ** 3, qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 81 ** 3|); is($CALC->_str($CALC->_root($x, $n)), 81, qq|$CALC->_str($CALC->_root(\$x, \$n)) = 81|); $x = $CALC->_new("81"); is($CALC->_str($CALC->_pow($x, $n)), 81 ** 3, qq|$CALC->_str($CALC->_pow(\$x, \$n)) = 81 ** 3|); is($CALC->_str($CALC->_pow($x, $n)), "150094635296999121", # 531441 ** 3 qq|$CALC->_str($CALC->_pow(\$x, \$n)) = "150094635296999121"|); is($CALC->_str($CALC->_root($x, $n)), "531441", qq|$CALC->_str($CALC->_root(\$x, \$n)) = "531441"|); is($CALC->_str($CALC->_root($x, $n)), "81", qq|$CALC->_str($CALC->_root(\$x, \$n)) = "81"|); $x = $CALC->_new("81"); $n = $CALC->_new("14"); is($CALC->_str($CALC->_pow($x, $n)), "523347633027360537213511521", qq|$CALC->_str($CALC->_pow(\$x, \$n)) = "523347633027360537213511521"|); is($CALC->_str($CALC->_root($x, $n)), "81", qq|$CALC->_str($CALC->_root(\$x, \$n)) = "81"|); $x = $CALC->_new("523347633027360537213511520"); is($CALC->_str($CALC->_root($x, $n)), "80", qq|$CALC->_str($CALC->_root(\$x, \$n)) = "80"|); $x = $CALC->_new("523347633027360537213511522"); is($CALC->_str($CALC->_root($x, $n)), "81", qq|$CALC->_str($CALC->_root(\$x, \$n)) = "81"|); my $res = [ qw/9 31 99 316 999 3162 9999 31622 99999/ ]; # 99 ** 2 = 9801, 999 ** 2 = 998001 etc for my $i (2 .. 9) { $x = '9' x $i; $x = $CALC->_new($x); $n = $CALC->_new("2"); my $rc = '9' x ($i-1). '8' . '0' x ($i - 1) . '1'; print "# _pow( ", '9' x $i, ", 2) \n" unless is($CALC->_str($CALC->_pow($x, $n)), $rc, qq|$CALC->_str($CALC->_pow(\$x, \$n)) = $rc|); SKIP: { # If $i > $BASE_LEN, the test takes a really long time. skip "$i > $BASE_LEN", 2 unless $i <= $BASE_LEN; $x = '9' x $i; $x = $CALC->_new($x); $n = '9' x $i; $n = $CALC->_new($n); print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n"; print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless is($CALC->_str($CALC->_root($x, $n)), '1', qq|$CALC->_str($CALC->_root(\$x, \$n)) = '1'|); $x = '9' x $i; $x = $CALC->_new($x); $n = $CALC->_new("2"); print "# BASE_LEN $BASE_LEN _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless is($CALC->_str($CALC->_root($x, $n)), $res->[$i-2], qq|$CALC->_str($CALC->_root(\$x, \$n)) = $res->[$i-2]|); } } ############################################################################## # _fac $x = $CALC->_new("0"); is($CALC->_str($CALC->_fac($x)), "1", qq|$CALC->_str($CALC->_fac(\$x)) = "1"|); $x = $CALC->_new("1"); is($CALC->_str($CALC->_fac($x)), "1", qq|$CALC->_str($CALC->_fac(\$x)) = "1"|); $x = $CALC->_new("2"); is($CALC->_str($CALC->_fac($x)), "2", qq|$CALC->_str($CALC->_fac(\$x)) = "2"|); $x = $CALC->_new("3"); is($CALC->_str($CALC->_fac($x)), "6", qq|$CALC->_str($CALC->_fac(\$x)) = "6"|); $x = $CALC->_new("4"); is($CALC->_str($CALC->_fac($x)), "24", qq|$CALC->_str($CALC->_fac(\$x)) = "24"|); $x = $CALC->_new("5"); is($CALC->_str($CALC->_fac($x)), "120", qq|$CALC->_str($CALC->_fac(\$x)) = "120"|); $x = $CALC->_new("10"); is($CALC->_str($CALC->_fac($x)), "3628800", qq|$CALC->_str($CALC->_fac(\$x)) = "3628800"|); $x = $CALC->_new("11"); is($CALC->_str($CALC->_fac($x)), "39916800", qq|$CALC->_str($CALC->_fac(\$x)) = "39916800"|); $x = $CALC->_new("12"); is($CALC->_str($CALC->_fac($x)), "479001600", qq|$CALC->_str($CALC->_fac(\$x)) = "479001600"|); $x = $CALC->_new("13"); is($CALC->_str($CALC->_fac($x)), "6227020800", qq|$CALC->_str($CALC->_fac(\$x)) = "6227020800"|); # test that _fac modifies $x in place for small arguments $x = $CALC->_new("3"); $CALC->_fac($x); is($CALC->_str($x), "6", qq|$CALC->_str(\$x) = "6"|); $x = $CALC->_new("13"); $CALC->_fac($x); is($CALC->_str($x), "6227020800", qq|$CALC->_str(\$x) = "6227020800"|); ############################################################################## # _inc and _dec for (qw/1 11 121 1231 12341 1234561 12345671 123456781 1234567891/) { $x = $CALC->_new("$_"); $CALC->_inc($x); my $expected = substr($_, 0, length($_) - 1) . '2'; is($CALC->_str($x), $expected, qq|$CALC->_str(\$x) = $expected|); $CALC->_dec($x); is($CALC->_str($x), $_, qq|$CALC->_str(\$x) = $_|); } for (qw/19 119 1219 12319 1234519 12345619 123456719 1234567819/) { $x = $CALC->_new("$_"); $CALC->_inc($x); my $expected = substr($_, 0, length($_)-2) . '20'; is($CALC->_str($x), $expected, qq|$CALC->_str(\$x) = $expected|); $CALC->_dec($x); is($CALC->_str($x), $_, qq|$CALC->_str(\$x) = $_|); } for (qw/999 9999 99999 9999999 99999999 999999999 9999999999 99999999999/) { $x = $CALC->_new("$_"); $CALC->_inc($x); my $expected = '1' . '0' x (length($_)); is($CALC->_str($x), $expected, qq|$CALC->_str(\$x) = $expected|); $CALC->_dec($x); is($CALC->_str($x), $_, qq|$CALC->_str(\$x) = $_|); } $x = $CALC->_new("1000"); $CALC->_inc($x); is($CALC->_str($x), "1001", qq|$CALC->_str(\$x) = "1001"|); $CALC->_dec($x); is($CALC->_str($x), "1000", qq|$CALC->_str(\$x) = "1000"|); my $BL; { no strict 'refs'; $BL = &{"$CALC"."::_base_len"}(); } $x = '1' . '0' x $BL; $z = '1' . '0' x ($BL - 1); $z .= '1'; $x = $CALC->_new($x); $CALC->_inc($x); is($CALC->_str($x), $z, qq|$CALC->_str(\$x) = $z|); $x = '1' . '0' x $BL; $z = '9' x $BL; $x = $CALC->_new($x); $CALC->_dec($x); is($CALC->_str($x), $z, qq|$CALC->_str(\$x) = $z|); # should not happen: # $x = $CALC->_new("-2"); # $y = $CALC->_new("4"); # is($CALC->_acmp($x, $y), -1, qq|$CALC->_acmp($x, $y) = -1|); ############################################################################### # _mod $x = $CALC->_new("1000"); $y = $CALC->_new("3"); is($CALC->_str(scalar($CALC->_mod($x, $y))), 1, qq|$CALC->_str(scalar($CALC->_mod(\$x, \$y))) = 1|); $x = $CALC->_new("1000"); $y = $CALC->_new("2"); is($CALC->_str(scalar($CALC->_mod($x, $y))), 0, qq|$CALC->_str(scalar($CALC->_mod(\$x, \$y))) = 0|); # _and, _or, _xor $x = $CALC->_new("5"); $y = $CALC->_new("2"); is($CALC->_str(scalar($CALC->_xor($x, $y))), 7, qq|$CALC->_str(scalar($CALC->_xor(\$x, \$y))) = 7|); $x = $CALC->_new("5"); $y = $CALC->_new("2"); is($CALC->_str(scalar($CALC->_or($x, $y))), 7, qq|$CALC->_str(scalar($CALC->_or(\$x, \$y))) = 7|); $x = $CALC->_new("5"); $y = $CALC->_new("3"); is($CALC->_str(scalar($CALC->_and($x, $y))), 1, qq|$CALC->_str(scalar($CALC->_and(\$x, \$y))) = 1|); # _from_hex, _from_bin, _from_oct is($CALC->_str($CALC->_from_hex("0xFf")), 255, qq|$CALC->_str($CALC->_from_hex("0xFf")) = 255|); is($CALC->_str($CALC->_from_bin("0b10101011")), 160+11, qq|$CALC->_str($CALC->_from_bin("0b10101011")) = 160+11|); is($CALC->_str($CALC->_from_oct("0100")), 8*8, qq|$CALC->_str($CALC->_from_oct("0100")) = 8*8|); is($CALC->_str($CALC->_from_oct("01000")), 8*8*8, qq|$CALC->_str($CALC->_from_oct("01000")) = 8*8*8|); is($CALC->_str($CALC->_from_oct("010001")), 8*8*8*8+1, qq|$CALC->_str($CALC->_from_oct("010001")) = 8*8*8*8+1|); is($CALC->_str($CALC->_from_oct("010007")), 8*8*8*8+7, qq|$CALC->_str($CALC->_from_oct("010007")) = 8*8*8*8+7|); # _as_hex, _as_bin, as_oct is($CALC->_str($CALC->_from_hex($CALC->_as_hex($CALC->_new("128")))), 128, qq|$CALC->_str($CALC->_from_hex($CALC->_as_hex(| . qq|$CALC->_new("128")))) = 128|); is($CALC->_str($CALC->_from_bin($CALC->_as_bin($CALC->_new("128")))), 128, qq|$CALC->_str($CALC->_from_bin($CALC->_as_bin(| . qq|$CALC->_new("128")))) = 128|); is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new("128")))), 128, qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct(| . qq|$CALC->_new("128")))) = 128|); is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new("123456")))), 123456, qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct| . qq|($CALC->_new("123456")))) = 123456|); is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new("123456789")))), "123456789", qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct(| . qq|$CALC->_new("123456789")))) = "123456789"|); is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new("1234567890123")))), "1234567890123", qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct(| . qq|$CALC->_new("1234567890123")))) = "1234567890123"|); my $long = "123456789012345678901234567890"; is($CALC->_str($CALC->_from_hex($CALC->_as_hex($CALC->_new($long)))), $long, qq|$CALC->_str($CALC->_from_hex($CALC->_as_hex(| . qq|$CALC->_new("$long")))) = "$long"|); is($CALC->_str($CALC->_from_bin($CALC->_as_bin($CALC->_new($long)))), $long, qq|$CALC->_str($CALC->_from_bin($CALC->_as_bin(| . qq|$CALC->_new("$long")))) = "$long"|); is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new($long)))), $long, qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct(| . qq|$CALC->_new("$long")))) = "$long"|); is($CALC->_str($CALC->_from_hex($CALC->_as_hex($CALC->_new("0")))), 0, qq|$CALC->_str($CALC->_from_hex($CALC->_as_hex(| . qq|$CALC->_new("0")))) = 0|); is($CALC->_str($CALC->_from_bin($CALC->_as_bin($CALC->_new("0")))), 0, qq|$CALC->_str($CALC->_from_bin($CALC->_as_bin(| . qq|$CALC->_new("0")))) = 0|); is($CALC->_str($CALC->_from_oct($CALC->_as_oct($CALC->_new("0")))), 0, qq|$CALC->_str($CALC->_from_oct($CALC->_as_oct(| . qq|$CALC->_new("0")))) = 0|); is($CALC->_as_hex($CALC->_new("0")), "0x0", qq|$CALC->_as_hex($CALC->_new("0")) = "0x0"|); is($CALC->_as_bin($CALC->_new("0")), "0b0", qq|$CALC->_as_bin($CALC->_new("0")) = "0b0"|); is($CALC->_as_oct($CALC->_new("0")), "00", qq|$CALC->_as_oct($CALC->_new("0")) = "00"|); is($CALC->_as_hex($CALC->_new("12")), "0xc", qq|$CALC->_as_hex($CALC->_new("12")) = "0xc"|); is($CALC->_as_bin($CALC->_new("12")), "0b1100", qq|$CALC->_as_bin($CALC->_new("12")) = "0b1100"|); is($CALC->_as_oct($CALC->_new("64")), "0100", qq|$CALC->_as_oct($CALC->_new("64")) = "0100"|); # _1ex is($CALC->_str($CALC->_1ex(0)), "1", qq|$CALC->_str($CALC->_1ex(0)) = "1"|); is($CALC->_str($CALC->_1ex(1)), "10", qq|$CALC->_str($CALC->_1ex(1)) = "10"|); is($CALC->_str($CALC->_1ex(2)), "100", qq|$CALC->_str($CALC->_1ex(2)) = "100"|); is($CALC->_str($CALC->_1ex(12)), "1000000000000", qq|$CALC->_str($CALC->_1ex(12)) = "1000000000000"|); is($CALC->_str($CALC->_1ex(16)), "10000000000000000", qq|$CALC->_str($CALC->_1ex(16)) = "10000000000000000"|); # _check $x = $CALC->_new("123456789"); is($CALC->_check($x), 0, qq|$CALC->_check(\$x) = 0|); is($CALC->_check(123), "123 is not a reference", qq|$CALC->_check(123) = "123 is not a reference"|); ############################################################################### # __strip_zeros { no strict 'refs'; # correct empty arrays $x = &{$CALC."::__strip_zeros"}([]); is(@$x, 1, q|@$x = 1|); is($x->[0], 0, q|$x->[0] = 0|); # don't strip single elements $x = &{$CALC."::__strip_zeros"}([0]); is(@$x, 1, q|@$x = 1|); is($x->[0], 0, q|$x->[0] = 0|); $x = &{$CALC."::__strip_zeros"}([1]); is(@$x, 1, q|@$x = 1|); is($x->[0], 1, q|$x->[0] = 1|); # don't strip non-zero elements $x = &{$CALC."::__strip_zeros"}([0, 1]); is(@$x, 2, q|@$x = 2|); is($x->[0], 0, q|$x->[0] = 0|); is($x->[1], 1, q|$x->[1] = 1|); $x = &{$CALC."::__strip_zeros"}([0, 1, 2]); is(@$x, 3, q|@$x = 3|); is($x->[0], 0, q|$x->[0] = 0|); is($x->[1], 1, q|$x->[1] = 1|); is($x->[2], 2, q|$x->[2] = 2|); # but strip leading zeros $x = &{$CALC."::__strip_zeros"}([0, 1, 2, 0]); is(@$x, 3, q|@$x = 3|); is($x->[0], 0, q|$x->[0] = 0|); is($x->[1], 1, q|$x->[1] = 1|); is($x->[2], 2, q|$x->[2] = 2|); $x = &{$CALC."::__strip_zeros"}([0, 1, 2, 0, 0]); is(@$x, 3, q|@$x = 3|); is($x->[0], 0, q|$x->[0] = 0|); is($x->[1], 1, q|$x->[1] = 1|); is($x->[2], 2, q|$x->[2] = 2|); $x = &{$CALC."::__strip_zeros"}([0, 1, 2, 0, 0, 0]); is(@$x, 3, q|@$x = 3|); is($x->[0], 0, q|$x->[0] = 0|); is($x->[1], 1, q|$x->[1] = 1|); is($x->[2], 2, q|$x->[2] = 2|); # collapse multiple zeros $x = &{$CALC."::__strip_zeros"}([0, 0, 0, 0]); is(@$x, 1, q|@$x = 1|); is($x->[0], 0, q|$x->[0] = 0|); } # done 1; Math-BigInt-1.999715/t/bigintpm.inc0000644403072340010010000020070112641215046017003 0ustar ospjaDomain Users#include this file into another for subclass testing use strict; use warnings; our ($CLASS, $CALC); ############################################################################## # for testing inheritance of _swap package Math::Foo; use Math::BigInt lib => $main::CALC; our @ISA = (qw/Math::BigInt/); use overload # customized overload for sub, since original does not use swap there '-' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bsub($a[1]); }; sub _swap { # a fake _swap, which reverses the params my $self = shift; # for override in subclass if ($_[2]) { my $c = ref($_[0]) || 'Math::Foo'; return( $_[0]->copy(), $_[1] ); } else { return( Math::Foo->new($_[1]), $_[0] ); } } ############################################################################## package main; is($CLASS->config()->{lib}, $CALC, "$CLASS->config()->{lib}"); my ($x, $y, $z, @args, $try, $got, $want); my ($f, $round_mode, $expected_class); while () { s/#.*$//; # remove comments s/\s+$//; # remove trailing whitespace next unless length; # skip empty lines my ($m, $e); if (s/^&//) { $f = $_; next; } if (/^\$/) { $round_mode = $_; $round_mode =~ s/^\$/$CLASS\->/; next; } @args = split(/:/, $_, 99); $want = pop(@args); $expected_class = $CLASS; if ($want =~ /(.*?)=(.*)/) { $expected_class = $2; $want = $1; } $try = qq|\$x = $CLASS->new("$args[0]");|; if ($f eq "bnorm") { $try = qq|\$x = $CLASS->bnorm("$args[0]");|; } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) { $try .= " \$x->$f() || 0;"; } elsif ($f eq "is_inf") { $try .= qq| \$x->is_inf("$args[1]");|; } elsif ($f eq "binf") { $try .= qq| \$x->binf("$args[1]");|; } elsif ($f eq "bone") { $try .= qq| \$x->bone("$args[1]");|; # some unary ops } elsif ($f =~ /^b(nan|floor|ceil|int|sstr|neg|abs|sgn|inc|dec|not|sqrt|fac)$/) { $try .= " \$x->$f();"; # overloaded functions } elsif ($f =~ /^(log|exp|sin|cos|atan2|int|neg|abs|sqrt)$/) { $try .= " \$x = $f(\$x);"; } elsif ($f =~ /^(numify|length|stringify|as_hex|as_bin|as_oct)$/) { $try .= " \$x->$f();"; } elsif ($f eq "exponent") { # ->bstr() to see if an object is returned $try .= ' $x = $x->exponent()->bstr();'; } elsif ($f eq "mantissa") { # ->bstr() to see if an object is returned $try .= ' $x = $x->mantissa()->bstr();'; } elsif ($f eq "parts") { $try .= ' ($m, $e) = $x->parts();'; # ->bstr() to see if an object is returned $try .= ' $m = $m->bstr(); $m = "NaN" if !defined $m;'; $try .= ' $e = $e->bstr(); $e = "NaN" if !defined $e;'; $try .= ' "$m,$e";'; } elsif ($f eq "bexp") { $try .= " \$x->bexp();"; } elsif ($f eq "bpi") { $try .= " $CLASS\->bpi(\$x);"; } else { # binary operators $try .= qq| \$y = $CLASS->new("$args[1]");|; if ($f eq "bcmp") { $try .= ' $x->bcmp($y);'; } elsif ($f eq "bround") { $try .= " $round_mode; \$x->bround(\$y);"; } elsif ($f eq "bacmp") { $try .= ' $x->bacmp($y);'; } elsif ($f eq "badd") { $try .= ' $x + $y;'; } elsif ($f eq "bsub") { $try .= ' $x - $y;'; } elsif ($f eq "bmul") { $try .= ' $x * $y;'; } elsif ($f eq "bdiv") { $try .= ' $x / $y;'; } elsif ($f eq "bdiv-list") { $try .= ' join (",", $x->bdiv($y));'; # overload via x= } elsif ($f =~ /^.=$/) { $try .= " \$x $f \$y;"; # overload via x } elsif ($f =~ /^.$/) { $try .= " \$x $f \$y;"; } elsif ($f eq "bmod") { $try .= ' $x % $y;'; } elsif ($f eq "bgcd") { if (defined $args[2]) { $try .= qq| \$z = $CLASS->new("$args[2]");|; } $try .= " $CLASS\::bgcd(\$x, \$y"; $try .= ", \$z" if defined $args[2]; $try .= ");"; } elsif ($f eq "blcm") { if (defined $args[2]) { $try .= qq| \$z = $CLASS->new("$args[2]");|; } $try .= " $CLASS\::blcm(\$x, \$y"; $try .= ", \$z" if defined $args[2]; $try .= ");"; } elsif ($f eq "blsft") { if (defined $args[2]) { $try .= " \$x->blsft(\$y, $args[2]);"; } else { $try .= " \$x << \$y;"; } } elsif ($f eq "brsft") { if (defined $args[2]) { $try .= " \$x->brsft(\$y, $args[2]);"; } else { $try .= " \$x >> \$y;"; } } elsif ($f eq "bnok") { $try .= " \$x->bnok(\$y);"; } elsif ($f eq "broot") { $try .= " \$x->broot(\$y);"; } elsif ($f eq "blog") { $try .= " \$x->blog(\$y);"; } elsif ($f eq "band") { $try .= " \$x & \$y;"; } elsif ($f eq "bior") { $try .= " \$x | \$y;"; } elsif ($f eq "bxor") { $try .= " \$x ^ \$y;"; } elsif ($f eq "bpow") { $try .= " \$x ** \$y;"; } elsif ( $f eq "bmodinv") { $try .= " \$x->bmodinv(\$y);"; } elsif ($f eq "digit") { $try .= " \$x->digit(\$y);"; } elsif ($f eq "batan2") { $try .= " \$x->batan2(\$y);"; } else { # Functions with three arguments $try .= qq| \$z = $CLASS->new("$args[2]");|; if ( $f eq "bmodpow") { $try .= " \$x->bmodpow(\$y, \$z);"; } elsif ($f eq "bmuladd") { $try .= " \$x->bmuladd(\$y, \$z);"; } else { warn "Unknown op '$f'"; } } } # end else all other ops $got = eval $try; print "# Error: $@\n" if $@; # convert hex/binary targets to decimal if ($want =~ /^(0x0x|0b0b)/) { $want =~ s/^0[xb]//; $want = Math::BigInt->new($want)->bstr(); } if ($want eq "") { is($got, undef, $try); } else { # print "try: $try ans: $got $want\n"; is($got, $want, $try); is(ref($got), $expected_class, qq|output is a "$expected_class" object|) if $expected_class ne $CLASS; } # check internal state of number objects is_valid($got, $f) if ref $got; } # endwhile data tests close DATA; # test whether self-multiplication works correctly (result is 2**64) $try = qq|\$x = $CLASS->new("4294967296");|; $try .= ' $a = $x->bmul($x);'; $got = eval $try; is($got, $CLASS->new(2) ** 64, $try); # test self-pow $try = qq|\$x = $CLASS->new(10);|; $try .= ' $a = $x->bpow($x);'; $got = eval $try; is($got, $CLASS->new(10) ** 10, $try); ############################################################################### # test whether op destroys args or not (should better not) $x = $CLASS->new(3); $y = $CLASS->new(4); $z = $x & $y; is($x, 3, '$z = $x & $y; $x'); is($y, 4, '$z = $x & $y; $y'); is($z, 0, '$z = $x & $y; $z'); $z = $x | $y; is($x, 3, '$z = $x | $y; $x'); is($y, 4, '$z = $x | $y; $y'); is($z, 7, '$z = $x | $y; $z'); $x = $CLASS->new(1); $y = $CLASS->new(2); $z = $x | $y; is($x, 1, '$z = $x | $y; $x'); is($y, 2, '$z = $x | $y; $y'); is($z, 3, '$z = $x | $y; $z'); $x = $CLASS->new(5); $y = $CLASS->new(4); $z = $x ^ $y; is($x, 5, '$z = $x ^ $y; $x'); is($y, 4, '$z = $x ^ $y; $y'); is($z, 1, '$z = $x ^ $y; $z'); $x = $CLASS->new(-5); $y = -$x; is($x, -5, '$y = -$x; $x'); $x = $CLASS->new(-5); $y = abs($x); is($x, -5, '$y = abs($x); $x'); $x = $CLASS->new(8); $y = $CLASS->new(-1); $z = $CLASS->new(5033); my $u = $x->copy()->bmodpow($y, $z); is($u, 4404, '$x->copy()->bmodpow($y, $z); $u'); is($y, -1, '$x->copy()->bmodpow($y, $z); $y'); is($z, 5033, '$x->copy()->bmodpow($y, $z); $z'); $x = $CLASS->new(-5); $y = -$x; is($x, -5, '$y = -$x; $x'); is($y, 5, '$y = -$x; $y'); $x = $CLASS->new(-5); $y = $x->copy()->bneg(); is($x, -5, '$y = $x->copy()->bneg(); $x'); is($y, 5, '$y = $x->copy()->bneg(); $y'); $x = $CLASS->new(-5); $y = $CLASS->new(3); $x->bmul($y); is($x, -15, '$x->bmul($y); $x'); is($y, 3, '$x->bmul($y); $y'); $x = $CLASS->new(-5); $y = $CLASS->new(3); $x->badd($y); is($x, -2, '$x->badd($y); $x'); is($y, 3, '$x->badd($y); $y'); $x = $CLASS->new(-5); $y = $CLASS->new(3); $x->bsub($y); is($x, -8, '$x->bsub($y); $x'); is($y, 3, '$x->bsub($y); $y'); $x = $CLASS->new(-15); $y = $CLASS->new(3); $x->bdiv($y); is($x, -5, '$x->bdiv($y); $x'); is($y, 3, '$x->bdiv($y); $y'); $x = $CLASS->new(-5); $y = $CLASS->new(3); $x->bmod($y); is($x, 1, '$x->bmod($y); $x'); is($y, 3, '$x->bmod($y); $y'); $x = $CLASS->new(5); $y = $CLASS->new(3); $x->bmul($y); is($x, 15, '$x->bmul($y); $x'); is($y, 3, '$x->bmul($y); $y'); $x = $CLASS->new(5); $y = $CLASS->new(3); $x->badd($y); is($x, 8, '$x->badd($y); $x'); is($y, 3, '$x->badd($y); $y'); $x = $CLASS->new(5); $y = $CLASS->new(3); $x->bsub($y); is($x, 2, '$x->bsub($y); $x'); is($y, 3, '$x->bsub($y); $y'); $x = $CLASS->new(15); $y = $CLASS->new(3); $x->bdiv($y); is($x, 5, '$x->bdiv($y); $x'); is($y, 3, '$x->bdiv($y); $y'); $x = $CLASS->new(5); $y = $CLASS->new(3); $x->bmod($y); is($x, 2, '$x->bmod($y); $x'); is($y, 3, '$x->bmod($y); $y'); $x = $CLASS->new(5); $y = $CLASS->new(-3); $x->bmul($y); is($x, -15, '$x->bmul($y); $x'); is($y, -3, '$x->bmul($y); $y'); $x = $CLASS->new(5); $y = $CLASS->new(-3); $x->badd($y); is($x, 2, '$x->badd($y); $x'); is($y, -3, '$x->badd($y); $y'); $x = $CLASS->new(5); $y = $CLASS->new(-3); $x->bsub($y); is($x, 8, '$x->bsub($y); $x'); is($y, -3, '$x->bsub($y); $y'); $x = $CLASS->new(15); $y = $CLASS->new(-3); $x->bdiv($y); is($x, -5, '$x->bdiv($y); $x'); is($y, -3, '$x->bdiv($y); $y'); $x = $CLASS->new(5); $y = $CLASS->new(-3); $x->bmod($y); is($x, -1, '$x->bmod($y); $x'); is($y, -3, '$x->bmod($y); $y'); ############################################################################### # check whether overloading cmp works $try = '$x = $CLASS->new(0);'; $try .= ' $y = 10;'; $try .= ' $x ne $y;'; $want = eval $try; ok($want, "overloading cmp works"); # We can't test for working cmpt with other objects here, we would need a dummy # object with stringify overload for this. See Math::String tests as example. ############################################################################### # check reversed order of arguments $try = "\$x = $CLASS->new(10); \$x = 2 ** \$x; \$x == 1024;"; $want = eval $try; ok($want, $try); $try = "\$x = $CLASS->new(10); \$x = 2 * \$x; \$x == 20;"; $want = eval $try; ok($want, $try); $try = "\$x = $CLASS->new(10); \$x = 2 + \$x; \$x == 12;"; $want = eval $try; ok($want, $try); $try = "\$x = $CLASS\->new(10); \$x = 2 - \$x; \$x == -8;"; $want = eval $try; ok($want, $try); $try = "\$x = $CLASS\->new(10); \$x = 20 / \$x; \$x == 2;"; $want = eval $try; ok($want, $try); $try = "\$x = $CLASS\->new(3); \$x = 20 % \$x; \$x == 2;"; $want = eval $try; ok($want, $try); $try = "\$x = $CLASS\->new(7); \$x = 20 & \$x; \$x == 4;"; $want = eval $try; ok($want, $try); $try = "\$x = $CLASS\->new(7); \$x = 0x20 | \$x; \$x == 0x27;"; $want = eval $try; ok($want, $try); $try = "\$x = $CLASS\->new(7); \$x = 0x20 ^ \$x; \$x == 0x27;"; $want = eval $try; ok($want, $try); ############################################################################### # check badd(4, 5) form $try = "\$x = $CLASS\->badd(4, 5); \$x == 9;"; $want = eval $try; ok($want, $try); ############################################################################### # check undefs: NOT DONE YET ############################################################################### # bool $x = $CLASS->new(1); if ($x) { pass("\$x = $CLASS->new(1); \$x is true"); } else { fail("\$x = $CLASS->new(1); \$x is true"); } $x = $CLASS->new(0); if (!$x) { pass("\$x = $CLASS->new(0); !\$x is false"); } else { fail("\$x = $CLASS->new(0); !\$x is false"); } ############################################################################### # objectify() @args = Math::BigInt::objectify(2, 4, 5); is(scalar(@args), 3, "objectify(2, 4, 5) gives $CLASS, 4, 5"); like($args[0], qr/^Math::BigInt/, "first arg matches /^Math::BigInt/"); is($args[1], 4, "second arg is 4"); is($args[2], 5, "third arg is 5"); @args = Math::BigInt::objectify(0, 4, 5); is(scalar(@args), 3, "objectify(0, 4, 5) gives $CLASS, 4, 5"); like($args[0], qr/^Math::BigInt/, "first arg matches /^Math::BigInt/"); is($args[1], 4, "second arg is 4"); is($args[2], 5, "third arg is 5"); @args = Math::BigInt::objectify(2, 4, 5); is(scalar(@args), 3, "objectify(2, 4, 5) gives $CLASS, 4, 5"); like($args[0], qr/^Math::BigInt/, "first arg matches /^Math::BigInt/"); is($args[1], 4, "second arg is 4"); is($args[2], 5, "third arg is 5"); @args = Math::BigInt::objectify(2, 4, 5, 6, 7); is(scalar(@args), 5, "objectify(2, 4, 5, 6, 7) gives $CLASS, 4, 5, 6, 7"); like($args[0], qr/^Math::BigInt/, "first arg matches /^Math::BigInt/"); is($args[1], 4, "second arg is 4"); is(ref($args[1]), $args[0], "second arg is a $args[0] object"); is($args[2], 5, "third arg is 5"); is(ref($args[2]), $args[0], "third arg is a $args[0] object"); is($args[3], 6, "fourth arg is 6"); is(ref($args[3]), '', "fourth arg is a scalar"); is($args[4], 7, "fifth arg is 7"); is(ref($args[4]), '', "fifth arg is a scalar"); @args = Math::BigInt::objectify(2, $CLASS, 4, 5, 6, 7); is(scalar(@args), 5, "objectify(2, $CLASS, 4, 5, 6, 7) gives $CLASS, 4, 5, 6, 7"); is($args[0], $CLASS, "first arg is $CLASS"); is($args[1], 4, "second arg is 4"); is(ref($args[1]), $args[0], "second arg is a $args[0] object"); is($args[2], 5, "third arg is 5"); is(ref($args[2]), $args[0], "third arg is a $args[0] object"); is($args[3], 6, "fourth arg is 6"); is(ref($args[3]), '', "fourth arg is a scalar"); is($args[4], 7, "fifth arg is 7"); is(ref($args[4]), '', "fifth arg is a scalar"); ############################################################################### # test whether an opp calls objectify properly or not (or at least does what # it should do given non-objects, w/ or w/o objectify()) is($CLASS->new(123)->badd(123), 246, qq|$CLASS->new(123)->badd(123) = 246|);; is($CLASS->badd(123, 321), 444, qq|$CLASS->badd(123, 321) = 444|);; is($CLASS->badd(123, $CLASS->new(321)), 444, qq|$CLASS->badd(123, $CLASS->new(321)) = 444|);; is($CLASS->new(123)->bsub(122), 1, qq|$CLASS->new(123)->bsub(122) = 1|);; is($CLASS->bsub(321, 123), 198, qq|$CLASS->bsub(321, 123) = 198|);; is($CLASS->bsub(321, $CLASS->new(123)), 198, qq|$CLASS->bsub(321, $CLASS->new(123)) = 198|);; is($CLASS->new(123)->bmul(123), 15129, qq|$CLASS->new(123)->bmul(123) = 15129|);; is($CLASS->bmul(123, 123), 15129, qq|$CLASS->bmul(123, 123) = 15129|);; is($CLASS->bmul(123, $CLASS->new(123)), 15129, qq|$CLASS->bmul(123, $CLASS->new(123)) = 15129|);; is($CLASS->new(15129)->bdiv(123), 123, qq|$CLASS->new(15129)->bdiv(123) = 123|);; is($CLASS->bdiv(15129, 123), 123, qq|$CLASS->bdiv(15129, 123) = 123|);; is($CLASS->bdiv(15129, $CLASS->new(123)), 123, qq|$CLASS->bdiv(15129, $CLASS->new(123)) = 123|);; is($CLASS->new(15131)->bmod(123), 2, qq|$CLASS->new(15131)->bmod(123) = 2|);; is($CLASS->bmod(15131, 123), 2, qq|$CLASS->bmod(15131, 123) = 2|);; is($CLASS->bmod(15131, $CLASS->new(123)), 2, qq|$CLASS->bmod(15131, $CLASS->new(123)) = 2|);; is($CLASS->new(2)->bpow(16), 65536, qq|$CLASS->new(2)->bpow(16) = 65536|);; is($CLASS->bpow(2, 16), 65536, qq|$CLASS->bpow(2, 16) = 65536|);; is($CLASS->bpow(2, $CLASS->new(16)), 65536, qq|$CLASS->bpow(2, $CLASS->new(16)) = 65536|);; is($CLASS->new(2**15)->brsft(1), 2**14, qq|$CLASS->new(2**15)->brsft(1) = 2**14|);; is($CLASS->brsft(2**15, 1), 2**14, qq|$CLASS->brsft(2**15, 1) = 2**14|);; is($CLASS->brsft(2**15, $CLASS->new(1)), 2**14, qq|$CLASS->brsft(2**15, $CLASS->new(1)) = 2**14|);; is($CLASS->new(2**13)->blsft(1), 2**14, qq|$CLASS->new(2**13)->blsft(1) = 2**14|);; is($CLASS->blsft(2**13, 1), 2**14, qq|$CLASS->blsft(2**13, 1) = 2**14|);; is($CLASS->blsft(2**13, $CLASS->new(1)), 2**14, qq|$CLASS->blsft(2**13, $CLASS->new(1)) = 2**14|);; ############################################################################### # test for floating-point input (other tests in bnorm() below) $z = 1050000000000000; # may be int on systems with 64bit? $x = $CLASS->new($z); is($x->bsstr(), '105e+13', # not 1.05e+15 qq|\$x = $CLASS->new($z); \$x->bsstr() = "105e+13"|); $z = 1e+129; # definitely a float (may fail on UTS) # don't compare to $z, since some Perl versions stringify $z into something # like '1.e+129' or something equally ugly $x = $CLASS->new($z); is($x->bsstr(), '1e+129', qq|\$x = $CLASS->new($z); \$x->bsstr() = "1e+129"|); ############################################################################### # test for whitespace including newlines to be handled correctly # is($Math::BigInt::strict, 1); # the default foreach my $c (qw/1 12 123 1234 12345 123456 1234567 12345678 123456789 1234567890/) { my $m = $CLASS->new($c); is($CLASS->new("$c"), $m, qq|$CLASS->new("$c") = $m|); is($CLASS->new(" $c"), $m, qq|$CLASS->new(" $c") = $m|); is($CLASS->new("$c "), $m, qq|$CLASS->new("$c ") = $m|); is($CLASS->new(" $c "), $m, qq|$CLASS->new(" $c ") = $m|); is($CLASS->new("\n$c"), $m, qq|$CLASS->new("\\n$c") = $m|); is($CLASS->new("$c\n"), $m, qq|$CLASS->new("$c\\n") = $m|); is($CLASS->new("\n$c\n"), $m, qq|$CLASS->new("\\n$c\\n") = $m|); is($CLASS->new(" \n$c\n"), $m, qq|$CLASS->new(" \\n$c\\n") = $m|); is($CLASS->new(" \n$c \n"), $m, qq|$CLASS->new(" \\n$c \\n") = $m|); is($CLASS->new(" \n$c\n "), $m, qq|$CLASS->new(" \\n$c\\n ") = $m|); is($CLASS->new(" \n$c\n1"), 'NaN', qq|$CLASS->new(" \\n$c\\n1") = 'NaN'|); is($CLASS->new("1 \n$c\n1"), 'NaN', qq|$CLASS->new("1 \\n$c\\n1") = 'NaN'|); } ############################################################################### # prime number tests, also test for **= and length() # found on: http://www.utm.edu/research/primes/notes/by_year.html # ((2^148)+1)/17 $x = $CLASS->new(2); $x **= 148; $x++; $x = $x / 17; is($x, "20988936657440586486151264256610222593863921", "value of ((2^148)+1)/17"); is($x->length(), length("20988936657440586486151264256610222593863921"), "number of digits in ((2^148)+1)/17"); # MM7 = 2^127-1 $x = $CLASS->new(2); $x **= 127; $x--; is($x, "170141183460469231731687303715884105727", "value of 2^127-1"); $x = $CLASS->new('215960156869840440586892398248'); ($x, $y) = $x->length(); is($x, 30, "number of digits in 2^127-1"); is($y, 0, "number of digits in fraction part of 2^127-1"); $x = $CLASS->new('1_000_000_000_000'); ($x, $y) = $x->length(); is($x, 13, "number of digits in 1_000_000_000_000"); is($y, 0, "number of digits in fraction part of 1_000_000_000_000"); # test <<=, >>= $x = $CLASS->new('2'); $y = $CLASS->new('18'); is($x <<= $y, 2 << 18, "2 <<= 18 with $CLASS objects"); is($x, 2 << 18, "2 <<= 18 with $CLASS objects"); is($x >>= $y, 2, "2 >>= 18 with $CLASS objects"); is($x, 2, "2 >>= 18 with $CLASS objects"); # I am afraid the following is not yet possible due to slowness # Also, testing for 2 meg output is a bit hard ;) #$x = $CLASS->new(2); #$x **= 6972593; #$x--; # 593573509*2^332162+1 has exactly 1,000,000 digits # takes about 24 mins on 300 Mhz, so cannot be done yet ;) #$x = $CLASS->new(2); #$x **= 332162; #$x *= "593573509"; #$x++; #is($x->length(), 1_000_000); ############################################################################### # inheritance and overriding of _swap $x = Math::Foo->new(5); $x = $x - 8; # 8 - 5 instead of 5-8 is($x, 3, '$x = Math::Foo->new(5); $x = $x - 8; $x = 3'); is(ref($x), 'Math::Foo', '$x is an object of class "Math::Foo"'); $x = Math::Foo->new(5); $x = 8 - $x; # 5 - 8 instead of 8 - 5 is($x, -3, '$x = Math::Foo->new(5); $x = 8 - $x; $x = -3'); is(ref($x), 'Math::Foo', '$x is an object of class "Math::Foo"'); ############################################################################### # Check numify on non-finite objects. { require Math::Complex; my $inf = Math::Complex::Inf(); my $nan = $inf - $inf; is($CLASS -> binf("+") -> numify(), $inf, "numify of +Inf"); is($CLASS -> binf("-") -> numify(), -$inf, "numify of -Inf"); is($CLASS -> bnan() -> numify(), $nan, "numify of NaN"); } ############################################################################### # Test whether +inf eq inf # # This tried to test whether Math::BigInt inf equals Perl inf. Unfortunately, # Perl hasn't (before 5.7.3 at least) a consistent way to say inf, and some # things like 1e100000 crash on some platforms. So simple test for the string # 'inf'. $x = $CLASS->new('+inf'); is($x, 'inf', qq|$CLASS->new("+inf") = "inf"|); ############################################################################### # numify() and 64 bit integer support require Config; SKIP: { skip("no 64 bit integer support", 4) if ! $Config::Config{use64bitint} || ! $Config::Config{use64bitall} || $] <= 5.006002; # The following should not give "1.84467440737096e+19". $x = $CLASS -> new(2) -> bpow(64) -> bdec(); is($x -> bstr(), "18446744073709551615", "bigint 2**64-1 as string"); is($x -> numify(), "18446744073709551615", "bigint 2**64-1 as number"); # The following should not give "-9.22337203685478e+18". $x = $CLASS -> new(2) -> bpow(63) -> bneg(); is($x -> bstr(), "-9223372036854775808", "bigint -2**63 as string"); is($x -> numify(), "-9223372036854775808", "bigint -2**63 as number"); }; ############################################################################### ############################################################################### # the following tests only make sense with Math::BigInt::Calc or BareCalc or # FastCalc SKIP: { # skip GMP, Pari et al. skip("skipping tests not intended for the backend $CALC", 50) unless $CALC =~ /^Math::BigInt::(Bare|Fast)?Calc$/; ########################################################################### # check proper length of internal arrays my $bl = $CALC->_base_len(); my $BASE = '9' x $bl; my $MAX = $BASE; $BASE++; # f.i. 9999 $x = $CLASS->new($MAX); is_valid($x); # 10000 $x += 1; is($x, $BASE, "\$x == $BASE"); is_valid($x); # 9999 again $x -= 1; is($x, $MAX, "\$x == $MAX"); is_valid($x); ########################################################################### # check numify $x = $CLASS->new($BASE-1); is($x->numify(), $BASE-1, q|$x->numify() = $BASE-1|); $x = $CLASS->new(-($BASE-1)); is($x->numify(), -($BASE-1), q|$x->numify() = -($BASE-1)|); # +0 is to protect from 1e15 vs 100000000 (stupid to_string aaarglburbll...) $x = $CLASS->new($BASE); is($x->numify()+0, $BASE+0, q|$x->numify()+0 = $BASE+0|); $x = $CLASS->new(-$BASE); is($x->numify(), -$BASE, q|$x->numify() = -$BASE|); $x = $CLASS->new(-($BASE*$BASE*1+$BASE*1+1)); is($x->numify(), -($BASE*$BASE*1+$BASE*1+1), q|$x->numify() = -($BASE*$BASE*1+$BASE*1+1))|); ########################################################################### # test bug in _digits with length($c[-1]) where $c[-1] was "00001" instead # of 1 $x = $CLASS->new($BASE - 2); $x++; $x++; $x++; $x++; ok($x > $BASE, '$x > $BASE'); $x = $CLASS->new($BASE + 3); $x++; ok($x > $BASE, '$x > $BASE'); # test for +0 instead of int(): $x = $CLASS->new($MAX); is($x->length(), length($MAX), q|$x->length() = length($MAX)|); ########################################################################### # test bug that $CLASS->digit($string) did not work is($CLASS->digit(123, 2), 1, qq|$CLASS->digit(123, 2) = 1|); ########################################################################### # bug in sub where number with at least 6 trailing zeros after any op failed $x = $CLASS->new(123456); $z = $CLASS->new(10000); $z *= 10; $x -= $z; is($z, 100000, "testing bug in sub"); is($x, 23456, "testing bug in sub"); ########################################################################### # bug in shortcut in mul() # construct a number with a zero-hole of BASE_LEN_SMALL { my @bl = $CALC->_base_len(); my $bl = $bl[5]; $x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl; $y = '1' x (2 * $bl); $x = $CLASS->new($x)->bmul($y); # result is 123..$bl . $bl x (3*bl-1) . $bl...321 . '0' x $bl $y = ''; my $d = ''; for (my $i = 1; $i <= $bl; $i++) { $y .= $i; $d = $i . $d; } $y .= $bl x (3 * $bl - 1) . $d . '0' x $bl; is($x, $y, "testing number with a zero-hole of BASE_LEN_SMALL"); ######################################################################### # see if mul shortcut for small numbers works $x = '9' x $bl; $x = $CLASS->new($x); # 999 * 999 => 998 . 001, 9999*9999 => 9998 . 0001 is($x * $x, '9' x ($bl - 1) . '8' . '0' x ($bl - 1) . '1', "see if mul shortcut for small numbers works"); } ########################################################################### # bug with rest "-0" in div, causing further div()s to fail $x = $CLASS->new('-322056000'); ($x, $y) = $x->bdiv('-12882240'); is($y, '0', '-322056000 / -12882240 has remainder 0'); is_valid($y); # $y not '-0' ########################################################################### # bug in $x->bmod($y) # if $x < 0 and $y > 0 $x = $CLASS->new('-629'); is($x->bmod(5033), 4404, q|$x->bmod(5033) = 4404|); ########################################################################### # bone/binf etc as plain calls (Lite failed them) is($CLASS->bzero(), 0, qq|$CLASS->bzero() = 0|); is($CLASS->bone(), 1, qq|$CLASS->bone() = 1|); is($CLASS->bone("+"), 1, qq|$CLASS->bone("+") = 1|); is($CLASS->bone("-"), -1, qq|$CLASS->bone("-") = -1|); is($CLASS->bnan(), "NaN", qq|$CLASS->bnan() = "NaN"|); is($CLASS->binf(), "inf", qq|$CLASS->binf() = "inf"|); is($CLASS->binf("+"), "inf", qq|$CLASS->binf("+") = "inf"|); is($CLASS->binf("-"), "-inf", qq|$CLASS->binf("-") = "-inf"|); is($CLASS->binf("-inf"), "-inf", qq|$CLASS->binf("-inf") = "-inf"|); ########################################################################### # is_one("-") is($CLASS->new(1)->is_one("-"), 0, qq|$CLASS->new(1)->is_one("-") = 0|); is($CLASS->new(-1)->is_one("-"), 1, qq|$CLASS->new(-1)->is_one("-") = 1|); is($CLASS->new(1)->is_one(), 1, qq|$CLASS->new(1)->is_one() = 1|); is($CLASS->new(-1)->is_one(), 0, qq|$CLASS->new(-1)->is_one() = 0|); ########################################################################### # [perl #30609] bug with $x -= $x not being 0, but 2*$x $x = $CLASS->new(3); $x -= $x; is($x, 0, qq|\$x = $CLASS->new(3); \$x -= \$x; = 0|); $x = $CLASS->new(-3); $x -= $x; is($x, 0, qq|\$x = $CLASS->new(-3); \$x -= \$x; = 0|); $x = $CLASS->new("NaN"); $x -= $x; is($x->is_nan(), 1, qq|\$x = $CLASS->new("NaN"); \$x -= \$x; \$x->is_nan() = 1|); $x = $CLASS->new("inf"); $x -= $x; is($x->is_nan(), 1, qq|\$x = $CLASS->new("inf"); \$x -= \$x; \$x->is_nan() = 1|); $x = $CLASS->new("-inf"); $x -= $x; is($x->is_nan(), 1, qq|\$x = $CLASS->new("-inf"); \$x -= \$x; \$x->is_nan() = 1|); $x = $CLASS->new("NaN"); $x += $x; is($x->is_nan(), 1, qq|\$x = $CLASS->new("NaN"); \$x += \$x; \$x->is_nan() = 1|); $x = $CLASS->new("inf"); $x += $x; is($x->is_inf(), 1, qq|\$x = $CLASS->new("inf"); \$x += \$x; \$x->is_inf() = 1|); $x = $CLASS->new("-inf"); $x += $x; is($x->is_inf("-"), 1, qq|\$x = $CLASS->new("-inf"); \$x += \$x; \$x->is_inf("-") = 1|); $x = $CLASS->new(3); $x += $x; is($x, 6, qq|\$x = $CLASS->new(3); \$x += \$x; \$x = 6|); $x = $CLASS->new(-3); $x += $x; is($x, -6, qq|\$x = $CLASS->new(-3); \$x += \$x; \$x = -6|); $x = $CLASS->new(3); $x *= $x; is($x, 9, qq|\$x = $CLASS->new(3); \$x *= \$x; \$x = 9|); $x = $CLASS->new(-3); $x *= $x; is($x, 9, qq|\$x = $CLASS->new(-3); \$x *= \$x; \$x = 9|); $x = $CLASS->new(3); $x /= $x; is($x, 1, qq|\$x = $CLASS->new(3); \$x /= \$x; \$x = 1|); $x = $CLASS->new(-3); $x /= $x; is($x, 1, qq|\$x = $CLASS->new(-3); \$x /= \$x; \$x = 1|); $x = $CLASS->new(3); $x %= $x; is($x, 0, qq|\$x = $CLASS->new(3); \$x %= \$x; \$x = 0|); $x = $CLASS->new(-3); $x %= $x; is($x, 0, qq|\$x = $CLASS->new(-3); \$x %= \$x; \$x = 0|); } ############################################################################### # all tests done 1; ############################################################################### # sub to check validity of a Math::BigInt internally, to ensure that no op # leaves a number object in an invalid state (f.i. "-0") sub is_valid { my ($x, $f) = @_; my $e = 0; # error? # allow the check to pass for all Lite, and all MBI and subclasses # ok as reference? $e = 'Not a reference to Math::BigInt' if ref($x) !~ /^Math::BigInt/; if (ref($x) ne 'Math::BigInt::Lite') { # has ok sign? $e = qq|Illegal sign $x->{sign}| . qq| (expected: "+", "-", "-inf", "+inf" or "NaN"| if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/; $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0; $e = $CALC->_check($x->{value}) if $e eq '0'; } # test done, see if error did crop up if ($e eq '0') { pass('is a valid object'); return; } fail($e . " after op '$f'"); } __DATA__ &.= 1234:-345:1234-345 &+= 1:2:3 -1:-2:-3 &-= 1:2:-1 -1:-2:1 &*= 2:3:6 -1:5:-5 &%= 100:3:1 8:9:8 -629:5033:4404 &/= 100:3:33 -8:2:-4 &|= 2:1:3 &&= 5:7:5 &^= 5:7:2 &blog # NaNlog:2:NaN 122:NaNlog:NaN NaNlog1:NaNlog:NaN # 122:inf:0 inf:122:inf 122:-inf:0 -inf:122:inf -inf:-inf:NaN 0:4:-inf -21:4:NaN 21:-21:NaN # 0:-inf:NaN 0:-1:NaN 0:0:NaN 0:1:NaN 0:inf:NaN # 1:-inf:0 1:-1:0 1:0:0 1:1:NaN 1:4:0 1:inf:0 # inf:-inf:NaN inf:-1:NaN inf:0:NaN inf:1:NaN inf:4:inf inf:inf:NaN # # normal results 1024:2:10 81:3:4 # 3.01.. truncate 82:3:4 # 3.9... truncate 80:3:3 4096:2:12 15625:5:6 15626:5:6 15624:5:5 1000:10:3 10000:10:4 100000:10:5 1000000:10:6 10000000:10:7 100000000:10:8 8916100448256:12:12 8916100448257:12:12 8916100448255:12:11 2251799813685248:8:17 72057594037927936:2:56 144115188075855872:2:57 288230376151711744:2:58 576460752303423488:2:59 1329227995784915872903807060280344576:2:120 # $x == $base => result 1 3:3:1 # $x < $base => result 0 ($base ** 0 <= $x) 3:4:0 # $x == 1 => result 0 1:5:0 &is_negative 0:0 -1:1 1:0 +inf:0 -inf:1 NaNneg:0 &is_positive 0:0 -1:0 1:1 +inf:1 -inf:0 NaNneg:0 &is_int -inf:0 +inf:0 NaNis_int:0 1:1 0:1 123e12:1 &is_odd abc:0 0:0 1:1 3:1 -1:1 -3:1 10000001:1 10000002:0 2:0 120:0 121:1 &is_even abc:0 0:1 1:0 3:0 -1:0 -3:0 10000001:0 10000002:1 2:1 120:1 121:0 &bacmp +0:-0:0 +0:+1:-1 -1:+1:0 +1:-1:0 -1:+2:-1 +2:-1:1 -123456789:+987654321:-1 +123456789:-987654321:-1 +987654321:+123456789:1 -987654321:+123456789:1 -123:+4567889:-1 # NaNs acmpNaN:123: 123:acmpNaN: acmpNaN:acmpNaN: # infinity +inf:+inf:0 -inf:-inf:0 +inf:-inf:0 -inf:+inf:0 +inf:123:1 -inf:123:1 +inf:-123:1 -inf:-123:1 123:-inf:-1 -123:inf:-1 -123:-inf:-1 123:inf:-1 # return undef +inf:NaN: NaN:inf: -inf:NaN: NaN:-inf: &bnorm 0e999:0 0e-999:0 -0e999:0 -0e-999:0 123:123 123.000:123 123e0:123 123e+0:123 123e-0:123 123.000e0:123 123.000e+0:123 123.000e-0:123 # binary input 0babc:NaN 0b123:NaN 0b0:0 -0b0:0 -0b1:-1 0b0001:1 0b001:1 0b011:3 0b101:5 0b1001:9 0b10001:17 0b100001:33 0b1000001:65 0b10000001:129 0b100000001:257 0b1000000001:513 0b10000000001:1025 0b100000000001:2049 0b1000000000001:4097 0b10000000000001:8193 0b100000000000001:16385 0b1000000000000001:32769 0b10000000000000001:65537 0b100000000000000001:131073 0b1000000000000000001:262145 0b10000000000000000001:524289 0b100000000000000000001:1048577 0b1000000000000000000001:2097153 0b10000000000000000000001:4194305 0b100000000000000000000001:8388609 0b1000000000000000000000001:16777217 0b10000000000000000000000001:33554433 0b100000000000000000000000001:67108865 0b1000000000000000000000000001:134217729 0b10000000000000000000000000001:268435457 0b100000000000000000000000000001:536870913 0b1000000000000000000000000000001:1073741825 0b10000000000000000000000000000001:2147483649 0b100000000000000000000000000000001:4294967297 0b1000000000000000000000000000000001:8589934593 0b10000000000000000000000000000000001:17179869185 0b__101:NaN 0b1_0_1:5 0b0_0_0_1:1 # hex input -0x0:0 0xabcdefgh:NaN 0x1234:4660 0xabcdef:11259375 -0xABCDEF:-11259375 -0x1234:-4660 0x12345678:305419896 0x1_2_3_4_56_78:305419896 0xa_b_c_d_e_f:11259375 0x__123:NaN 0x9:9 0x11:17 0x21:33 0x41:65 0x81:129 0x101:257 0x201:513 0x401:1025 0x801:2049 0x1001:4097 0x2001:8193 0x4001:16385 0x8001:32769 0x10001:65537 0x20001:131073 0x40001:262145 0x80001:524289 0x100001:1048577 0x200001:2097153 0x400001:4194305 0x800001:8388609 0x1000001:16777217 0x2000001:33554433 0x4000001:67108865 0x8000001:134217729 0x10000001:268435457 0x20000001:536870913 0x40000001:1073741825 0x80000001:2147483649 0x100000001:4294967297 0x200000001:8589934593 0x400000001:17179869185 0x800000001:34359738369 # bug found by Mark Lakata in Calc.pm creating too big one-element numbers # in _from_hex() 0x2dd59e18a125dbed30a6ab1d93e9c855569f44f75806f0645dc9a2e98b808c3:1295719234436071846486578237372801883390756472611551858964079371952886122691 # inf input inf:inf +inf:inf -inf:-inf 0inf:NaN # abnormal input :NaN abc:NaN 1 a:NaN 1bcd2:NaN 11111b:NaN +1z:NaN -1z:NaN # only one underscore between two digits _123:NaN _123_:NaN 123_:NaN 1__23:NaN 1E1__2:NaN 1_E12:NaN 1E_12:NaN 1_E_12:NaN +_1E12:NaN +0_1E2:100 +0_0_1E2:100 -0_0_1E2:-100 -0_0_1E+0_0_2:-100 E1:NaN E23:NaN 1.23E1:NaN 1.23E-1:NaN # bug with two E's in number being valid 1e2e3:NaN 1e2r:NaN 1e2.0:NaN # bug with two '.' in number being valid 1.2.2:NaN 1.2.3e1:NaN -1.2.3:NaN -1.2.3e-4:NaN 1.2e3.4:NaN 1.2e-3.4:NaN 1.2.3.4:NaN 1.2.t:NaN 1..2:NaN 1..2e1:NaN 1..2e1..1:NaN 12e1..1:NaN ..2:NaN .-2:NaN # leading zeros 012:12 0123:123 01234:1234 012345:12345 0123456:123456 01234567:1234567 012345678:12345678 0123456789:123456789 01234567891:1234567891 012345678912:12345678912 0123456789123:123456789123 01234567891234:1234567891234 # some inputs that result in zero 0e0:0 +0e0:0 +0e+0:0 -0e+0:0 0e-0:0 -0e-0:0 +0e-0:0 000:0 00e2:0 00e02:0 000e002:0 000e1230:0 00e-3:0 00e+3:0 00e-03:0 00e+03:0 -000:0 -00e2:0 -00e02:0 -000e002:0 -000e1230:0 -00e-3:0 -00e+3:0 -00e-03:0 -00e+03:0 # normal input 0:0 +0:0 +00:0 +000:0 000000000000000000:0 -0:0 -0000:0 +1:1 +01:1 +001:1 +00000100000:100000 123456789:123456789 -1:-1 -01:-1 -001:-1 -123456789:-123456789 -00000100000:-100000 1_2_3:123 10000000000E-1_0:1 1E2:100 1E1:10 1E0:1 1.23E2:123 100E-1:10 # floating point input # .2e2:20 1.E3:1000 1.01E2:101 1010E-1:101 -1010E0:-1010 -1010E1:-10100 1234.00:1234 # non-integer numbers -1010E-2:NaN -1.01E+1:NaN -1.01E-1:NaN 1E-999999:NaN 0.5:NaN &bnan 1:NaN 2:NaN abc:NaN &bone 2:+:1 2:-:-1 boneNaN:-:-1 boneNaN:+:1 2:abc:1 3::1 &binf 1:+:inf 2:-:-inf 3:abc:inf &is_nan 123:0 abc:1 NaN:1 -123:0 &is_inf +inf::1 -inf::1 abc::0 1::0 NaN::0 -1::0 +inf:-:0 +inf:+:1 -inf:-:1 -inf:+:0 -inf:-inf:1 -inf:+inf:0 +inf:-inf:0 +inf:+inf:1 +iNfInItY::1 -InFiNiTy::1 &blsft abc:abc:NaN +2:+2:8 +1:+32:4294967296 +1:+48:281474976710656 +8:-2:NaN # exercise base 10 +12345:4:10:123450000 -1234:0:10:-1234 +1234:0:10:1234 +2:2:10:200 +12:2:10:1200 +1234:-3:10:NaN 1234567890123:12:10:1234567890123000000000000 -3:1:2:-6 -5:1:2:-10 -2:1:2:-4 -102533203:1:2:-205066406 &brsft abc:abc:NaN +8:+2:2 +4294967296:+32:1 +281474976710656:+48:1 +2:-2:NaN # exercise base 10 -1234:0:10:-1234 +1234:0:10:1234 +200:2:10:2 +1234:3:10:1 +1234:2:10:12 +1234:-3:10:NaN 310000:4:10:31 12300000:5:10:123 1230000000000:10:10:123 09876123456789067890:12:10:9876123 1234561234567890123:13:10:123456 820265627:1:2:410132813 # test shifting negative numbers in base 2 -15:1:2:-8 -14:1:2:-7 -13:1:2:-7 -12:1:2:-6 -11:1:2:-6 -10:1:2:-5 -9:1:2:-5 -8:1:2:-4 -7:1:2:-4 -6:1:2:-3 -5:1:2:-3 -4:1:2:-2 -3:1:2:-2 -2:1:2:-1 -1:1:2:-1 -1640531254:2:2:-410132814 -1640531254:1:2:-820265627 -820265627:1:2:-410132814 -205066405:1:2:-102533203 &bsstr +inf:inf -inf:-inf 1e+34:1e+34 123.456E3:123456e+0 100:1e+2 bsstrabc:NaN -5:-5e+0 -100:-1e+2 &numify 5:5 -5:-5 100:100 -100:-100 &bneg bnegNaN:NaN +inf:-inf -inf:inf abd:NaN 0:0 1:-1 -1:1 +123456789:-123456789 -123456789:123456789 &babs babsNaN:NaN +inf:inf -inf:inf 0:0 1:1 -1:1 +123456789:123456789 -123456789:123456789 &bsgn NaN:NaN +inf:1 -inf:-1 0:0 +123456789:1 -123456789:-1 &bcmp bcmpNaN:bcmpNaN: bcmpNaN:0: 0:bcmpNaN: 0:0:0 -1:0:-1 0:-1:1 1:0:1 0:1:-1 -1:1:-1 1:-1:1 -1:-1:0 1:1:0 123:123:0 123:12:1 12:123:-1 -123:-123:0 -123:-12:-1 -12:-123:1 123:124:-1 124:123:1 -123:-124:1 -124:-123:-1 100:5:1 -123456789:987654321:-1 +123456789:-987654321:1 -987654321:123456789:-1 -inf:5432112345:-1 +inf:5432112345:1 -inf:-5432112345:-1 +inf:-5432112345:1 +inf:+inf:0 -inf:-inf:0 +inf:-inf:1 -inf:+inf:-1 5:inf:-1 5:inf:-1 -5:-inf:1 -5:-inf:1 # return undef +inf:NaN: NaN:inf: -inf:NaN: NaN:-inf: &binc abc:NaN +inf:inf -inf:-inf +0:1 +1:2 -1:0 &bdec abc:NaN +inf:inf -inf:-inf +0:-1 +1:0 -1:-2 &badd abc:abc:NaN abc:0:NaN +0:abc:NaN +inf:-inf:NaN -inf:+inf:NaN +inf:+inf:inf -inf:-inf:-inf baddNaN:+inf:NaN baddNaN:+inf:NaN +inf:baddNaN:NaN -inf:baddNaN:NaN 0:0:0 1:0:1 0:1:1 1:1:2 -1:0:-1 0:-1:-1 -1:-1:-2 -1:+1:0 +1:-1:0 +9:+1:10 +99:+1:100 +999:+1:1000 +9999:+1:10000 +99999:+1:100000 +999999:+1:1000000 +9999999:+1:10000000 +99999999:+1:100000000 +999999999:+1:1000000000 +9999999999:+1:10000000000 +99999999999:+1:100000000000 +10:-1:9 +100:-1:99 +1000:-1:999 +10000:-1:9999 +100000:-1:99999 +1000000:-1:999999 +10000000:-1:9999999 +100000000:-1:99999999 +1000000000:-1:999999999 +10000000000:-1:9999999999 +123456789:987654321:1111111110 -123456789:987654321:864197532 -123456789:-987654321:-1111111110 +123456789:-987654321:-864197532 -1:10001:10000 -1:100001:100000 -1:1000001:1000000 -1:10000001:10000000 -1:100000001:100000000 -1:1000000001:1000000000 -1:10000000001:10000000000 -1:100000000001:100000000000 -1:1000000000001:1000000000000 -1:10000000000001:10000000000000 -1:-10001:-10002 -1:-100001:-100002 -1:-1000001:-1000002 -1:-10000001:-10000002 -1:-100000001:-100000002 -1:-1000000001:-1000000002 -1:-10000000001:-10000000002 -1:-100000000001:-100000000002 -1:-1000000000001:-1000000000002 -1:-10000000000001:-10000000000002 &bsub abc:abc:NaN abc:+0:NaN +0:abc:NaN +inf:-inf:inf -inf:+inf:-inf +inf:+inf:NaN -inf:-inf:NaN +0:+0:0 +1:+0:1 +0:+1:-1 +1:+1:0 -1:+0:-1 +0:-1:1 -1:-1:0 -1:+1:-2 +1:-1:2 +9:+1:8 +99:+1:98 +999:+1:998 +9999:+1:9998 +99999:+1:99998 +999999:+1:999998 +9999999:+1:9999998 +99999999:+1:99999998 +999999999:+1:999999998 +9999999999:+1:9999999998 +99999999999:+1:99999999998 +10:-1:11 +100:-1:101 +1000:-1:1001 +10000:-1:10001 +100000:-1:100001 +1000000:-1:1000001 +10000000:-1:10000001 +100000000:-1:100000001 +1000000000:-1:1000000001 +10000000000:-1:10000000001 +123456789:+987654321:-864197532 -123456789:+987654321:-1111111110 -123456789:-987654321:864197532 +123456789:-987654321:1111111110 10001:1:10000 100001:1:100000 1000001:1:1000000 10000001:1:10000000 100000001:1:100000000 1000000001:1:1000000000 10000000001:1:10000000000 100000000001:1:100000000000 1000000000001:1:1000000000000 10000000000001:1:10000000000000 10001:-1:10002 100001:-1:100002 1000001:-1:1000002 10000001:-1:10000002 100000001:-1:100000002 1000000001:-1:1000000002 10000000001:-1:10000000002 100000000001:-1:100000000002 1000000000001:-1:1000000000002 10000000000001:-1:10000000000002 &bmuladd abc:abc:0:NaN abc:+0:0:NaN +0:abc:0:NaN +0:0:abc:NaN NaNmul:+inf:0:NaN NaNmul:-inf:0:NaN -inf:NaNmul:0:NaN +inf:NaNmul:0:NaN +inf:+inf:0:inf +inf:-inf:0:-inf -inf:+inf:0:-inf -inf:-inf:0:inf +0:+0:0:0 +0:+1:0:0 +1:+0:0:0 +0:-1:0:0 -1:+0:0:0 123456789123456789:0:0:0 0:123456789123456789:0:0 -1:-1:0:1 -1:-1:0:1 -1:+1:0:-1 +1:-1:0:-1 +1:+1:0:1 +2:+3:0:6 -2:+3:0:-6 +2:-3:0:-6 -2:-3:0:6 111:111:0:12321 10101:10101:0:102030201 1001001:1001001:0:1002003002001 100010001:100010001:0:10002000300020001 10000100001:10000100001:0:100002000030000200001 11111111111:9:0:99999999999 22222222222:9:0:199999999998 33333333333:9:0:299999999997 44444444444:9:0:399999999996 55555555555:9:0:499999999995 66666666666:9:0:599999999994 77777777777:9:0:699999999993 88888888888:9:0:799999999992 99999999999:9:0:899999999991 11111111111:9:1:100000000000 22222222222:9:1:199999999999 33333333333:9:1:299999999998 44444444444:9:1:399999999997 55555555555:9:1:499999999996 66666666666:9:1:599999999995 77777777777:9:1:699999999994 88888888888:9:1:799999999993 99999999999:9:1:899999999992 -3:-4:-5:7 3:-4:-5:-17 -3:4:-5:-17 3:4:-5:7 -3:4:5:-7 3:-4:5:-7 9999999999999999999:10000000000000000000:1234567890:99999999999999999990000000001234567890 2:3:12345678901234567890:12345678901234567896 &bmul abc:abc:NaN abc:+0:NaN +0:abc:NaN NaNmul:+inf:NaN NaNmul:-inf:NaN -inf:NaNmul:NaN +inf:NaNmul:NaN +inf:+inf:inf +inf:-inf:-inf -inf:+inf:-inf -inf:-inf:inf +0:+0:0 +0:+1:0 +1:+0:0 +0:-1:0 -1:+0:0 123456789123456789:0:0 0:123456789123456789:0 -1:-1:1 -1:+1:-1 +1:-1:-1 +1:+1:1 +2:+3:6 -2:+3:-6 +2:-3:-6 -2:-3:6 111:111:12321 10101:10101:102030201 1001001:1001001:1002003002001 100010001:100010001:10002000300020001 10000100001:10000100001:100002000030000200001 11111111111:9:99999999999 22222222222:9:199999999998 33333333333:9:299999999997 44444444444:9:399999999996 55555555555:9:499999999995 66666666666:9:599999999994 77777777777:9:699999999993 88888888888:9:799999999992 99999999999:9:899999999991 +25:+25:625 +12345:+12345:152399025 +99999:+11111:1111088889 9999:10000:99990000 99999:100000:9999900000 999999:1000000:999999000000 9999999:10000000:99999990000000 99999999:100000000:9999999900000000 999999999:1000000000:999999999000000000 9999999999:10000000000:99999999990000000000 99999999999:100000000000:9999999999900000000000 999999999999:1000000000000:999999999999000000000000 9999999999999:10000000000000:99999999999990000000000000 99999999999999:100000000000000:9999999999999900000000000000 999999999999999:1000000000000000:999999999999999000000000000000 9999999999999999:10000000000000000:99999999999999990000000000000000 99999999999999999:100000000000000000:9999999999999999900000000000000000 999999999999999999:1000000000000000000:999999999999999999000000000000000000 9999999999999999999:10000000000000000000:99999999999999999990000000000000000000 &bdiv-list 100:20:5,0 4095:4095:1,0 -4095:-4095:1,0 4095:-4095:-1,0 -4095:4095:-1,0 123:2:61,1 9:5:1,4 9:4:2,1 # inf handling and general remainder 5:8:0,5 0:8:0,0 11:2:5,1 11:-2:-6,-1 -11:2:-6,1 # see table in documentation in MBI 0:inf:0,0 0:-inf:0,0 5:inf:0,5 5:-inf:-1,-inf -5:inf:-1,inf -5:-inf:0,-5 inf:5:inf,NaN -inf:5:-inf,NaN inf:-5:-inf,NaN -inf:-5:inf,NaN 5:5:1,0 -5:-5:1,0 inf:inf:NaN,NaN -inf:-inf:NaN,NaN -inf:inf:NaN,NaN inf:-inf:NaN,NaN 8:0:inf,8 inf:0:inf,inf # exceptions to remainder rule -8:0:-inf,-8 -inf:0:-inf,-inf 0:0:NaN,0 # test the shortcut in Calc if @$x == @$yorg 1234567812345678:123456712345678:10,688888898 12345671234567:1234561234567:10,58888897 123456123456:12345123456:10,4888896 1234512345:123412345:10,388895 1234567890999999999:1234567890:1000000000,999999999 1234567890000000000:1234567890:1000000000,0 1234567890999999999:9876543210:124999998,9503086419 1234567890000000000:9876543210:124999998,8503086420 96969696969696969696969696969678787878626262626262626262626262:484848484848484848484848486666666666666689898989898989898989:199,484848484848484848484848123012121211954972727272727272727451 # bug in v1.76 1267650600228229401496703205375:1267650600228229401496703205376:0,1267650600228229401496703205375 # exercise shortcut for numbers of the same length in div 999999999999999999999999999999999:999999999999999999999999999999999:1,0 999999999999999999999999999999999:888888888888888888888888888888888:1,111111111111111111111111111111111 999999999999999999999999999999999:777777777777777777777777777777777:1,222222222222222222222222222222222 999999999999999999999999999999999:666666666666666666666666666666666:1,333333333333333333333333333333333 999999999999999999999999999999999:555555555555555555555555555555555:1,444444444444444444444444444444444 999999999999999999999999999999999:444444444444444444444444444444444:2,111111111111111111111111111111111 999999999999999999999999999999999:333333333333333333333333333333333:3,0 999999999999999999999999999999999:222222222222222222222222222222222:4,111111111111111111111111111111111 999999999999999999999999999999999:111111111111111111111111111111111:9,0 9999999_9999999_9999999_9999999:3333333_3333333_3333333_3333333:3,0 9999999_9999999_9999999_9999999:3333333_0000000_0000000_0000000:3,999999999999999999999 9999999_9999999_9999999_9999999:3000000_0000000_0000000_0000000:3,999999999999999999999999999 9999999_9999999_9999999_9999999:2000000_0000000_0000000_0000000:4,1999999999999999999999999999 9999999_9999999_9999999_9999999:1000000_0000000_0000000_0000000:9,999999999999999999999999999 9999999_9999999_9999999_9999999:100000_0000000_0000000_0000000:99,99999999999999999999999999 9999999_9999999_9999999_9999999:10000_0000000_0000000_0000000:999,9999999999999999999999999 9999999_9999999_9999999_9999999:1000_0000000_0000000_0000000:9999,999999999999999999999999 9999999_9999999_9999999_9999999:100_0000000_0000000_0000000:99999,99999999999999999999999 9999999_9999999_9999999_9999999:10_0000000_0000000_0000000:999999,9999999999999999999999 9999999_9999999_9999999_9999999:1_0000000_0000000_0000000:9999999,999999999999999999999 &bdiv abc:abc:NaN abc:1:NaN 1:abc:NaN 0:0:NaN # inf handling (see table in doc) 0:inf:0 0:-inf:0 5:inf:0 5:-inf:-1 -5:inf:-1 -5:-inf:0 inf:5:inf -inf:5:-inf inf:-5:-inf -inf:-5:inf 5:5:1 -5:-5:1 inf:inf:NaN -inf:-inf:NaN -inf:inf:NaN inf:-inf:NaN 8:0:inf inf:0:inf -8:0:-inf -inf:0:-inf 0:0:NaN 11:2:5 -11:-2:5 -11:2:-6 11:-2:-6 0:1:0 0:-1:0 1:1:1 -1:-1:1 1:-1:-1 -1:1:-1 1:2:0 2:1:2 1:26:0 1000000000:9:111111111 2000000000:9:222222222 3000000000:9:333333333 4000000000:9:444444444 5000000000:9:555555555 6000000000:9:666666666 7000000000:9:777777777 8000000000:9:888888888 9000000000:9:1000000000 35500000:113:314159 71000000:226:314159 106500000:339:314159 1000000000:3:333333333 +10:+5:2 +100:+4:25 +1000:+8:125 +10000:+16:625 999999999999:9:111111111111 999999999999:99:10101010101 999999999999:999:1001001001 999999999999:9999:100010001 999999999999999:99999:10000100001 +1111088889:99999:11111 -5:-3:1 -5:3:-2 4:3:1 4:-3:-2 1:3:0 1:-3:-1 -2:-3:0 -2:3:-1 8:3:2 -8:3:-3 14:-3:-5 -14:3:-5 -14:-3:4 14:3:4 # bug in Calc with '99999' vs $BASE-1 10000000000000000000000000000000000000000000000000000000000000000000000000000000000:10000000375084540248994272022843165711074:999999962491547381984643365663244474111576 # test the shortcut in Calc if @$x == @$yorg 1234567812345678:123456712345678:10 12345671234567:1234561234567:10 123456123456:12345123456:10 1234512345:123412345:10 1234567890999999999:1234567890:1000000000 1234567890000000000:1234567890:1000000000 1234567890999999999:9876543210:124999998 1234567890000000000:9876543210:124999998 96969696969696969696969696969678787878626262626262626262626262:484848484848484848484848486666666666666689898989898989898989:199 # bug up to v0.35 in Calc (--$q one too many) 84696969696969696956565656566184292929292929292847474747436308080808080808086765396464646464646465:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6449999999999999999 84696969696969696943434343434871161616161616161452525252486813131313131313143230042929292929292930:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6449999999999999998 84696969696969696969696969697497424242424242424242424242385803030303030303030300750000000000000000:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6450000000000000000 84696969696969696930303030303558030303030303030057575757537318181818181818199694689393939393939395:13131313131313131313131313131394949494949494949494949494943535353535353535353535:6449999999999999997 # exercise shortcut for numbers of the same length in div 999999999999999999999999999999999:999999999999999999999999999999999:1 999999999999999999999999999999999:888888888888888888888888888888888:1 999999999999999999999999999999999:777777777777777777777777777777777:1 999999999999999999999999999999999:666666666666666666666666666666666:1 999999999999999999999999999999999:555555555555555555555555555555555:1 999999999999999999999999999999999:444444444444444444444444444444444:2 999999999999999999999999999999999:333333333333333333333333333333333:3 999999999999999999999999999999999:222222222222222222222222222222222:4 999999999999999999999999999999999:111111111111111111111111111111111:9 9999999_9999999_9999999_9999999:3333333_3333333_3333333_3333333:3 9999999_9999999_9999999_9999999:3333333_0000000_0000000_0000000:3 9999999_9999999_9999999_9999999:3000000_0000000_0000000_0000000:3 9999999_9999999_9999999_9999999:2000000_0000000_0000000_0000000:4 9999999_9999999_9999999_9999999:1000000_0000000_0000000_0000000:9 9999999_9999999_9999999_9999999:100000_0000000_0000000_0000000:99 9999999_9999999_9999999_9999999:10000_0000000_0000000_0000000:999 9999999_9999999_9999999_9999999:1000_0000000_0000000_0000000:9999 9999999_9999999_9999999_9999999:100_0000000_0000000_0000000:99999 9999999_9999999_9999999_9999999:10_0000000_0000000_0000000:999999 9999999_9999999_9999999_9999999:1_0000000_0000000_0000000:9999999 # bug with shortcut in Calc 0.44 949418181818187070707070707070707070:181818181853535353535353535353535353:5 &bmodinv # format: number:modulus:result # bmodinv Data errors abc:abc:NaN abc:5:NaN 5:abc:NaN # bmodinv Expected Results from normal use 1:5:1 3:5:2 3:-5:-3 -2:5:2 8:5033:4404 1234567891:13:6 -1234567891:13:7 324958749843759385732954874325984357439658735983745:2348249874968739:1741662881064902 -2:1:0 -1:1:0 0:1:0 1:1:0 2:1:0 3:1:0 4:1:0 -2:3:1 -1:3:2 0:3:NaN 1:3:1 2:3:2 3:3:NaN 4:3:1 -2:4:NaN -1:4:3 0:4:NaN 1:4:1 2:4:NaN 3:4:3 4:4:NaN ## bmodinv Error cases / useless use of function inf:5:NaN 5:inf:NaN -inf:5:NaN 5:-inf:NaN &bmodpow # format: number:exponent:modulus:result # bmodpow Data errors abc:abc:abc:NaN 5:abc:abc:NaN abc:5:abc:NaN abc:abc:5:NaN 5:5:abc:NaN 5:abc:5:NaN abc:5:5:NaN 3:5:0:3 # bmodpow Expected results 0:0:2:1 1:0:2:1 0:3:5:0 -2:-2:1:0 -1:-2:1:0 0:-2:1:0 1:-2:1:0 2:-2:1:0 3:-2:1:0 4:-2:1:0 -2:-1:1:0 -1:-1:1:0 0:-1:1:0 1:-1:1:0 2:-1:1:0 3:-1:1:0 4:-1:1:0 -2:0:1:0 -1:0:1:0 0:0:1:0 1:0:1:0 2:0:1:0 3:0:1:0 4:0:1:0 -2:1:1:0 -1:1:1:0 0:1:1:0 1:1:1:0 2:1:1:0 3:1:1:0 4:1:1:0 -2:2:1:0 -1:2:1:0 0:2:1:0 1:2:1:0 2:2:1:0 3:2:1:0 4:2:1:0 -2:3:1:0 -1:3:1:0 0:3:1:0 1:3:1:0 2:3:1:0 3:3:1:0 4:3:1:0 -2:4:1:0 -1:4:1:0 0:4:1:0 1:4:1:0 2:4:1:0 3:4:1:0 4:4:1:0 -2:-2:3:1 -1:-2:3:1 0:-2:3:NaN 1:-2:3:1 2:-2:3:1 3:-2:3:NaN 4:-2:3:1 -2:-1:3:1 -1:-1:3:2 0:-1:3:NaN 1:-1:3:1 2:-1:3:2 3:-1:3:NaN 4:-1:3:1 -2:0:3:1 -1:0:3:1 0:0:3:1 1:0:3:1 2:0:3:1 3:0:3:1 4:0:3:1 -2:1:3:1 -1:1:3:2 0:1:3:0 1:1:3:1 2:1:3:2 3:1:3:0 4:1:3:1 -2:2:3:1 -1:2:3:1 0:2:3:0 1:2:3:1 2:2:3:1 3:2:3:0 4:2:3:1 -2:3:3:1 -1:3:3:2 0:3:3:0 1:3:3:1 2:3:3:2 3:3:3:0 4:3:3:1 -2:4:3:1 -1:4:3:1 0:4:3:0 1:4:3:1 2:4:3:1 3:4:3:0 4:4:3:1 -2:-2:4:NaN -1:-2:4:1 0:-2:4:NaN 1:-2:4:1 2:-2:4:NaN 3:-2:4:1 4:-2:4:NaN -2:-1:4:NaN -1:-1:4:3 0:-1:4:NaN 1:-1:4:1 2:-1:4:NaN 3:-1:4:3 4:-1:4:NaN -2:0:4:1 -1:0:4:1 0:0:4:1 1:0:4:1 2:0:4:1 3:0:4:1 4:0:4:1 -2:1:4:2 -1:1:4:3 0:1:4:0 1:1:4:1 2:1:4:2 3:1:4:3 4:1:4:0 -2:2:4:0 -1:2:4:1 0:2:4:0 1:2:4:1 2:2:4:0 3:2:4:1 4:2:4:0 -2:3:4:0 -1:3:4:3 0:3:4:0 1:3:4:1 2:3:4:0 3:3:4:3 4:3:4:0 -2:4:4:0 -1:4:4:1 0:4:4:0 1:4:4:1 2:4:4:0 3:4:4:1 4:4:4:0 8:-1:16:NaN 8:-1:5033:4404 8:7:5032:3840 8:8:-5:-4 1e50:1:1:0 98436739867439843769485798542749827593285729587325:43698764986460981048259837659386739857456983759328457:6943857329857295827698367:3104744730915914415259518 # bmodpow Error cases inf:5:13:NaN 5:inf:13:NaN &bmod # inf handling, see table in doc 0:inf:0 0:-inf:0 5:inf:5 5:-inf:-inf -5:inf:inf -5:-inf:-5 inf:5:NaN -inf:5:NaN inf:-5:NaN -inf:-5:NaN 5:5:0 -5:-5:0 inf:inf:NaN -inf:-inf:NaN -inf:inf:NaN inf:-inf:NaN 8:0:8 inf:0:inf -inf:0:-inf -8:0:-8 0:0:0 abc:abc:NaN abc:1:abc:NaN 1:abc:NaN 0:1:0 1:0:1 0:-1:0 -1:0:-1 1:1:0 -1:-1:0 1:-1:0 -1:1:0 1:2:1 2:1:0 1000000000:9:1 2000000000:9:2 3000000000:9:3 4000000000:9:4 5000000000:9:5 6000000000:9:6 7000000000:9:7 8000000000:9:8 9000000000:9:0 35500000:113:33 71000000:226:66 106500000:339:99 1000000000:3:1 10:5:0 100:4:0 1000:8:0 10000:16:0 999999999999:9:0 999999999999:99:0 999999999999:999:0 999999999999:9999:0 999999999999999:99999:0 -9:+5:1 +9:-5:-1 -9:-5:-4 -5:3:1 -2:3:1 4:3:1 1:3:1 -5:-3:-2 -2:-3:-2 4:-3:-2 1:-3:-2 4095:4095:0 100041000510123:3:0 152403346:12345:4321 9:5:4 # test shortcuts in Calc # 1ex % 9 is always == 1, 1ex % 113 is != 1 for x = (4..9), 1ex % 10 = 0 1234:9:1 123456:9:3 12345678:9:0 1234567891:9:1 123456789123:9:6 12345678912345:9:6 1234567891234567:9:1 123456789123456789:9:0 1234:10:4 123456:10:6 12345678:10:8 1234567891:10:1 123456789123:10:3 12345678912345:10:5 1234567891234567:10:7 123456789123456789:10:9 1234:113:104 123456:113:60 12345678:113:89 1234567891:113:64 123456789123:113:95 12345678912345:113:53 1234567891234567:113:56 123456789123456789:113:39 # bug in bmod() not modifying the variable in place -629:5033:4404 # bug in bmod() in Calc in the _div_use_div() shortcut code path, # when X == X and X was big 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 +0:+0:0 +0:+1:1 +1:+0:1 +1:+1:1 +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 27:90:56:1 27:90:54:9 &blcm abc:abc:NaN abc:+0:NaN +0:abc:NaN +0:+0:NaN +1:+0:0 +0:+1:0 +27:+90:270 +1034:+804:415668 &band abc:abc:NaN abc:0:NaN 0:abc:NaN 1:2:0 3:2:2 +8:+2:0 +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 0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF 0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF 0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF 0xF0F0:0xF0F0:0x0xF0F0 0x0F0F:0x0F0F:0x0x0F0F 0xF0F0F0:0xF0F0F0:0x0xF0F0F0 0x0F0F0F:0x0F0F0F:0x0x0F0F0F 0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0 0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F 0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0 0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F 0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0 0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F 0x1F0F0F0F0F0F:0x3F0F0F0F0F0F:0x0x1F0F0F0F0F0F &bior abc:abc:NaN abc:0:NaN 0:abc:NaN 1:2:3 +8:+2:10 +281474976710656:0:281474976710656 +281474976710656:1:281474976710657 +281474976710656:281474976710656:281474976710656 -2:-3:-1 -1:-1:-1 -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 0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF 0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF 0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF 0:0xFFFF:0x0xFFFF 0:0xFFFFFF:0x0xFFFFFF 0:0xFFFFFFFF:0x0xFFFFFFFF 0:0xFFFFFFFFFF:0x0xFFFFFFFFFF 0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF 0xFFFF:0:0x0xFFFF 0xFFFFFF:0:0x0xFFFFFF 0xFFFFFFFF:0:0x0xFFFFFFFF 0xFFFFFFFFFF:0:0x0xFFFFFFFFFF 0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF 0xF0F0:0xF0F0:0x0xF0F0 0x0F0F:0x0F0F:0x0x0F0F 0xF0F0:0x0F0F:0x0xFFFF 0xF0F0F0:0xF0F0F0:0x0xF0F0F0 0x0F0F0F:0x0F0F0F:0x0x0F0F0F 0x0F0F0F:0xF0F0F0:0x0xFFFFFF 0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0 0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F 0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF 0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0 0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F 0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF 0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0 0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F 0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF 0x1F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF &bxor abc:abc:NaN abc:0:NaN 0:abc:NaN 1:2:3 +8:+2:10 +281474976710656:0:281474976710656 +281474976710656:1:281474976710657 +281474976710656:281474976710656:0 -2:-3:3 -1:-1:0 -6:-6:0 -7:4:-3 -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 0xFFFFFFFF:0xFFFFFFFF:0 0xFFFFFFFFFF:0xFFFFFFFFFF:0 0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0 0:0xFFFF:0x0xFFFF 0:0xFFFFFF:0x0xFFFFFF 0:0xFFFFFFFF:0x0xFFFFFFFF 0:0xFFFFFFFFFF:0x0xFFFFFFFFFF 0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF 0xFFFF:0:0x0xFFFF 0xFFFFFF:0:0x0xFFFFFF 0xFFFFFFFF:0:0x0xFFFFFFFF 0xFFFFFFFFFF:0:0x0xFFFFFFFFFF 0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF 0xF0F0:0xF0F0:0 0x0F0F:0x0F0F:0 0xF0F0:0x0F0F:0x0xFFFF 0xF0F0F0:0xF0F0F0:0 0x0F0F0F:0x0F0F0F:0 0x0F0F0F:0xF0F0F0:0x0xFFFFFF 0xF0F0F0F0:0xF0F0F0F0:0 0x0F0F0F0F:0x0F0F0F0F:0 0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF 0xF0F0F0F0F0:0xF0F0F0F0F0:0 0x0F0F0F0F0F:0x0F0F0F0F0F:0 0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF 0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0 0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0 0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF &bnot abc:NaN +0:-1 +8:-9 +281474976710656:-281474976710657 -1:0 -2:1 -12:11 &digit 0:0:0 12:0:2 12:1:1 123:0:3 123:1:2 123:2:1 123:-1:1 123:-2:2 123:-3:3 123456:0:6 123456:1:5 123456:2:4 123456:3:3 123456:4:2 123456:5:1 123456:-1:1 123456:-2:2 123456:-3:3 100000:-3:0 100000:0:0 100000:1:0 &mantissa abc:NaN 1e4:1 2e0:2 123:123 -1:-1 -2:-2 +inf:inf -inf:-inf &exponent abc:NaN 1e4:4 2e0:0 123:0 -1:0 -2:0 0:0 +inf:inf -inf:inf &parts abc:NaN,NaN 1e4:1,4 2e0:2,0 123:123,0 -1:-1,0 -2:-2,0 0:0,0 +inf:inf,inf -inf:-inf,inf &bfac -1:NaN NaNfac:NaN +inf:inf -inf:NaN 0:1 1:1 2:2 3:6 4:24 5:120 6:720 7:5040 8:40320 9:362880 10:3628800 11:39916800 12:479001600 20:2432902008176640000 22:1124000727777607680000 69:171122452428141311372468338881272839092270544893520369393648040923257279754140647424000000000000000 &bpow abc:12:NaN 12:abc:NaN 0:0:1 0:1:0 0:2:0 0:-1:inf 0:-2:inf 1:0:1 1:1:1 1:2:1 1:3:1 1:-1:1 1:-2:1 1:-3:1 2:0:1 2:1:2 2:2:4 2:3:8 3:3:27 -2:2:4 -2:3:-8 -2:4:16 -2:5:-32 2:-1:NaN -2:-1:NaN 2:-2:NaN -2:-2:NaN # inf tests +inf:1234500012:inf -inf:1234500012:inf -inf:1234500013:-inf +inf:-12345000123:inf -inf:-12345000123:-inf # -inf * -inf = inf -inf:2:inf -inf:0:NaN -inf:-1:0 -inf:inf:NaN 2:inf:inf 2:-inf:0 0:inf:0 0:-inf:inf -1:-inf:NaN -1:inf:NaN -2:inf:NaN -2:-inf:0 NaN:inf:NaN NaN:-inf:NaN -inf:NaN:NaN inf:NaN:NaN inf:-inf:NaN 1:inf:1 1:-inf:1 # 1 ** -x => 1 / (1 ** x) -1:0:1 -2:0:1 -1:1:-1 -1:2:1 -1:3:-1 -1:4:1 -1:5:-1 -1:-1:-1 -1:-2:1 -1:-3:-1 -1:-4:1 10:2:100 10:3:1000 10:4:10000 10:5:100000 10:6:1000000 10:7:10000000 10:8:100000000 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 1:1 0:1 12345:5 10000000000000000:17 -123:3 215960156869840440586892398248:30 &broot # sqrt() +0:2:0 +1:2:1 -1:2:NaN # -$x ** (1/2) => -$y, but not in broot() -123:2:NaN +inf:2:inf -inf:2:NaN 2:2:1 -2:2:NaN 4:2:2 9:2:3 16:2:4 100:2:10 123:2:11 15241:2:123 144:2:12 12:2:3 # 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 # 2 ** 64 18446744073709551616:4:65536 18446744073709551616:8:256 18446744073709551616:16:16 18446744073709551616:32:4 18446744073709551616:64:2 18446744073709551616:128:1 # 213 ** 15 84274086103068221283760416414557757:15:213 # see t/bigroot.t for more tests &bsqrt 145:12 144:12 143:11 16:4 170:13 169:13 168:12 4:2 3:1 2:1 9:3 12:3 256:16 100000000:10000 4000000000000:2000000 152399026:12345 152399025:12345 152399024:12344 # 2 ** 64 => 2 ** 32 18446744073709551616:4294967296 84274086103068221283760416414557757:290299993288095377 1:1 0:0 -2:NaN -123:NaN Nan:NaN +inf:inf -inf:NaN # see t/biglog.t for more tests &bexp NaN:NaN inf:inf 1:2 2:7 &batan2 NaN:1:10:NaN NaN:NaN:10:NaN 1:NaN:10:NaN inf:1:14:1 -inf:1:14:-1 0:-inf:14:3 -1:-inf:14:-3 1:-inf:14:3 0:inf:14:0 inf:-inf:14:2 -inf:-inf:14:-2 # +- 0.78.... inf:+inf:14:0 -inf:+inf:14:0 1:5:13:0 1:5:14:0 0:0:10:0 0:1:14:0 0:2:14:0 1:0:14:1 5:0:14:1 -1:0:11:-1 -2:0:77:-1 2:0:77:1 -1:5:14:0 1:5:14:0 -1:8:14:0 1:8:14:0 -1:1:14:0 &bpi 77:3 +0:3 11:3 # see t/bignok.t for more tests &bnok +inf:10:inf NaN:NaN:NaN NaN:1:NaN 1:NaN:NaN 1:1:1 # k > n 1:2:0 2:3:0 # k < 0 1:-2:0 # 7 over 3 = 35 7:3:35 7:6:7 100:90:17310309456440 100:95:75287520 2:0:1 7:0:1 2:1:2 &bround $round_mode("trunc") 0:12:0 NaNbround:12:NaN +inf:12:inf -inf:12:-inf 1234:0:1234 1234:2:1200 123456:4:123400 123456:5:123450 123456:6:123456 +10123456789:5:10123000000 -10123456789:5:-10123000000 +10123456789:9:10123456700 -10123456789:9:-10123456700 +101234500:6:101234000 -101234500:6:-101234000 #+101234500:-4:101234000 #-101234500:-4:-101234000 $round_mode("zero") +20123456789:5:20123000000 -20123456789:5:-20123000000 +20123456789:9:20123456800 -20123456789:9:-20123456800 +201234500:6:201234000 -201234500:6:-201234000 #+201234500:-4:201234000 #-201234500:-4:-201234000 +12345000:4:12340000 -12345000:4:-12340000 $round_mode("+inf") +30123456789:5:30123000000 -30123456789:5:-30123000000 +30123456789:9:30123456800 -30123456789:9:-30123456800 +301234500:6:301235000 -301234500:6:-301234000 #+301234500:-4:301235000 #-301234500:-4:-301234000 +12345000:4:12350000 -12345000:4:-12340000 $round_mode("-inf") +40123456789:5:40123000000 -40123456789:5:-40123000000 +40123456789:9:40123456800 -40123456789:9:-40123456800 +401234500:6:401234000 +401234500:6:401234000 #-401234500:-4:-401235000 #-401234500:-4:-401235000 +12345000:4:12340000 -12345000:4:-12350000 $round_mode("odd") +50123456789:5:50123000000 -50123456789:5:-50123000000 +50123456789:9:50123456800 -50123456789:9:-50123456800 +501234500:6:501235000 -501234500:6:-501235000 #+501234500:-4:501235000 #-501234500:-4:-501235000 +12345000:4:12350000 -12345000:4:-12350000 $round_mode("even") +60123456789:5:60123000000 -60123456789:5:-60123000000 +60123456789:9:60123456800 -60123456789:9:-60123456800 +601234500:6:601234000 -601234500:6:-601234000 #+601234500:-4:601234000 #-601234500:-4:-601234000 #-601234500:-9:0 #-501234500:-9:0 #-601234500:-8:0 #-501234500:-8:0 +1234567:7:1234567 +1234567:6:1234570 +12345000:4:12340000 -12345000:4:-12340000 $round_mode("common") +60123456789:5:60123000000 +60123199999:5:60123000000 +60123299999:5:60123000000 +60123399999:5:60123000000 +60123499999:5:60123000000 +60123500000:5:60124000000 +60123600000:5:60124000000 +60123700000:5:60124000000 +60123800000:5:60124000000 +60123900000:5:60124000000 -60123456789:5:-60123000000 -60123199999:5:-60123000000 -60123299999:5:-60123000000 -60123399999:5:-60123000000 -60123499999:5:-60123000000 -60123500000:5:-60124000000 -60123600000:5:-60124000000 -60123700000:5:-60124000000 -60123800000:5:-60124000000 -60123900000:5:-60124000000 &is_zero 0:1 NaNzero:0 +inf:0 -inf:0 123:0 -1:0 1:0 &is_one 0:0 NaNone:0 +inf:0 -inf:0 1:1 2:0 -1:0 -2:0 # floor, ceil, and int are pretty pointless in integer space, but play safe &bfloor 0:0 NaNfloor:NaN +inf:inf -inf:-inf -1:-1 -2:-2 2:2 3:3 abc:NaN &bceil NaNceil:NaN +inf:inf -inf:-inf 0:0 -1:-1 -2:-2 2:2 3:3 abc:NaN &bint NaN:NaN +inf:inf -inf:-inf 0:0 -1:-1 -2:-2 2:2 3:3 &as_hex 128:0x80 -128:-0x80 0:0x0 -0:0x0 1:0x1 0x123456789123456789:0x123456789123456789 +inf:inf -inf:-inf NaNas_hex:NaN &as_bin 128:0b10000000 -128:-0b10000000 0:0b0 -0:0b0 1:0b1 0b1010111101010101010110110110110110101:0b1010111101010101010110110110110110101 0x123456789123456789:0b100100011010001010110011110001001000100100011010001010110011110001001 +inf:inf -inf:-inf NaNas_bin:NaN &as_oct 128:0200 -128:-0200 0:00 -0:00 1:01 0b1010111101010101010110110110110110101:01275252666665 0x123456789123456789:044321263611044321263611 +inf:inf -inf:-inf NaNas_oct:NaN # overloaded functions &log -1:NaN 0:-inf 1:0 2:0 3:1 123456789:18 1234567890987654321:41 -inf:inf inf:inf NaN:NaN &exp &sin &cos &atan2 &int &neg &abs &sqrt Math-BigInt-1.999715/t/bigintpm.t0000644403072340010010000000242712641213041016473 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 3724 # tests in require'd file + 6; # tests in this file use Math::BigInt lib => 'Calc'; our ($CLASS, $CALC); $CLASS = "Math::BigInt"; $CALC = "Math::BigInt::Calc"; my $x; ############################################################################# # from_hex(), from_bin() and from_oct() tests $x = Math::BigInt->from_hex('0xcafe'); is($x, "51966", qq|Math::BigInt->from_hex("0xcafe")|); $x = Math::BigInt->from_hex('0xcafebabedead'); is($x, "223195403574957", qq|Math::BigInt->from_hex("0xcafebabedead")|); $x = Math::BigInt->from_bin('0b1001'); is($x, "9", qq|Math::BigInt->from_bin("0b1001")|); $x = Math::BigInt->from_bin('0b1001100110011001100110011001'); is($x, "161061273", qq|Math::BigInt->from_bin("0b1001100110011001100110011001");|); $x = Math::BigInt->from_oct('0775'); is($x, "509", qq|Math::BigInt->from_oct("0775");|); $x = Math::BigInt->from_oct('07777777777777711111111222222222'); is($x, "9903520314281112085086151826", qq|Math::BigInt->from_oct("07777777777777711111111222222222");|); ############################################################################# # all the other tests require 't/bigintpm.inc'; # all tests here for sharing Math-BigInt-1.999715/t/bigints.t0000644403072340010010000001103212632033726016323 0ustar ospjaDomain Users#!perl use strict; use warnings; use lib 't'; use Test::More tests => 50; # testing of Math::BigInt:Scalar (used by the testsuite), # primarily for interface/api and not for the math functionality use Math::BigInt::Scalar; my $class = 'Math::BigInt::Scalar'; # pass classname to sub's # _new and _str my $x = $class->_new("123"); my $y = $class->_new("321"); is(ref($x), 'SCALAR', 'ref($x)'); is($class->_str($x), 123, "$class->_str(\$x)"); is($class->_str($y), 321, "$class->_str(\$y)"); # _add, _sub, _mul, _div is($class->_str($class->_add($x, $y)), 444, "$class->_str($class->_add(\$x, \$y)"); is($class->_str($class->_sub($x, $y)), 123, "$class->_str($class->_sub(\$x, \$y)"); is($class->_str($class->_mul($x, $y)), 39483, "$class->_str($class->_mul(\$x, \$y))"); is($class->_str($class->_div($x, $y)), 123, "$class->_str($class->_div(\$x, \$y)"); $class->_mul($x, $y); is($class->_str($x), 39483, "$class->_str(\$x)"); is($class->_str($y), 321, "$class->_str(\$y)"); my $z = $class->_new("2"); is($class->_str($class->_add($x, $z)), 39485, "$class->_str($class->_add(\$x, \$z)"); my ($re, $rr) = $class->_div($x, $y); is($class->_str($re), 123, "$class->_str(\$re)"); is($class->_str($rr), 2, "$class->_str(\$rr)"); # is_zero, _is_one, _one, _zero is($class->_is_zero($x), 0, "$class->_is_zero($x)"); is($class->_is_one($x), 0, "$class->_is_one($x)"); is($class->_is_one($class->_one()), 1, "$class->_is_one($class->_one())"); is($class->_is_one($class->_zero()), 0, "$class->_is_one($class->_zero())"); is($class->_is_zero($class->_zero()), 1, "$class->_is_zero($class->_zero())"); is($class->_is_zero($class->_one()), 0, "$class->_is_zero($class->_one())"); # is_odd, is_even is($class->_is_odd($class->_one()), 1, "$class->_is_odd($class->_one())"); is($class->_is_odd($class->_zero()), 0, "$class->_is_odd($class->_zero())"); is($class->_is_even($class->_one()), 0, "$class->_is_even($class->_one())"); is($class->_is_even($class->_zero()), 1, "$class->_is_even($class->_zero())"); # _digit $x = $class->_new("123456789"); is($class->_digit($x, 0), 9, "$class->_digit(\$x, 0)"); is($class->_digit($x, 1), 8, "$class->_digit(\$x, 1)"); is($class->_digit($x, 2), 7, "$class->_digit(\$x, 2)"); is($class->_digit($x, -1), 1, "$class->_digit(\$x, -1)"); is($class->_digit($x, -2), 2, "$class->_digit(\$x, -2)"); is($class->_digit($x, -3), 3, "$class->_digit(\$x, -3)"); # _copy $x = $class->_new("12356"); is($class->_str($class->_copy($x)), 12356, "$class->_str($class->_copy(\$x))"); # _acmp $x = $class->_new("123456789"); $y = $class->_new("987654321"); is($class->_acmp($x, $y), -1, "$class->_acmp(\$x, \$y)"); is($class->_acmp($y, $x), 1, "$class->_acmp(\$y, \$x)"); is($class->_acmp($x, $x), 0, "$class->_acmp(\$x, \$x)"); is($class->_acmp($y, $y), 0, "$class->_acmp(\$y, \$y)"); # _div $x = $class->_new("3333"); $y = $class->_new("1111"); is($class->_str(scalar $class->_div($x, $y)), 3, "$class->_str(scalar $class->_div(\$x, \$y))"); $x = $class->_new("33333"); $y = $class->_new("1111"); ($x, $y) = $class->_div($x, $y); is($class->_str($x), 30, "$class->_str(\$x)"); is($class->_str($y), 3, "$class->_str(\$y)"); $x = $class->_new("123"); $y = $class->_new("1111"); ($x, $y) = $class->_div($x, $y); is($class->_str($x), 0, "$class->_str(\$x)"); is($class->_str($y), 123, "$class->_str(\$y)"); # _num $x = $class->_new("12345"); $x = $class->_num($x); is(ref($x) || '', '', 'ref($x) || ""'); is($x, 12345, '$x'); # _len $x = $class->_new("12345"); $x = $class->_len($x); is(ref($x) || '', '', 'ref($x) || ""'); is($x, 5, '$x'); # _and, _or, _xor $x = $class->_new("3"); $y = $class->_new("4"); is($class->_str($class->_or($x, $y)), 7, "$class->_str($class->_or($x, $y))"); $x = $class->_new("1"); $y = $class->_new("4"); is($class->_str($class->_xor($x, $y)), 5, "$class->_str($class->_xor($x, $y))"); $x = $class->_new("7"); $y = $class->_new("3"); is($class->_str($class->_and($x, $y)), 3, "$class->_str($class->_and($x, $y))"); # _pow $x = $class->_new("2"); $y = $class->_new("4"); is($class->_str($class->_pow($x, $y)), 16, "$class->_str($class->_pow($x, $y))"); $x = $class->_new("2"); $y = $class->_new("5"); is($class->_str($class->_pow($x, $y)), 32, "$class->_str($class->_pow($x, $y))"); $x = $class->_new("3"); $y = $class->_new("3"); is($class->_str($class->_pow($x, $y)), 27, "$class->_str($class->_pow($x, $y))"); # _check $x = $class->_new("123456789"); is($class->_check($x), 0, "$class->_check(\$x)"); is($class->_check(123), '123 is not a reference', "$class->_check(123)"); Math-BigInt-1.999715/t/biglog.t0000644403072340010010000002204412642752043016135 0ustar ospjaDomain Users#!perl # Test blog function (and bpow, since it uses blog), as well as bexp(). # It is too slow to be simple included in bigfltpm.inc, where it would get # executed 3 times. One time would be under Math::BigInt::BareCalc, which # shouldn't make any difference since there is no CALC->_log() function, and # one time under a subclass, which *should* work. # But it is better to test the numerical functionality, instead of not testing # it at all (which did lead to wrong answers for 0 < $x < 1 in blog() in # versions up to v1.63, and for bsqrt($x) when $x << 1 for instance). use strict; use warnings; use Test::More tests => 73; use Math::BigFloat; use Math::BigInt; my $class = "Math::BigInt"; ############################################################################### # test $n->blog() in Math::BigInt (broken until 1.80) is($class->new(2)->blog(), '0', "$class->new(2)->blog()"); is($class->new(288)->blog(), '5', "$class->new(288)->blog()"); is($class->new(2000)->blog(), '7', "$class->new(2000)->blog()"); ############################################################################### # test $n->bexp() in Math::BigInt is($class->new(1)->bexp(), '2', "$class->new(1)->bexp()"); is($class->new(2)->bexp(), '7', "$class->new(2)->bexp()"); is($class->new(3)->bexp(), '20', "$class->new(3)->bexp()"); ############################################################################### ############################################################################### # Math::BigFloat tests ############################################################################### # test $n->blog(undef, N) where N > 67 (broken until 1.82) $class = "Math::BigFloat"; # These tests can take quite a while, but are necessary. Maybe protect them # with some alarm()? # this triggers the calculation and caching of ln(2): is($class->new(5)->blog(undef, 71), '1.6094379124341003746007593332261876395256013542685177219126478914741790', "$class->new(5)->blog(undef, 71)"); # if the cache was correct, we should get this result, fast: is($class->new(2)->blog(undef, 71), '0.69314718055994530941723212145817656807550013436025525412068000949339362', "$class->new(2)->blog(undef, 71)"); is($class->new(11)->blog(undef, 71), '2.3978952727983705440619435779651292998217068539374171752185677091305736', "$class->new(11)->blog(undef, 71)"); is($class->new(21)->blog(undef, 71), '3.0445224377234229965005979803657054342845752874046106401940844835750742', "$class->new(21)->blog(undef, 71)"); ############################################################################### # 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 is($class->new(-2)->blog(), 'NaN', "$class->new(-2)->blog()"); is($class->new(-1)->blog(), 'NaN', "$class->new(-1)->blog()"); is($class->new(-10)->blog(), 'NaN', "$class->new(-10)->blog()"); is($class->new(-2, 2)->blog(), 'NaN', "$class->new(-2, 2)->blog()"); my $ten = $class->new(10)->blog(); # 10 is cached (up to 75 digits) is($class->new(10)->blog(), '2.302585092994045684017991454684364207601', qq|$class->new(10)->blog()|); # 0.1 is using the cached value for log(10), too is($class->new("0.1")->blog(), -$ten, qq|$class->new("0.1")->blog()|); is($class->new("0.01")->blog(), -$ten * 2, qq|$class->new("0.01")->blog()|); is($class->new("0.001")->blog(), -$ten * 3, qq|$class->new("0.001")->blog()|); is($class->new("0.0001")->blog(), -$ten * 4, qq|$class->new("0.0001")->blog()|); # also cached is($class->new(2)->blog(), '0.6931471805599453094172321214581765680755', qq|$class->new(2)->blog()|); is($class->new(4)->blog(), $class->new(2)->blog * 2, qq|$class->new(4)->blog()|); # These are still slow, so do them only to 10 digits is($class->new("0.2")->blog(undef, 10), "-1.609437912", qq|$class->new("0.2")->blog(undef, 10)|); is($class->new("0.3")->blog(undef, 10), "-1.203972804", qq|$class->new("0.3")->blog(undef, 10)|); is($class->new("0.4")->blog(undef, 10), "-0.9162907319", qq|$class->new("0.4")->blog(undef, 10)|); is($class->new("0.5")->blog(undef, 10), "-0.6931471806", qq|$class->new("0.5")->blog(undef, 10)|); is($class->new("0.6")->blog(undef, 10), "-0.5108256238", qq|$class->new("0.6")->blog(undef, 10)|); is($class->new("0.7")->blog(undef, 10), "-0.3566749439", qq|$class->new("0.7")->blog(undef, 10)|); is($class->new("0.8")->blog(undef, 10), "-0.2231435513", qq|$class->new("0.8")->blog(undef, 10)|); is($class->new("0.9")->blog(undef, 10), "-0.1053605157", qq|$class->new("0.9")->blog(undef, 10)|); is($class->new("9")->blog(undef, 10), "2.197224577", qq|$class->new("9")->blog(undef, 10)|); is($class->new("10")->blog(10, 10), "1.000000000", qq|$class->new("10")->blog(10, 10)|); is($class->new("20")->blog(20, 10), "1.000000000", qq|$class->new("20")->blog(20, 10)|); is($class->new("100")->blog(100, 10), "1.000000000", qq|$class->new("100")->blog(100, 10)|); is($class->new("100")->blog(10, 10), "2.000000000", # 10 ** 2 == 100 qq|$class->new("100")->blog(10, 10)|); is($class->new("400")->blog(20, 10), "2.000000000", # 20 ** 2 == 400 qq|$class->new("400")->blog(20, 10)|); is($class->new("4")->blog(2, 10), "2.000000000", # 2 ** 2 == 4 qq|$class->new("4")->blog(2, 10)|); is($class->new("16")->blog(2, 10), "4.000000000", # 2 ** 4 == 16 qq|$class->new("16")->blog(2, 10)|); is($class->new("1.2")->bpow("0.3", 10), "1.056219968", qq|$class->new("1.2")->bpow("0.3", 10)|); is($class->new("10")->bpow("0.6", 10), "3.981071706", qq|$class->new("10")->bpow("0.6", 10)|); # blog should handle bigint input is(Math::BigFloat::blog(Math::BigInt->new(100), 10), 2, "blog(100)"); ############################################################################### # some integer results is($class->new(2)->bpow(32)->blog(2), "32", "2 ** 32"); is($class->new(3)->bpow(32)->blog(3), "32", "3 ** 32"); is($class->new(2)->bpow(65)->blog(2), "65", "2 ** 65"); my $x = Math::BigInt->new('777') ** 256; my $base = Math::BigInt->new('12345678901234'); is($x->copy()->blog($base), 56, 'blog(777**256, 12345678901234)'); $x = Math::BigInt->new('777') ** 777; $base = Math::BigInt->new('777'); is($x->copy()->blog($base), 777, 'blog(777**777, 777)'); ############################################################################### # test for bug in bsqrt() not taking negative _e into account test_bpow('200', '0.5', 10, '14.14213562'); test_bpow('20', '0.5', 10, '4.472135955'); test_bpow('2', '0.5', 10, '1.414213562'); test_bpow('0.2', '0.5', 10, '0.4472135955'); test_bpow('0.02', '0.5', 10, '0.1414213562'); test_bpow('0.49', '0.5', undef, '0.7'); test_bpow('0.49', '0.5', 10, '0.7000000000'); test_bpow('0.002', '0.5', 10, '0.04472135955'); test_bpow('0.0002', '0.5', 10, '0.01414213562'); test_bpow('0.0049', '0.5', undef, '0.07'); test_bpow('0.0049', '0.5', 10, '0.07000000000'); test_bpow('0.000002', '0.5', 10, '0.001414213562'); test_bpow('0.021', '0.5', 10, '0.1449137675'); test_bpow('1.2', '0.5', 10, '1.095445115'); test_bpow('1.23', '0.5', 10, '1.109053651'); test_bpow('12.3', '0.5', 10, '3.507135583'); test_bpow('9.9', '0.5', 10, '3.146426545'); test_bpow('9.86902225', '0.5', 10, '3.141500000'); test_bpow('9.86902225', '0.5', undef, '3.1415'); ############################################################################### # other tests for bpow() test_bpow('0.2', '0.41', 10, '0.5169187652'); is($class->new("0.01")->bpow("28.4", 40)->bsstr(), '1584893192461113485202101373391507013269e-96', qq|$class->new("0.01")->bpow("28.4", 40)->bsstr()|); # The following test takes too long. #is($class->new("2")->bpow("-1034.5", 40)->bsstr(), # '3841222690408590466868250378242558090957e-351', # qq|$class->new("2")->bpow("-1034.5", 40)|); ############################################################################### # test bexp() with cached results is($class->new(1)->bexp(), '2.718281828459045235360287471352662497757', 'bexp(1)'); is($class->new(2)->bexp(40), $class->new(1)->bexp(45)->bpow(2, 40), 'bexp(2)'); is($class->new("12.5")->bexp(61), $class->new(1)->bexp(65)->bpow(12.5, 61), 'bexp(12.5)'); ############################################################################### # test bexp() with big values (non-cached) is($class->new(1)->bexp(100), '2.7182818284590452353602874713526624977572470936999' . '59574966967627724076630353547594571382178525166427', qq|$class->new(1)->bexp(100)|); is($class->new("12.5")->bexp(91), $class->new(1)->bexp(95)->bpow(12.5, 91), qq|$class->new("12.5")->bexp(91)|); is($class->new("-118.5")->bexp(20)->bsstr(), '34364014567198602057e-71', qq|$class->new("-118.5")->bexp(20)->bsstr()|); is($class->new("-394.84010945715266885")->bexp(20)->bsstr(), '33351796227864913873e-191', qq|$class->new("-118.5")->bexp(20)->bsstr()|); # all done 1; ############################################################################### sub test_bpow { my ($x, $y, $scale, $result) = @_; is($class->new($x)->bpow($y, $scale), $result, qq|$class->new($x)->bpow($y, | . (defined($scale) ? $scale : 'undef') . qq|)|); } Math-BigInt-1.999715/t/bigroot.t0000644403072340010010000000321412624037140016327 0ustar ospjaDomain Users#!perl # Test broot function (and bsqrt() function, since it is used by broot()). # It is too slow to be simple included in bigfltpm.inc, where it would get # executed 3 times. # But it is better to test the numerical functionality, instead of not testing # it at all. use strict; # restrict unsafe constructs use warnings; # enable optional warnings use Test::More tests => 4 * 2; use Math::BigFloat; use Math::BigInt; my $mbf = "Math::BigFloat"; my $mbi = "Math::BigInt"; # 2 ** 240 = # 1766847064778384329583297500742918515827483896875618958121606201292619776 # takes way too long #test_broot('2', '240', 8, undef, # '1073741824'); #test_broot('2', '240', 9, undef, # '106528681.3099908308759836475139583940127'); #test_broot('2', '120', 9, undef, # '10321.27324073880096577298929482324664787'); #test_broot('2', '120', 17, undef, # '133.3268493632747279600707813049418888729'); test_broot('2', '120', 8, undef, '32768'); test_broot('2', '60', 8, undef, '181.0193359837561662466161566988413540569'); test_broot('2', '60', 9, undef, '101.5936673259647663841091609134277286651'); test_broot('2', '60', 17, undef, '11.54672461623965153271017217302844672562'); sub test_broot { my ($x, $n, $y, $scale, $expected) = @_; my $s = $scale || 'undef'; is($mbf->new($x)->bpow($n)->broot($y, $scale), $expected, "Try: $mbf->new($x)->bpow($n)->broot($y, $s) == $expected"); $expected =~ s/\..*//; is($mbi->new($x)->bpow($n)->broot($y, $scale), $expected, "Try: $mbi->new($x)->bpow($n)->broot($y, $s) == $expected"); } Math-BigInt-1.999715/t/big_pi_e.t0000644403072340010010000000125312632033712016420 0ustar ospjaDomain Users#!perl # Test bpi() and bexp() use strict; use warnings; use Test::More tests => 8; use Math::BigFloat; ############################################################################# my $pi = Math::BigFloat::bpi(); ok(!exists $pi->{_a}, 'A not set'); ok(!exists $pi->{_p}, 'P not set'); $pi = Math::BigFloat->bpi(); ok(!exists $pi->{_a}, 'A not set'); ok(!exists $pi->{_p}, 'P not set'); $pi = Math::BigFloat->bpi(10); is($pi->{_a}, 10, 'A set'); is($pi->{_p}, undef, 'P not set'); ############################################################################# my $e = Math::BigFloat->new(1)->bexp(); ok(!exists $e->{_a}, 'A not set'); ok(!exists $e->{_p}, 'P not set'); Math-BigInt-1.999715/t/calling.t0000644403072340010010000000650212642755242016310 0ustar ospjaDomain Users#!perl # test calling conventions, and :constant overloading use strict; use warnings; use lib 't'; my $VERSION = '1.999715'; # adjust manually to match latest release $VERSION = eval $VERSION; use Test::More tests => 161; ############################################################################## package Math::BigInt::Test; use Math::BigInt; our @ISA = qw/Math::BigInt/; # subclass of MBI use overload; ############################################################################## package Math::BigFloat::Test; use Math::BigFloat; our @ISA = qw/Math::BigFloat/; # subclass of MBI use overload; ############################################################################## package main; use Math::BigInt try => 'Calc'; use Math::BigFloat; my ($x, $y, $z, $u); ############################################################################### # check whether op's accept normal strings, even when inherited by subclasses # do one positive and one negative test to avoid false positives by "accident" my ($method, $expected); while () { s/#.*$//; # remove comments s/\s+$//; # remove trailing whitespace next unless length; # skip empty lines if (s/^&//) { $method = $_; next; } my @args = split /:/, $_, 99; $expected = pop @args; foreach my $class (qw/ Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test /) { my $arg = $args[0] =~ /"/ || $args[0] eq "" ? $args[0] : qq|"$args[0]"|; my $try = "$class\->$method($arg);"; my $got = eval $try; is($got, $expected, $try); } } my $class = 'Math::BigInt'; my $try; # test whether use Math::BigInt qw/VERSION/ works $try = "use $class (" . ($VERSION . '1') .");"; $try .= ' $x = $class->new(123); $x = "$x";'; eval $try; like($@, qr/ ^ Math::BigInt \s+ ( version \s+ )? \S+ \s+ required--this \s+ is \s+ only \s+ version \s+ \S+ /x, $try); # test whether fallback to calc works $try = qq|use $class ($VERSION, "try", "foo, bar, ");| . qq| $class\->config()->{lib};|; $expected = eval $try; like($expected, qr/^Math::BigInt::(Fast)?Calc\z/, $try); # test whether constant works or not, also test for qw($VERSION) # bgcd() is present in subclass, too $try = qq|use $class ($VERSION, "bgcd", ":constant");| . q| $x = 2**150; bgcd($x); $x = "$x";|; $expected = eval $try; is($expected, "1427247692705959881058285969449495136382746624", $try); # test whether Math::BigInt::Scalar via use works (w/ dff. spellings of calc) $try = qq|use $class ($VERSION, "lib", "Scalar");| . q| $x = 2**10; $x = "$x";|; $expected = eval $try; is($expected, "1024", $try); $try = qq|use $class ($VERSION, "lib", "$class\::Scalar");| . q| $x = 2**10; $x = "$x";|; $expected = eval $try; is($expected, "1024", $try); # all done __END__ &is_zero 1:0 0:1 &is_one 1:1 0:0 &is_positive 1:1 -1:0 &is_negative 1:0 -1:1 &is_nan abc:1 1:0 &is_inf inf:1 0:0 &bstr 5:5 10:10 -10:-10 abc:NaN "+inf":inf "-inf":-inf &bsstr 1:1e+0 0:0e+0 2:2e+0 200:2e+2 -5:-5e+0 -100:-1e+2 abc:NaN "+inf":inf &babs -1:1 1:1 &bnot -2:1 1:-2 &bzero :0 &bnan :NaN abc:NaN &bone :1 "+":1 "-":-1 &binf :inf "+":inf "-":-inf Math-BigInt-1.999715/t/config.t0000644403072340010010000000736312632033743016144 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 55; # test whether Math::BigInt->config() and Math::BigFloat->config() works use Math::BigInt lib => 'Calc'; use Math::BigFloat; my $mbi = 'Math::BigInt'; my $mbf = 'Math::BigFloat'; ############################################################################## # Math::BigInt { can_ok($mbi, 'config'); my $cfg = $mbi->config(); is(ref($cfg), 'HASH', 'ref() of output from $mbi->config()'); is($cfg->{lib}, 'Math::BigInt::Calc', 'lib'); is($cfg->{lib_version}, $Math::BigInt::Calc::VERSION, 'lib_version'); is($cfg->{class}, $mbi, 'class'); is($cfg->{upgrade} || '', '', 'upgrade'); is($cfg->{div_scale}, 40, 'div_Scale'); is($cfg->{precision} || 0, 0, 'precision'); # should test for undef is($cfg->{accuracy} || 0, 0, 'accuracy'); is($cfg->{round_mode}, 'even', 'round_mode'); is($cfg->{trap_nan}, 0, 'trap_nan'); is($cfg->{trap_inf}, 0, 'trap_inf'); is($mbi->config('lib'), 'Math::BigInt::Calc', 'config("lib")'); # can set via hash ref? $cfg = $mbi->config({ trap_nan => 1 }); is($cfg->{trap_nan}, 1, 'can set "trap_nan" via hash ref'); # reset for later $mbi->config(trap_nan => 0); } ############################################################################## # Math::BigFloat { can_ok($mbf, 'config'); my $cfg = $mbf->config(); is(ref($cfg), 'HASH', 'ref() of output from $mbf->config()'); is($cfg->{lib}, 'Math::BigInt::Calc', 'lib'); is($cfg->{with}, 'Math::BigInt::Calc', 'with'); is($cfg->{lib_version}, $Math::BigInt::Calc::VERSION, 'lib_version'); is($cfg->{class}, $mbf, 'class'); is($cfg->{upgrade} || '', '', 'upgrade'); is($cfg->{div_scale}, 40, 'div_Scale'); is($cfg->{precision} || 0, 0, 'precision'); # should test for undef is($cfg->{accuracy} || 0, 0, 'accuracy'); is($cfg->{round_mode}, 'even', 'round_mode'); is($cfg->{trap_nan}, 0, 'trap_nan'); is($cfg->{trap_inf}, 0, 'trap_inf'); is($mbf->config('lib'), 'Math::BigInt::Calc', 'config("lib")'); # can set via hash ref? $cfg = $mbf->config({ trap_nan => 1 }); is($cfg->{trap_nan}, 1, 'can set "trap_nan" via hash ref'); # reset for later $mbf->config(trap_nan => 0); } ############################################################################## # test setting values my $test = { trap_nan => 1, trap_inf => 1, accuracy => 2, precision => 3, round_mode => 'zero', div_scale => '100', upgrade => 'Math::BigInt::SomeClass', downgrade => 'Math::BigInt::SomeClass', }; my $c; foreach my $key (keys %$test) { # see if setting in MBI works eval { $mbi->config($key => $test->{$key}); }; $c = $mbi->config(); is("$key = $c->{$key}", "$key = $test->{$key}", "$key = $test->{$key}"); $c = $mbf->config(); # see if setting it in MBI leaves MBF alone ok(($c->{$key} || 0) ne $test->{$key}, "$key ne \$c->{$key}"); # see if setting in MBF works eval { $mbf->config($key => $test->{$key}); }; $c = $mbf->config(); is("$key = $c->{$key}", "$key = $test->{$key}", "$key = $test->{$key}"); } ############################################################################## # test setting illegal keys (should croak) eval { $mbi->config('some_garbage' => 1); }; like($@, qr/ ^ Illegal \s+ key\(s\) \s+ 'some_garbage' \s+ passed \s+ to \s+ Math::BigInt->config\(\) \s+ at /x, 'Passing invalid key to Math::BigInt->config() causes an error.'); eval { $mbf->config('some_garbage' => 1); }; like($@, qr/ ^ Illegal \s+ key\(s\) \s+ 'some_garbage' \s+ passed \s+ to \s+ Math::BigFloat->config\(\) \s+ at /x, 'Passing invalid key to Math::BigFloat->config() causes an error.'); Math-BigInt-1.999715/t/constant.t0000644403072340010010000000251712632033750016522 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 7; use Math::BigInt ':constant'; is(2 ** 255, '578960446186580977117854925043439539266' . '34992332820282019728792003956564819968', '2 ** 255'); { no warnings 'portable'; # protect against "non-portable" warnings # hexadecimal constants is(0x123456789012345678901234567890, Math::BigInt->new('0x123456789012345678901234567890'), 'hexadecimal constant 0x123456789012345678901234567890'); # binary constants is(0b01010100011001010110110001110011010010010110000101101101, Math::BigInt->new('0b0101010001100101011011000111' . '0011010010010110000101101101'), 'binary constant 0b0101010001100101011011000111' . '0011010010010110000101101101'); } use Math::BigFloat ':constant'; is(1.0 / 3.0, '0.3333333333333333333333333333333333333333', '1.0 / 3.0 = 0.3333333333333333333333333333333333333333'); # stress-test Math::BigFloat->import() Math::BigFloat->import(qw/:constant/); pass('Math::BigFloat->import(qw/:constant/);'); Math::BigFloat->import(qw/:constant upgrade Math::BigRat/); pass('Math::BigFloat->import(qw/:constant upgrade Math::BigRat/);'); Math::BigFloat->import(qw/upgrade Math::BigRat :constant/); pass('Math::BigFloat->import(qw/upgrade Math::BigRat :constant/);'); # all tests done Math-BigInt-1.999715/t/const_mbf.t0000644403072340010010000000062312632033746016644 0ustar ospjaDomain Users#!perl # test Math::BigFloat constants alone (w/o Math::BigInt loading) use strict; use warnings; use Test::More tests => 2; use Math::BigFloat ':constant'; is(1.0 / 3.0, '0.3333333333333333333333333333333333333333', "1.0 / 3.0 = 0.3333333333333333333333333333333333333333"); # Math::BigInt was not loaded with ':constant', so only floats are handled is(ref(2 ** 2), '', "2 ** 2 is a scalar"); Math-BigInt-1.999715/t/downgrade.t0000644403072340010010000000407112632034766016650 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 15; use Math::BigInt upgrade => 'Math::BigFloat'; use Math::BigFloat downgrade => 'Math::BigInt', upgrade => 'Math::BigInt'; our ($CLASS, $EXPECTED_CLASS, $CALC); $CLASS = "Math::BigInt"; $EXPECTED_CLASS = "Math::BigFloat"; $CALC = "Math::BigInt::Calc"; # backend # simplistic test for now is(Math::BigFloat->downgrade(), 'Math::BigInt', 'Math::BigFloat->downgrade()'); is(Math::BigFloat->upgrade(), 'Math::BigInt', 'Math::BigFloat->upgrade()'); # these downgrade is(ref(Math::BigFloat->new("inf")), "Math::BigInt", qq|ref(Math::BigFloat->new("inf"))|); is(ref(Math::BigFloat->new("-inf")), "Math::BigInt", qq|ref(Math::BigFloat->new("-inf"))|); is(ref(Math::BigFloat->new("NaN")), "Math::BigInt", qq|ref(Math::BigFloat->new("NaN"))|); is(ref(Math::BigFloat->new("0")), "Math::BigInt", qq|ref(Math::BigFloat->new("0"))|); is(ref(Math::BigFloat->new("1")), "Math::BigInt", qq|ref(Math::BigFloat->new("1"))|); is(ref(Math::BigFloat->new("10")), "Math::BigInt", qq|ref(Math::BigFloat->new("10"))|); is(ref(Math::BigFloat->new("-10")), "Math::BigInt", qq|ref(Math::BigFloat->new("-10"))|); is(ref(Math::BigFloat->new("-10.0E1")), "Math::BigInt", qq|ref(Math::BigFloat->new("-10.0E1"))|); # bug until v1.67: is(Math::BigFloat->new("0.2E0"), "0.2", qq|Math::BigFloat->new("0.2E0")|); is(Math::BigFloat->new("0.2E1"), "2", qq|Math::BigFloat->new("0.2E1")|); # until v1.67 resulted in 200: is(Math::BigFloat->new("0.2E2"), "20", qq|Math::BigFloat->new("0.2E2")|); # disable, otherwise it screws calculations Math::BigFloat->upgrade(undef); is(Math::BigFloat->upgrade() || "", "", qq/Math::BigFloat->upgrade() || ""/); Math::BigFloat->div_scale(20); # make it a bit faster my $x = Math::BigFloat->new(2); # downgrades # the following test upgrade for bsqrt() and also makes new() NOT downgrade # for the bpow() side is(Math::BigFloat->bpow("2", "0.5"), $x->bsqrt(), qq|Math::BigFloat->bpow("2", "0.5")|); #require 'upgrade.inc'; # all tests here for sharing Math-BigInt-1.999715/t/from_hex-mbf.t0000644403072340010010000000200512623547372017244 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 27; my $class; BEGIN { $class = 'Math::BigFloat'; } BEGIN { use_ok($class, '1.999710'); } while () { s/#.*$//; # remove comments s/\s+$//; # remove trailing whitespace next unless length; # skip empty lines my ($in0, $out0) = split /:/; my $x; my $test = qq|\$x = $class -> from_hex("$in0");|; my $desc = $test; eval $test; die $@ if $@; # this should never happen subtest $desc, sub { plan tests => 2, # Check output. is(ref($x), $class, "output arg is a $class"); is($x, $out0, 'output arg has the right value'); }; } __END__ 0x1p+0:1 0x.8p+1:1 0x.4p+2:1 0x.2p+3:1 0x.1p+4:1 0x2p-1:1 0x4p-2:1 0x8p-3:1 -0x1p+0:-1 0x0p+0:0 0x0p+7:0 0x0p-7:0 0x0.p+0:0 0x.0p+0:0 0x0.0p+0:0 0xcafe:51966 xcafe:51966 cafe:51966 0x1.9p+3:12.5 0x12.34p-1:9.1015625 -0x.789abcdefp+32:-2023406814.9375 0x12.3456789ap+31:39093746765 NaN:NaN +inf:NaN -inf:NaN 0x.p+0:NaN Math-BigInt-1.999715/t/inf_nan.t0000644403072340010010000001554212632033760016304 0ustar ospjaDomain Users#!perl # test inf/NaN handling all in one place # Thanx to Jarkko for the excellent explanations and the tables use strict; use warnings; use lib 't'; use Test::More tests => 2052; use Math::BigInt; use Math::BigFloat; use Math::BigInt::Subclass; use Math::BigFloat::Subclass; my @biclasses = qw/ Math::BigInt Math::BigInt::Subclass /; my @bfclasses = qw/ Math::BigFloat Math::BigFloat::Subclass /; my (@args, $x, $y, $z); # + foreach (qw/ -inf:-inf:-inf -1:-inf:-inf -0:-inf:-inf 0:-inf:-inf 1:-inf:-inf inf:-inf:NaN NaN:-inf:NaN -inf:-1:-inf -1:-1:-2 -0:-1:-1 0:-1:-1 1:-1:0 inf:-1:inf NaN:-1:NaN -inf:0:-inf -1:0:-1 -0:0:0 0:0:0 1:0:1 inf:0:inf NaN:0:NaN -inf:1:-inf -1:1:0 -0:1:1 0:1:1 1:1:2 inf:1:inf NaN:1:NaN -inf:inf:NaN -1:inf:inf -0:inf:inf 0:inf:inf 1:inf:inf inf:inf:inf NaN:inf:NaN -inf:NaN:NaN -1:NaN:NaN -0:NaN:NaN 0:NaN:NaN 1:NaN:NaN inf:NaN:NaN NaN:NaN:NaN /) { @args = split /:/, $_; for my $class (@biclasses, @bfclasses) { $x = $class->new($args[0]); $y = $class->new($args[1]); $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0 my $r = $x->badd($y); is($x->bstr(), $args[2], "x $class $args[0] + $args[1]"); is($x->bstr(), $args[2], "r $class $args[0] + $args[1]"); } } # - foreach (qw/ -inf:-inf:NaN -1:-inf:inf -0:-inf:inf 0:-inf:inf 1:-inf:inf inf:-inf:inf NaN:-inf:NaN -inf:-1:-inf -1:-1:0 -0:-1:1 0:-1:1 1:-1:2 inf:-1:inf NaN:-1:NaN -inf:0:-inf -1:0:-1 -0:0:-0 0:0:0 1:0:1 inf:0:inf NaN:0:NaN -inf:1:-inf -1:1:-2 -0:1:-1 0:1:-1 1:1:0 inf:1:inf NaN:1:NaN -inf:inf:-inf -1:inf:-inf -0:inf:-inf 0:inf:-inf 1:inf:-inf inf:inf:NaN NaN:inf:NaN -inf:NaN:NaN -1:NaN:NaN -0:NaN:NaN 0:NaN:NaN 1:NaN:NaN inf:NaN:NaN NaN:NaN:NaN /) { @args = split /:/, $_; for my $class (@biclasses, @bfclasses) { $x = $class->new($args[0]); $y = $class->new($args[1]); $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0 my $r = $x->bsub($y); is($x->bstr(), $args[2], "x $class $args[0] - $args[1]"); is($r->bstr(), $args[2], "r $class $args[0] - $args[1]"); } } # * foreach (qw/ -inf:-inf:inf -1:-inf:inf -0:-inf:NaN 0:-inf:NaN 1:-inf:-inf inf:-inf:-inf NaN:-inf:NaN -inf:-1:inf -1:-1:1 -0:-1:0 0:-1:-0 1:-1:-1 inf:-1:-inf NaN:-1:NaN -inf:0:NaN -1:0:-0 -0:0:-0 0:0:0 1:0:0 inf:0:NaN NaN:0:NaN -inf:1:-inf -1:1:-1 -0:1:-0 0:1:0 1:1:1 inf:1:inf NaN:1:NaN -inf:inf:-inf -1:inf:-inf -0:inf:NaN 0:inf:NaN 1:inf:inf inf:inf:inf NaN:inf:NaN -inf:NaN:NaN -1:NaN:NaN -0:NaN:NaN 0:NaN:NaN 1:NaN:NaN inf:NaN:NaN NaN:NaN:NaN /) { @args = split /:/, $_; for my $class (@biclasses, @bfclasses) { $x = $class->new($args[0]); $y = $class->new($args[1]); $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0 my $r = $x->bmul($y); is($x->bstr(), $args[2], "x $class $args[0] * $args[1]"); is($r->bstr(), $args[2], "r $class $args[0] * $args[1]"); } } # / foreach (qw/ -inf:-inf:NaN -1:-inf:0 -0:-inf:0 0:-inf:-0 1:-inf:-1 inf:-inf:NaN NaN:-inf:NaN -inf:-1:inf -1:-1:1 -0:-1:0 0:-1:-0 1:-1:-1 inf:-1:-inf NaN:-1:NaN -inf:0:-inf -1:0:-inf -0:0:NaN 0:0:NaN 1:0:inf inf:0:inf NaN:0:NaN -inf:1:-inf -1:1:-1 -0:1:-0 0:1:0 1:1:1 inf:1:inf NaN:1:NaN -inf:inf:NaN -1:inf:-1 -0:inf:-0 0:inf:0 1:inf:0 inf:inf:NaN NaN:inf:NaN -inf:NaN:NaN -1:NaN:NaN -0:NaN:NaN 0:NaN:NaN 1:NaN:NaN inf:NaN:NaN NaN:NaN:NaN /) { @args = split /:/, $_; for my $class (@biclasses, @bfclasses) { $x = $class->new($args[0]); $y = $class->new($args[1]); $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0 my $t = $x->copy(); my $tmod = $t->copy(); # bdiv in scalar context unless ($class =~ /^Math::BigFloat/) { my $r = $x->bdiv($y); is($x->bstr(), $args[2], "x $class $args[0] / $args[1]"); is($r->bstr(), $args[2], "r $class $args[0] / $args[1]"); } # bmod and bdiv in list context my ($d, $rem) = $t->bdiv($y); # bdiv in list context is($t->bstr(), $args[2], "t $class $args[0] / $args[1]"); is($d->bstr(), $args[2], "d $class $args[0] / $args[1]"); # bmod my $m = $tmod->bmod($y); # bmod() agrees with bdiv? is($m->bstr(), $rem->bstr(), "m $class $args[0] % $args[1]"); # bmod() return agrees with set value? is($tmod->bstr(), $m->bstr(), "o $class $args[0] % $args[1]"); } } # / foreach (qw/ -inf:-inf:NaN -1:-inf:0 -0:-inf:0 0:-inf:-0 1:-inf:-0 inf:-inf:NaN NaN:-inf:NaN -inf:-1:inf -1:-1:1 -0:-1:0 0:-1:-0 1:-1:-1 inf:-1:-inf NaN:-1:NaN -inf:0:-inf -1:0:-inf -0:0:NaN 0:0:NaN 1:0:inf inf:0:inf NaN:0:NaN -inf:1:-inf -1:1:-1 -0:1:-0 0:1:0 1:1:1 inf:1:inf NaN:1:NaN -inf:inf:NaN -1:inf:-0 -0:inf:-0 0:inf:0 1:inf:0 inf:inf:NaN NaN:inf:NaN -inf:NaN:NaN -1:NaN:NaN -0:NaN:NaN 0:NaN:NaN 1:NaN:NaN inf:NaN:NaN NaN:NaN:NaN /) { @args = split /:/, $_; for my $class (@bfclasses) { $x = $class->new($args[0]); $y = $class->new($args[1]); $args[2] = '0' if $args[2] eq '-0'; # Math::Big(Int|Float) has no -0 my $t = $x->copy(); my $tmod = $t->copy(); # bdiv in scalar context my $r = $x->bdiv($y); is($x->bstr(), $args[2], "x $class $args[0] / $args[1]"); is($r->bstr(), $args[2], "r $class $args[0] / $args[1]"); } } ############################################################################# # overloaded comparisons foreach my $c (@biclasses, @bfclasses) { my $x = $c->bnan(); my $y = $c->bnan(); # test with two different objects, too my $z = $c->bzero(); is($x == $y, '', 'NaN == NaN: ""'); is($x != $y, 1, 'NaN != NaN: 1'); is($x == $x, '', 'NaN == NaN: ""'); is($x != $x, 1, 'NaN != NaN: 1'); is($z != $x, 1, '0 != NaN: 1'); is($z == $x, '', '0 == NaN: ""'); is($z < $x, '', '0 < NaN: ""'); is($z <= $x, '', '0 <= NaN: ""'); is($z >= $x, '', '0 >= NaN: ""'); #is($z > $x, '', '0 > NaN: ""'); # Bug! Todo: fix it! } # All done. Math-BigInt-1.999715/t/isa.t0000644403072340010010000000241412632033762015444 0ustar ospjaDomain Users#!perl use strict; use warnings; use lib 't'; use Test::More tests => 11; use Math::BigInt::Subclass; use Math::BigFloat::Subclass; use Math::BigInt; use Math::BigFloat; my $class = "Math::BigInt::Subclass"; my $CALC = "Math::BigInt::Calc"; # Check that a subclass is still considered a Math::BigInt isa_ok($class->new(123), 'Math::BigInt'); # ditto for plain Math::BigInt isa_ok(Math::BigInt->new(123), 'Math::BigInt'); # But Math::BigFloats aren't ok(!Math::BigFloat->new(123)->isa('Math::BigInt'), "A Math::BigFloat isn't a Math::BigInt"); { # see what happens if we feed a Math::BigFloat into new() my $x = Math::BigInt->new(Math::BigFloat->new(123)); is(ref($x), 'Math::BigInt', 'ref($x) = "Math::BigInt"'); isa_ok($x, 'Math::BigInt'); } { # ditto for subclass my $x = Math::BigInt->new(Math::BigFloat::Subclass->new(123)); is(ref($x), 'Math::BigInt', 'ref($x) = "Math::BigInt"'); isa_ok($x, 'Math::BigInt'); } { my $x = Math::BigFloat->new(Math::BigInt->new(123)); is(ref($x), 'Math::BigFloat', 'ref($x) = "Math::BigFloat"'); isa_ok($x, 'Math::BigFloat'); } { my $x = Math::BigFloat->new(Math::BigInt::Subclass->new(123)); is(ref($x), 'Math::BigFloat', 'ref($x) = "Math::BigFloat"'); isa_ok($x, 'Math::BigFloat'); } Math-BigInt-1.999715/t/lib_load.t0000644403072340010010000000167712632033765016452 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 4; use lib 't'; # first load Math::BigInt with Math::BigInt::Calc use Math::BigInt lib => 'Calc'; # Math::BigFloat will remember that we loaded Math::BigInt::Calc require Math::BigFloat; is(Math::BigFloat::config()->{lib}, 'Math::BigInt::Calc', 'Math::BigFloat got Math::BigInt::Calc'); # now load Math::BigInt again with a different lib Math::BigInt->import(lib => 'BareCalc'); # and finally test that Math::BigFloat knows about Math::BigInt::BareCalc is(Math::BigFloat::config()->{lib}, 'Math::BigInt::BareCalc', 'Math::BigFloat was notified'); # See that Math::BigFloat supports "only" eval "Math::BigFloat->import('only' => 'Calc')"; is(Math::BigFloat::config()->{lib}, 'Math::BigInt::Calc', '"only" worked'); # See that Math::BigFloat supports "try" eval "Math::BigFloat->import('try' => 'BareCalc')"; is(Math::BigFloat::config()->{lib}, 'Math::BigInt::BareCalc', '"try" worked'); Math-BigInt-1.999715/t/Math/0000755403072340010010000000000012642757312015400 5ustar ospjaDomain UsersMath-BigInt-1.999715/t/Math/BigFloat/0000755403072340010010000000000012642757312017067 5ustar ospjaDomain UsersMath-BigInt-1.999715/t/Math/BigFloat/Subclass.pm0000644403072340010010000000202412632016561021173 0ustar ospjaDomain Users#!perl # for testing subclassing Math::BigFloat package Math::BigFloat::Subclass; require 5.006; use strict; use warnings; use Exporter; use Math::BigFloat 1.38; our ($accuracy, $precision, $round_mode, $div_scale); our @ISA = qw(Exporter Math::BigFloat); our $VERSION = "0.06"; use overload; # inherit overload from BigInt # Globals $accuracy = $precision = undef; $round_mode = 'even'; $div_scale = 40; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $value = shift; my $a = $accuracy; $a = $_[0] if defined $_[0]; my $p = $precision; $p = $_[1] if defined $_[1]; # Store the floating point value my $self = Math::BigFloat->new($value, $a, $p, $round_mode); bless $self, $class; $self->{'_custom'} = 1; # make sure this never goes away return $self; } BEGIN { *objectify = \&Math::BigInt::objectify; # to allow Math::BigFloat::Subclass::bgcd( ... ) style calls *bgcd = \&Math::BigFloat::bgcd; *blcm = \&Math::BigFloat::blcm; } 1; Math-BigInt-1.999715/t/Math/BigInt/0000755403072340010010000000000012642757312016554 5ustar ospjaDomain UsersMath-BigInt-1.999715/t/Math/BigInt/BareCalc.pm0000644403072340010010000000164312632016711020540 0ustar ospjaDomain Users#!perl package Math::BigInt::BareCalc; use 5.005; use strict; use warnings; require Exporter; our @ISA = qw(Exporter); our $VERSION = '0.06'; sub api_version () { 1; } # Package to to test Bigint's simulation of Calc # Uses Calc, but only features the strictly neccessary methods. use Math::BigInt::Calc '0.51'; BEGIN { no strict 'refs'; foreach (qw/ base_len new zero one two ten copy str num add sub mul div mod inc dec acmp alen 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 as_oct from_hex from_bin from_oct modpow modinv and xor or /) { my $name = "Math::BigInt::Calc::_$_"; *{"Math::BigInt::BareCalc::_$_"} = \&$name; } print "# BareCalc using Calc v$Math::BigInt::Calc::VERSION\n"; } # catch and throw away sub import { } 1; Math-BigInt-1.999715/t/Math/BigInt/Scalar.pm0000644403072340010010000001145212632022307020306 0ustar ospjaDomain Users############################################################################### # core math lib for BigInt, representing big numbers by normal int/float's # for testing only, will fail any bignum test if range is exceeded package Math::BigInt::Scalar; use 5.006; use strict; use warnings; require Exporter; our @ISA = qw(Exporter); our $VERSION = '0.13'; sub api_version() { 1; } ############################################################################## # global constants, flags and accessory # constants for easier life my $nan = 'NaN'; ############################################################################## # create objects from various representations sub _new { # create scalar ref from string my $d = $_[1]; my $x = $d; # make copy \$x; } sub _from_hex { # not used } sub _from_oct { # not used } sub _from_bin { # not used } sub _zero { my $x = 0; \$x; } sub _one { my $x = 1; \$x; } sub _two { my $x = 2; \$x; } sub _ten { my $x = 10; \$x; } sub _copy { my $x = $_[1]; my $z = $$x; \$z; } # catch and throw away sub import { } ############################################################################## # convert back to string and number sub _str { # make string "${$_[1]}"; } sub _num { # make a number 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]}); } sub _as_oct { sprintf("0%o", ${$_[1]}); } ############################################################################## # actual math code sub _add { my ($c, $x, $y) = @_; $$x += $$y; return $x; } sub _sub { my ($c, $x, $y) = @_; $$x -= $$y; return $x; } sub _mul { my ($c, $x, $y) = @_; $$x *= $$y; return $x; } sub _div { my ($c, $x, $y) = @_; my $u = int($$x / $$y); my $r = $$x % $$y; $$x = $u; return ($x, \$r) if wantarray; return $x; } sub _pow { my ($c, $x, $y) = @_; my $u = $$x ** $$y; $$x = $u; return $x; } sub _and { my ($c, $x, $y) = @_; my $u = int($$x) & int($$y); $$x = $u; return $x; } sub _xor { my ($c, $x, $y) = @_; my $u = int($$x) ^ int($$y); $$x = $u; return $x; } sub _or { my ($c, $x, $y) = @_; my $u = int($$x) | int($$y); $$x = $u; return $x; } sub _inc { my ($c, $x) = @_; my $u = int($$x)+1; $$x = $u; return $x; } sub _dec { my ($c, $x) = @_; my $u = int($$x)-1; $$x = $u; return $x; } ############################################################################## # testing sub _acmp { my ($c, $x, $y) = @_; return ($$x <=> $$y); } sub _len { return length("${$_[1]}"); } sub _digit { # return the nth digit, negative values count backward # 0 is the rightmost digit my ($c, $x, $n) = @_; $n ++; # 0 => 1, 1 => 2 return substr($$x, -$n, 1); # 1 => -1, -2 => 2 etc } ############################################################################## # _is_* routines sub _is_zero { # return true if arg is zero my ($c, $x) = @_; ($$x == 0) <=> 0; } sub _is_even { # return true if arg is even my ($c, $x) = @_; (!($$x & 1)) <=> 0; } sub _is_odd { # return true if arg is odd my ($c, $x) = @_; ($$x & 1) <=> 0; } sub _is_one { # return true if arg is one my ($c, $x) = @_; ($$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; } ############################################################################### # check routine to test internal state of corruptions sub _check { # no checks yet, pull it out from the test suite my ($c, $x) = @_; return "$x is not a reference" if !ref($x); return 0; } 1; __END__ =head1 NAME Math::BigInt::Scalar - Pure Perl module to test Math::BigInt with scalars =head1 SYNOPSIS Provides support for big integer calculations via means of 'small' int/floats. Only for testing purposes, since it will fail at large values. But it is simple enough not to introduce bugs on it's own and to serve as a testbed. =head1 DESCRIPTION Please see Math::BigInt::Calc. =head1 LICENSE This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Tels http://bloodgate.com in 2001 - 2007. =head1 SEE ALSO L, L. =cut Math-BigInt-1.999715/t/Math/BigInt/Subclass.pm0000644403072340010010000000343112632016561020663 0ustar ospjaDomain Users#!perl package Math::BigInt::Subclass; require 5.005_02; use strict; use warnings; use Exporter; use Math::BigInt 1.64; # $lib is for the "lib => " test our $lib; our ($accuracy, $precision, $round_mode, $div_scale); our @ISA = qw(Exporter Math::BigInt); our @EXPORT_OK = qw(bgcd objectify); our $VERSION = "0.05"; use overload; # inherit overload from BigInt # Globals $accuracy = $precision = undef; $round_mode = 'even'; $div_scale = 40; $lib = ''; sub new { my $proto = shift; my $class = ref($proto) || $proto; my $value = shift; my $a = $accuracy; $a = $_[0] if defined $_[0]; my $p = $precision; $p = $_[1] if defined $_[1]; my $self = Math::BigInt->new($value, $a, $p, $round_mode); bless $self, $class; $self->{'_custom'} = 1; # make sure this never goes away return $self; } sub bgcd { Math::BigInt::bgcd(@_); } sub blcm { Math::BigInt::blcm(@_); } sub as_int { Math::BigInt->new($_[0]); } BEGIN { *objectify = \&Math::BigInt::objectify; # these are called by AUTOLOAD from BigFloat, so we need at least these. # We cheat, of course.. *bneg = \&Math::BigInt::bneg; *babs = \&Math::BigInt::babs; *bnan = \&Math::BigInt::bnan; *binf = \&Math::BigInt::binf; *bzero = \&Math::BigInt::bzero; *bone = \&Math::BigInt::bone; } sub import { my $self = shift; my @a; my $t = 0; foreach (@_) { # remove the "lib => foo" parameters and store it if ($t == 1) { $lib = $_; $t = 0; next; } if ($_ eq 'lib') { $t = 1; next; } push @a, $_; } $self->SUPER::import(@a); # need it for subclasses $self->export_to_level(1, $self, @a); # need this ? } 1; Math-BigInt-1.999715/t/mbf_ali.t0000644403072340010010000000027112632033767016265 0ustar ospjaDomain Users#!perl # test that the new alias names work use strict; use warnings; use Test::More tests => 6; use Math::BigFloat; our $CLASS; $CLASS = 'Math::BigFloat'; require 't/alias.inc'; Math-BigInt-1.999715/t/mbimbf.inc0000644403072340010010000011456612632253442016445 0ustar ospjaDomain Users# test rounding, accuracy, precision and fallback, round_mode and mixing # of classes # Make sure you always quote any bare floating-point values, lest 123.46 will # be stringified to 123.4599999999 due to limited float prevision. use strict; use warnings; my ($x, $y, $z, $u, $rc); our ($mbi, $mbf); ############################################################################### # test defaults and set/get { no strict 'refs'; is(${"$mbi\::accuracy"}, undef, qq|\${"$mbi\::accuracy"}|); is(${"$mbi\::precision"}, undef, qq|\${"$mbi\::precision"}|); is($mbi->accuracy(), undef, qq|$mbi->accuracy()|); is($mbi->precision(), undef, qq|$mbi->precision()|); is(${"$mbi\::div_scale"}, 40, qq|\${"$mbi\::div_scale"}|); is(${"$mbi\::round_mode"}, 'even', qq|\${"$mbi\::round_mode"}|); is($mbi->round_mode(), 'even', qq|$mbi->round_mode()|); is(${"$mbf\::accuracy"}, undef, qq|\${"$mbf\::accuracy"}|); is(${"$mbf\::precision"}, undef, qq|\${"$mbf\::precision"}|); is($mbf->precision(), undef, qq|$mbf->precision()|); is($mbf->precision(), undef, qq|$mbf->precision()|); is(${"$mbf\::div_scale"}, 40, qq|\${"$mbf\::div_scale"}|); is(${"$mbf\::round_mode"}, 'even', qq|\${"$mbf\::round_mode"}|); is($mbf->round_mode(), 'even', qq|$mbf->round_mode()|); } # accessors foreach my $class ($mbi, $mbf) { is($class->accuracy(), undef, qq|$class->accuracy()|); is($class->precision(), undef, qq|$class->precision()|); is($class->round_mode(), "even", qq|$class->round_mode()|); is($class->div_scale(), 40, qq|$class->div_scale()|); is($class->div_scale(20), 20, qq|$class->div_scale(20)|); $class->div_scale(40); is($class->div_scale(), 40, qq|$class->div_scale()|); is($class->round_mode("odd"), "odd", qq|$class->round_mode("odd")|); $class->round_mode("even"); is($class->round_mode(), "even", qq|$class->round_mode()|); is($class->accuracy(2), 2, qq|$class->accuracy(2)|); $class->accuracy(3); is($class->accuracy(), 3, qq|$class->accuracy()|); is($class->accuracy(undef), undef, qq|$class->accuracy(undef)|); is($class->precision(2), 2, qq|$class->precision(2)|); is($class->precision(-2), -2, qq|$class->precision(-2)|); $class->precision(3); is($class->precision(), 3, qq|$class->precision()|); is($class->precision(undef), undef, qq|$class->precision(undef)|); } { no strict 'refs'; # accuracy foreach (qw/5 42 -1 0/) { is(${"$mbf\::accuracy"} = $_, $_, qq|\${"$mbf\::accuracy"} = $_|); is(${"$mbi\::accuracy"} = $_, $_, qq|\${"$mbi\::accuracy"} = $_|); } is(${"$mbf\::accuracy"} = undef, undef, qq|\${"$mbf\::accuracy"} = undef|); is(${"$mbi\::accuracy"} = undef, undef, qq|\${"$mbi\::accuracy"} = undef|); # precision foreach (qw/5 42 -1 0/) { is(${"$mbf\::precision"} = $_, $_, qq|\${"$mbf\::precision"} = $_|); is(${"$mbi\::precision"} = $_, $_, qq|\${"$mbi\::precision"} = $_|); } is(${"$mbf\::precision"} = undef, undef, qq|\${"$mbf\::precision"} = undef|); is(${"$mbi\::precision"} = undef, undef, qq|\${"$mbi\::precision"} = undef|); # fallback foreach (qw/5 42 1/) { is(${"$mbf\::div_scale"} = $_, $_, qq|\${"$mbf\::div_scale"} = $_|); is(${"$mbi\::div_scale"} = $_, $_, qq|\${"$mbi\::div_scale"} = $_|); } # illegal values are possible for fallback due to no accessor # round_mode foreach (qw/odd even zero trunc +inf -inf/) { is(${"$mbf\::round_mode"} = $_, $_, qq|\${"$mbf\::round_mode"} = "$_"|); is(${"$mbi\::round_mode"} = $_, $_, qq|\${"$mbi\::round_mode"} = "$_"|); } ${"$mbf\::round_mode"} = 'zero'; is(${"$mbf\::round_mode"}, 'zero', qq|\${"$mbf\::round_mode"}|); is(${"$mbi\::round_mode"}, '-inf', qq|\${"$mbi\::round_mode"}|); # reset for further tests ${"$mbi\::accuracy"} = undef; ${"$mbi\::precision"} = undef; ${"$mbf\::div_scale"} = 40; } # local copies $x = $mbf->new('123.456'); is($x->accuracy(), undef, q|$x->accuracy()|); is($x->accuracy(5), 5, q|$x->accuracy(5)|); is($x->accuracy(undef), undef, q|$x->accuracy(undef)|); is($x->precision(), undef, q|$x->precision()|); is($x->precision(5), 5, q|$x->precision(5)|); is($x->precision(undef), undef, q|$x->precision(undef)|); { no strict 'refs'; # see if MBF changes MBIs values is(${"$mbi\::accuracy"} = 42, 42, qq|\${"$mbi\::accuracy"} = 42|); is(${"$mbf\::accuracy"} = 64, 64, qq|\${"$mbf\::accuracy"} = 64|); is(${"$mbi\::accuracy"}, 42, qq|\${"$mbi\::accuracy"} = 42|); is(${"$mbf\::accuracy"}, 64, qq|\${"$mbf\::accuracy"} = 64|); } ############################################################################### # see if creating a number under set A or P will round it { no strict 'refs'; ${"$mbi\::accuracy"} = 4; ${"$mbi\::precision"} = undef; is($mbi->new(123456), 123500, qq|$mbi->new(123456) = 123500|); # with A ${"$mbi\::accuracy"} = undef; ${"$mbi\::precision"} = 3; is($mbi->new(123456), 123000, qq|$mbi->new(123456) = 123000|); # with P ${"$mbf\::accuracy"} = 4; ${"$mbf\::precision"} = undef; ${"$mbi\::precision"} = undef; is($mbf->new("123.456"), "123.5", qq|$mbf->new("123.456") = 123.5|); ${"$mbf\::accuracy"} = undef; ${"$mbf\::precision"} = -1; is($mbf->new("123.456"), "123.5", qq|$mbf->new("123.456") = 123.5|); ${"$mbf\::precision"} = undef; # reset } ############################################################################### # see if MBI leaves MBF's private parts alone { no strict 'refs'; ${"$mbi\::precision"} = undef; ${"$mbf\::precision"} = undef; ${"$mbi\::accuracy"} = 4; ${"$mbf\::accuracy"} = undef; is($mbf->new("123.456"), "123.456", qq|$mbf->new("123.456") = 123.456|); ${"$mbi\::accuracy"} = undef; # reset } ############################################################################### # see if setting accuracy/precision actually rounds the number $x = $mbf->new("123.456"); $x->accuracy(4); is($x, "123.5", qq|\$x = $mbf->new("123.456"); \$x->accuracy(4)|); $x = $mbf->new("123.456"); $x->precision(-2); is($x, "123.46", qq|\$x = $mbf->new("123.456"); \$x->precision(-2)|); $x = $mbi->new(123456); $x->accuracy(4); is($x, 123500, qq|\$x = $mbi->new(123456); \$x->accuracy(4)|); $x = $mbi->new(123456); $x->precision(2); is($x, 123500, qq|\$x = $mbi->new(123456); \$x->precision(2)|); ############################################################################### # test actual rounding via round() $x = $mbf->new("123.456"); is($x->copy()->round(5), "123.46", qq|\$x = $mbf->new("123.456"); \$x->copy()->round(5)|); is($x->copy()->round(4), "123.5", qq|\$x = $mbf->new("123.456"); \$x->copy()->round(4)|); is($x->copy()->round(5, 2), "NaN", qq|\$x = $mbf->new("123.456"); \$x->copy()->round(5, 2)|); is($x->copy()->round(undef, -2), "123.46", qq|\$x = $mbf->new("123.456"); \$x->copy()->round(undef, -2)|); is($x->copy()->round(undef, 2), 120, qq|\$x = $mbf->new("123.456"); \$x->copy()->round(undef, 2)|); $x = $mbi->new("123"); is($x->round(5, 2), "NaN", qq|\$x = $mbi->new("123"); \$x->round(5, 2)|); $x = $mbf->new("123.45000"); is($x->copy()->round(undef, -1, "odd"), "123.5", qq|\$x = $mbf->new("123.45000"); \$x->copy()->round(undef, -1, "odd")|); # see if rounding is 'sticky' $x = $mbf->new("123.4567"); $y = $x->copy()->bround(); # no-op since nowhere A or P defined is($y, 123.4567, qq|\$x = $mbf->new("123.4567"); \$y = \$x->copy()->bround()|); $y = $x->copy()->round(5); is($y->accuracy(), 5, q|$y = $x->copy()->round(5); $y->accuracy()|); is($y->precision(), undef, # A has precedence, so P still unset q|$y = $x->copy()->round(5); $y->precision()|); $y = $x->copy()->round(undef, 2); is($y->precision(), 2, q|$y = $x->copy()->round(undef, 2); $y->precision()|); is($y->accuracy(), undef, # P has precedence, so A still unset q|$y = $x->copy()->round(undef, 2); $y->accuracy()|); # see if setting A clears P and vice versa $x = $mbf->new("123.4567"); is($x, "123.4567", q|$x = $mbf->new("123.4567")|); is($x->accuracy(4), 4, q|$x->accuracy(4)|); is($x->precision(-2), -2, q|$x->precision(-2)|); # clear A is($x->accuracy(), undef, q|$x->accuracy()|); $x = $mbf->new("123.4567"); is($x, "123.4567", q|$x = $mbf->new("123.4567")|); is($x->precision(-2), -2, q|$x->precision(-2)|); is($x->accuracy(4), 4, q|$x->accuracy(4)|); # clear P is($x->precision(), undef, q|$x->precision()|); # does copy work? $x = $mbf->new(123.456); $x->accuracy(4); $x->precision(2); $z = $x->copy(); is($z->accuracy(), undef, q|$z = $x->copy(); $z->accuracy()|); is($z->precision(), 2, q|$z = $x->copy(); $z->precision()|); # does $x->bdiv($y, d) work when $d > div_scale? $x = $mbf->new("0.008"); $x->accuracy(8); for my $e (4, 8, 16, 32) { is(scalar $x->copy()->bdiv(3, $e), "0.002" . ("6" x ($e - 2)) . "7", qq|\$x->copy()->bdiv(3, $e)|); } # does accuracy()/precision work on zeros? foreach my $class ($mbi, $mbf) { $x = $class->bzero(); $x->accuracy(5); is($x->{_a}, 5, qq|\$x = $class->bzero(); \$x->accuracy(5); \$x->{_a}|); $x = $class->bzero(); $x->precision(5); is($x->{_p}, 5, qq|\$x = $class->bzero(); \$x->precision(5); \$x->{_p}|); $x = $class->new(0); $x->accuracy(5); is($x->{_a}, 5, qq|\$x = $class->new(0); \$x->accuracy(5); \$x->{_a}|); $x = $class->new(0); $x->precision(5); is($x->{_p}, 5, qq|\$x = $class->new(0); \$x->precision(5); \$x->{_p}|); $x = $class->bzero(); $x->round(5); is($x->{_a}, 5, qq|\$x = $class->bzero(); \$x->round(5); \$x->{_a}|); $x = $class->bzero(); $x->round(undef, 5); is($x->{_p}, 5, qq|\$x = $class->bzero(); \$x->round(undef, 5); \$x->{_p}|); $x = $class->new(0); $x->round(5); is($x->{_a}, 5, qq|\$x = $class->new(0); \$x->round(5); \$x->{_a}|); $x = $class->new(0); $x->round(undef, 5); is($x->{_p}, 5, qq|\$x = $class->new(0); \$x->round(undef, 5); \$x->{_p}|); # see if trying to increasing A in bzero() doesn't do something $x = $class->bzero(); $x->{_a} = 3; $x->round(5); is($x->{_a}, 3, qq|\$x = $class->bzero(); \$x->{_a} = 3; \$x->round(5); \$x->{_a}|); } ############################################################################### # test whether an opp calls objectify properly or not (or at least does what # it should do given non-objects, w/ or w/o objectify()) foreach my $class ($mbi, $mbf) { # ${"$class\::precision"} = undef; # reset # ${"$class\::accuracy"} = undef; # reset is($class->new(123)->badd(123), 246, qq|$class->new(123)->badd(123)|); is($class->badd(123, 321), 444, qq|$class->badd(123, 321)|); is($class->badd(123, $class->new(321)), 444, qq|$class->badd(123, $class->new(321))|); is($class->new(123)->bsub(122), 1, qq|$class->new(123)->bsub(122)|); is($class->bsub(321, 123), 198, qq|$class->bsub(321, 123)|); is($class->bsub(321, $class->new(123)), 198, qq|$class->bsub(321, $class->new(123))|); is($class->new(123)->bmul(123), 15129, qq|$class->new(123)->bmul(123)|); is($class->bmul(123, 123), 15129, qq|$class->bmul(123, 123)|); is($class->bmul(123, $class->new(123)), 15129, qq|$class->bmul(123, $class->new(123))|); # is($class->new(15129)->bdiv(123), 123, qq|$class->new(15129)->bdiv(123)|); # is($class->bdiv(15129, 123), 123, qq|$class->bdiv(15129, 123)|); # is($class->bdiv(15129, $class->new(123)), 123, # qq|$class->bdiv(15129, $class->new(123))|); is($class->new(15131)->bmod(123), 2, qq|$class->new(15131)->bmod(123)|); is($class->bmod(15131, 123), 2, qq|$class->bmod(15131, 123)|); is($class->bmod(15131, $class->new(123)), 2, qq|$class->bmod(15131, $class->new(123))|); is($class->new(2)->bpow(16), 65536, qq|$class->new(2)->bpow(16)|); is($class->bpow(2, 16), 65536, qq|$class->bpow(2, 16)|); is($class->bpow(2, $class->new(16)), 65536, qq|$class->bpow(2, $class->new(16))|); is($class->new(2**15)->brsft(1), 2**14, qq|$class->new(2**15)->brsft(1)|); is($class->brsft(2**15, 1), 2**14, qq|$class->brsft(2**15, 1)|); is($class->brsft(2**15, $class->new(1)), 2**14, qq|$class->brsft(2**15, $class->new(1))|); is($class->new(2**13)->blsft(1), 2**14, qq|$class->new(2**13)->blsft(1)|); is($class->blsft(2**13, 1), 2**14, qq|$class->blsft(2**13, 1)|); is($class->blsft(2**13, $class->new(1)), 2**14, qq|$class->blsft(2**13, $class->new(1))|); } ############################################################################### # Test whether operations round properly afterwards. # These tests are not complete, since they do not exercise every "return" # statement in the op's. But heh, it's better than nothing... $x = $mbf->new("123.456"); $y = $mbf->new("654.321"); $x->{_a} = 5; # $x->accuracy(5) would round $x straight away $y->{_a} = 4; # $y->accuracy(4) would round $x straight away $z = $x + $y; is($z, "777.8", q|$z = $x + $y|); $z = $y - $x; is($z, "530.9", q|$z = $y - $x|); $z = $y * $x; is($z, "80780", q|$z = $y * $x|); $z = $x ** 2; is($z, "15241", q|$z = $x ** 2|); $z = $x * $x; is($z, "15241", q|$z = $x * $x|); # not: #$z = -$x; #is($z, '-123.46'); #is($x, '123.456'); $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; is($z, 62, q|$z = $z / 2|); $x = $mbf->new(123456); $x->{_a} = 4; $z = $x->copy; $z++; is($z, 123500, q|$z++|); $x = $mbi->new(123456); $y = $mbi->new(654321); $x->{_a} = 5; # $x->accuracy(5) would round $x straight away $y->{_a} = 4; # $y->accuracy(4) would round $x straight away $z = $x + $y; is($z, 777800, q|$z = $x + $y|); $z = $y - $x; is($z, 530900, q|$z = $y - $x|); $z = $y * $x; is($z, 80780000000, q|$z = $y * $x|); $z = $x ** 2; is($z, 15241000000, q|$z = $x ** 2|); # not yet: $z = -$x; # is($z, -123460, qq|$z|); # is($x, 123456, qq|$x|); $z = $x->copy; $z++; is($z, 123460, q|$z++|); $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; is($z, 62000, q|$z = $z / 2|); $x = $mbi->new(123400); $x->{_a} = 4; is($x->bnot(), -123400, q|$x->bnot()|); # not -1234001 # both babs() and bneg() don't need to round, since the input will already # be rounded (either as $x or via new($string)), and they don't change the # value. The two tests below peek at this by using _a (illegally) directly $x = $mbi->new(-123401); $x->{_a} = 4; is($x->babs(), 123401, q|$x->babs()|); $x = $mbi->new(-123401); $x->{_a} = 4; is($x->bneg(), 123401, q|$x->bneg()|); # test bdiv rounding to A and R (bug in v1.48 and maybe earlier versions) $mbf->round_mode('even'); $x = $mbf->new('740.7')->bdiv('6', 4, undef, 'zero'); is($x, '123.4', q|$x|); $x = $mbi->new('123456'); $y = $mbi->new('123456'); $y->{_a} = 6; is($x->bdiv($y), 1, q|$x->bdiv($y)|); is($x->{_a}, 6, q|$x->{_a}|); # carried over $x = $mbi->new('123456'); $y = $mbi->new('123456'); $x->{_a} = 6; is($x->bdiv($y), 1, q|$x->bdiv($y)|); is($x->{_a}, 6, q|$x->{_a}|); # carried over $x = $mbi->new('123456'); $y = $mbi->new('223456'); $y->{_a} = 6; is($x->bdiv($y), 0, q|$x->bdiv($y)|); is($x->{_a}, 6, q|$x->{_a}|); # carried over $x = $mbi->new('123456'); $y = $mbi->new('223456'); $x->{_a} = 6; is($x->bdiv($y), 0, q|$x->bdiv($y)|); is($x->{_a}, 6, q|$x->{_a}|); # carried over ############################################################################### # test that bop(0) does the same than bop(undef) $x = $mbf->new('1234567890'); is($x->copy()->bsqrt(0), $x->copy()->bsqrt(undef), q|$x->copy()->bsqrt(...)|); is($x->copy->bsqrt(0), '35136.41828644462161665823116758077037159', q|$x->copy->bsqrt(...)|); is($x->{_a}, undef, q|$x->{_a}|); # test that bsqrt() modifies $x and does not just return something else # (especially under Math::BigInt::BareCalc) $z = $x->bsqrt(); is($z, $x, q|$z = $x->bsqrt(); $z|); is($x, '35136.41828644462161665823116758077037159', q|$z = $x->bsqrt(); $x|); $x = $mbf->new('1.234567890123456789'); is($x->copy()->bpow('0.5', 0), $x->copy()->bpow('0.5', undef), q|$x->copy()->bpow(...)|); is($x->copy()->bpow('0.5', 0), $x->copy()->bsqrt(undef), q|$x->copy()->bpow(...) vs. $x->copy()->bsqrt(...)|); is($x->copy()->bpow('2', 0), '1.524157875323883675019051998750190521', q|$x->copy()->bpow('2', 0)|); ############################################################################### # test (also under Bare) that bfac() rounds at last step is($mbi->new(12)->bfac(), '479001600', q|$mbi->new(12)->bfac()|); is($mbi->new(12)->bfac(2), '480000000', q|$mbi->new(12)->bfac(2)|); $x = $mbi->new(12); $x->accuracy(2); is($x->bfac(), '480000000', qq|\$x = $mbi->new(12); \$x->accuracy(2); \$x->bfac()|); $x = $mbi->new(13); $x->accuracy(2); is($x->bfac(), '6200000000', qq|\$x = $mbi->new(13); \$x->accuracy(2); \$x->bfac()|); $x = $mbi->new(13); $x->accuracy(3); is($x->bfac(), '6230000000', qq|\$x = $mbi->new(13); \$x->accuracy(3); \$x->bfac()|); $x = $mbi->new(13); $x->accuracy(4); is($x->bfac(), '6227000000', qq|\$x = $mbi->new(13); \$x->accuracy(4); \$x->bfac()|); # this does 1, 2, 3...9, 10, 11, 12...20 $x = $mbi->new(20); $x->accuracy(1); is($x->bfac(), '2000000000000000000', qq|\$x = $mbi->new(20); \$x->accuracy(1); \$x->bfac()|); ############################################################################### # test bsqrt) rounding to given A/P/R (bug prior to v1.60) $x = $mbi->new('123456')->bsqrt(2, undef); is($x, '350', qq|\$x = $mbi->new("123456")->bsqrt(2, undef)|); # not 351 $x = $mbi->new('3')->bsqrt(2, undef); is($x->accuracy(), 2, q|$x->accuracy()|); $mbi->round_mode('even'); $x = $mbi->new('126025')->bsqrt(2, undef, '+inf'); is($x, '360', q|$x = 360|); # not 355 nor 350 $x = $mbi->new('126025')->bsqrt(undef, 2); is($x, '400', q|$x = 400|); # not 355 ############################################################################### # test mixed arguments $x = $mbf->new(10); $u = $mbf->new(2.5); $y = $mbi->new(2); $z = $x + $y; is($z, 12, q|$z = $x + $y;|); is(ref($z), $mbf, qq|\$z is a "$mbf" object|); $z = $x / $y; is($z, 5, q|$z = $x / $y;|); is(ref($z), $mbf, qq|\$z is a "$mbf" object|); $z = $u * $y; is($z, 5, q|$z = $u * $y;|); is(ref($z), $mbf, qq|\$z is a "$mbf" object|); $y = $mbi->new(12345); $z = $u->copy()->bmul($y, 2, undef, 'odd'); is($z, 31000, q|$z = 31000|); $z = $u->copy()->bmul($y, 3, undef, 'odd'); is($z, 30900, q|$z = 30900|); $z = $u->copy()->bmul($y, undef, 0, 'odd'); is($z, 30863, q|$z = 30863|); $z = $u->copy()->bmul($y, undef, 1, 'odd'); is($z, 30863, q|$z = 30863|); $z = $u->copy()->bmul($y, undef, 2, 'odd'); is($z, 30860, q|$z = 30860|); $z = $u->copy()->bmul($y, undef, 3, 'odd'); is($z, 30900, q|$z = 30900|); $z = $u->copy()->bmul($y, undef, -1, 'odd'); is($z, 30862.5, q|$z = 30862.5|); my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; }; # These should no longer warn, even though '3.17' is a NaN in Math::BigInt # (>= returns now false, bug until v1.80). $warn = ''; eval '$z = 3.17 <= $y'; is($z, '', q|$z = ""|); unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric le \(<=\) |)at/, q|"$z = $y >= 3.17" gives warning as expected|); $warn = ''; eval '$z = $y >= 3.17'; is($z, '', q|$z = ""|); unlike($warn, qr/^Use of uninitialized value (\$y )?(in numeric ge \(>=\) |)at/, q|"$z = $y >= 3.17" gives warning as expected|); # XXX TODO breakage: # # $z = $y->copy()->bmul($u, 2, 0, 'odd'); # is($z, 31000); # # $z = $y * $u; # is($z, 5); # is(ref($z), $mbi, q|\$z is a $mbi object|); # # $z = $y + $x; # is($z, 12); # is(ref($z), $mbi, q|\$z is a $mbi object|); # # $z = $y / $x; # is($z, 0); # is(ref($z), $mbi, q|\$z is a $mbi object|); ############################################################################### # rounding in bdiv with fallback and already set A or P { no strict 'refs'; ${"$mbf\::accuracy"} = undef; ${"$mbf\::precision"} = undef; ${"$mbf\::div_scale"} = 40; } $x = $mbf->new(10); $x->{_a} = 4; is($x->bdiv(3), '3.333', q|$x->bdiv(3)|); is($x->{_a}, 4, q|$x->{_a}|); # set's it since no fallback $x = $mbf->new(10); $x->{_a} = 4; $y = $mbf->new(3); is($x->bdiv($y), '3.333', q|$x->bdiv($y)|); is($x->{_a}, 4, q|$x->{_a}|); # set's it since no fallback # rounding to P of x $x = $mbf->new(10); $x->{_p} = -2; is($x->bdiv(3), '3.33', q|$x->bdiv(3)|); # round in div with requested P $x = $mbf->new(10); is($x->bdiv(3, undef, -2), '3.33', q|$x->bdiv(3, undef, -2)|); # round in div with requested P greater than fallback { no strict 'refs'; ${"$mbf\::div_scale"} = 5; $x = $mbf->new(10); is($x->bdiv(3, undef, -8), "3.33333333", q|$x->bdiv(3, undef, -8) = "3.33333333"|); ${"$mbf\::div_scale"} = 40; } $x = $mbf->new(10); $y = $mbf->new(3); $y->{_a} = 4; is($x->bdiv($y), '3.333', q|$x->bdiv($y) = '3.333'|); is($x->{_a}, 4, q|$x->{_a} = 4|); is($y->{_a}, 4, q|$y->{_a} = 4|); # set's it since no fallback is($x->{_p}, undef, q|$x->{_p} = undef|); is($y->{_p}, undef, q|$y->{_p} = undef|); # rounding to P of y $x = $mbf->new(10); $y = $mbf->new(3); $y->{_p} = -2; is($x->bdiv($y), '3.33', q|$x->bdiv($y) = '3.33'|); is($x->{_p}, -2, q|$x->{_p} = -2|); is($y->{_p}, -2, q|$y->{_p} = -2|); is($x->{_a}, undef, q|$x->{_a} = undef|); is($y->{_a}, undef, q|$y->{_a} = undef|); ############################################################################### # test whether bround(-n) fails in MBF (undocumented in MBI) eval { $x = $mbf->new(1); $x->bround(-2); }; like($@, qr/^bround\(\) needs positive accuracy/, qq|"\$x->bround(-2)" gives warning as expected|); # test whether rounding to higher accuracy is no-op $x = $mbf->new(1); $x->{_a} = 4; is($x, "1.000", q|$x = "1.000"|); $x->bround(6); # must be no-op is($x->{_a}, 4, q|$x->{_a} = 4|); is($x, "1.000", q|$x = "1.000"|); $x = $mbi->new(1230); $x->{_a} = 3; is($x, "1230", q|$x = "1230"|); $x->bround(6); # must be no-op is($x->{_a}, 3, q|$x->{_a} = 3|); is($x, "1230", q|$x = "1230"|); # bround(n) should set _a $x->bround(2); # smaller works is($x, "1200", q|$x = "1200"|); is($x->{_a}, 2, q|$x->{_a} = 2|); # bround(-n) is undocumented and only used by MBF # bround(-n) should set _a $x = $mbi->new(12345); $x->bround(-1); is($x, "12300", q|$x = "12300"|); is($x->{_a}, 4, q|$x->{_a} = 4|); # bround(-n) should set _a $x = $mbi->new(12345); $x->bround(-2); is($x, "12000", q|$x = "12000"|); is($x->{_a}, 3, q|$x->{_a} = 3|); # bround(-n) should set _a $x = $mbi->new(12345); $x->{_a} = 5; $x->bround(-3); is($x, "10000", q|$x = "10000"|); is($x->{_a}, 2, q|$x->{_a} = 2|); # bround(-n) should set _a $x = $mbi->new(12345); $x->{_a} = 5; $x->bround(-4); is($x, "0", q|$x = "0"|); is($x->{_a}, 1, q|$x->{_a} = 1|); # bround(-n) should be no-op if n too big $x = $mbi->new(12345); $x->bround(-5); is($x, "0", q|$x = "0"|); # scale to "big" => 0 is($x->{_a}, 0, q|$x->{_a} = 0|); # bround(-n) should be no-op if n too big $x = $mbi->new(54321); $x->bround(-5); is($x, "100000", q|$x = "100000"|); # used by MBF to round 0.0054321 at 0.0_6_00000 is($x->{_a}, 0, q|$x->{_a} = 0|); # bround(-n) should be no-op if n too big $x = $mbi->new(54321); $x->{_a} = 5; $x->bround(-6); is($x, "100000", q|$x = "100000"|); # no-op is($x->{_a}, 0, q|$x->{_a} = 0|); # bround(n) should set _a $x = $mbi->new(12345); $x->{_a} = 5; $x->bround(5); # must be no-op is($x, "12345", q|$x = "12345"|); is($x->{_a}, 5, q|$x->{_a} = 5|); # bround(n) should set _a $x = $mbi->new(12345); $x->{_a} = 5; $x->bround(6); # must be no-op is($x, "12345", q|$x = "12345"|); $x = $mbf->new("0.0061"); $x->bfround(-2); is($x, "0.01", q|$x = "0.01"|); $x = $mbf->new("0.004"); $x->bfround(-2); is($x, "0.00", q|$x = "0.00"|); $x = $mbf->new("0.005"); $x->bfround(-2); is($x, "0.00", q|$x = "0.00"|); $x = $mbf->new("12345"); $x->bfround(2); is($x, "12340", q|$x = "12340"|); $x = $mbf->new("12340"); $x->bfround(2); is($x, "12340", q|$x = "12340"|); # MBI::bfround should clear A for negative P $x = $mbi->new("1234"); $x->accuracy(3); $x->bfround(-2); is($x->{_a}, undef, q|$x->{_a} = undef|); # test that bfround() and bround() work with large numbers $x = $mbf->new(1)->bdiv(5678, undef, -63); is($x, "0.000176118351532229658330398027474462839027826699542092286016203", q|$x = "0.000176118351532229658330398027474462839027826699542092286016203"|); $x = $mbf->new(1)->bdiv(5678, undef, -90); is($x, "0.00017611835153222965833039802747446283902782" . "6699542092286016202888340965128566396618527651", q|$x = "0.00017611835153222965833039802747446283902782| . q|6699542092286016202888340965128566396618527651"|); $x = $mbf->new(1)->bdiv(5678, 80); is($x, "0.00017611835153222965833039802747446283902782" . "669954209228601620288834096512856639662", q|$x = "0.00017611835153222965833039802747446283902782| . q|669954209228601620288834096512856639662"|); ############################################################################### # rounding with already set precision/accuracy $x = $mbf->new(1); $x->{_p} = -5; is($x, "1.00000", q|$x = "1.00000"|); # further rounding donw is($x->bfround(-2), "1.00", q|$x->bfround(-2) = "1.00"|); is($x->{_p}, -2, q|$x->{_p} = -2|); $x = $mbf->new(12345); $x->{_a} = 5; is($x->bround(2), "12000", q|$x->bround(2) = "12000"|); is($x->{_a}, 2, q|$x->{_a} = 2|); $x = $mbf->new("1.2345"); $x->{_a} = 5; is($x->bround(2), "1.2", q|$x->bround(2) = "1.2"|); is($x->{_a}, 2, q|$x->{_a} = 2|); # mantissa/exponent format and A/P $x = $mbf->new("12345.678"); $x->accuracy(4); is($x, "12350", q|$x = "12350"|); is($x->{_a}, 4, q|$x->{_a} = 4|); is($x->{_p}, undef, q|$x->{_p} = undef|); #is($x->{_m}->{_a}, undef, q|$x->{_m}->{_a} = undef|); #is($x->{_e}->{_a}, undef, q|$x->{_e}->{_a} = undef|); #is($x->{_m}->{_p}, undef, q|$x->{_m}->{_p} = undef|); #is($x->{_e}->{_p}, undef, q|$x->{_e}->{_p} = undef|); # check for no A/P in case of fallback # result $x = $mbf->new(100) / 3; is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, undef, q|$x->{_p} = undef|); # result & remainder $x = $mbf->new(100) / 3; ($x, $y) = $x->bdiv(3); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, undef, q|$x->{_p} = undef|); is($y->{_a}, undef, q|$y->{_a} = undef|); is($y->{_p}, undef, q|$y->{_p} = undef|); ############################################################################### # math with two numbers with different A and P $x = $mbf->new(12345); $x->accuracy(4); # "12340" $y = $mbf->new(12345); $y->accuracy(2); # "12000" is($x+$y, 24000, q|$x+$y = 24000|); # 12340+12000=> 24340 => 24000 $x = $mbf->new(54321); $x->accuracy(4); # "12340" $y = $mbf->new(12345); $y->accuracy(3); # "12000" is($x-$y, 42000, q|$x-$y = 42000|); # 54320+12300=> 42020 => 42000 $x = $mbf->new("1.2345"); $x->precision(-2); # "1.23" $y = $mbf->new("1.2345"); $y->precision(-4); # "1.2345" is($x+$y, "2.46", q|$x+$y = "2.46"|); # 1.2345+1.2300=> 2.4645 => 2.46 ############################################################################### # round should find and use proper class #$x = Foo->new(); #is($x->round($Foo::accuracy), "a" x $Foo::accuracy); #is($x->round(undef, $Foo::precision), "p" x $Foo::precision); #is($x->bfround($Foo::precision), "p" x $Foo::precision); #is($x->bround($Foo::accuracy), "a" x $Foo::accuracy); ############################################################################### # find out whether _find_round_parameters is doing what's it's supposed to do { no strict 'refs'; ${"$mbi\::accuracy"} = undef; ${"$mbi\::precision"} = undef; ${"$mbi\::div_scale"} = 40; ${"$mbi\::round_mode"} = 'odd'; } $x = $mbi->new(123); my @params = $x->_find_round_parameters(); is(scalar(@params), 1, q|scalar(@params) = 1|); # nothing to round @params = $x->_find_round_parameters(1); is(scalar(@params), 4, q|scalar(@params) = 4|); # a=1 is($params[0], $x, q|$params[0] = $x|); # self is($params[1], 1, q|$params[1] = 1|); # a is($params[2], undef, q|$params[2] = undef|); # p is($params[3], "odd", q|$params[3] = "odd"|); # round_mode @params = $x->_find_round_parameters(undef, 2); is(scalar(@params), 4, q|scalar(@params) = 4|); # p=2 is($params[0], $x, q|$params[0] = $x|); # self is($params[1], undef, q|$params[1] = undef|); # a is($params[2], 2, q|$params[2] = 2|); # p is($params[3], "odd", q|$params[3] = "odd"|); # round_mode eval { @params = $x->_find_round_parameters(undef, 2, "foo"); }; like($@, qr/^Unknown round mode 'foo'/, q|round mode "foo" gives a warning as expected|); @params = $x->_find_round_parameters(undef, 2, "+inf"); is(scalar(@params), 4, q|scalar(@params) = 4|); # p=2 is($params[0], $x, q|$params[0] = $x|); # self is($params[1], undef, q|$params[1] = undef|); # a is($params[2], 2, q|$params[2] = 2|); # p is($params[3], "+inf", q|$params[3] = "+inf"|); # round_mode @params = $x->_find_round_parameters(2, -2, "+inf"); is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined is($params[0], $x, q|$params[0] = $x|); # self { no strict 'refs'; ${"$mbi\::accuracy"} = 1; @params = $x->_find_round_parameters(undef, -2); is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined is($params[0], $x, q|$params[0] = $x|); # self is($x->is_nan(), 1, q|$x->is_nan() = 1|); # and must be NaN ${"$mbi\::accuracy"} = undef; ${"$mbi\::precision"} = 1; @params = $x->_find_round_parameters(1, undef); is(scalar(@params), 1, q|scalar(@params) = 1|); # error, A and P defined is($params[0], $x, q|$params[0] = $x|); # self is($x->is_nan(), 1, q|$x->is_nan() = 1|); # and must be NaN ${"$mbi\::precision"} = undef; # reset } ############################################################################### # test whether bone/bzero take additional A & P, or reset it etc foreach my $class ($mbi, $mbf) { $x = $class->new(2)->bzero(); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2)->bone(); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2)->binf(); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2)->bnan(); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan(); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf(); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2, 1); is($x->{_a}, 1, q|$x->{_a} = 1|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2, undef, 1); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, 1, q|$x->{_p} = 1|); $x = $class->new(2, 1)->bzero(); is($x->{_a}, 1, q|$x->{_a} = 1|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2, undef, 1)->bzero(); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, 1, q|$x->{_p} = 1|); $x = $class->new(2, 1)->bone(); is($x->{_a}, 1, q|$x->{_a} = 1|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2, undef, 1)->bone(); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, 1, q|$x->{_p} = 1|); $x = $class->new(2); $x->bone('+', 2, undef); is($x->{_a}, 2, q|$x->{_a} = 2|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2); $x->bone('+', undef, 2); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, 2, q|$x->{_p} = 2|); $x = $class->new(2); $x->bone('-', 2, undef); is($x->{_a}, 2, q|$x->{_a} = 2|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2); $x->bone('-', undef, 2); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, 2, q|$x->{_p} = 2|); $x = $class->new(2); $x->bzero(2, undef); is($x->{_a}, 2, q|$x->{_a} = 2|); is($x->{_p}, undef, q|$x->{_p} = undef|); $x = $class->new(2); $x->bzero(undef, 2); is($x->{_a}, undef, q|$x->{_a} = undef|); is($x->{_p}, 2, q|$x->{_p} = 2|); } ############################################################################### # test whether bone/bzero honour globals for my $class ($mbi, $mbf) { $class->accuracy(2); $x = $class->bone(); is($x->accuracy(), 2, q|$x->accuracy() = 2|); $x = $class->bzero(); is($x->accuracy(), 2, q|$x->accuracy() = 2|); $class->accuracy(undef); # reset $class->precision(-2); $x = $class->bone(); is($x->precision(), -2, q|$x->precision() = -2|); $x = $class->bzero(); is($x->precision(), -2, q|$x->precision() = -2|); $class->precision(undef); # reset } ############################################################################### # check whether mixing A and P creates a NaN # new with set accuracy/precision and with parameters { no strict 'refs'; foreach my $class ($mbi, $mbf) { is($class->new(123, 4, -3), 'NaN', # with parameters "mixing A and P creates a NaN"); ${"$class\::accuracy"} = 42; ${"$class\::precision"} = 2; is($class->new(123), "NaN", # with globals q|$class->new(123) = "NaN"|); ${"$class\::accuracy"} = undef; ${"$class\::precision"} = undef; } } # binary ops foreach my $class ($mbi, $mbf) { #foreach (qw/add sub mul div pow mod/) { foreach my $method (qw/add sub mul pow mod/) { my $try = "my \$x = $class->new(1234); \$x->accuracy(5);"; $try .= " my \$y = $class->new(12); \$y->precision(-3);"; $try .= " \$x->b$method(\$y);"; $rc = eval $try; is($rc, "NaN", $try); } } # unary ops foreach my $method (qw/new bsqrt/) { my $try = "my \$x = $mbi->$method(1234, 5, -3);"; $rc = eval $try; is($rc, "NaN", $try); } # see if $x->bsub(0) and $x->badd(0) really round foreach my $class ($mbi, $mbf) { $x = $class->new(123); $class->accuracy(2); $x->bsub(0); is($x, 120, q|$x = 120|); $class->accuracy(undef); # reset $x = $class->new(123); $class->accuracy(2); $x->badd(0); is($x, 120, q|$x = 120|); $class->accuracy(undef); # reset } ############################################################################### # test whether shortcuts returning zero/one preserve A and P my ($got, $f, $a, $p, $xp, $yp, $xa, $ya, $try, $want, @args); my $CALC = Math::BigInt->config()->{lib}; while () { s/#.*$//; # remove comments s/\s+$//; # remove trailing whitespace next unless length; # skip empty lines if (s/^&//) { $f = $_; # function next; } @args = split(/:/, $_); my $want = pop(@args); ($x, $xa, $xp) = split (/,/, $args[0]); $xa = $xa || ''; $xp = $xp || ''; $try = qq|\$x = $mbi->new("$x");|; $try .= qq| \$x->accuracy($xa);| if $xa ne ''; $try .= qq| \$x->precision($xp);| if $xp ne ''; ($y, $ya, $yp) = split (/,/, $args[1]); $ya = $ya || ''; $yp = $yp || ''; $try .= qq| \$y = $mbi->new("$y");|; $try .= qq| \$y->accuracy($ya);| if $ya ne ''; $try .= qq| \$y->precision($yp);| if $yp ne ''; $try .= ' $x->$f($y);'; # print "trying $try\n"; $rc = eval $try; print "# Error: $@\n" if $@; # convert hex/binary targets to decimal if ($want =~ /^(0x0x|0b0b)/) { $want =~ s/^0[xb]//; $want = $mbi->new($want)->bstr(); } is($rc, $want, $try); # check internal state of number objects is_valid($rc, $f) if ref $rc; # now check whether A and P are set correctly # only one of $a or $p will be set (no crossing here) $a = $xa || $ya; $p = $xp || $yp; # print "Check a=$a p=$p\n"; # print "# Tried: '$try'\n"; if ($a ne '') { unless (is($x->{_a}, $a, qq|\$x->{_a} == $a|) && is($x->{_p}, undef, qq|\$x->{_p} is undef|)) { print "# Check: A = $a and P = undef\n"; print "# Tried: $try\n"; } } if ($p ne '') { unless (is($x->{_p}, $p, qq|\$x->{_p} == $p|) && is($x->{_a}, undef, qq|\$x->{_a} is undef|)) { print "# Check: A = undef and P = $p\n"; print "# Tried: $try\n"; } } } # all done 1; ############################################################################### # sub to check validity of a Math::BigInt object internally, to ensure that no # op leaves a number object in an invalid state (f.i. "-0") sub is_valid { my ($x, $f) = @_; my $e = 0; # error? # ok as reference? $e = 'Not a reference' if !ref($x); # has ok sign? $e = qq|Illegal sign $x->{sign}| . q| (expected: "+", "-", "-inf", "+inf" or "NaN")| if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/; $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0; $e = $CALC->_check($x->{value}) if $e eq '0'; # test done, see if error did crop up if ($e eq '0') { pass('is a valid object'); return; } fail($e . qq| after op "$f"|); } # format is: # x,A,P:x,A,P:result # 123,,3 means 123 with precision 3 (A is undef) # the A or P of the result is calculated automatically __DATA__ &badd 123,,:123,,:246 123,3,:0,,:123 123,,-3:0,,:123 123,,:0,3,:123 123,,:0,,-3:123 &bmul 123,,:1,,:123 123,3,:0,,:0 123,,-3:0,,:0 123,,:0,3,:0 123,,:0,,-3:0 123,3,:1,,:123 123,,-3:1,,:123 123,,:1,3,:123 123,,:1,,-3:123 1,3,:123,,:123 1,,-3:123,,:123 1,,:123,3,:123 1,,:123,,-3:123 &bdiv 123,,:1,,:123 123,4,:1,,:123 123,,:1,4,:123 123,,:1,,-4:123 123,,-4:1,,:123 1,4,:123,,:0 1,,:123,4,:0 1,,:123,,-4:0 1,,-4:123,,:0 &band 1,,:3,,:1 1234,1,:0,,:0 1234,,:0,1,:0 1234,,-1:0,,:0 1234,,:0,,-1:0 0xFF,,:0x10,,:0x0x10 0xFF,2,:0xFF,,:250 0xFF,,:0xFF,2,:250 0xFF,,1:0xFF,,:250 0xFF,,:0xFF,,1:250 &bxor 1,,:3,,:2 1234,1,:0,,:1000 1234,,:0,1,:1000 1234,,3:0,,:1000 1234,,:0,,3:1000 0xFF,,:0x10,,:239 # 250 ^ 255 => 5 0xFF,2,:0xFF,,:5 0xFF,,:0xFF,2,:5 0xFF,,1:0xFF,,:5 0xFF,,:0xFF,,1:5 # 250 ^ 4095 = 3845 => 3800 0xFF,2,:0xFFF,,:3800 # 255 ^ 4100 = 4347 => 4300 0xFF,,:0xFFF,2,:4300 0xFF,,2:0xFFF,,:3800 # 255 ^ 4100 = 10fb => 4347 => 4300 0xFF,,:0xFFF,,2:4300 &bior 1,,:3,,:3 1234,1,:0,,:1000 1234,,:0,1,:1000 1234,,3:0,,:1000 1234,,:0,,3:1000 0xFF,,:0x10,,:0x0xFF # FF | FA = FF => 250 250,2,:0xFF,,:250 0xFF,,:250,2,:250 0xFF,,1:0xFF,,:250 0xFF,,:0xFF,,1:250 &bpow 2,,:3,,:8 2,,:0,,:1 2,2,:0,,:1 2,,:0,2,:1 Math-BigInt-1.999715/t/mbimbf.t0000644403072340010010000000545712627337461016145 0ustar ospjaDomain Users#!/usr/bin/perl # test rounding, accuracy, precision and fallback, round_mode and mixing # of classes use strict; use warnings; use Test::More tests => 684 # tests in require'd file + 26; # tests in this file use Math::BigInt lib => 'Calc'; use Math::BigFloat; our $mbi = 'Math::BigInt'; our $mbf = 'Math::BigFloat'; require 't/mbimbf.inc'; # some tests that won't work with subclasses, since the things are only # guaranteed in the Math::Big(Int|Float) (unless subclass chooses to support # this) Math::BigInt->round_mode("even"); # reset for tests Math::BigFloat->round_mode("even"); # reset for tests is($Math::BigInt::rnd_mode, "even", '$Math::BigInt::rnd_mode = "even"'); is($Math::BigFloat::rnd_mode, "even", '$Math::BigFloat::rnd_mode = "even"'); my $x = eval '$mbi->round_mode("huhmbi");'; like($@, qr/^Unknown round mode 'huhmbi' at/, '$mbi->round_mode("huhmbi")'); $x = eval '$mbf->round_mode("huhmbf");'; like($@, qr/^Unknown round mode 'huhmbf' at/, '$mbf->round_mode("huhmbf")'); # old way (now with test for validity) $x = eval '$Math::BigInt::rnd_mode = "huhmbi";'; like($@, qr/^Unknown round mode 'huhmbi' at/, '$Math::BigInt::rnd_mode = "huhmbi"'); $x = eval '$Math::BigFloat::rnd_mode = "huhmbf";'; like($@, qr/^Unknown round mode 'huhmbf' at/, '$Math::BigFloat::rnd_mode = "huhmbf"'); # see if accessor also changes old variable $mbi->round_mode('odd'); is($Math::BigInt::rnd_mode, 'odd', '$Math::BigInt::rnd_mode = "odd"'); $mbf->round_mode('odd'); is($Math::BigInt::rnd_mode, 'odd', '$Math::BigInt::rnd_mode = "odd"'); foreach my $class (qw/Math::BigInt Math::BigFloat/) { is($class->accuracy(5), 5, "set A ..."); is($class->precision(), undef, "... and now P must be cleared"); is($class->precision(5), 5, "set P ..."); is($class->accuracy(), undef, "... and now A must be cleared"); } foreach my $class (qw/Math::BigInt Math::BigFloat/) { $class->accuracy(42); # $x gets A of 42, too! my $x = $class->new(123); # really? is($x->accuracy(), 42, '$x has A of 42'); # $x has no A, but the global is still in effect for $x so the return value # of that operation should be 42, not undef is($x->accuracy(undef), 42, '$x has A from global'); # so $x should still have A = 42 is($x->accuracy(), 42, '$x has still A of 42'); # reset for further tests $class->accuracy(undef); $class->precision(undef); } # bug with blog(Math::BigFloat, Math::BigInt) $x = Math::BigFloat->new(100); $x = $x->blog(Math::BigInt->new(10)); is($x, 2, 'bug with blog(Math::BigFloat, Math::BigInt)'); # bug until v1.88 for sqrt() with enough digits for my $i (80, 88, 100) { $x = Math::BigFloat->new("1." . ("0" x $i) . "1"); $x = $x->bsqrt; is($x, 1, '$x->bsqrt() with many digits'); } Math-BigInt-1.999715/t/mbi_ali.t0000644403072340010010000000026512632033773016270 0ustar ospjaDomain Users#!perl # test that the new alias names work use strict; use warnings; use Test::More tests => 6; use Math::BigInt; our $CLASS; $CLASS = 'Math::BigInt'; require 't/alias.inc'; Math-BigInt-1.999715/t/mbi_rand.t0000644403072340010010000000552712632033776016460 0ustar ospjaDomain Users#!perl use strict; use warnings; my $count; BEGIN { $count = 128; } use Test::More tests => $count * 4; use Math::BigInt; my $class = 'Math::BigInt'; my $length = 128; # If you get a failure here, please re-run the test with the printed seed # value as input "perl t/mbi_rand.t seed" and send me the output my $seed = @ARGV == 1 ? $ARGV[0] : int(rand(1165537)); #diag(" seed: $seed\n"); srand($seed); my $_base_len; my @_base_len; #diag(" lib: ", Math::BigInt->config()->{lib}); if (Math::BigInt->config()->{lib} =~ /::Calc/) { $_base_len = Math::BigInt::Calc->_base_len(); @_base_len = Math::BigInt::Calc->_base_len(); #diag("base len: $_base_len (scalar context)"); #diag("base len: @_base_len (list contex)"); } my ($A, $B, $A_str, $B_str, $AdivB, $AmodB, $A_len, $B_len); my $two = Math::BigInt->new(2); for (my $i = 0; $i < $count; $i++) { #diag(""); # length of A and B $A_len = int(rand($length) + 1); $B_len = int(rand($length) + 1); $A_str = ''; $B_str = ''; # We create the numbers from "patterns", e.g. get a random number and a # random count and string them together. This means things like # "100000999999999999911122222222" are much more likely. If we just strung # together digits, we would end up with "1272398823211223" etc. It also # means that we get more frequently equal numbers or other special cases. while (length($A_str) < $A_len) { $A_str .= int(rand(100)) x int(rand(16)); } while (length($B_str) < $B_len) { $B_str .= int(rand(100)) x int(rand(16)); } $A_str =~ s/^0+(?=\d)//; $B_str =~ s/^0+(?=\d)//; #diag(" As: $A_str"); #diag(" Bs: $B_str"); $A = $class->new($A_str); $B = $class->new($B_str); #diag(" A: $A"); #diag(" B: $B"); SKIP: { skip '$A and/or $B are zero.', 4 if $A->is_zero() || $B->is_zero(); # check that int(A / B) * B + A % B == A holds for all inputs # $X = ($A / $B) * $B + 2 * ($A % $B) - ($A % $B); ($AdivB, $AmodB) = $A->copy()->bdiv($B); #diag(" A / B: $AdivB"); #diag(" A % B: $AmodB"); is($AdivB * $B + $two * $AmodB - $AmodB, $A_str, "AdivB * B + 2 * AmodB - AmodB == A"); if (is($AdivB * $B / $B, $AdivB, "AdivB * B / B == AdivB")) { if (Math::BigInt->config()->{lib} =~ /::Calc/) { #diag("AdivB->[-1]: ", $AdivB->{value}->[-1]); #diag(" B->[-1]: ", $B->{value}->[-1]); } } # swap 'em and try this, too # $X = ($B/$A)*$A + $B % $A; ($AdivB, $AmodB) = $B->copy()->bdiv($A); # print "check: $AdivB $AmodB"; is($AdivB * $A + $two * $AmodB - $AmodB, $B_str, "AdivB * A + 2 * AmodB - AmodB == B"); is($AdivB * $A / $A, $AdivB, "AdivB * A / A == AdivB"); } } Math-BigInt-1.999715/t/nan_cmp.t0000644403072340010010000000213612632034006016274 0ustar ospjaDomain Users#!perl # test that overloaded compare works when NaN are involved use strict; use warnings; use Test::More tests => 26; use Math::BigInt; use Math::BigFloat; compare('Math::BigInt'); compare('Math::BigFloat'); sub compare { my $class = shift; my $nan = $class->bnan(); my $one = $class->bone(); is($one, $one, "$class->bone() == $class->bone()"); is($one != $nan, 1, "$class->bone() != $class->bnan()"); is($nan != $one, 1, "$class->bnan() != $class->bone()"); is($nan != $nan, 1, "$class->bnan() != $class->bnan()"); is($nan == $one, '', "$class->bnan() == $class->bone()"); is($one == $nan, '', "$class->bone() == $class->bnan()"); is($nan == $nan, '', "$class->bnan() == $class->bnan()"); is($nan <= $one, '', "$class->bnan() <= $class->bone()"); is($one <= $nan, '', "$class->bone() <= $class->bnan()"); is($nan <= $nan, '', "$class->bnan() <= $class->bnan()"); is($nan >= $one, '', "$class->bnan() >= $class->bone()"); is($one >= $nan, '', "$class->bone() >= $class->bnan()"); is($nan >= $nan, '', "$class->bnan() >= $class->bnan()"); } Math-BigInt-1.999715/t/new_overloaded.t0000644403072340010010000000163212632034011017652 0ustar ospjaDomain Users#!perl # Math::BigFloat->new had a bug where it would assume any object is a # Math::BigInt which broke overloaded non-Math::BigInt objects. use strict; use warnings; use Test::More tests => 4; ############################################################################## package Overloaded::Num; use overload '0+' => sub { ${$_[0]} }, fallback => 1; sub new { my ($class, $num) = @_; return bless \$num, $class; } package main; use Math::BigFloat; my $overloaded_num = Overloaded::Num->new(2.23); is($overloaded_num, 2.23, 'Overloaded::Num->new(2.23)'); my $bigfloat = Math::BigFloat->new($overloaded_num); is($bigfloat, 2.23, 'Math::BigFloat->new() accepts overloaded numbers'); my $bigint = Math::BigInt->new(Overloaded::Num->new(3)); is($bigint, 3, 'Math::BigInt->new() accepts overloaded numbers'); is(Math::BigFloat->new($bigint), 3, 'Math::BigFloat->new() accepts a Math::BigInt'); Math-BigInt-1.999715/t/objectify_mbf.t0000644403072340010010000000464512627042404017477 0ustar ospjaDomain Users#!perl # # Verify that objectify() is able to convert a "foreign" object into what we # want, when what we want is Math::BigFloat or subclass thereof. use strict; use warnings; package main; use Test::More tests => 6; use Math::BigFloat; ############################################################################### for my $class ('Math::BigFloat', 'Math::BigFloat::Subclass') { # This object defines what we want. my $float = $class -> new(10); # Create various objects that should work with the object above after # objectify() has done its thing. my $float_percent1 = My::Percent::Float1 -> new(100); is($float * $float_percent1, 10, qq|\$float = $class -> new(10);| . q| $float_percent1 = My::Percent::Float1 -> new(100);| . q| $float * $float_percent1;|); my $float_percent2 = My::Percent::Float2 -> new(100); is($float * $float_percent2, 10, qq|\$float = $class -> new(10);| . q| $float_percent2 = My::Percent::Float2 -> new(100);| . q| $float * $float_percent2;|); my $float_percent3 = My::Percent::Float3 -> new(100); is($float * $float_percent3, 10, qq|\$float = $class -> new(10);| . q| $float_percent3 = My::Percent::Float3 -> new(100);| . q| $float * $float_percent3;|); } ############################################################################### # Class supports as_float(), which returns a Math::BigFloat. package My::Percent::Float1; sub new { my $class = shift; my $num = shift; return bless \$num, $class; } sub as_float { my $self = shift; return Math::BigFloat -> new($$self / 100); } ############################################################################### # Class supports as_float(), which returns a scalar. package My::Percent::Float2; sub new { my $class = shift; my $num = shift; return bless \$num, $class; } sub as_float { my $self = shift; return $$self / 100; } ############################################################################### # Class does not support as_float(). package My::Percent::Float3; use overload '""' => sub { $_[0] -> as_string(); }; sub new { my $class = shift; my $num = shift; return bless \$num, $class; } sub as_string { my $self = shift; return $$self / 100; } ############################################################################### package Math::BigFloat::Subclass; use base 'Math::BigFloat'; Math-BigInt-1.999715/t/objectify_mbi.t0000644403072340010010000000671712627042351017505 0ustar ospjaDomain Users#!perl # # Verify that objectify() is able to convert a "foreign" object into what we # want, when what we want is Math::BigInt or subclass thereof. use strict; use warnings; package main; use Test::More tests => 10; use Math::BigInt; ############################################################################### for my $class ('Math::BigInt', 'Math::BigInt::Subclass') { # This object defines what we want. my $int = $class -> new(10); # Create various objects that should work with the object above after # objectify() has done its thing. my $int_percent1 = My::Percent::Int1 -> new(100); is($int * $int_percent1, 10, qq|\$class -> new(10);| . q| $int_percent1 = My::Percent::Int1 -> new(100);| . q| $int * $int_percent1|); my $int_percent2 = My::Percent::Int2 -> new(100); is($int * $int_percent2, 10, qq|\$class -> new(10);| . q| $int_percent2 = My::Percent::Int2 -> new(100);| . q| $int * $int_percent2|); my $int_percent3 = My::Percent::Int3 -> new(100); is($int * $int_percent3, 10, qq|\$class -> new(10);| . q| $int_percent3 = My::Percent::Int3 -> new(100);| . q| $int * $int_percent3|); my $int_percent4 = My::Percent::Int4 -> new(100); is($int * $int_percent4, 10, qq|\$class -> new(10);| . q| $int_percent4 = My::Percent::Int4 -> new(100);| . q| $int * $int_percent4|); my $int_percent5 = My::Percent::Int5 -> new(100); is($int * $int_percent5, 10, qq|\$class -> new(10);| . q| $int_percent5 = My::Percent::Int5 -> new(100);| . q| $int * $int_percent5|); } ############################################################################### # Class supports as_int(), which returns a Math::BigInt. package My::Percent::Int1; sub new { my $class = shift; my $num = shift; return bless \$num, $class; } sub as_int { my $self = shift; return Math::BigInt -> new($$self / 100); } ############################################################################### # Class supports as_int(), which returns a scalar. package My::Percent::Int2; sub new { my $class = shift; my $num = shift; return bless \$num, $class; } sub as_int { my $self = shift; return $$self / 100; } ############################################################################### # Class does not support as_int(), but supports as_number(), which returns a # Math::BigInt. package My::Percent::Int3; sub new { my $class = shift; my $num = shift; return bless \$num, $class; } sub as_number { my $self = shift; return Math::BigInt -> new($$self / 100); } ############################################################################### # Class does not support as_int(), but supports as_number(), which returns a # scalar. package My::Percent::Int4; sub new { my $class = shift; my $num = shift; return bless \$num, $class; } sub as_number { my $self = shift; return $$self / 100; } ############################################################################### # Class supports neither as_int() or as_number(). package My::Percent::Int5; use overload '""' => sub { $_[0] -> as_string(); }; sub new { my $class = shift; my $num = shift; return bless \$num, $class; } sub as_string { my $self = shift; return $$self / 100; } ############################################################################### package Math::BigInt::Subclass; use base 'Math::BigInt'; Math-BigInt-1.999715/t/require.t0000644403072340010010000000033612632013212016331 0ustar ospjaDomain Users#!/usr/bin/perl # check that simple requiring Math::BigInt works use strict; use warnings; use Test::More tests => 1; require Math::BigInt; my $x = Math::BigInt->new(1); ++$x; is($x, 2, '$x is 2'); # all tests done Math-BigInt-1.999715/t/req_mbf0.t0000644403072340010010000000035412632034022016352 0ustar ospjaDomain Users#!perl # check that simple requiring Math::BigFloat and then bzero() works use strict; use warnings; use Test::More tests => 1; require Math::BigFloat; my $x = Math::BigFloat->bzero(); $x++; is($x, 1, '$x is 1'); # all tests done Math-BigInt-1.999715/t/req_mbf1.t0000644403072340010010000000034412632034025016355 0ustar ospjaDomain Users#!perl # check that simple requiring Math::BigFloat and then bone() works use strict; use warnings; use Test::More tests => 1; require Math::BigFloat; my $x = Math::BigFloat->bone(); is($x, 1, '$x is 1'); # all tests done Math-BigInt-1.999715/t/req_mbfa.t0000644403072340010010000000035312632034027016437 0ustar ospjaDomain Users#!perl # check that simple requiring Math::BigFloat and then bnan() works use strict; use warnings; use Test::More tests => 1; require Math::BigFloat; my $x = Math::BigFloat->bnan(1); is($x, 'NaN', '$x is NaN'); # all tests done Math-BigInt-1.999715/t/req_mbfi.t0000644403072340010010000000036312631624351016454 0ustar ospjaDomain Users#!/usr/bin/perl # check that simple requiring Math::BigFloat and then binf() works use strict; use warnings; use Test::More tests => 1; require Math::BigFloat; my $x = Math::BigFloat->binf(); is($x, 'inf', '$x is inf'); # all tests done Math-BigInt-1.999715/t/req_mbfn.t0000644403072340010010000000036212631624343016461 0ustar ospjaDomain Users#!/usr/bin/perl # check that simple requiring Math::BigFloat and then new() works use strict; use warnings; use Test::More tests => 1; require Math::BigFloat; my $x = Math::BigFloat->new(1); ++$x; is($x, 2, '$x is 2'); # all tests done Math-BigInt-1.999715/t/req_mbfw.t0000644403072340010010000000120212631624327016466 0ustar ospjaDomain Users#!/usr/bin/perl # check that requiring Math::BigFloat and then calling import() works use strict; use warnings; use Test::More tests => 3; use lib 't'; # normal require that calls import automatically (we thus have MBI afterwards) require Math::BigFloat; my $x = Math::BigFloat->new(1); ++$x; is($x, 2, '$x is 2'); like(Math::BigFloat->config()->{with}, qr/^Math::BigInt::(Fast)?Calc\z/, '"with" ignored'); # now override Math::BigFloat->import(with => 'Math::BigInt::Subclass'); # the "with" argument is ignored like(Math::BigFloat->config()->{with}, qr/^Math::BigInt::(Fast)?Calc\z/, '"with" ignored'); # all tests done Math-BigInt-1.999715/t/round.t0000644403072340010010000000546612626375746016047 0ustar ospjaDomain Users#!/usr/bin/perl # test rounding with non-integer A and P parameters use strict; use warnings; use Test::More tests => 95; use Math::BigFloat; my $mbf = 'Math::BigFloat'; #my $mbi = 'Math::BigInt'; my $x = $mbf->new('123456.123456'); # unary ops with A _do_a($x, 'round', 3, '123000'); _do_a($x, 'bfround', 3, '123500'); _do_a($x, 'bfround', 2, '123460'); _do_a($x, 'bfround', -2, '123456.12'); _do_a($x, 'bfround', -3, '123456.123'); _do_a($x, 'bround', 4, '123500'); _do_a($x, 'bround', 3, '123000'); _do_a($x, 'bround', 2, '120000'); _do_a($x, 'bsqrt', 4, '351.4'); _do_a($x, 'bsqrt', 3, '351'); _do_a($x, 'bsqrt', 2, '350'); # setting P _do_p($x, 'bsqrt', 2, '350'); _do_p($x, 'bsqrt', -2, '351.36'); # binary ops _do_2_a($x, 'bdiv', 2, 6, '61728.1'); _do_2_a($x, 'bdiv', 2, 4, '61730'); _do_2_a($x, 'bdiv', 2, 3, '61700'); _do_2_p($x, 'bdiv', 2, -6, '61728.061728'); _do_2_p($x, 'bdiv', 2, -4, '61728.0617'); _do_2_p($x, 'bdiv', 2, -3, '61728.062'); # all tests done ############################################################################# sub _do_a { my ($x, $method, $A, $result) = @_; is($x->copy->$method($A), $result, "$method($A)"); is($x->copy->$method($A.'.1'), $result, "$method(${A}.1)"); is($x->copy->$method($A.'.5'), $result, "$method(${A}.5)"); is($x->copy->$method($A.'.6'), $result, "$method(${A}.6)"); is($x->copy->$method($A.'.9'), $result, "$method(${A}.9)"); } sub _do_p { my ($x, $method, $P, $result) = @_; is($x->copy->$method(undef, $P), $result, "$method(undef, $P)"); is($x->copy->$method(undef, $P.'.1'), $result, "$method(undef, ${P}.1)"); is($x->copy->$method(undef, $P.'.5'), $result, "$method(undef.${P}.5)"); is($x->copy->$method(undef, $P.'.6'), $result, "$method(undef, ${P}.6)"); is($x->copy->$method(undef, $P.'.9'), $result, "$method(undef, ${P}.9)"); } sub _do_2_a { my ($x, $method, $y, $A, $result) = @_; my $cy = $mbf->new($y); is($x->copy->$method($cy, $A), $result, "$method($cy, $A)"); is($x->copy->$method($cy, $A.'.1'), $result, "$method($cy, ${A}.1)"); is($x->copy->$method($cy, $A.'.5'), $result, "$method($cy, ${A}.5)"); is($x->copy->$method($cy, $A.'.6'), $result, "$method($cy, ${A}.6)"); is($x->copy->$method($cy, $A.'.9'), $result, "$method($cy, ${A}.9)"); } sub _do_2_p { my ($x, $method, $y, $P, $result) = @_; my $cy = $mbf->new($y); is($x->copy->$method($cy, undef, $P), $result, "$method(undef, $P)"); is($x->copy->$method($cy, undef, $P.'.1'), $result, "$method($cy, undef, ${P}.1)"); is($x->copy->$method($cy, undef, $P.'.5'), $result, "$method($cy, undef, ${P}.5)"); is($x->copy->$method($cy, undef, $P.'.6'), $result, "$method($cy, undef, ${P}.6)"); is($x->copy->$method($cy, undef, $P.'.9'), $result, "$method($cy, undef, ${P}.9)"); } Math-BigInt-1.999715/t/rt-16221.t0000644403072340010010000000312012627352636015771 0ustar ospjaDomain Users#!/usr/bin/perl # # Verify that # - Math::BigInt::objectify() calls as_int() (or as_number(), as a fallback) # if the target object class is Math::BigInt. # - Math::BigInt::objectify() calls as_float() if the target object class is # Math::BigFloat. # # See RT #16221 and RT #52124. use strict; use warnings; package main; use Test::More tests => 2; use Math::BigInt; use Math::BigFloat; ############################################################################ my $int = Math::BigInt->new(10); my $int_percent = My::Percent::Float->new(100); is($int * $int_percent, 10, '$int * $int_percent = 10'); ############################################################################ my $float = Math::BigFloat->new(10); my $float_percent = My::Percent::Float->new(100); is($float * $float_percent, 10, '$float * $float_percent = 10'); ############################################################################ package My::Percent::Int; sub new { my $class = shift; my $num = shift; return bless \$num, $class; } sub as_number { my $self = shift; return Math::BigInt->new($$self / 100); } sub as_string { my $self = shift; return $$self; } ############################################################################ package My::Percent::Float; sub new { my $class = shift; my $num = shift; return bless \$num, $class; } sub as_int { my $self = shift; return Math::BigInt->new($$self / 100); } sub as_float { my $self = shift; return Math::BigFloat->new($$self / 100); } sub as_string { my $self = shift; return $$self; } Math-BigInt-1.999715/t/sub_ali.t0000644403072340010010000000034012632032732016276 0ustar ospjaDomain Users#!/usr/bin/perl # test that the new alias names work use strict; use warnings; use Test::More tests => 6; use lib 't'; use Math::BigInt::Subclass; our $CLASS; $CLASS = 'Math::BigInt::Subclass'; require 't/alias.inc'; Math-BigInt-1.999715/t/sub_mbf.t0000644403072340010010000000202012641542050016271 0ustar ospjaDomain Users#!perl use strict; use warnings; use Test::More tests => 2409 # tests in require'd file + 6; # tests in this file use lib 't'; use Math::BigFloat::Subclass; our ($CLASS, $CALC); $CLASS = "Math::BigFloat::Subclass"; $CALC = Math::BigFloat->config()->{lib}; # backend require 't/bigfltpm.inc'; # perform same tests as bigfltpm ############################################################################### # Now do custom tests for Subclass itself my $ms = $CLASS->new(23); is($ms->{_custom}, 1, '$ms has custom attribute \$ms->{_custom}'); # Check that subclass is a Math::BigFloat, but not a Math::Bigint isa_ok($ms, 'Math::BigFloat'); ok(!$ms->isa('Math::BigInt'), "An object of class '" . ref($ms) . "' isn't a 'Math::BigFloat'"); use Math::BigFloat; my $bf = Math::BigFloat->new(23); # same as other $ms += $bf; is($ms, 46, '$ms is 46'); is($ms->{_custom}, 1, '$ms has custom attribute $ms->{_custom}'); is(ref($ms), $CLASS, "\$ms is not an object of class '$CLASS'"); Math-BigInt-1.999715/t/sub_mbi.t0000644403072340010010000000164512641213041016303 0ustar ospjaDomain Users#!/usr/bin/perl use strict; use warnings; use Test::More tests => 3724 # tests in require'd file + 5; # tests in this file use lib 't'; use Math::BigInt::Subclass; our ($CLASS, $CALC); $CLASS = "Math::BigInt::Subclass"; $CALC = "Math::BigInt::Calc"; # backend require 't/bigintpm.inc'; # perform same tests as bigintpm ############################################################################### # Now do custom tests for Subclass itself my $ms = $CLASS->new(23); is($ms->{_custom}, 1, '$ms has custom attribute \$ms->{_custom}'); # Check that a subclass is still considered a Math::BigInt isa_ok($ms, 'Math::BigInt'); use Math::BigInt; my $bi = Math::BigInt->new(23); # same as other $ms += $bi; is($ms, 46, '$ms is 46'); is($ms->{_custom}, 1, '$ms has custom attribute $ms->{_custom}'); is(ref($ms), $CLASS, "\$ms is not an object of class '$CLASS'"); Math-BigInt-1.999715/t/sub_mif.t0000644403072340010010000000053112632035314016305 0ustar ospjaDomain Users#!/usr/bin/perl # test rounding, accuracy, precision and fallback, round_mode and mixing # of classes use strict; use warnings; use Test::More tests => 684; use lib 't'; use Math::BigInt::Subclass; use Math::BigFloat::Subclass; our ($mbi, $mbf); $mbi = 'Math::BigInt::Subclass'; $mbf = 'Math::BigFloat::Subclass'; require 't/mbimbf.inc'; Math-BigInt-1.999715/t/trap.t0000644403072340010010000000466712626376244015662 0ustar ospjaDomain Users#!/usr/bin/perl # test that config ( trap_nan => 1, trap_inf => 1) really works/dies use strict; use warnings; use Test::More tests => 43; use Math::BigInt; use Math::BigFloat; my $mbi = 'Math::BigInt'; my $mbf = 'Math::BigFloat'; my ($cfg, $x); foreach my $class ($mbi, $mbf) { # can do and defaults are okay? ok($class->can('config'), 'can config()'); is($class->config()->{trap_nan}, 0, 'trap_nan defaults to 0'); is($class->config()->{trap_inf}, 0, 'trap_inf defaults to 0'); # can set? $cfg = $class->config( trap_nan => 1 ); is($cfg->{trap_nan}, 1, 'trap_nan now true'); # also test that new() still works normally eval ("\$x = \$class->new('42'); \$x->bnan();"); like($@, qr/^Tried to set/, 'died'); is($x, 42, '$x after new() never modified'); # can reset? $cfg = $class->config( trap_nan => 0 ); is($cfg->{trap_nan}, 0, 'trap_nan disabled'); # can set? $cfg = $class->config( trap_inf => 1 ); is($cfg->{trap_inf}, 1, 'trap_inf enabled'); eval ("\$x = \$class->new('4711'); \$x->binf();"); like($@, qr/^Tried to set/, 'died'); is($x, 4711, '$x after new() never modified'); eval ("\$x = \$class->new('inf');"); like($@, qr/^Tried to set/, 'died'); is($x, 4711, '$x after new() never modified'); eval ("\$x = \$class->new('-inf');"); like($@, qr/^Tried to set/, 'died'); is($x, 4711, '$x after new() never modified'); # +$x/0 => +inf eval ("\$x = \$class->new('4711'); \$x->bdiv(0);"); like($@, qr/^Tried to set/, 'died'); is($x, 4711, '$x after new() never modified'); # -$x/0 => -inf eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);"); like($@, qr/^Tried to set/, 'died'); is($x, '-815', '$x after new not modified'); $cfg = $class->config( trap_nan => 1 ); # 0/0 => NaN eval ("\$x = \$class->new('0'); \$x->bdiv(0);"); like($@, qr/^Tried to set/, 'died'); is($x, '0', '$x after new not modified'); } ############################################################################## # Math::BigInt $x = Math::BigInt->new(2); eval ("\$x = \$mbi->new('0.1');"); is($x, 2, 'never modified since it dies'); eval ("\$x = \$mbi->new('0a.1');"); is($x, 2, 'never modified since it dies'); ############################################################################## # Math::BigFloat $x = Math::BigFloat->new(2); eval ("\$x = \$mbf->new('0.1a');"); is($x, 2, 'never modified since it dies'); # all tests done Math-BigInt-1.999715/t/upgrade.inc0000644403072340010010000006720012632777520016640 0ustar ospjaDomain Users# include this file into another for subclass testing # This file is nearly identical to bigintpm.t, except that certain results are # _requird_ to be different due to "upgrading" or "promoting" to # Math::BigFloat. The reverse is not true. Any unmarked results can be either # Math::BigInt or Math::BigFloat, depending on how good the internal # optimization is (e.g., it is usually desirable to have 2 ** 2 return a # Math::BigInt, not a Math::BigFloat). # Results that are required to be Math::BigFloat are marked with C<^> at the # end. # Please note that the testcount goes up by two for each extra result marked # with ^, since then we test whether it has the proper class and that it left # the upgrade variable alone. use strict; use warnings; our ($CLASS, $CALC, $EXPECTED_CLASS); ############################################################################## # for testing inheritance of _swap package Math::Foo; use Math::BigInt lib => $main::CALC; our @ISA = (qw/Math::BigInt/); use overload # customized overload for sub, since original does not use swap there '-' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bsub($a[1]); }; sub _swap { # a fake _swap, which reverses the params my $self = shift; # for override in subclass if ($_[2]) { my $c = ref ($_[0] ) || 'Math::Foo'; return ( $_[0]->copy(), $_[1] ); } else { return ( Math::Foo->new($_[1]), $_[0] ); } } ############################################################################## package main; is($CLASS->config()->{lib}, $CALC, "$CLASS->config()->{lib}"); my ($x, $y, $z, @args, $a, $m, $e, $try, $got, $want, $exp); my ($f, $round_mode, $expected_class); while () { s/#.*$//; # remove comments s/\s+$//; # remove trailing whitespace next unless length; # skip empty lines if (s/^&//) { $f = $_; next; } if (/^\$/) { $round_mode = $_; $round_mode =~ s/^\$/$CLASS\->/; next; } @args = split(/:/, $_, 99); $want = pop(@args); $expected_class = $CLASS; if ($want =~ /\^$/) { $expected_class = $EXPECTED_CLASS; $want =~ s/\^$//; } $try = qq|\$x = $CLASS->new("$args[0]");|; if ($f eq "bnorm") { $try = qq|\$x = $CLASS->bnorm("$args[0]");|; } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan|int)$/) { $try .= " \$x->$f();"; } elsif ($f eq "as_hex") { $try .= ' $x->as_hex();'; } elsif ($f eq "as_bin") { $try .= ' $x->as_bin();'; } elsif ($f eq "is_inf") { $try .= " \$x->is_inf('$args[1]');"; } elsif ($f eq "binf") { $try .= " \$x->binf('$args[1]');"; } elsif ($f eq "bone") { $try .= " \$x->bone('$args[1]');"; # some unary ops } elsif ($f =~ /^b(nan|floor|ceil|int|sstr|neg|abs|inc|dec|not|sqrt|fac)$/) { $try .= " \$x->$f();"; } elsif ($f eq "length") { $try .= ' $x->length();'; } elsif ($f eq "exponent") { # ->bstr() to see if an object is returned $try .= ' $x = $x->exponent()->bstr();'; } elsif ($f eq "mantissa") { # ->bstr() to see if an object is returned $try .= ' $x = $x->mantissa()->bstr();'; } elsif ($f eq "parts") { $try .= ' ($m, $e) = $x->parts();'; # ->bstr() to see if an object is returned $try .= ' $m = $m->bstr(); $m = "NaN" if !defined $m;'; $try .= ' $e = $e->bstr(); $e = "NaN" if !defined $e;'; $try .= ' "$m,$e";'; } else { if ($args[1] !~ /\./) { $try .= qq| \$y = $CLASS->new("$args[1]");|; } else { $try .= qq| \$y = $EXPECTED_CLASS->new("$args[1]");|; } if ($f eq "bcmp") { $try .= ' $x->bcmp($y);'; } elsif ($f eq "bacmp") { $try .= ' $x->bacmp($y);'; } elsif ($f eq "bround") { $try .= " $round_mode; \$x->bround(\$y);"; } elsif ($f eq "broot") { $try .= " \$x->broot(\$y);"; } elsif ($f eq "badd") { $try .= ' $x + $y;'; } elsif ($f eq "bsub") { $try .= ' $x - $y;'; } elsif ($f eq "bmul") { $try .= ' $x * $y;'; } elsif ($f eq "bdiv") { $try .= ' $x / $y;'; } elsif ($f eq "bdiv-list") { $try .= ' join(",", $x->bdiv($y));'; # overload via x= } elsif ($f =~ /^.=$/) { $try .= " \$x $f \$y;"; # overload via x } elsif ($f =~ /^.$/) { $try .= " \$x $f \$y;"; } elsif ($f eq "bmod") { $try .= ' $x % $y;'; } elsif ($f eq "bgcd") { if (defined $args[2]) { $try .= qq| \$z = $CLASS->new("$args[2]");|; } $try .= " $CLASS\::bgcd(\$x, \$y"; $try .= ", \$z" if defined $args[2]; $try .= ");"; } elsif ($f eq "blcm") { if (defined $args[2]) { $try .= qq| \$z = $CLASS->new("$args[2]");|; } $try .= " $CLASS\::blcm(\$x, \$y"; $try .= ", \$z" if defined $args[2]; $try .= ");"; } elsif ($f eq "blsft") { if (defined $args[2]) { $try .= " \$x->blsft(\$y, $args[2]);"; } else { $try .= " \$x << \$y;"; } } elsif ($f eq "brsft") { if (defined $args[2]) { $try .= " \$x->brsft(\$y, $args[2]);"; } else { $try .= " \$x >> \$y;"; } } elsif ($f eq "band") { $try .= " \$x & \$y;"; } elsif ($f eq "bior") { $try .= " \$x | \$y;"; } elsif ($f eq "bxor") { $try .= " \$x ^ \$y;"; } elsif ($f eq "bpow") { $try .= " \$x ** \$y;"; } elsif ($f eq "digit") { $try = qq|\$x = $CLASS->new("$args[0]"); \$x->digit($args[1]);|; } else { warn "Unknown op '$f'"; } } # end else all other ops $got = eval $try; print "# Error: $@\n" if $@; # convert hex/binary targets to decimal if ($want =~ /^(0x0x|0b0b)/) { $want =~ s/^0[xb]//; $want = Math::BigInt->new($want)->bstr(); } if ($want eq "") { is($got, undef, $try); } else { # print "try: $try ans: $got $want\n"; is($got, $want, $try); if ($expected_class ne $CLASS) { is(ref($got), $expected_class, 'ref($got)'); is($Math::BigInt::upgrade, 'Math::BigFloat', '$Math::BigInt::upgrade'); } } # check internal state of number objects is_valid($got, $f) if ref $got; } # endwhile data tests close DATA; my $warn = ''; $SIG{__WARN__} = sub { $warn = shift; }; # these should not warn $warn = ''; eval '$z = 3.17 <= $y'; is($z, 1, '$z = 3.17 <= $y'); is($warn, '', 'the code "$z = 3.17 <= $y" issued no warning'); $warn = ''; eval '$z = $y >= 3.17'; is($z, 1, '$z = $y >= 3.17'); is($warn, '', 'the code "$z = $y >= 3.17" issued no warning'); # all tests done 1; ############################################################################### # sub to check validity of a Math::BigInt internally, to ensure that no op # leaves a number object in an invalid state (f.i. "-0") sub is_valid { my ($x, $f, $c) = @_; # The checks here are loosened a bit to allow Math::BigInt or # Math::BigFloats to pass my $e = 0; # error? # ok as reference? # $e = "Not a reference to $c" if (ref($x) || '') ne $c; # has ok sign? $e = "Illegal sign $x->{sign} (expected: '+', '-', '-inf', '+inf' or 'NaN'" if $e eq '0' && $x->{sign} !~ /^(\+|-|\+inf|-inf|NaN)$/; $e = "-0 is invalid!" if $e ne '0' && $x->{sign} eq '-' && $x == 0; #$e = $CALC->_check($x->{value}) if $e eq '0'; # test done, see if error did crop up if ($e eq '0') { pass('is a valid object'); return; } fail($e . " after op '$f'"); } __DATA__ &.= 1234:-345:1234-345 &+= 1:2:3 -1:-2:-3 &-= 1:2:-1 -1:-2:1 &*= 2:3:6 -1:5:-5 &%= 100:3:1 8:9:8 &/= 100:3:33.33333333333333333333333333333333333333 -8:2:-4 &|= 2:1:3 &&= 5:7:5 &^= 5:7:2 &is_negative 0:0 -1:1 1:0 +inf:0 -inf:1 NaNneg:0 &is_positive 0:0 -1:0 1:1 +inf:1 -inf:0 NaNneg:0 &is_odd abc:0 0:0 1:1 3:1 -1:1 -3:1 10000001:1 10000002:0 2:0 120:0 121:1 &is_int NaN:0 inf:0 -inf:0 1:1 12:1 123e12:1 &is_even abc:0 0:1 1:0 3:0 -1:0 -3:0 10000001:0 10000002:1 2:1 120:1 121:0 &bacmp +0:-0:0 +0:+1:-1 -1:+1:0 +1:-1:0 -1:+2:-1 +2:-1:1 -123456789:+987654321:-1 +123456789:-987654321:-1 +987654321:+123456789:1 -987654321:+123456789:1 -123:+4567889:-1 # NaNs acmpNaN:123: 123:acmpNaN: acmpNaN:acmpNaN: # infinity +inf:+inf:0 -inf:-inf:0 +inf:-inf:0 -inf:+inf:0 +inf:123:1 -inf:123:1 +inf:-123:1 -inf:-123:1 # return undef +inf:NaN: NaN:inf: -inf:NaN: NaN:-inf: &bnorm 123:123 12.3:12.3^ # binary input 0babc:NaN 0b123:NaN 0b0:0 -0b0:0 -0b1:-1 0b0001:1 0b001:1 0b011:3 0b101:5 0b1001:9 0b10001:17 0b100001:33 0b1000001:65 0b10000001:129 0b100000001:257 0b1000000001:513 0b10000000001:1025 0b100000000001:2049 0b1000000000001:4097 0b10000000000001:8193 0b100000000000001:16385 0b1000000000000001:32769 0b10000000000000001:65537 0b100000000000000001:131073 0b1000000000000000001:262145 0b10000000000000000001:524289 0b100000000000000000001:1048577 0b1000000000000000000001:2097153 0b10000000000000000000001:4194305 0b100000000000000000000001:8388609 0b1000000000000000000000001:16777217 0b10000000000000000000000001:33554433 0b100000000000000000000000001:67108865 0b1000000000000000000000000001:134217729 0b10000000000000000000000000001:268435457 0b100000000000000000000000000001:536870913 0b1000000000000000000000000000001:1073741825 0b10000000000000000000000000000001:2147483649 0b100000000000000000000000000000001:4294967297 0b1000000000000000000000000000000001:8589934593 0b10000000000000000000000000000000001:17179869185 0b__101:NaN 0b1_0_1:5 0b0_0_0_1:1 # hex input -0x0:0 0xabcdefgh:NaN 0x1234:4660 0xabcdef:11259375 -0xABCDEF:-11259375 -0x1234:-4660 0x12345678:305419896 0x1_2_3_4_56_78:305419896 0xa_b_c_d_e_f:11259375 0x__123:NaN 0x9:9 0x11:17 0x21:33 0x41:65 0x81:129 0x101:257 0x201:513 0x401:1025 0x801:2049 0x1001:4097 0x2001:8193 0x4001:16385 0x8001:32769 0x10001:65537 0x20001:131073 0x40001:262145 0x80001:524289 0x100001:1048577 0x200001:2097153 0x400001:4194305 0x800001:8388609 0x1000001:16777217 0x2000001:33554433 0x4000001:67108865 0x8000001:134217729 0x10000001:268435457 0x20000001:536870913 0x40000001:1073741825 0x80000001:2147483649 0x100000001:4294967297 0x200000001:8589934593 0x400000001:17179869185 0x800000001:34359738369 # inf input inf:inf +inf:inf -inf:-inf 0inf:NaN # abnormal input :NaN abc:NaN 1 a:NaN 1bcd2:NaN 11111b:NaN +1z:NaN -1z:NaN # only one underscore between two digits _123:NaN _123_:NaN 123_:NaN 1__23:NaN 1E1__2:NaN 1_E12:NaN 1E_12:NaN 1_E_12:NaN +_1E12:NaN +0_1E2:100 +0_0_1E2:100 -0_0_1E2:-100 -0_0_1E+0_0_2:-100 E1:NaN E23:NaN 1.23E1:12.3^ 1.23E-1:0.123^ # bug with two E's in number being valid 1e2e3:NaN 1e2r:NaN 1e2.0:NaN # leading zeros 012:12 0123:123 01234:1234 012345:12345 0123456:123456 01234567:1234567 012345678:12345678 0123456789:123456789 01234567891:1234567891 012345678912:12345678912 0123456789123:123456789123 01234567891234:1234567891234 # normal input 0:0 +0:0 +00:0 +000:0 000000000000000000:0 -0:0 -0000:0 +1:1 +01:1 +001:1 +00000100000:100000 123456789:123456789 -1:-1 -01:-1 -001:-1 -123456789:-123456789 -00000100000:-100000 1_2_3:123 10000000000E-1_0:1 1E2:100 1E1:10 1E0:1 1.23E2:123 100E-1:10 # floating point input # .2e2:20 1.E3:1000 1.01E2:101 1010E-1:101 -1010E0:-1010 -1010E1:-10100 1234.00:1234 # non-integer numbers -1010E-2:-10.1^ -1.01E+1:-10.1^ -1.01E-1:-0.101^ &bnan 1:NaN 2:NaN abc:NaN &bone 2:+:1 2:-:-1 boneNaN:-:-1 boneNaN:+:1 2:abc:1 3::1 &binf 1:+:inf 2:-:-inf 3:abc:inf &is_nan 123:0 abc:1 NaN:1 -123:0 &is_inf +inf::1 -inf::1 abc::0 1::0 NaN::0 -1::0 +inf:-:0 +inf:+:1 -inf:-:1 -inf:+:0 +iNfInItY::1 -InFiNiTy::1 &blsft abc:abc:NaN +2:+2:8 +1:+32:4294967296 +1:+48:281474976710656 +8:-2:NaN # exercise base 10 +12345:4:10:123450000 -1234:0:10:-1234 +1234:0:10:1234 +2:2:10:200 +12:2:10:1200 +1234:-3:10:NaN 1234567890123:12:10:1234567890123000000000000 &brsft abc:abc:NaN +8:+2:2 +4294967296:+32:1 +281474976710656:+48:1 +2:-2:NaN # exercise base 10 -1234:0:10:-1234 +1234:0:10:1234 +200:2:10:2 +1234:3:10:1 +1234:2:10:12 +1234:-3:10:NaN 310000:4:10:31 12300000:5:10:123 1230000000000:10:10:123 09876123456789067890:12:10:9876123 1234561234567890123:13:10:123456 &bsstr 1e+34:1e+34 123.456E3:123456e+0 100:1e+2 abc:NaN &bneg bnegNaN:NaN +inf:-inf -inf:inf abd:NaN 0:0 1:-1 -1:1 +123456789:-123456789 -123456789:123456789 &babs babsNaN:NaN +inf:inf -inf:inf 0:0 1:1 -1:1 +123456789:123456789 -123456789:123456789 &bcmp bcmpNaN:bcmpNaN: bcmpNaN:0: 0:bcmpNaN: 0:0:0 -1:0:-1 0:-1:1 1:0:1 0:1:-1 -1:1:-1 1:-1:1 -1:-1:0 1:1:0 123:123:0 123:12:1 12:123:-1 -123:-123:0 -123:-12:-1 -12:-123:1 123:124:-1 124:123:1 -123:-124:1 -124:-123:-1 100:5:1 -123456789:987654321:-1 +123456789:-987654321:1 -987654321:123456789:-1 -inf:5432112345:-1 +inf:5432112345:1 -inf:-5432112345:-1 +inf:-5432112345:1 +inf:+inf:0 -inf:-inf:0 +inf:-inf:1 -inf:+inf:-1 5:inf:-1 5:inf:-1 -5:-inf:1 -5:-inf:1 # return undef +inf:NaN: NaN:inf: -inf:NaN: NaN:-inf: &binc abc:NaN +inf:inf -inf:-inf +0:1 +1:2 -1:0 &bdec abc:NaN +inf:inf -inf:-inf +0:-1 +1:0 -1:-2 &badd abc:abc:NaN abc:0:NaN +0:abc:NaN +inf:-inf:NaN -inf:+inf:NaN +inf:+inf:inf -inf:-inf:-inf baddNaN:+inf:NaN baddNaN:+inf:NaN +inf:baddNaN:NaN -inf:baddNaN:NaN 0:0:0 1:0:1 0:1:1 1:1:2 -1:0:-1 0:-1:-1 -1:-1:-2 -1:+1:0 +1:-1:0 +9:+1:10 +99:+1:100 +999:+1:1000 +9999:+1:10000 +99999:+1:100000 +999999:+1:1000000 +9999999:+1:10000000 +99999999:+1:100000000 +999999999:+1:1000000000 +9999999999:+1:10000000000 +99999999999:+1:100000000000 +10:-1:9 +100:-1:99 +1000:-1:999 +10000:-1:9999 +100000:-1:99999 +1000000:-1:999999 +10000000:-1:9999999 +100000000:-1:99999999 +1000000000:-1:999999999 +10000000000:-1:9999999999 +123456789:987654321:1111111110 -123456789:987654321:864197532 -123456789:-987654321:-1111111110 +123456789:-987654321:-864197532 2:2.5:4.5^ -123:-1.5:-124.5^ -1.2:1:-0.2^ &bsub abc:abc:NaN abc:+0:NaN +0:abc:NaN +inf:-inf:inf -inf:+inf:-inf +inf:+inf:NaN -inf:-inf:NaN +0:+0:0 +1:+0:1 +0:+1:-1 +1:+1:0 -1:+0:-1 +0:-1:1 -1:-1:0 -1:+1:-2 +1:-1:2 +9:+1:8 +99:+1:98 +999:+1:998 +9999:+1:9998 +99999:+1:99998 +999999:+1:999998 +9999999:+1:9999998 +99999999:+1:99999998 +999999999:+1:999999998 +9999999999:+1:9999999998 +99999999999:+1:99999999998 +10:-1:11 +100:-1:101 +1000:-1:1001 +10000:-1:10001 +100000:-1:100001 +1000000:-1:1000001 +10000000:-1:10000001 +100000000:-1:100000001 +1000000000:-1:1000000001 +10000000000:-1:10000000001 +123456789:+987654321:-864197532 -123456789:+987654321:-1111111110 -123456789:-987654321:864197532 +123456789:-987654321:1111111110 &bmul abc:abc:NaN abc:+0:NaN +0:abc:NaN NaNmul:+inf:NaN NaNmul:-inf:NaN -inf:NaNmul:NaN +inf:NaNmul:NaN +inf:+inf:inf +inf:-inf:-inf -inf:+inf:-inf -inf:-inf:inf +0:+0:0 +0:+1:0 +1:+0:0 +0:-1:0 -1:+0:0 123456789123456789:0:0 0:123456789123456789:0 -1:-1:1 -1:+1:-1 +1:-1:-1 +1:+1:1 +2:+3:6 -2:+3:-6 +2:-3:-6 -2:-3:6 111:111:12321 10101:10101:102030201 1001001:1001001:1002003002001 100010001:100010001:10002000300020001 10000100001:10000100001:100002000030000200001 11111111111:9:99999999999 22222222222:9:199999999998 33333333333:9:299999999997 44444444444:9:399999999996 55555555555:9:499999999995 66666666666:9:599999999994 77777777777:9:699999999993 88888888888:9:799999999992 99999999999:9:899999999991 +25:+25:625 +12345:+12345:152399025 +99999:+11111:1111088889 9999:10000:99990000 99999:100000:9999900000 999999:1000000:999999000000 9999999:10000000:99999990000000 99999999:100000000:9999999900000000 999999999:1000000000:999999999000000000 9999999999:10000000000:99999999990000000000 99999999999:100000000000:9999999999900000000000 999999999999:1000000000000:999999999999000000000000 9999999999999:10000000000000:99999999999990000000000000 99999999999999:100000000000000:9999999999999900000000000000 999999999999999:1000000000000000:999999999999999000000000000000 9999999999999999:10000000000000000:99999999999999990000000000000000 99999999999999999:100000000000000000:9999999999999999900000000000000000 999999999999999999:1000000000000000000:999999999999999999000000000000000000 9999999999999999999:10000000000000000000:99999999999999999990000000000000000000 3:3.5:10.5^ 3.5:3:10.5^ &bdiv-list 100:20:5,0 4095:4095:1,0 -4095:-4095:1,0 4095:-4095:-1,0 -4095:4095:-1,0 123:2:61,1 9:5:1,4 9:4:2,1 # inf handling and general remainder 5:8:0,5 0:8:0,0 11:2:5,1 11:-2:-6,-1 -11:2:-6,1 # see table in documentation in MBI 0:inf:0,0 0:-inf:0,0 5:inf:0,5 5:-inf:-1,-inf -5:inf:-1,inf -5:-inf:0,-5 inf:5:inf,NaN -inf:5:-inf,NaN inf:-5:-inf,NaN -inf:-5:inf,NaN 5:5:1,0 -5:-5:1,0 inf:inf:NaN,NaN -inf:-inf:NaN,NaN -inf:inf:NaN,NaN inf:-inf:NaN,NaN 8:0:inf,8 inf:0:inf,inf # exceptions to remainder rule -8:0:-inf,-8 -inf:0:-inf,-inf 0:0:NaN,0 &bdiv abc:abc:NaN abc:1:NaN 1:abc:NaN 0:0:NaN # inf handling (see table in doc) 0:inf:0 0:-inf:0 5:inf:0 5:-inf:-1 -5:inf:-1 -5:-inf:0 inf:5:inf -inf:5:-inf inf:-5:-inf -inf:-5:inf 5:5:1 -5:-5:1 inf:inf:NaN -inf:-inf:NaN -inf:inf:NaN inf:-inf:NaN 8:0:inf inf:0:inf -8:0:-inf -inf:0:-inf 11:2:5.5^ -11:-2:5.5^ -11:2:-5.5^ 11:-2:-5.5^ 0:1:0 0:-1:0 1:1:1 -1:-1:1 1:-1:-1 -1:1:-1 1:2:0.5^ 2:1:2 1000000000:9:111111111.1111111111111111111111111111111^ 2000000000:9:222222222.2222222222222222222222222222222^ 3000000000:9:333333333.3333333333333333333333333333333^ 4000000000:9:444444444.4444444444444444444444444444444^ 5000000000:9:555555555.5555555555555555555555555555556^ 6000000000:9:666666666.6666666666666666666666666666667^ 7000000000:9:777777777.7777777777777777777777777777778^ 8000000000:9:888888888.8888888888888888888888888888889^ 9000000000:9:1000000000 35500000:113:314159.2920353982300884955752212389380531^ 71000000:226:314159.2920353982300884955752212389380531^ 106500000:339:314159.2920353982300884955752212389380531^ 1000000000:3:333333333.3333333333333333333333333333333^ +10:+5:2 +100:+4:25 +1000:+8:125 +10000:+16:625 999999999999:9:111111111111 999999999999:99:10101010101 999999999999:999:1001001001 999999999999:9999:100010001 999999999999999:99999:10000100001 +1111088889:99999:11111 -5:-3:1.666666666666666666666666666666666666667^ -5:3:-1.666666666666666666666666666666666666667^ 4:3:1.333333333333333333333333333333333333333^ 4:-3:-1.333333333333333333333333333333333333333^ 1:3:0.3333333333333333333333333333333333333333^ 1:-3:-0.3333333333333333333333333333333333333333^ -2:-3:0.6666666666666666666666666666666666666667^ -2:3:-0.6666666666666666666666666666666666666667^ 8:5:1.6^ -8:5:-1.6^ 14:-3:-4.666666666666666666666666666666666666667^ -14:3:-4.666666666666666666666666666666666666667^ -14:-3:4.666666666666666666666666666666666666667^ 14:3:4.666666666666666666666666666666666666667^ # bug in Calc with '99999' vs $BASE-1 #10000000000000000000000000000000000000000000000000000000000000000000000000000000000:10000000375084540248994272022843165711074:999999962491547381984643365663244474111576 12:24:0.5^ &bmod # inf handling, see table in doc 0:inf:0 0:-inf:0 5:inf:5 5:-inf:-inf -5:inf:inf -5:-inf:-5 inf:5:NaN -inf:5:NaN inf:-5:NaN -inf:-5:NaN 5:5:0 -5:-5:0 inf:inf:NaN -inf:-inf:NaN -inf:inf:NaN inf:-inf:NaN 8:0:8 inf:0:inf -inf:0:-inf -8:0:-8 0:0:0 abc:abc:NaN abc:1:abc:NaN 1:abc:NaN 0:1:0 1:0:1 0:-1:0 -1:0:-1 1:1:0 -1:-1:0 1:-1:0 -1:1:0 1:2:1 2:1:0 1000000000:9:1 2000000000:9:2 3000000000:9:3 4000000000:9:4 5000000000:9:5 6000000000:9:6 7000000000:9:7 8000000000:9:8 9000000000:9:0 35500000:113:33 71000000:226:66 106500000:339:99 1000000000:3:1 10:5:0 100:4:0 1000:8:0 10000:16:0 999999999999:9:0 999999999999:99:0 999999999999:999:0 999999999999:9999:0 999999999999999:99999:0 -9:+5:1 +9:-5:-1 -9:-5:-4 -5:3:1 -2:3:1 4:3:1 1:3:1 -5:-3:-2 -2:-3:-2 4:-3:-2 1:-3:-2 4095:4095:0 100041000510123:3:0 152403346:12345:4321 9:5:4 &bgcd abc:abc:NaN abc:+0:NaN +0:abc:NaN +0:+0:0 +0:+1:1 +1:+0:1 +1:+1:1 +2:+3:1 +3:+2:1 -3:+2:1 100:625:25 4096:81:1 1034:804:2 27:90:56:1 27:90:54:9 &blcm abc:abc:NaN abc:+0:NaN +0:abc:NaN +0:+0:NaN +1:+0:0 +0:+1:0 +27:+90:270 +1034:+804:415668 &band abc:abc:NaN abc:0:NaN 0:abc:NaN 1:2:0 3:2:2 +8:+2:0 +281474976710656:0:0 +281474976710656:1:0 +281474976710656:+281474976710656:281474976710656 -2:-3:-4 -1:-1:-1 -6:-6:-6 -7:-4:-8 -7:4:0 -4:7:4 # equal arguments are treated special, so also do some test with unequal ones 0xFFFF:0xFFFF:0x0xFFFF 0xFFFFFF:0xFFFFFF:0x0xFFFFFF 0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF 0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF 0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF 0xF0F0:0xF0F0:0x0xF0F0 0x0F0F:0x0F0F:0x0x0F0F 0xF0F0F0:0xF0F0F0:0x0xF0F0F0 0x0F0F0F:0x0F0F0F:0x0x0F0F0F 0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0 0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F 0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0 0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F 0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0 0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F 0x1F0F0F0F0F0F:0x3F0F0F0F0F0F:0x0x1F0F0F0F0F0F &bior abc:abc:NaN abc:0:NaN 0:abc:NaN 1:2:3 +8:+2:10 +281474976710656:0:281474976710656 +281474976710656:1:281474976710657 +281474976710656:281474976710656:281474976710656 -2:-3:-1 -1:-1:-1 -6:-6:-6 -7:4:-3 -4:7:-1 # equal arguments are treated special, so also do some test with unequal ones 0xFFFF:0xFFFF:0x0xFFFF 0xFFFFFF:0xFFFFFF:0x0xFFFFFF 0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF 0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF 0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF 0:0xFFFF:0x0xFFFF 0:0xFFFFFF:0x0xFFFFFF 0:0xFFFFFFFF:0x0xFFFFFFFF 0:0xFFFFFFFFFF:0x0xFFFFFFFFFF 0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF 0xFFFF:0:0x0xFFFF 0xFFFFFF:0:0x0xFFFFFF 0xFFFFFFFF:0:0x0xFFFFFFFF 0xFFFFFFFFFF:0:0x0xFFFFFFFFFF 0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF 0xF0F0:0xF0F0:0x0xF0F0 0x0F0F:0x0F0F:0x0x0F0F 0xF0F0:0x0F0F:0x0xFFFF 0xF0F0F0:0xF0F0F0:0x0xF0F0F0 0x0F0F0F:0x0F0F0F:0x0x0F0F0F 0x0F0F0F:0xF0F0F0:0x0xFFFFFF 0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0 0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F 0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF 0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0 0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F 0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF 0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0 0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F 0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF 0x1F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF &bxor abc:abc:NaN abc:0:NaN 0:abc:NaN 1:2:3 +8:+2:10 +281474976710656:0:281474976710656 +281474976710656:1:281474976710657 +281474976710656:281474976710656:0 -2:-3:3 -1:-1:0 -6:-6:0 -7:4:-3 -4:7:-5 4:-7:-3 -4:-7:5 # equal arguments are treated special, so also do some test with unequal ones 0xFFFF:0xFFFF:0 0xFFFFFF:0xFFFFFF:0 0xFFFFFFFF:0xFFFFFFFF:0 0xFFFFFFFFFF:0xFFFFFFFFFF:0 0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0 0:0xFFFF:0x0xFFFF 0:0xFFFFFF:0x0xFFFFFF 0:0xFFFFFFFF:0x0xFFFFFFFF 0:0xFFFFFFFFFF:0x0xFFFFFFFFFF 0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF 0xFFFF:0:0x0xFFFF 0xFFFFFF:0:0x0xFFFFFF 0xFFFFFFFF:0:0x0xFFFFFFFF 0xFFFFFFFFFF:0:0x0xFFFFFFFFFF 0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF 0xF0F0:0xF0F0:0 0x0F0F:0x0F0F:0 0xF0F0:0x0F0F:0x0xFFFF 0xF0F0F0:0xF0F0F0:0 0x0F0F0F:0x0F0F0F:0 0x0F0F0F:0xF0F0F0:0x0xFFFFFF 0xF0F0F0F0:0xF0F0F0F0:0 0x0F0F0F0F:0x0F0F0F0F:0 0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF 0xF0F0F0F0F0:0xF0F0F0F0F0:0 0x0F0F0F0F0F:0x0F0F0F0F0F:0 0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF 0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0 0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0 0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF &bnot abc:NaN +0:-1 +8:-9 +281474976710656:-281474976710657 -1:0 -2:1 -12:11 &digit 0:0:0 12:0:2 12:1:1 123:0:3 123:1:2 123:2:1 123:-1:1 123:-2:2 123:-3:3 123456:0:6 123456:1:5 123456:2:4 123456:3:3 123456:4:2 123456:5:1 123456:-1:1 123456:-2:2 123456:-3:3 100000:-3:0 100000:0:0 100000:1:0 &mantissa abc:NaN 1e4:1 2e0:2 123:123 -1:-1 -2:-2 +inf:inf -inf:-inf &exponent abc:NaN 1e4:4 2e0:0 123:0 -1:0 -2:0 0:0 +inf:inf -inf:inf &parts abc:NaN,NaN 1e4:1,4 2e0:2,0 123:123,0 -1:-1,0 -2:-2,0 0:0,0 +inf:inf,inf -inf:-inf,inf &bfac -1:NaN NaNfac:NaN +inf:inf -inf:NaN 0:1 1:1 2:2 3:6 4:24 5:120 6:720 10:3628800 11:39916800 12:479001600 &bpow abc:12:NaN 12:abc:NaN 0:0:1 0:1:0 0:2:0 0:-1:inf 0:-2:inf 1:0:1 1:1:1 1:2:1 1:3:1 1:-1:1 1:-2:1 1:-3:1 2:0:1 2:1:2 2:2:4 2:3:8 3:3:27 2:-1:0.5^ -2:-1:-0.5^ 2:-2:0.25^ # Y is even => result positive -2:-2:0.25^ # Y is odd => result negative -2:-3:-0.125^ +inf:1234500012:inf -inf:1234500012:inf -inf:1234500013:-inf +inf:-12345000123:inf -inf:-12345000123:-inf # 1 ** -x => 1 / (1 ** x) -1:0:1 -2:0:1 -1:1:-1 -1:2:1 -1:3:-1 -1:4:1 -1:5:-1 -1:-1:-1 -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 10:5:100000 10:6:1000000 10:7:10000000 10:8:100000000 10:9:1000000000 10:20:100000000000000000000 123456:2:15241383936 #2:0.5:1.41^ &length 100:3 10:2 1:1 0:1 12345:5 10000000000000000:17 -123:3 215960156869840440586892398248:30 # broot always upgrades &broot 144:2:12^ 123:2:11.09053650640941716205160010260993291846^ # bsqrt always upgrades &bsqrt 145:12.04159457879229548012824103037860805243^ 144:12^ 143:11.95826074310139802112984075619561661399^ 16:4 170:13.03840481040529742916594311485836883306^ 169:13 168:12.96148139681572046193193487217599331541^ 4:2 3:1.732050807568877293527446341505872366943^ 2:1.41421356237309504880168872420969807857^ 9:3 12:3.464101615137754587054892683011744733886^ 256:16 100000000:10000 4000000000000:2000000 152399026:12345.00004050222755607815159966235881398^ 152399025:12345 152399024:12344.99995949777231103967404745303741942^ 1:1 0:0 -2:NaN -123:NaN Nan:NaN +inf:inf -inf:NaN &bround $round_mode('trunc') 0:12:0 NaNbround:12:NaN +inf:12:inf -inf:12:-inf 1234:0:1234 1234:2:1200 123456:4:123400 123456:5:123450 123456:6:123456 +10123456789:5:10123000000 -10123456789:5:-10123000000 +10123456789:9:10123456700 -10123456789:9:-10123456700 +101234500:6:101234000 -101234500:6:-101234000 #+101234500:-4:101234000 #-101234500:-4:-101234000 $round_mode('zero') +20123456789:5:20123000000 -20123456789:5:-20123000000 +20123456789:9:20123456800 -20123456789:9:-20123456800 +201234500:6:201234000 -201234500:6:-201234000 #+201234500:-4:201234000 #-201234500:-4:-201234000 +12345000:4:12340000 -12345000:4:-12340000 $round_mode('+inf') +30123456789:5:30123000000 -30123456789:5:-30123000000 +30123456789:9:30123456800 -30123456789:9:-30123456800 +301234500:6:301235000 -301234500:6:-301234000 #+301234500:-4:301235000 #-301234500:-4:-301234000 +12345000:4:12350000 -12345000:4:-12340000 $round_mode('-inf') +40123456789:5:40123000000 -40123456789:5:-40123000000 +40123456789:9:40123456800 -40123456789:9:-40123456800 +401234500:6:401234000 +401234500:6:401234000 #-401234500:-4:-401235000 #-401234500:-4:-401235000 +12345000:4:12340000 -12345000:4:-12350000 $round_mode('odd') +50123456789:5:50123000000 -50123456789:5:-50123000000 +50123456789:9:50123456800 -50123456789:9:-50123456800 +501234500:6:501235000 -501234500:6:-501235000 #+501234500:-4:501235000 #-501234500:-4:-501235000 +12345000:4:12350000 -12345000:4:-12350000 $round_mode('even') +60123456789:5:60123000000 -60123456789:5:-60123000000 +60123456789:9:60123456800 -60123456789:9:-60123456800 +601234500:6:601234000 -601234500:6:-601234000 #+601234500:-4:601234000 #-601234500:-4:-601234000 #-601234500:-9:0 #-501234500:-9:0 #-601234500:-8:0 #-501234500:-8:0 +1234567:7:1234567 +1234567:6:1234570 +12345000:4:12340000 -12345000:4:-12340000 &is_zero 0:1 NaNzero:0 +inf:0 -inf:0 123:0 -1:0 1:0 &is_one 0:0 NaNone:0 +inf:0 -inf:0 1:1 2:0 -1:0 -2:0 # floor and ceil are pretty pointless in integer space, but play safe &bfloor 0:0 NaNfloor:NaN +inf:inf -inf:-inf -1:-1 -2:-2 2:2 3:3 abc:NaN &bceil NaNceil:NaN +inf:inf -inf:-inf 0:0 -1:-1 -2:-2 2:2 3:3 abc:NaN &bint NaN:NaN +inf:inf -inf:-inf 0:0 -1:-1 -2:-2 2:2 3:3 &as_hex 128:0x80 -128:-0x80 0:0x0 -0:0x0 1:0x1 0x123456789123456789:0x123456789123456789 +inf:inf -inf:-inf NaNas_hex:NaN &as_bin 128:0b10000000 -128:-0b10000000 0:0b0 -0:0b0 1:0b1 0b1010111101010101010110110110110110101:0b1010111101010101010110110110110110101 +inf:inf -inf:-inf NaNas_bin:NaN Math-BigInt-1.999715/t/upgrade.t0000644403072340010010000000115512632033556016321 0ustar ospjaDomain Users#!/usr/bin/perl use strict; use warnings; use Test::More tests => 2124 # tests in require'd file + 2; # tests in this file use Math::BigInt upgrade => 'Math::BigFloat'; use Math::BigFloat; our ($CLASS, $EXPECTED_CLASS, $CALC); $CLASS = "Math::BigInt"; $EXPECTED_CLASS = "Math::BigFloat"; $CALC = "Math::BigInt::Calc"; # backend is(Math::BigInt->upgrade(), "Math::BigFloat", qq/Math::BigInt->upgrade()/); is(Math::BigInt->downgrade() || "", "", qq/Math::BigInt->downgrade() || ""/); require 't/upgrade.inc'; # all tests here for sharing Math-BigInt-1.999715/t/upgrade2.t0000644403072340010010000000061412622162610016373 0ustar ospjaDomain Users#!/usr/bin/perl use strict; use warnings; # Test 2 levels of upgrade classes. This used to cause a segv. use Test::More tests => 1; use Math::BigInt upgrade => 'Math::BigFloat'; use Math::BigFloat upgrade => 'Math::BigMouse'; no warnings 'once'; @Math::BigMouse::ISA = 'Math::BigFloat'; () = sqrt Math::BigInt->new(2); pass('sqrt on a big int does not segv if there are 2 upgrade levels'); Math-BigInt-1.999715/t/upgradef.t0000644403072340010010000000336212632035134016463 0ustar ospjaDomain Users#!/usr/bin/perl use strict; use warnings; use Test::More tests => 6; ############################################################################### package Math::BigFloat::Test; use Math::BigFloat; require Exporter; our @ISA = qw/Exporter Math::BigFloat/; use overload; sub isa { my ($self, $class) = @_; return if $class =~ /^Math::Big(Int|Float)/; # we aren't one of these UNIVERSAL::isa($self, $class); } sub bmul { return __PACKAGE__->new(123); } sub badd { return __PACKAGE__->new(321); } ############################################################################### package main; # use Math::BigInt upgrade => 'Math::BigFloat'; use Math::BigFloat upgrade => 'Math::BigFloat::Test'; my ($x, $y, $z); our ($CLASS, $EXPECTED_CLASS, $CALC); $CLASS = "Math::BigFloat"; $EXPECTED_CLASS = "Math::BigFloat::Test"; $CALC = "Math::BigInt::Calc"; # backend is(Math::BigFloat->upgrade(), $EXPECTED_CLASS, qq|Math::BigFloat->upgrade()|); is(Math::BigFloat->downgrade() || '', '', qq/Math::BigFloat->downgrade() || ''/); $x = $CLASS->new(123); $y = $EXPECTED_CLASS->new(123); $z = $x->bmul($y); is(ref($z), $EXPECTED_CLASS, qq|\$x = $CLASS->new(123); \$y = $EXPECTED_CLASS->new(123);| . q| $z = $x->bmul($y); ref($z)|); is($z, 123, qq|\$x = $CLASS->new(123); \$y = $EXPECTED_CLASS->new(123);| . q| $z = $x->bmul($y); $z|); $x = $CLASS->new(123); $y = $EXPECTED_CLASS->new(123); $z = $x->badd($y); is(ref($z), $EXPECTED_CLASS, qq|$x = $CLASS->new(123); $y = $EXPECTED_CLASS->new(123);| . q| $z = $x->badd($y); ref($z)|); is($z, 321, qq|$x = $CLASS->new(123); $y = $EXPECTED_CLASS->new(123);| . q| $z = $x->badd($y); $z|); # not yet: #require 't/upgrade.inc'; # all tests here for sharing Math-BigInt-1.999715/t/use.t0000644403072340010010000000064512631624035015466 0ustar ospjaDomain Users#!/usr/bin/perl # use Module(); doesn't call import() - thanx for cpan testers David. M. Town # and Andreas Marcel Riechert for spotting it. It is fixed by the same code # that fixes require Math::BigInt, but we make a test to be sure it really # works. use strict; use warnings; use Test::More tests => 1; my $x; use Math::BigInt (); $x = Math::BigInt->new(1); ++$x; is($x, 2, '$x = Math::BigInt->new(1); ++$x;'); Math-BigInt-1.999715/t/use_lib1.t0000644403072340010010000000064412631625017016375 0ustar ospjaDomain Users#!/usr/bin/perl # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent use strict; use warnings; use Test::More tests => 2; use lib 't'; use Math::BigFloat lib => 'BareCalc'; is(Math::BigInt->config()->{lib}, 'Math::BigInt::BareCalc', 'Math::BigInt->config()->{lib}'); is(Math::BigFloat->new(123)->badd(123), 246, 'Math::BigFloat->new(123)->badd(123)'); Math-BigInt-1.999715/t/use_lib2.t0000644403072340010010000000066612631625013016376 0ustar ospjaDomain Users#!/usr/bin/perl # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent use strict; use warnings; use Test::More tests => 2; use lib 't'; use Math::BigInt; use Math::BigFloat lib => 'BareCalc'; is(Math::BigInt->config()->{lib}, 'Math::BigInt::BareCalc', 'Math::BigInt->config()->{lib}'); is(Math::BigFloat->new(123)->badd(123), 246, 'Math::BigFloat->new(123)->badd(123)'); Math-BigInt-1.999715/t/use_lib3.t0000644403072340010010000000066612631625004016377 0ustar ospjaDomain Users#!/usr/bin/perl # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent use strict; use warnings; use Test::More tests => 2; use lib 't'; use Math::BigInt lib => 'BareCalc'; use Math::BigFloat; is(Math::BigInt->config()->{lib}, 'Math::BigInt::BareCalc', 'Math::BigInt->config()->{lib}'); is(Math::BigFloat->new(123)->badd(123), 246, 'Math::BigFloat->new(123)->badd(123)'); Math-BigInt-1.999715/t/use_lib4.t0000644403072340010010000000100212627044364016372 0ustar ospjaDomain Users#!/usr/bin/perl # see if using Math::BigInt and Math::BigFloat works together nicely. # all use_lib*.t should be equivalent, except this, since the later overrides # the former lib statement use strict; use warnings; use lib 't'; use Test::More tests => 2; use Math::BigInt lib => 'BareCalc'; use Math::BigFloat lib => 'Calc'; is(Math::BigInt->config()->{lib}, 'Math::BigInt::Calc', 'Math::BigInt->config()->{lib}'); is(Math::BigFloat->new(123)->badd(123), 246, 'Math::BigFloat->new(123)->badd(123)'); Math-BigInt-1.999715/t/use_mbfw.t0000644403072340010010000000177212631624767016517 0ustar ospjaDomain Users#!/usr/bin/perl # check that using Math::BigFloat with "with" and "lib" at the same time works # broken in versions up to v1.63 use strict; use warnings; use lib 't'; use Test::More tests => 2; # the replacement lib can handle the lib statement, but it could also ignore it # completely, for instance, when it is a 100% replacement for Math::BigInt, but # doesn't know the concept of alternative libs. But it still needs to cope with # "lib => ". SubClass does record it, so we test here essential if # Math::BigFloat hands the lib properly down, any more is outside out testing # reach. use Math::BigFloat with => 'Math::BigInt::Subclass', lib => 'BareCalc'; is(Math::BigFloat->config()->{with}, 'Math::BigInt::BareCalc', 'Math::BigFloat->config()->{with}'); # is($Math::BigInt::Subclass::lib, 'BareCalc'); # it never arrives here, but that is a design decision in SubClass is(Math::BigInt->config->{lib}, 'Math::BigInt::BareCalc', 'Math::BigInt->config->{lib}'); # all tests done Math-BigInt-1.999715/t/with_sub.t0000644403072340010010000000113212641542216016507 0ustar ospjaDomain Users#!perl # Test use Math::BigFloat with => 'Math::BigInt::SomeSubclass'; use strict; use warnings; use Test::More tests => 2409 # tests in require'd file + 1; # tests in this file use Math::BigFloat with => 'Math::BigInt::Subclass', lib => 'Calc'; our ($CLASS, $CALC); $CLASS = "Math::BigFloat"; $CALC = "Math::BigInt::Calc"; # backend # the with argument is ignored is(Math::BigFloat->config()->{with}, 'Math::BigInt::Calc', 'Math::BigFloat->config()->{with}'); require 't/bigfltpm.inc'; # all tests here for sharing Math-BigInt-1.999715/t/_e_math.t0000644403072340010010000000571212632553356016276 0ustar ospjaDomain Users#!perl # test the helper math routines in Math::BigFloat use strict; use warnings; use Test::More tests => 26; use Math::BigFloat lib => 'Calc'; ############################################################################# # add { my $a = Math::BigInt::Calc->_new("123"); my $b = Math::BigInt::Calc->_new("321"); test_add(123, 321, '+', '+'); test_add(123, 321, '+', '-'); test_add(123, 321, '-', '+'); test_add(321, 123, '-', '+'); test_add(321, 123, '+', '-'); test_add(10, 1, '+', '-'); test_add(10, 1, '-', '+'); test_add( 1, 10, '-', '+'); SKIP: { skip q|$x -> _zero() does not (yet?) modify the first argument|, 2; test_add(123, 123, '-', '+'); test_add(123, 123, '+', '-'); } test_add(123, 123, '+', '+'); test_add(123, 123, '-', '-'); test_add(0, 0, '-', '+'); test_add(0, 0, '+', '-'); test_add(0, 0, '+', '+'); test_add(0, 0, '-', '-'); # gives "-0"! TODO: fix this! } ############################################################################# # sub { my $a = Math::BigInt::Calc->_new("123"); my $b = Math::BigInt::Calc->_new("321"); test_sub(123, 321, '+', '-'); test_sub(123, 321, '-', '+'); test_sub(123, 123, '-', '+'); test_sub(123, 123, '+', '-'); SKIP: { skip q|$x -> _zero() does not (yet?) modify the first argument|, 2; test_sub(123, 123, '+', '+'); test_sub(123, 123, '-', '-'); } test_sub(0, 0, '-', '+'); # gives "-0"! TODO: fix this! test_sub(0, 0, '+', '-'); test_sub(0, 0, '+', '+'); test_sub(0, 0, '-', '-'); } ############################################################################### sub test_add { my ($a, $b, $as, $bs) = @_; my $aa = Math::BigInt::Calc -> _new($a); my $bb = Math::BigInt::Calc -> _new($b); my ($x, $xs) = Math::BigFloat::_e_add($aa, $bb, "$as", "$bs"); my $got = $xs . Math::BigInt::Calc->_str($x); my $expected = sprintf("%+d", "$as$a" + "$bs$b"); subtest qq|Math::BigFloat::_e_add($a, $b, "$as", "$bs");| => sub { plan tests => 2; is($got, $expected, 'output has the correct value'); is(Math::BigInt::Calc->_str($x), Math::BigInt::Calc->_str($aa), 'first operand to _e_add() is modified' ); }; } sub test_sub { my ($a, $b, $as, $bs) = @_; my $aa = Math::BigInt::Calc -> _new($a); my $bb = Math::BigInt::Calc -> _new($b); my ($x, $xs) = Math::BigFloat::_e_sub($aa, $bb, "$as", "$bs"); my $got = $xs . Math::BigInt::Calc->_str($x); my $expected = sprintf("%+d", "$as$a" - "$bs$b"); subtest qq|Math::BigFloat::_e_sub($a, $b, "$as", "$bs");| => sub { plan tests => 2; is($got, $expected, 'output has the correct value'); is(Math::BigInt::Calc->_str($x), Math::BigInt::Calc->_str($aa), 'first operand to _e_sub() is modified' ); }; } Math-BigInt-1.999715/TODO0000644403072340010010000000511412626121063014723 0ustar ospjaDomain UsersSee also various .pm files. General: * Copy on write (helps for $x = -$x; cases etc) (seems to make it slower :/ * run config() and die_on_nan() tests under Subclass.pm Math::BigFloat: * finish upgrading and downgrading * ! bround()/bfround(): some bugs may lurk in there * accuracy() & precision() maybe not finished (bnorm() in every op, testcases) * do not reduce numbers in new(), rather do it in anything that outputs it like bsstr(), bstr(), mantissa(), exponent() and parts(). Reducing the number after each op is slow with a binary core math lib like BitVect. * add bfract() that returns just the fractional part? * tests for frsft() and flsft() with $n != 2 * blog() is still quite slow for non-integer results. See if we can reuse the integer calculation somehow * finish broot() by using different algorithm * hexadecimal integers work, but what about '0xABC.DEF'? Really needed? Math::BigInt: * finish 'upgrade' * remove rounding overhead when no rounding is done, e.g. no $object has A nor P and neither of bround(), bround(), accuracy() or precision() was called * bround() is only used by MBF for -$scale = -$len, anyway. POD is wrong for this, too * overload of cos()/sin()/exp()/atan2() is too DWIM (should return BigInt or BigFloat, not scalar) - also document it * +5 % 0 or -5 % 0 == NaN (should it be something else?) * certain shortcuts returning bzero(), bone() etc may not set the requested rounding parameters, so that $x->foo($y,$a,$p,$r) may return $x without a set $a or $p, thus failing later on: use Test; BEGIN { plan tests => 1; } use Math::BigInt; $x = Math::BigInt->bone(); $x->bsqrt(3,0,'odd'); # $x = 0, but _a is not 3! ok ($x + '12345','12300'); # fails (12346 instead of 12300) The shortcuts in code that return $x->bzero() or similar things need to do $x->bzero($a,$p); and this needs tests. Update: Should now work for most things. Check for completeness. Given the fact that we are be able to plug-in a much faster core-lib, the following are pretty much ultra-low-priority: Math::BigInt::Calc: * look at div() for more speed (I have the hunch that the general _div() routine does way too much work for normal div (e.g. when we don't need the reminder). A simplified version could take care of this. * alternative mul() method using shifts * implement in Calc (and GMP etc) to calculate band(), bior(), bxor() for negative inputs (_signed_or() etc) * _root() doesn't scale too well Please send me test-reports, your experiences with this and your ideas - I love to hear about my work! Tels