diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Math/BigFloat.pm | 278 | ||||
| -rw-r--r-- | lib/Math/BigInt.pm | 664 | ||||
| -rw-r--r-- | lib/Math/BigInt/Calc.pm | 303 | ||||
| -rwxr-xr-x | lib/Math/BigInt/t/bigfltpm.t | 203 | ||||
| -rw-r--r-- | lib/Math/BigInt/t/bigintc.t | 139 | ||||
| -rwxr-xr-x | lib/Math/BigInt/t/bigintpm.t | 227 | ||||
| -rw-r--r-- | lib/Math/BigInt/t/mbimbf.t | 2 |
7 files changed, 1249 insertions, 567 deletions
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index 5c1eb33e3e..32f0a21c40 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -11,7 +11,7 @@ package Math::BigFloat; -$VERSION = 1.16; +$VERSION = '1.20'; require 5.005; use Exporter; use Math::BigInt qw/objectify/; @@ -22,7 +22,7 @@ use Math::BigInt qw/objectify/; badd bmul bdiv bmod bnorm bsub bgcd blcm bround bfround bpow bnan bzero bfloor bceil - bacmp bstr binc bdec bint binf + bacmp bstr binc bdec binf is_odd is_even is_nan is_inf is_positive is_negative is_zero is_one sign ); @@ -49,7 +49,6 @@ use constant MB_NEVER_ROUND => 0x0001; my $NaNOK=1; # constant for easier life my $nan = 'NaN'; -my $ten = Math::BigInt->new(10); # shortcut for speed # Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc' $rnd_mode = 'even'; @@ -57,6 +56,9 @@ $accuracy = undef; $precision = undef; $div_scale = 40; +# in case we call SUPER::->foo() and this wants to call modify() +# sub modify () { 0; } + { # checks for AUTOLOAD my %methods = map { $_ => 1 } @@ -129,19 +131,6 @@ sub new return $self; } -# some shortcuts for easier life -sub bfloat - { - # exportable version of new - return $class->new(@_); - } - -sub bint - { - # exportable version of new - return $class->new(@_,0)->bround(0,'trunc'); - } - sub bnan { # create a bigfloat 'NaN', if given a BigFloat, set it to 'NaN' @@ -151,8 +140,8 @@ sub bnan { my $c = $self; $self = {}; bless $self, $c; } - $self->{_e} = new Math::BigInt 0; - $self->{_m} = new Math::BigInt 0; + $self->{_m} = Math::BigInt->bzero(); + $self->{_e} = Math::BigInt->bzero(); $self->{sign} = $nan; return $self; } @@ -168,12 +157,29 @@ sub binf { my $c = $self; $self = {}; bless $self, $c; } - $self->{_e} = new Math::BigInt 0; - $self->{_m} = new Math::BigInt 0; + $self->{_m} = Math::BigInt->bzero(); + $self->{_e} = Math::BigInt->bzero(); $self->{sign} = $sign.'inf'; return $self; } +sub bone + { + # create a bigfloat '+-1', if given a BigFloat, set it to '+-1' + 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->{_m} = Math::BigInt->bone(); + $self->{_e} = Math::BigInt->bzero(); + $self->{sign} = $sign; + return $self; + } + sub bzero { # create a bigfloat '+0', if given a BigFloat, set it to 0 @@ -183,8 +189,8 @@ sub bzero { my $c = $self; $self = {}; bless $self, $c; } - $self->{_m} = new Math::BigInt 0; - $self->{_e} = new Math::BigInt 1; + $self->{_m} = Math::BigInt->bzero(); + $self->{_e} = Math::BigInt->bone(); $self->{sign} = '+'; return $self; } @@ -199,38 +205,66 @@ sub bstr # internal format is always normalized (no leading zeros, "-0" => "+0") my ($self,$x) = objectify(1,@_); - #return "Oups! e was $nan" if $x->{_e}->{sign} eq $nan; - #return "Oups! m was $nan" if $x->{_m}->{sign} eq $nan; - return $x->{sign} if $x->{sign} !~ /^[+-]$/; - return '0' if $x->is_zero(); - - my $es = $x->{_m}->bstr(); - if ($x->{_e}->is_zero()) + #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan; + #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan; + if ($x->{sign} !~ /^[+-]$/) { - $es = $x->{sign}.$es if $x->{sign} eq '-'; - return $es; + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf } - if ($x->{_e}->sign() eq '-') + my $es = '0'; my $len = 1; my $cad = 0; my $dot = '.'; + + my $not_zero = !$x->is_zero(); + if ($not_zero) { - if ($x->{_e} <= -CORE::length($es)) - { - # print "style: 0.xxxx\n"; - my $r = $x->{_e}->copy(); $r->babs()->bsub( CORE::length($es) ); - $es = '0.'. ('0' x $r) . $es; - } - else + $es = $x->{_m}->bstr(); + $len = CORE::length($es); + if (!$x->{_e}->is_zero()) +# { +# $es = $x->{sign}.$es if $x->{sign} eq '-'; +# } +# else { - # print "insert '.' at $x->{_e} in '$es'\n"; - substr($es,$x->{_e},0) = '.'; + if ($x->{_e}->sign() eq '-') + { + $dot = ''; + if ($x->{_e} <= -$len) + { + # print "style: 0.xxxx\n"; + my $r = $x->{_e}->copy(); $r->babs()->bsub( CORE::length($es) ); + $es = '0.'. ('0' x $r) . $es; $cad = -($len+$r); + } + else + { + # print "insert '.' at $x->{_e} in '$es'\n"; + substr($es,$x->{_e},0) = '.'; $cad = $x->{_e}; + } + } + else + { + # expand with zeros + $es .= '0' x $x->{_e}; $len += $x->{_e}; $cad = 0; + } } + } # if not zero + $es = $x->{sign}.$es if $x->{sign} eq '-'; + # if set accuracy or precision, pad with zeros + 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; + #print "acc padd $x->{_a} $zeros (len $len cad $cad)\n"; + $es .= $dot.'0' x $zeros if $zeros > 0; } - else + elsif ($x->{_p} || 0 < 0) { - # expand with zeros - $es .= '0' x $x->{_e}; + # 123400 => 6, 0.1234 => 4, 0.001234 => 6 + my $zeros = -$x->{_p} + $cad; + #print "pre padd $x->{_p} $zeros (len $len cad $cad)\n"; + $es .= $dot.'0' x $zeros if $zeros > 0; } - $es = $x->{sign}.$es if $x->{sign} eq '-'; return $es; } @@ -241,9 +275,13 @@ sub bsstr # internal format is always normalized (no leading zeros, "-0E0" => "+0E0") my ($self,$x) = objectify(1,@_); - return "Oups! e was $nan" if $x->{_e}->{sign} eq $nan; - return "Oups! m was $nan" if $x->{_m}->{sign} eq $nan; - return $x->{sign} if $x->{sign} !~ /^[+-]$/; + #die "Oups! e was $nan" if $x->{_e}->{sign} eq $nan; + #die "Oups! m was $nan" if $x->{_m}->{sign} eq $nan; + if ($x->{sign} !~ /^[+-]$/) + { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf + } my $sign = $x->{_e}->{sign}; $sign = '' if $sign eq '-'; my $sep = 'e'.$sign; return $x->{_m}->bstr().$sep.$x->{_e}->bstr(); @@ -252,7 +290,7 @@ sub bsstr sub numify { # Make a number from a BigFloat object - # simple return string and let Perl's atoi() handle the rest + # simple return string and let Perl's atoi()/atof() handle the rest my ($self,$x) = objectify(1,@_); return $x->bsstr(); } @@ -269,6 +307,10 @@ sub numify # { # $class->SUPER::bneg($class,@_); # } + +# tels 2001-08-04 +# todo: this must be overwritten and return NaN for non-integer values +# band(), bior(), bxor(), too #sub bnot # { # $class->SUPER::bnot($class,@_); @@ -292,12 +334,15 @@ sub bcmp } # check sign for speed first - return 1 if $x->{sign} eq '+' && $y->{sign} eq '-'; + 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 - return 0 if $x->is_zero() && $y->is_zero(); # 0 <=> 0 - return -1 if $x->is_zero() && $y->{sign} eq '+'; # 0 <=> +y - return 1 if $y->is_zero() && $x->{sign} eq '+'; # +x <=> 0 + # shortcut + 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 # adjust so that exponents are equal my $lx = $x->{_m}->length() + $x->{_e}; @@ -343,8 +388,24 @@ sub badd # return result as BFLOAT my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); - return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - + # inf and NaN handling + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) + { + # NaN first + return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + # inf handline + if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) + { + # + and + => +, - and - => -, + and - => 0, - and + => 0 + return $x->bzero() if $x->{sign} ne $y->{sign}; + return $x; + } + # +-inf + something => +inf + # something +-inf => +-inf + $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/; + return $x; + } + # speed: no add for 0+y or x+0 return $x if $y->is_zero(); # x+0 if ($x->is_zero()) # 0+y @@ -447,8 +508,9 @@ sub is_zero { # return true if arg (BINT or num_str) is zero (array '+', '0') my $x = shift; $x = $class->new($x) unless ref $x; - #my ($self,$x) = objectify(1,@_); - return ($x->{sign} ne $nan && $x->{_m}->is_zero()); + + return 1 if $x->{sign} eq '+' && $x->{_m}->is_zero(); + return 0; } sub is_one @@ -491,6 +553,19 @@ sub bmul # print "mbf bmul $x->{_m}e$x->{_e} $y->{_m}e$y->{_e}\n"; return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + # handle result = 0 + return $x->bzero() if $x->is_zero() || $y->is_zero(); + # inf handling + if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) + { + # 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('-'); + } + # aEb * cEd = (a*c)E(b+d) $x->{_m} = $x->{_m} * $y->{_m}; #print "m: $x->{_m}\n"; @@ -509,19 +584,32 @@ sub bdiv # (BFLOAT,BFLOAT) (quo,rem) or BINT (only rem) my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + # x / +-inf => 0, reminder x + return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero() + if $y->{sign} =~ /^[+-]inf$/; + + # NaN if x == NaN or y == NaN or x==y==0 return wantarray ? ($x->bnan(),bnan()) : $x->bnan() - if ($x->{sign} eq $nan || $y->is_nan() || $y->is_zero()); + if (($x->is_nan() || $y->is_nan()) || + ($x->is_zero() && $y->is_zero())); + + # 5 / 0 => +inf, -6 / 0 => -inf + return wantarray + ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign}) + if ($x->{sign} =~ /^[+-]$/ && $y->is_zero()); $y = $class->new($y) if ref($y) ne $class; # promote bigints # print "mbf bdiv $x ",ref($x)," ",$y," ",ref($y),"\n"; # we need to limit the accuracy to protect against overflow my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r); # ignore $p + my $fallback = 0; if (!defined $scale) { # simulate old behaviour $scale = $div_scale+1; # one more for proper riund - $a = $div_scale; # and round to it + $a = $div_scale; # and round to it + $fallback = 1; # to clear a/p afterwards } my $lx = $x->{_m}->length(); my $ly = $y->{_m}->length(); $scale = $lx if $lx > $scale; @@ -555,11 +643,23 @@ sub bdiv $x->bnorm(); # remove trailing 0's #print "after div: m: $x->{_m} e: $x->{_e}\n"; $x->round($a,$p,$r); # then round accordingly + if ($fallback) + { + # clear a/p after round, since user did not request it + $x->{_a} = undef; + $x->{_p} = undef; + } if (wantarray) { my $rem = $x->copy(); $rem->bmod($y,$a,$p,$r); + if ($fallback) + { + # clear a/p after round, since user did not request it + $x->{_a} = undef; + $x->{_p} = undef; + } return ($x,$rem); } return $x; @@ -589,11 +689,13 @@ sub bsqrt # we need to limit the accuracy to protect against overflow my ($scale) = $x->_scale_a($accuracy,$rnd_mode,$a,$r); # ignore $p + my $fallback = 0; if (!defined $scale) { # simulate old behaviour $scale = $div_scale+1; # one more for proper riund $a = $div_scale; # and round to it + $fallback = 1; # to clear a/p afterwards } my $lx = $x->{_m}->length(); $scale = $lx if $scale < $lx; @@ -602,6 +704,7 @@ sub bsqrt # start with some reasonable guess #$x *= 10 ** ($len - $org->{_e}); $x /= 2; # !?!? + $lx = $lx+$x->{_e}; $lx = 1 if $lx < 1; my $gs = Math::BigFloat->new('1'. ('0' x $lx)); @@ -622,6 +725,13 @@ sub bsqrt $gs = $x->copy(); } $x->round($a,$p,$r); + if ($fallback) + { + # clear a/p after round, since user did not request it + $x->{_a} = undef; + $x->{_p} = undef; + } + $x; } sub bpow @@ -634,7 +744,7 @@ sub bpow return $x if $x->{sign} =~ /^[+-]inf$/; return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; - return $x->bzero()->binc() if $y->is_zero(); + return $x->bone() if $y->is_zero(); return $x if $x->is_one() || $y->is_one(); my $y1 = $y->as_number(); # make bigint if ($x == -1) @@ -643,8 +753,8 @@ sub bpow return $y1->is_odd() ? $x : $x->babs(1); } return $x if $x->is_zero() && $y->{sign} eq '+'; # 0**y => 0 (if not y <= 0) - # 0 ** -y => 1 / (0 ** y) => / 0! - return $x->bnan() if $x->is_zero() && $y->{sign} eq '-'; + # 0 ** -y => 1 / (0 ** y) => / 0! (1 / 0 => +inf) + return $x->binf() if $x->is_zero() && $y->{sign} eq '-'; # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster) $y1->babs(); @@ -676,8 +786,9 @@ sub bfround my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_); return $x if !defined $scale; # no-op + # never round a 0, +-inf, NaN + return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero(); # print "MBF bfround $x to scale $scale mode $mode\n"; - return $x if $x->is_nan() or $x->is_zero(); if ($scale < 0) { @@ -705,10 +816,7 @@ sub bfround # 0.0065, scale -2, round last '0' with following '65' (scale == zad case) if ($scale < $zad) { - $x->{_m} = Math::BigInt->new(0); - $x->{_e} = Math::BigInt->new(1); - $x->{sign} = '+'; - return $x; + return $x->bzero(); } if ($scale == $zad) # for 0.006, scale -2 and trunc { @@ -738,10 +846,7 @@ sub bfround if (($scale > $dbt) && ($dbt < 0)) { # if not enough digits before dot, round to zero - $x->{_m} = Math::BigInt->new(0); - $x->{_e} = Math::BigInt->new(1); - $x->{sign} = '+'; - return $x; + return $x->bzero(); } if (($scale >= 0) && ($dbt == 0)) { @@ -762,8 +867,8 @@ sub bfround $scale = $x->{_m}->length() - $scale; } } - #print "using $scale for $x->{_m} with '$mode'\n"; - # pass sign to bround for '+inf' and '-inf' rounding modes + # print "using $scale for $x->{_m} with '$mode'\n"; + # pass sign to bround for rounding modes '+inf' and '-inf' $x->{_m}->{sign} = $x->{sign}; $x->{_m}->bround($scale,$mode); $x->{_m}->{sign} = '+'; # fix sign back @@ -782,7 +887,8 @@ sub bround # print "bround $scale $mode\n"; # 0 => return all digits, scale < 0 makes no sense return $x if ($scale <= 0); - return $x if $x->is_nan() or $x->is_zero(); # never round a 0 + # never round a 0, +-inf, NaN + return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero(); # if $e longer than $m, we have 0.0000xxxyyy style number, and must # subtract the delta from scale, to simulate keeping the zeros @@ -798,7 +904,7 @@ sub bround $x->{_m}->{sign} = $x->{sign}; $x->{_m}->bround($scale,$mode); # round mantissa $x->{_m}->{sign} = '+'; # fix sign back - return $x->bnorm(); # del trailing zeros gen. by bround() + $x->bnorm(); # del trailing zeros gen. by bround() } sub bfloor @@ -951,7 +1057,7 @@ sub bnorm $x->{_m}->brsft($zeros,10); $x->{_e} += $zeros; } # for something like 0Ey, set y to 1 - $x->{_e}->bzero()->binc() if $x->{_m}->is_zero(); + $x->{sign} = '+', $x->{_e}->bzero()->binc() if $x->{_m}->is_zero(); $x->{_m}->{_f} = MB_NEVER_ROUND; $x->{_e}->{_f} = MB_NEVER_ROUND; return $x; # MBI bnorm is no-op @@ -1243,22 +1349,7 @@ C<as_number()>: =head1 EXAMPLES - use Math::BigFloat qw(bstr bint); # not ready yet - $x = bstr("1234") # string "1234" - $x = "$x"; # same as bstr() - $x = bneg("1234") # BigFloat "-1234" - $x = Math::BigFloat->bneg("1234"); # BigFloat "1234" - $x = Math::BigFloat->babs("-12345"); # BigFloat "12345" - $x = Math::BigFloat->bnorm("-0 00"); # BigFloat "0" - $x = bint(1) + bint(2); # BigFloat "3" - $x = bint(1) + "2"; # ditto (auto-BigFloatify of "2") - $x = bint(1); # BigFloat "1" - $x = $x + 5 / 2; # BigFloat "3" - $x = $x ** 3; # BigFloat "27" - $x *= 2; # BigFloat "54" - $x = new Math::BigFloat; # BigFloat "0" - $x--; # BigFloat "-1" =head1 Autocreating constants @@ -1274,11 +1365,6 @@ 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. -=head1 PERFORMANCE - -Greatly enhanced ;o) -SectionNotReadyYet. - =head1 BUGS =over 2 diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index ec3f1f9009..42521f606a 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -12,18 +12,21 @@ # _f : flags, used by MBF to flag parts of a float as untouchable # _cow : copy on write: number of objects that share the data (NRY) +# Remember not to take shortcuts ala $xs = $x->{value}; $CALC->foo($xs); since +# underlying lib might change the reference! + package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = 1.36; +$VERSION = '1.40'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub bgcd blcm bround blsft brsft band bior bxor bnot bpow bnan bzero - bacmp bstr bsstr binc bdec bint binf bfloor bceil + bacmp bstr bsstr binc bdec binf bfloor bceil is_odd is_even is_zero is_one is_nan is_inf sign is_positive is_negative length as_number @@ -91,7 +94,7 @@ use overload '^' => sub { my @a = ref($_[0])->_swap(@_); $a[0]->bxor($a[1]); }, # can modify arg of ++ and --, so avoid a new-copy for speed, but don't -# use $_[0]->_one(), it modifies $_[0] to be 1! +# use $_[0]->__one(), it modifies $_[0] to be 1! '++' => sub { $_[0]->binc() }, '--' => sub { $_[0]->bdec() }, @@ -276,13 +279,6 @@ sub new } # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign my ($mis,$miv,$mfv,$es,$ev) = _split(\$wanted); - if (ref $mis && !ref $miv) - { - # _from_hex or _from_bin - $self->{value} = $mis->{value}; - $self->{sign} = $mis->{sign}; - return $self; # throw away $mis - } if (!ref $mis) { die "$wanted is not a number initialized to $class" if !$NaNOK; @@ -291,6 +287,13 @@ sub new $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 exp, then convert to bigint $self->{sign} = $$mis; # store sign $self->{value} = $CALC->_zero(); # for all the NaN cases @@ -339,13 +342,6 @@ sub new return $self; } -# some shortcuts for easier life -sub bint - { - # exportable version of new - return $class->new(@_); - } - sub bnan { # create a bigint 'NaN', if given a BigInt, set it to 'NaN' @@ -383,7 +379,6 @@ sub bzero # create a bigint '+0', if given a BigInt, set it to 0 my $self = shift; $self = $class if !defined $self; - #print "bzero $self\n"; if (!ref($self)) { @@ -396,6 +391,26 @@ sub bzero return $self; } +sub bone + { + # create a bigint '+1' (or -1 if given sign '-'), + # if given a BigInt, set it to +1 or -1, respecively + my $self = shift; + my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-'; + $self = $class if !defined $self; + #print "bone $self\n"; + + if (!ref($self)) + { + my $c = $self; $self = {}; bless $self, $c; + } + return if $self->modify('bone'); + $self->{value} = $CALC->_one(); + $self->{sign} = $sign; + #print "result: $self\n"; + return $self; + } + ############################################################################## # string conversation @@ -406,9 +421,13 @@ sub bsstr # internal format is always normalized (no leading zeros, "-0E0" => "+0E0") my ($self,$x) = objectify(1,@_); - return $x->{sign} if $x->{sign} !~ /^[+-]$/; + if ($x->{sign} !~ /^[+-]$/) + { + return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN + return 'inf'; # +inf + } my ($m,$e) = $x->parts(); - # can be only '+', so + # e can only be positive my $sign = 'e+'; # MBF: my $s = $e->{sign}; $s = '' if $s eq '-'; my $sep = 'e'.$s; return $m->bstr().$sign.$e->bstr(); @@ -418,7 +437,11 @@ sub bstr { # make a string from bigint object my $x = shift; $x = $class->new($x) unless ref $x; - return $x->{sign} if $x->{sign} !~ /^[+-]$/; + 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 '-'; return $es.${$CALC->_str($x->{value})}; } @@ -459,16 +482,20 @@ sub round my $r = shift; # round_mode, if given by caller my @args = @_; # all 'other' arguments (0 for unary, 1 for binary ops) + $self = new($self) unless ref($self); # if not object, make one + my $c = ref($args[0]); # find out class of argument + unshift @args,$self; # add 'first' argument + + no strict 'refs'; + my $z = "$c\::accuracy"; my $aa = $$z; my $ap = undef; + if (!defined $aa) + { + $z = "$c\::precision"; $ap = $$z; + } + # leave bigfloat parts alone return $self if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0; - unshift @args,$self; # add 'first' argument - - $self = new($self) unless ref($self); # if not object, make one - - # find out class of argument to round - my $c = ref($args[0]); - # now pick $a or $p, but only if we have got "arguments" if ((!defined $a) && (!defined $p) && (@args > 0)) { @@ -487,12 +514,7 @@ sub round # if none defined, use globals (#2) if (!defined $p) { - no strict 'refs'; - my $z = "$c\::accuracy"; $a = $$z; - if (!defined $a) - { - $z = "$c\::precision"; $p = $$z; - } + $a = $aa; $p = $ap; # save the check: if !defined $a; } } # endif !$a } # endif !$a || !$P && args > 0 @@ -513,16 +535,13 @@ sub bnorm { # (num_str or BINT) return BINT # Normalize number -- no-op here - my $self = shift; - - return $self; + return $_[0]; } sub babs { # (BINT or num_str) return BINT # make number absolute, or return absolute BINT from string - #my ($self,$x) = objectify(1,@_); my $x = shift; $x = $class->new($x) unless ref $x; return $x if $x->modify('babs'); # post-normalized abs for internal use (does nothing for NaN) @@ -534,12 +553,11 @@ sub bneg { # (BINT or num_str) return BINT # negate number or make a negated number from string - my ($self,$x,$a,$p,$r) = objectify(1,@_); + my $x = shift; $x = $class->new($x) unless ref $x; return $x if $x->modify('bneg'); # for +0 dont negate (to have always normalized) return $x if $x->is_zero(); $x->{sign} =~ tr/+\-/-+/; # does nothing for NaN - # $x->round($a,$p,$r); # changing this makes $x - $y modify $y!! $x; } @@ -553,12 +571,22 @@ sub bcmp { # 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 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 if $y->{sign} eq '-inf'; } + # 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 + + # shortcut + 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 # normal compare now &cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0; } @@ -569,8 +597,14 @@ sub bacmp # Returns one of undef, <0, =0, >0. (suitable for sort) # (BINT, BINT) return cond_code my ($self,$x,$y) = objectify(2,@_); - return undef if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); - #acmp($x->{value},$y->{value}) <=> 0; + + 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; # inf is always bigger + } $CALC->_acmp($x->{value},$y->{value}) <=> 0; } @@ -581,8 +615,25 @@ sub badd my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); return $x if $x->modify('badd'); - return $x->bnan() if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)); + # inf and NaN handling + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)) + { + # NaN first + return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + # inf handline + if (($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) + { + # + and + => +, - and - => -, + and - => 0, - and + => 0 + return $x->bzero() if $x->{sign} ne $y->{sign}; + return $x; + } + # +-inf + something => +inf + # something +-inf => +-inf + $x->{sign} = $y->{sign}, return $x if $y->{sign} =~ /^[+-]inf$/; + return $x; + } + my @bn = ($a,$p,$r,$y); # make array for round calls # speed: no add for 0+y or x+0 return $x->round(@bn) if $y->is_zero(); # x+0 @@ -590,28 +641,24 @@ sub badd { # make copy, clobbering up x $x->{value} = $CALC->_copy($y->{value}); - #$x->{value} = [ @{$y->{value}} ]; $x->{sign} = $y->{sign} || $nan; return $x->round(@bn); } - # shortcuts - my $xv = $x->{value}; - my $yv = $y->{value}; my ($sx, $sy) = ( $x->{sign}, $y->{sign} ); # get signs if ($sx eq $sy) { - $CALC->_add($xv,$yv); # if same sign, absolute add + $x->{value} = $CALC->_add($x->{value},$y->{value}); # same sign, abs add $x->{sign} = $sx; } else { - my $a = $CALC->_acmp ($yv,$xv); # absolute compare + my $a = $CALC->_acmp ($y->{value},$x->{value}); # absolute compare if ($a > 0) { #print "swapped sub (a=$a)\n"; - $CALC->_sub($yv,$xv,1); # absolute sub w/ swapped params + $x->{value} = $CALC->_sub($y->{value},$x->{value},1); # abs sub w/ swap $x->{sign} = $sy; } elsif ($a == 0) @@ -624,7 +671,7 @@ sub badd else # a < 0 { #print "unswapped sub (a=$a)\n"; - $CALC->_sub($xv, $yv); # absolute sub + $x->{value} = $CALC->_sub($x->{value}, $y->{value}); # abs sub $x->{sign} = $sx; } } @@ -649,7 +696,7 @@ sub binc my ($self,$x,$a,$p,$r) = objectify(1,@_); # my $x = shift; $x = $class->new($x) unless ref $x; my $self = ref($x); return $x if $x->modify('binc'); - $x->badd($self->_one())->round($a,$p,$r); + $x->badd($self->__one())->round($a,$p,$r); } sub bdec @@ -657,7 +704,7 @@ sub bdec # decrement arg by one my ($self,$x,$a,$p,$r) = objectify(1,@_); return $x if $x->modify('bdec'); - $x->badd($self->_one('-'))->round($a,$p,$r); + $x->badd($self->__one('-'))->round($a,$p,$r); } sub blcm @@ -709,7 +756,7 @@ sub bgcd { while (@_) { - $x = _gcd($x,shift); last if $x->is_one(); # _gcd handles NaN + $x = __gcd($x,shift); last if $x->is_one(); # _gcd handles NaN } } $x->babs(); @@ -741,10 +788,8 @@ sub is_zero #my ($self,$x) = objectify(1,@_); my $x = shift; $x = $class->new($x) unless ref $x; - return 0 if $x->{sign} !~ /^[+-]$/; + return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't return $CALC->_is_zero($x->{value}); - #return (@{$x->{value}} == 1) && ($x->{sign} eq '+') - # && ($x->{value}->[0] == 0); } sub is_nan @@ -772,13 +817,10 @@ sub is_one # or -1 if sign is given #my ($self,$x) = objectify(1,@_); my $x = shift; $x = $class->new($x) unless ref $x; - my $sign = shift || '+'; + my $sign = shift || ''; $sign = '+' if $sign ne '-'; - # catch also NaN, +inf, -inf - return 0 if $x->{sign} ne $sign || $x->{sign} !~ /^[+-]$/; + return 0 if $x->{sign} ne $sign; return $CALC->_is_one($x->{value}); - #return (@{$x->{value}} == 1) && ($x->{sign} eq $sign) - # && ($x->{value}->[0] == 1); } sub is_odd @@ -789,7 +831,6 @@ sub is_odd return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't return $CALC->_is_odd($x->{value}); - #return (($x->{sign} ne $nan) && ($x->{value}->[0] & 1)); } sub is_even @@ -800,8 +841,6 @@ sub is_even return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't return $CALC->_is_even($x->{value}); - #return (($x->{sign} ne $nan) && (!($x->{value}->[0] & 1))); - #return (($x->{sign} !~ /^[+-]$/) && ($CALC->_is_even($x->{value}))); } sub is_positive @@ -827,11 +866,23 @@ sub bmul my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); return $x if $x->modify('bmul'); - return $x->bnan() if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/)); + return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan)); + # handle result = 0 + return $x if $x->is_zero(); + return $x->bzero() if $y->is_zero(); + # inf handling + if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) + { + # 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 $x->bzero() if $x->is_zero() || $y->is_zero(); # handle result = 0 $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + - $CALC->_mul($x->{value},$y->{value}); # do actual math + $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math return $x->round($a,$p,$r,$y); } @@ -843,14 +894,23 @@ sub bdiv return $x if $x->modify('bdiv'); - # 5 / 0 => +inf, -6 / 0 => -inf (0 / 0 => 1 or +inf or NaN?) - #return wantarray - # ? ($x->binf($x->{sign}),binf($x->{sign})) : $x->binf($x->{sign}) - # if ($x->{sign} =~ /^[+-]$/ && $y->is_zero()); + # x / +-inf => 0, reminder x + return wantarray ? ($x->bzero(),$x->copy()) : $x->bzero() + if $y->{sign} =~ /^[+-]inf$/; - # NaN? + # NaN if x == NaN or y == NaN or x==y==0 return wantarray ? ($x->bnan(),bnan()) : $x->bnan() - if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $y->is_zero()); + if (($x->is_nan() || $y->is_nan()) || + ($x->is_zero() && $y->is_zero())); + + # 5 / 0 => +inf, -6 / 0 => -inf + return wantarray + ? ($x->binf($x->{sign}),$self->bnan()) : $x->binf($x->{sign}) + if ($x->{sign} =~ /^[+-]$/ && $y->is_zero()); + + # old code: always NaN if /0 + #return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan() + # if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/ || $y->is_zero()); # 0 / something return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); @@ -866,7 +926,7 @@ sub bdiv elsif ($cmp == 0) { # shortcut, both are the same, so set to +/- 1 - $x->_one( ($x->{sign} ne $y->{sign} ? '-' : '+') ); + $x->__one( ($x->{sign} ne $y->{sign} ? '-' : '+') ); return $x unless wantarray; return ($x,$self->bzero()); } @@ -913,22 +973,23 @@ sub bpow return $x if $x->{sign} =~ /^[+-]inf$/; # -inf/+inf ** x return $x->bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan; - return $x->_one() if $y->is_zero(); + return $x->__one() if $y->is_zero(); return $x if $x->is_one() || $y->is_one(); #if ($x->{sign} eq '-' && @{$x->{value}} == 1 && $x->{value}->[0] == 1) if ($x->{sign} eq '-' && $CALC->_is_one($x->{value})) { # if $x == -1 and odd/even y => +1/-1 return $y->is_odd() ? $x : $x->babs(); - # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; LOL + # my Casio FX-5500L has a bug here: -1 ** 2 is -1, but -1 * -1 is 1; } - # 1 ** -y => 1 / (1**y), so do test for negative $y after above's clause + # 1 ** -y => 1 / (1 ** |y|) + # so do test for negative $y after above's clause return $x->bnan() if $y->{sign} eq '-'; return $x if $x->is_zero(); # 0**y => 0 (if not y <= 0) if ($CALC->can('_pow')) { - $CALC->_pow($x->{value},$y->{value}); + $x->{value} = $CALC->_pow($x->{value},$y->{value}); return $x->round($a,$p,$r); } # based on the assumption that shifting in base 10 is fast, and that mul @@ -938,17 +999,17 @@ sub bpow # afterwards like this: # 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6 # creates deep recursion? - #my $zeros = $x->_trailing_zeros(); - #if ($zeros > 0) - # { - # $x->brsft($zeros,10); # remove zeros - # $x->bpow($y); # recursion (will not branch into here again) - # $zeros = $y * $zeros; # real number of zeros to add - # $x->blsft($zeros,10); - # return $x->round($a,$p,$r); - # } - - my $pow2 = $self->_one(); +# my $zeros = $x->_trailing_zeros(); +# if ($zeros > 0) +# { +# $x->brsft($zeros,10); # remove zeros +# $x->bpow($y); # recursion (will not branch into here again) +# $zeros = $y * $zeros; # real number of zeros to add +# $x->blsft($zeros,10); +# return $x->round($a,$p,$r); +# } + + my $pow2 = $self->__one(); my $y1 = $class->new($y); my ($res); while (!$y1->is_one()) @@ -975,47 +1036,15 @@ sub blsft return $x if $x->modify('blsft'); return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); - $n = 2 if !defined $n; return $x if $n == 0; - return $x->bnan() if $n < 0 || $y->{sign} eq '-'; - #if ($n != 10) - # { - $x->bmul( $self->bpow($n, $y) ); - # } - #else - # { - # # shortcut (faster) for shifting by 10) since we are in base 10eX - # # multiples of 5: - # my $src = scalar @{$x->{value}}; # source - # my $len = $y->numify(); # shift-len as normal int - # my $rem = $len % 5; # reminder to shift - # my $dst = $src + int($len/5); # destination - # - # my $v = $x->{value}; # speed-up - # my $vd; # further speedup - # #print "src $src:",$v->[$src]||0," dst $dst:",$v->[$dst]||0," rem $rem\n"; - # $v->[$src] = 0; # avoid first ||0 for speed - # while ($src >= 0) - # { - # $vd = $v->[$src]; $vd = '00000'.$vd; - # #print "s $src d $dst '$vd' "; - # $vd = substr($vd,-5+$rem,5-$rem); - # #print "'$vd' "; - # $vd .= $src > 0 ? substr('00000'.$v->[$src-1],-5,$rem) : '0' x $rem; - # #print "'$vd' "; - # $vd = substr($vd,-5,5) if length($vd) > 5; - # #print "'$vd'\n"; - # $v->[$dst] = int($vd); - # $dst--; $src--; - # } - # # set lowest parts to 0 - # while ($dst >= 0) { $v->[$dst--] = 0; } - # # fix spurios last zero element - # splice @$v,-1 if $v->[-1] == 0; - # #print "elems: "; my $i = 0; - # #foreach (reverse @$v) { print "$i $_ "; $i++; } print "\n"; - # # old way: $x->bmul( $self->bpow($n, $y) ); - # } - return $x; + $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; + + my $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft'); + if (defined $t) + { + $x->{value} = $t; return $x; + } + # fallback + return $x->bmul( $self->bpow($n, $y) ); } sub brsft @@ -1028,48 +1057,14 @@ sub brsft return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; - #if ($n != 10) - # { - scalar bdiv($x, $self->bpow($n, $y)); - # } - #else - # { - # # shortcut (faster) for shifting by 10) - # # multiples of 5: - # my $dst = 0; # destination - # my $src = $y->numify(); # as normal int - # my $rem = $src % 5; # reminder to shift - # $src = int($src / 5); # source - # my $len = scalar @{$x->{value}} - $src; # elems to go - # my $v = $x->{value}; # speed-up - # if ($rem == 0) - # { - # splice (@$v,0,$src); # even faster, 38.4 => 39.3 - # } - # else - # { - # my $vd; - # $v->[scalar @$v] = 0; # avoid || 0 test inside loop - # while ($dst < $len) - # { - # $vd = '00000'.$v->[$src]; - # #print "$dst $src '$vd' "; - # $vd = substr($vd,-5,5-$rem); - # #print "'$vd' "; - # $src++; - # $vd = substr('00000'.$v->[$src],-$rem,$rem) . $vd; - # #print "'$vd1' "; - # #print "'$vd'\n"; - # $vd = substr($vd,-5,5) if length($vd) > 5; - # $v->[$dst] = int($vd); - # $dst++; - # } - # splice (@$v,$dst) if $dst > 0; # kill left-over array elems - # pop @$v if $v->[-1] == 0; # kill last element - # } # else rem == 0 - # # old way: scalar bdiv($x, $self->bpow($n, $y)); - # } - return $x; + + my $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft'); + if (defined $t) + { + $x->{value} = $t; return $x; + } + # fallback + return scalar bdiv($x, $self->bpow($n, $y)); } sub band @@ -1083,28 +1078,34 @@ sub band return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); return $x->bzero() if $y->is_zero(); - if ($CALC->can('_and')) + my $sign = 0; # sign of result + $sign = 1 if ($x->{sign} eq '-') && ($y->{sign} eq '-'); + my $sx = 1; $sx = -1 if $x->{sign} eq '-'; + my $sy = 1; $sy = -1 if $y->{sign} eq '-'; + + if ($CALC->can('_and') && $sx == 1 && $sy == 1) { - $CALC->_and($x->{value},$y->{value}); + $x->{value} = $CALC->_and($x->{value},$y->{value}); return $x->round($a,$p,$r); } - + my $m = new Math::BigInt 1; my ($xr,$yr); - my $x10000 = new Math::BigInt (0x10000); - my $y1 = copy(ref($x),$y); # make copy - my $x1 = $x->copy(); $x->bzero(); # modify x in place! + my $x10000 = new Math::BigInt (0x1000); + my $y1 = copy(ref($x),$y); # make copy + $y1->babs(); # and positive + my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! + use integer; # need this for negative bools while (!$x1->is_zero() && !$y1->is_zero()) { ($x1, $xr) = bdiv($x1, $x10000); ($y1, $yr) = bdiv($y1, $x10000); - #print ref($xr), " $xr ", $xr->numify(),"\n"; - #print ref($yr), " $yr ", $yr->numify(),"\n"; - #print "res: ",$yr->numify() & $xr->numify(),"\n"; - my $u = bmul( $class->new( $xr->numify() & $yr->numify() ), $m); - #print "res: $u\n"; - $x->badd( bmul( $class->new( $xr->numify() & $yr->numify() ), $m)); + # make both op's numbers! + $x->badd( bmul( $class->new( + abs($sx*int($xr->numify()) & $sy*int($yr->numify()))), + $m)); $m->bmul($x10000); } + $x->bneg() if $sign; return $x->round($a,$p,$r); } @@ -1118,23 +1119,37 @@ sub bior return $x->bnan() if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/); return $x if $y->is_zero(); - if ($CALC->can('_or')) + + my $sign = 0; # sign of result + $sign = 1 if ($x->{sign} eq '-') || ($y->{sign} eq '-'); + my $sx = 1; $sx = -1 if $x->{sign} eq '-'; + my $sy = 1; $sy = -1 if $y->{sign} eq '-'; + + # don't use lib for negative values + if ($CALC->can('_or') && $sx == 1 && $sy == 1) { - $CALC->_or($x->{value},$y->{value}); + $x->{value} = $CALC->_or($x->{value},$y->{value}); return $x->round($a,$p,$r); } my $m = new Math::BigInt 1; my ($xr,$yr); my $x10000 = new Math::BigInt (0x10000); - my $y1 = copy(ref($x),$y); # make copy - my $x1 = $x->copy(); $x->bzero(); # modify x in place! + my $y1 = copy(ref($x),$y); # make copy + $y1->babs(); # and positive + my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! + use integer; # need this for negative bools while (!$x1->is_zero() || !$y1->is_zero()) { ($x1, $xr) = bdiv($x1,$x10000); ($y1, $yr) = bdiv($y1,$x10000); - $x->badd( bmul( $class->new( $xr->numify() | $yr->numify() ), $m)); + # make both op's numbers! + $x->badd( bmul( $class->new( + abs($sx*int($xr->numify()) | $sy*int($yr->numify()))), + $m)); +# $x->badd( bmul( $class->new(int($xr->numify()) | int($yr->numify())), $m)); $m->bmul($x10000); } + $x->bneg() if $sign; return $x->round($a,$p,$r); } @@ -1150,23 +1165,36 @@ sub bxor return $x if $y->is_zero(); return $x->bzero() if $x == $y; # shortcut - if ($CALC->can('_xor')) + my $sign = 0; # sign of result + $sign = 1 if $x->{sign} ne $y->{sign}; + my $sx = 1; $sx = -1 if $x->{sign} eq '-'; + my $sy = 1; $sy = -1 if $y->{sign} eq '-'; + + # don't use lib for negative values + if ($CALC->can('_xor') && $sx == 1 && $sy == 1) { - $CALC->_xor($x->{value},$y->{value}); + $x->{value} = $CALC->_xor($x->{value},$y->{value}); return $x->round($a,$p,$r); } my $m = new Math::BigInt 1; my ($xr,$yr); my $x10000 = new Math::BigInt (0x10000); my $y1 = copy(ref($x),$y); # make copy - my $x1 = $x->copy(); $x->bzero(); # modify x in place! + $y1->babs(); # and positive + my $x1 = $x->copy()->babs(); $x->bzero(); # modify x in place! + use integer; # need this for negative bools while (!$x1->is_zero() || !$y1->is_zero()) { ($x1, $xr) = bdiv($x1, $x10000); ($y1, $yr) = bdiv($y1, $x10000); - $x->badd( bmul( $class->new( $xr->numify() ^ $yr->numify() ), $m)); + # make both op's numbers! + $x->badd( bmul( $class->new( + abs($sx*int($xr->numify()) ^ $sy*int($yr->numify()))), + $m)); +# $x->badd( bmul( $class->new(int($xr->numify()) ^ int($yr->numify())), $m)); $m->bmul($x10000); } + $x->bneg() if $sign; return $x->round($a,$p,$r); } @@ -1196,7 +1224,7 @@ sub _trailing_zeros my $x = shift; $x = $class->new($x) unless ref $x; - return 0 if $x->is_zero() || $x->is_nan() || $x->is_inf(); + return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/; return $CALC->_zeros($x->{value}) if $CALC->can('_zeros'); @@ -1324,7 +1352,7 @@ sub bround # print "MBI round: $x to $scale $mode\n"; # -scale means what? tom? hullo? -$scale needed by MBF round, but what for? - return $x if $x->is_nan() || $x->is_zero() || $scale == 0; + return $x if $x->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0; # we have fewer digits than we want to scale to my $len = $x->length(); @@ -1397,9 +1425,9 @@ sub bround } elsif ($pad > $len) { - $x->{value} = $CALC->_zero(); # round to '0' + $x->bzero(); # round to '0' } - #print "res $$xs\n"; + # print "res $pad $len $x $$xs\n"; } # move this later on after the inc of the string #$x->{value} = $CALC->_new($xs); # put back in @@ -1442,11 +1470,10 @@ sub bceil ############################################################################## # private stuff (internal use only) -sub _one +sub __one { # internal speedup, set argument to 1, or create a +/- 1 my $self = shift; - #my $x = $self->bzero(); $x->{value} = [ 1 ]; $x->{sign} = shift || '+'; $x; my $x = $self->bzero(); $x->{value} = $CALC->_one(); $x->{sign} = shift || '+'; return $x; @@ -1502,7 +1529,7 @@ sub objectify # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y # Math::BigInt::badd(1,2); => scalar x, scalar y # In the last case we check number of arguments to turn it silently into - # $class,1,2. (We cannot take '1' as class ;o) + # $class,1,2. (We can not take '1' as class ;o) # badd($class,1) is not supported (it should, eventually, try to add undef) # currently it tries 'Math::BigInt' + 1, which will not work. @@ -1592,7 +1619,7 @@ sub import { # this causes a different low lib to take care... $CALC = $_[$i+1] || $CALC; - my $s = 2; $s = 1 if @a-$j < 2; # avoid "cannot modify non-existant..." + my $s = 2; $s = 1 if @a-$j < 2; # avoid "can not modify non-existant..." splice @a, $j, $s; $j -= $s; } } @@ -1601,36 +1628,30 @@ sub import #$self->SUPER::import(@a); # does not work $self->export_to_level(1,$self,@a); # need this instead - # load core math lib - $CALC = 'Math::BigInt::'.$CALC if $CALC !~ /^Math::BigInt/i; - my $c = $CALC; - $c =~ s!::!/!g; # XXX portability, e.g. MacOS? - $c .= '.pm' if $c !~ /\.pm$/; - require $c; + # try to load core math lib + my @c = split /\s*,\s*/,$CALC; + push @c,'Calc'; # if all fail, try this + foreach my $lib (@c) + { + $lib = 'Math::BigInt::'.$lib if $lib !~ /^Math::BigInt/i; + $lib =~ s/\.pm$//; + if ($] < 5.6) + { + # Perl < 5.6.0 dies with "out of memory!" when eval() and ':constant' is + # used in the same script, or eval inside import(). + (my $mod = $lib . '.pm') =~ s!::!/!g; + # require does not automatically :: => /, so portability problems arise + eval { require $mod; $lib->import(); } + } + else + { + eval "use $lib;"; + } + $CALC = $lib, last if $@ eq ''; + } } -sub _strip_zeros - { - # internal normalization function that strips leading zeros from the array - # args: ref to array - my $s = shift; - - my $cnt = scalar @$s; # get count of parts - my $i = $cnt-1; - #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 - return $s; - } - -sub _from_hex +sub __from_hex { # convert a (ref to) big hex string to BigInt, return undef for error my $hs = shift; @@ -1668,7 +1689,7 @@ sub _from_hex return $x; } -sub _from_bin +sub __from_bin { # convert a (ref to) big binary string to BigInt, return undef for error my $bs = shift; @@ -1711,22 +1732,31 @@ sub _split { # (ref to num_str) return num_str # internal, take apart a string and return the pieces + # strip leading/trailing whitespace, leading zeros, underscore, reject + # invalid input my $x = shift; - # pre-parse input - $$x =~ s/^\s+//g; # strip white space at front + # strip white space at front, also extranous leading zeros + $$x =~ s/^\s*([-]?)0*([0-9])/$1$2/g; # will not strip ' .2' + $$x =~ s/^\s+//; # but this will $$x =~ s/\s+$//g; # strip white space at end - #$$x =~ s/\s+//g; # strip white space (no longer) - return if $$x eq ""; - return _from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string - return _from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string + # shortcut, if nothing to split, return early + if ($$x =~ /^[+-]?\d+$/) + { + $$x =~ s/^([+-])0*([0-9])/$2/; my $sign = $1 || '+'; + return (\$sign, $x, \'', \'', \0); + } - return if $$x !~ /^[\-\+]?\.?[0-9]/; + # invalid starting char? + return if $$x !~ /^[+-]?(\.?[0-9]|0b[0-1]|0x[0-9a-fA-F])/; $$x =~ s/(\d)_(\d)/$1$2/g; # strip underscores between digits $$x =~ s/(\d)_(\d)/$1$2/g; # do twice for 1_2_3 + return __from_hex($x) if $$x =~ /^[\-\+]?0x/; # hex string + return __from_bin($x) if $$x =~ /^[\-\+]?0b/; # binary string + # 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 @@ -1809,7 +1839,7 @@ sub _lcm return $x * $ty / bgcd($x,$ty); } -sub _gcd +sub __gcd { # (BINT or num_str, BINT or num_str) return BINT # does modify first arg @@ -1844,13 +1874,17 @@ Math::BigInt - Arbitrary size integer math package use Math::BigInt; # Number creation - $x = Math::BigInt->new($str); # defaults to 0 - $nan = Math::BigInt->bnan(); # create a NotANumber - $zero = Math::BigInt->bzero();# create a "+0" + $x = Math::BigInt->new($str); # defaults to 0 + $nan = Math::BigInt->bnan(); # create a NotANumber + $zero = Math::BigInt->bzero(); # create a +0 + $inf = Math::BigInt->binf(); # create a +inf + $inf = Math::BigInt->binf('-'); # create a -inf + $one = Math::BigInt->bone(); # create a +1 + $one = Math::BigInt->bone('-'); # create a -1 # Testing - $x->is_zero(); # return whether arg is zero or not - $x->is_nan(); # return whether arg is NaN or not + $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 @@ -1870,6 +1904,8 @@ Math::BigInt - Arbitrary size integer math package # set $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->bneg(); # negation $x->babs(); # absolute value @@ -1984,7 +2020,7 @@ 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 other people or documentation). +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. @@ -2000,16 +2036,19 @@ because 1200 can have p = 0, 1 or 2 (depending on what the inital value was). It could also have p < 0, when the digits after the decimal point are zero. - !The string output of such a number should be padded with zeros: - ! - ! Initial value P 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 +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 @@ -2018,9 +2057,20 @@ 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 both A and P are undefined, this is used as a fallback accuracy when +dividing numbers. =head2 Rounding mode R @@ -2165,9 +2215,9 @@ This is how it works now: operation according to the rules below * Negative P is ignored in Math::BigInt, since BigInts never have digits after the decimal point - !* Math::BigFloat uses Math::BigInts internally, but setting A or P inside - ! Math::BigInt as globals should not tamper with the parts of a BigFloat. - ! Thus a flag is used to mark all Math::BigFloat numbers as 'never round' + * Math::BigFloat uses Math::BigInts internally, but setting A or P inside + Math::BigInt as globals should not tamper with the parts of a BigFloat. + Thus a flag is used to mark all Math::BigFloat numbers as 'never round' =item Precedence @@ -2191,7 +2241,7 @@ This is how it works now: * fdiv will calculate 1 more digit 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 cannot be helped - or can it?) + or P of 5, but this can not be helped - or can it?) * Thus you can have the math done by on Math::Big* class in three modes: + never round (this is the default): This is done by setting A and P to undef. No math operation @@ -2289,28 +2339,41 @@ This is how it works now: =head1 INTERNALS -The actual numbers are stored as unsigned big integers, and math with them is -done (by default) by a module called Math::BigInt::Calc. This is equivalent to: +The actual numbers are stored as unsigned big integers (with seperate sign). +You should neither care about nor depend on the internal representation; it +might change without notice. Use only method calls like C<< $x->sign(); >> +instead relying on the internal hash keys like in C<< $x->{sign}; >>. + +=head2 MATH LIBRARY - use Math::BigInt lib => 'calc'; +Math with the numbers is done (by default) by a module called +Math::BigInt::Calc. This is equivalent to saying: + + use Math::BigInt lib => 'Calc'; You can change this by using: use Math::BigInt lib => 'BitVect'; -('Math::BitInt::BitVect' works, too.) +The following would first try to find Math::BigInt::Foo, then +Math::BigInt::Bar, and when this also fails, revert to Math::BigInt::Calc: -Calc.pm uses as internal format an array of elements of base 100000 digits -with the least significant digit first, BitVect.pm uses a bit vector of base 2, -most significant bit first. + use Math::BigInt lib => 'Foo,Math::BigInt::Bar'; -The sign C</^[+-]$/> is stored separately. The string 'NaN' is used to -represent the result when input arguments are not numbers. '+inf' and -'-inf' represent infinity. +Calc.pm uses as internal format an array of elements of some decimal base +(usually 1e5, but this might change to 1e7) with the least significant digit +first, while BitVect.pm uses a bit vector of base 2, most significant bit +first. Other modules might use even different means of representing the +numbers. See the respective module documentation for further details. -You should neither care about nor depend on the internal representation; it -might change without notice. Use only method calls like C<< $x->sign(); >> -instead of relying on the internal hash keys like in C<< $x->{sign}; >>. +=head2 SIGN + +The sign is either '+', '-', 'NaN', '+inf' or '-inf' and stored seperately. + +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() @@ -2325,9 +2388,10 @@ that: C<< ($m,$e) = $x->parts() >> is just a shortcut that gives you both of them in one go. Both the returned mantissa and exponent have a sign. -Currently, for BigInts C<$e> will be always 0, except for NaN where it will be -NaN and for $x == 0, then it will be 1 (to be compatible with Math::BigFloat's -internal representation of a zero as C<0E1>). +Currently, for BigInts C<$e> will be always 0, except for NaN, +inf and -inf, +where it will be NaN; and for $x == 0, where it will be 1 +(to be compatible with Math::BigFloat's internal representation of a zero as +C<0E1>). C<$m> will always be a copy of the original number. The relation between $e and $m might change in the future, but will always be equivalent in a @@ -2335,7 +2399,10 @@ numerical sense, e.g. $m might get minimized. =head1 EXAMPLES - use Math::BigInt qw(bstr bint); + use Math::BigInt qw(bstr); + + sub bint { Math::BigInt->new(shift); } + $x = bstr("1234") # string "1234" $x = "$x"; # same as bstr() $x = bneg("1234") # Bigint "-1234" @@ -2421,37 +2488,47 @@ operations may be slower for small numbers, but are significantly faster for big numbers. Other operations are now constant (O(1), like bneg(), babs() etc), instead of O(N) and thus nearly always take much less time. -For more benchmark results see http://bloodgate.com/perl/benchmarks.html +If you find the Calc module to slow, try to install any of the replacement +modules and see if they help you. -=head2 Replacing the math library +=head2 Alternative math libraries You can use an alternative library to drive Math::BigInt via: use Math::BigInt lib => 'Module'; -The default is called Math::BigInt::Calc and is a pure-perl base 100,000 -math package that consists of the standard routine present in earlier versions -of Math::BigInt. +The default is called Math::BigInt::Calc and is a pure-perl implementation +that consists mainly of the standard routine present in earlier versions of +Math::BigInt. There are also Math::BigInt::Scalar (primarily for testing) and -Math::BigInt::BitVect; these and others can be found via -L<http://search.cpan.org/>: +Math::BigInt::BitVect; as well as Math::BigInt::Pari and likely others. +All these can be found via L<http://search.cpan.org/>: use Math::BigInt lib => 'BitVect'; my $x = Math::BigInt->new(2); print $x ** (1024*1024); +For more benchmark results see http://bloodgate.com/perl/benchmarks.html + =head1 BUGS =over 2 -=item :constant and eval() +=item Out of Memory! Under Perl prior to 5.6.0 having an C<use Math::BigInt ':constant';> and C<eval()> in your code will crash with "Out of memory". This is probably an overload/exporter bug. You can workaround by not having C<eval()> -and ':constant' at the same time or upgrade your Perl. +and ':constant' at the same time or upgrade your Perl to a newer version. + +=item Fails to load Calc on Perl prior 5.6.0 + +Since eval(' use ...') can not be used in conjunction with ':constant', BigInt +will fall back to eval { require ... } when loading the math lib on Perls +prior to 5.6.0. This simple replaces '::' with '/' and thus might fail on +filesystems using a different seperator. =back @@ -2511,6 +2588,9 @@ as 1e+308. If in doubt, convert both arguments to Math::BigInt before doing eq: $y = Math::BigInt->new($y); ok ($x,$y); # okay +There is not yet a way to get a number automatically represented in exactly +the way Perl represents it. + =item int() C<int()> will return (at least for Perl v5.7.1 and up) another BigInt, not a @@ -2528,6 +2608,8 @@ In all Perl versions you can use C<as_number()> for the same effect: This also works for other subclasses, like Math::String. +It is yet unlcear whether overloaded int() should return a scalar or a BigInt. + =item bdiv The following will probably not do what you expect: @@ -2548,8 +2630,8 @@ real-valued quotient of the two operands, and the remainder (when it is nonzero) always has the same sign as the second operand; so, for example, - 1 / 4 => ( 0, 1) - 1 / -4 => (-1,-3) + 1 / 4 => ( 0, 1) + 1 / -4 => (-1,-3) -3 / 4 => (-1, 1) -3 / -4 => ( 0,-3) @@ -2591,7 +2673,7 @@ See also the documentation for overload.pm regarding C<=>. =item bpow C<bpow()> (and the rounding functions) now modifies the first argument and -return it, unlike the old code which left it alone and only returned the +returns it, unlike the old code which left it alone and only returned the result. This is to be consistent with C<badd()> etc. The first three will modify $x, the last one won't: @@ -2703,6 +2785,8 @@ the same terms as Perl itself. L<Math::BigFloat> and L<Math::Big>. +L<Math::BigInt::BitVect> and L<Math::BigInt::Pari>. + =head1 AUTHORS Original code by Mark Biggar, overloaded interface by Ilya Zakharevich. diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index 23ff06329d..c42fc4043d 100644 --- a/lib/Math/BigInt/Calc.pm +++ b/lib/Math/BigInt/Calc.pm @@ -2,7 +2,7 @@ package Math::BigInt::Calc; use 5.005; use strict; -use warnings; +# use warnings; # dont use warnings for older Perls require Exporter; @@ -17,8 +17,9 @@ use vars qw/ @ISA @EXPORT $VERSION/; _is_zero _is_one _is_even _is_odd _check _zero _one _copy _zeros + _rsft _lsft ); -$VERSION = '0.06'; +$VERSION = '0.09'; # Package to store unsigned big integers in decimal and do math with them @@ -39,10 +40,37 @@ $VERSION = '0.06'; # constants for easier life my $nan = 'NaN'; -my $BASE_LEN = 5; + +my $BASE_LEN = 7; my $BASE = int("1e".$BASE_LEN); # var for trying to change it to 1e7 -my $RBASE = 1e-5; # see USE_MUL -my $class = 'Math::BigInt::Calc'; +my $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL + +BEGIN + { + # Daniel Pfeiffer: determine largest group of digits that is precisely + # multipliable with itself plus carry + my ($e, $num) = 4; + do { + $num = ('9' x ++$e) + 0; + $num *= $num + 1; + } until ($num == $num - 1 or $num - 1 == $num - 2); + $BASE_LEN = $e-1; + $BASE = int("1e".$BASE_LEN); + $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL + } + +# for quering and setting, to debug/benchmark things +sub _base_len + { + my $b = shift; + if (defined $b) + { + $BASE_LEN = $b; + $BASE = int("1e".$BASE_LEN); + $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL + } + $BASE_LEN; + } ############################################################################## # create objects from various representations @@ -52,12 +80,12 @@ sub _new # (string) return ref to num_array # Convert a number from string format to internal base 100000 format. # Assumes normalized value as input. - shift @_ if $_[0] eq $class; - my $d = shift; + my $d = $_[1]; # print "_new $d $$d\n"; my $il = CORE::length($$d)-1; # these leaves '00000' instead of int 0 and will be corrected after any op - return [ reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $$d)) ]; + return [ reverse(unpack("a" . ($il % $BASE_LEN+1) + . ("a$BASE_LEN" x ($il / $BASE_LEN)), $$d)) ]; } sub _zero @@ -74,9 +102,7 @@ sub _one sub _copy { - shift @_ if $_[0] eq $class; - my $x = shift; - return [ @$x ]; + return [ @{$_[1]} ]; } ############################################################################## @@ -87,8 +113,7 @@ sub _str # (ref to BINT) return num_str # Convert number from internal base 100000 format to string format. # internal format is always normalized (no leading zeros, "-0" => "+0") - shift @_ if $_[0] eq $class; - my $ar = shift; + my $ar = $_[1]; my $ret = ""; my $l = scalar @$ar; # number of parts return $nan if $l < 1; # should not happen @@ -96,10 +121,11 @@ sub _str # leading zero parts in internal representation) $l --; $ret .= $ar->[$l]; $l--; # Interestingly, the pre-padd method uses more time - # the old grep variant takes longer (14 to 10 sec) + # the old grep variant takes longer (14 to 10 sec) + my $z = '0' x ($BASE_LEN-1); while ($l >= 0) { - $ret .= substr('0000'.$ar->[$l],-5); # fastest way I could think of + $ret .= substr($z.$ar->[$l],-$BASE_LEN); # fastest way I could think of $l--; } return \$ret; @@ -108,8 +134,7 @@ sub _str sub _num { # Make a number (scalar int/float) from a BigInt object - shift @_ if $_[0] eq $class; - my $x = shift; + my $x = $_[1]; return $x->[0] if scalar @$x == 1; # below $BASE my $fac = 1; my $num = 0; @@ -126,13 +151,12 @@ sub _num sub _add { # (ref to int_num_array, ref to int_num_array) - # routine to add two base 1e5 numbers + # 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 clobbers up array x, but not y. - shift @_ if $_[0] eq $class; - my ($x,$y) = @_; + my ($c,$x,$y) = @_; # 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 @@ -155,10 +179,9 @@ sub _add sub _sub { # (ref to int_num_array, ref to int_num_array) - # subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y + # subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y # subtract Y from X (X is always greater/equal!) by modifying x in place - shift @_ if $_[0] eq $class; - my ($sx,$sy,$s) = @_; + my ($c,$sx,$sy,$s) = @_; my $car = 0; my $i; my $j = 0; if (!$s) @@ -198,41 +221,39 @@ sub _mul # (BINT, BINT) return nothing # multiply two numbers in internal representation # modifies first arg, second need not be different from first - shift @_ if $_[0] eq $class; - my ($xv,$yv) = @_; + my ($c,$xv,$yv) = @_; my @prod = (); my ($prod,$car,$cty,$xi,$yi); # since multiplying $x with $x fails, make copy in this case - $yv = [@$xv] if "$xv" eq "$yv"; - # looping through @$y if $xi == 0 is silly! optimize it! + $yv = [@$xv] if "$xv" eq "$yv"; # same references? 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 * 1e-5)) * $BASE; # see USE_MUL + $prod - ($car = int($prod * $RBASE)) * $BASE; # see USE_MUL } $prod[$cty] += $car if $car; # need really to check for 0? $xi = shift @prod; } -# for $xi (@$xv) -# { -# $car = 0; $cty = 0; -# # looping through this if $xi == 0 is silly! optimize it! -# if (($xi||0) != 0) -# { -# for $yi (@$yv) -# { -# $prod = $prod[$cty]; $prod += ($car + $xi * $yi); # no ||0 here -# $prod[$cty++] = -# $prod - ($car = int($prod * 1e-5)) * $BASE; # see USE_MUL -# } -# } -# $prod[$cty] += $car if $car; # need really to check for 0? -# $xi = shift @prod; -# } push @$xv, @prod; __strip_zeros($xv); # normalize (handled last to save check for $y->is_zero() @@ -244,8 +265,7 @@ sub _div # ref to array, ref to array, modify first array and return remainder if # in list context # no longer handles sign - shift @_ if $_[0] eq $class; - my ($x,$yorg) = @_; + my ($c,$x,$yorg) = @_; my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1); my (@d,$tmp,$q,$u2,$u1,$u0); @@ -280,7 +300,7 @@ sub _div #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; $q = (($u0 == $v1) ? 99999 : int(($u0*$BASE+$u1)/$v1)); - --$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*$BASE+$u2); + --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2); if ($q) { ($car, $bar) = (0,0); @@ -288,14 +308,14 @@ sub _div { $prd = $q * $y->[$yi] + $car; $prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL - $x->[$xi] += 1e5 if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + $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] -= 1e5 + $x->[$xi] -= $BASE if ($car = (($x->[$xi] += $y->[$yi] + $car) > $BASE)); } } @@ -330,6 +350,98 @@ sub _div } ############################################################################## +# shifts + +sub _rsft + { + my ($c,$x,$y,$n) = @_; + + if ($n != 10) + { + return; # we cant do this here, due to now _pow, so signal failure + } + else + { + # shortcut (faster) for shifting by 10) + # multiples of $BASE_LEN + my $dst = 0; # destination + my $src = _num($c,$y); # as normal int + my $rem = $src % $BASE_LEN; # reminder to shift + $src = int($src / $BASE_LEN); # source + if ($rem == 0) + { + splice (@$x,0,$src); # even faster, 38.4 => 39.3 + } + else + { + my $len = scalar @$x - $src; # elems to go + my $vd; my $z = '0'x $BASE_LEN; + $x->[scalar @$x] = 0; # avoid || 0 test inside loop + while ($dst < $len) + { + $vd = $z.$x->[$src]; + #print "$dst $src '$vd' "; + $vd = substr($vd,-$BASE_LEN,$BASE_LEN-$rem); + #print "'$vd' "; + $src++; + $vd = substr($z.$x->[$src],-$rem,$rem) . $vd; + #print "'$vd1' "; + #print "'$vd'\n"; + $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; # kill last element if 0 + } # else rem == 0 + } + $x; + } + +sub _lsft + { + my ($c,$x,$y,$n) = @_; + + if ($n != 10) + { + return; # we cant do this here, due to now _pow, so signal failure + } + else + { + # shortcut (faster) for shifting by 10) since we are in base 10eX + # multiples of $BASE_LEN: + my $src = scalar @$x; # source + my $len = _num($c,$y); # shift-len as normal int + my $rem = $len % $BASE_LEN; # reminder to shift + my $dst = $src + int($len/$BASE_LEN); # destination + my $vd; # further speedup + #print "src $src:",$x->[$src]||0," dst $dst:",$v->[$dst]||0," rem $rem\n"; + $x->[$src] = 0; # avoid first ||0 for speed + my $z = '0' x $BASE_LEN; + while ($src >= 0) + { + $vd = $x->[$src]; $vd = $z.$vd; + #print "s $src d $dst '$vd' "; + $vd = substr($vd,-$BASE_LEN+$rem,$BASE_LEN-$rem); + #print "'$vd' "; + $vd .= $src > 0 ? substr($z.$x->[$src-1],-$BASE_LEN,$rem) : '0' x $rem; + #print "'$vd' "; + $vd = substr($vd,-$BASE_LEN,$BASE_LEN) if length($vd) > $BASE_LEN; + #print "'$vd'\n"; + $x->[$dst] = int($vd); + $dst--; $src--; + } + # set lowest parts to 0 + while ($dst >= 0) { $x->[$dst--] = 0; } + # fix spurios last zero element + splice @$x,-1 if $x->[-1] == 0; + #print "elems: "; my $i = 0; + #foreach (reverse @$v) { print "$i $_ "; $i++; } print "\n"; + } + $x; + } + +############################################################################## # testing sub _acmp @@ -338,15 +450,16 @@ sub _acmp # ref to array, ref to array, return <0, 0, >0 # arrays must have at least one entry; this is not checked for - shift @_ if $_[0] eq $class; - my ($cx, $cy) = @_; + my ($c,$cx, $cy) = @_; #print "$cx $cy\n"; my ($i,$a,$x,$y,$k); # calculate length based on digits, not parts - $x = _len($cx); $y = _len($cy); + $x = _len('',$cx); $y = _len('',$cy); # print "length: ",($x-$y),"\n"; - return $x-$y if ($x - $y); # if different in length + my $lxy = $x - $y; # if different in length + return -1 if $lxy < 0; + return 1 if $lxy > 0; #print "full compare\n"; $i = 0; $a = 0; # first way takes 5.49 sec instead of 4.87, but has the early out advantage @@ -359,7 +472,9 @@ sub _acmp # print "$cx->[$j] $cy->[$j] $a",$cx->[$j]-$cy->[$j],"\n"; last if ($a = $cx->[$j] - $cy->[$j]); $j--; } - return $a; + return 1 if $a > 0; + return -1 if $a < 0; + return 0; # equal # while it early aborts, it is even slower than the manual variant #grep { return $a if ($a = $_ - $cy->[$i++]); } @$cx; # grep way, go trough all (bad for early ne) @@ -372,28 +487,25 @@ sub _len # computer number of digits in bigint, minus the sign # int() because add/sub sometimes leaves strings (like '00005') instead of # int ('5') in this place, causing length to fail - shift @_ if $_[0] eq $class; - my $cx = shift; + my $cx = $_[1]; - return (@$cx-1)*5+length(int($cx->[-1])); + return (@$cx-1)*$BASE_LEN+length(int($cx->[-1])); } sub _digit { # return the nth digit, negative values count backward # zero is rightmost, so _digit(123,0) will give 3 - shift @_ if $_[0] eq $class; - my $x = shift; - my $n = shift || 0; + my ($c,$x,$n) = @_; - my $len = _len($x); + my $len = _len('',$x); $n = $len+$n if $n < 0; # -1 last, -2 second-to-last $n = abs($n); # if negative was too big $len--; $n = $len if $n > $len; # n to big? - my $elem = int($n / 5); # which array element - my $digit = $n % 5; # which digit in this element + my $elem = int($n / $BASE_LEN); # which array element + my $digit = $n % $BASE_LEN; # which digit in this element $elem = '0000'.@$x[$elem]; # get element padded with 0's return substr($elem,-$digit-1,1); } @@ -403,20 +515,19 @@ sub _zeros # return amount of trailing zeros in decimal # check each array elem in _m for having 0 at end as long as elem == 0 # Upon finding a elem != 0, stop - shift @_ if $_[0] eq $class; - my $x = shift; + my $x = $_[1]; 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 *= 5; # elems * 5 - $zeros += CORE::length($elem); # count trailing zeros - last; # early out + $elem = "$e"; # preserve x + $elem =~ s/.*?(0*$)/$1/; # strip anything not zero + $zeros *= $BASE_LEN; # elems * 5 + $zeros += CORE::length($elem); # count trailing zeros + last; # early out } - $zeros ++; # real else branch: 50% slower! + $zeros ++; # real else branch: 50% slower! } return $zeros; } @@ -427,32 +538,28 @@ sub _zeros sub _is_zero { # return true if arg (BINT or num_str) is zero (array '+', '0') - shift @_ if $_[0] eq $class; - my ($x) = shift; + my $x = $_[1]; return (((scalar @$x == 1) && ($x->[0] == 0))) <=> 0; } sub _is_even { # return true if arg (BINT or num_str) is even - shift @_ if $_[0] eq $class; - my ($x) = shift; + my $x = $_[1]; return (!($x->[0] & 1)) <=> 0; } sub _is_odd { # return true if arg (BINT or num_str) is even - shift @_ if $_[0] eq $class; - my ($x) = shift; + my $x = $_[1]; return (($x->[0] & 1)) <=> 0; } sub _is_one { # return true if arg (BINT or num_str) is one (array '+', '1') - shift @_ if $_[0] eq $class; - my ($x) = shift; + my $x = $_[1]; return (scalar @$x == 1) && ($x->[0] == 1) <=> 0; } @@ -460,8 +567,6 @@ sub __strip_zeros { # internal normalization function that strips leading zeros from the array # args: ref to array - #trace(@_); - shift @_ if $_[0] eq $class; my $s = shift; my $cnt = scalar @$s; # get count of parts @@ -485,9 +590,8 @@ sub __strip_zeros sub _check { # no checks yet, pull it out from the test suite - shift @_ if $_[0] eq $class; + my $x = $_[1]; - my ($x) = shift; return "$x is not a reference" if !ref($x); # are all parts are valid? @@ -529,7 +633,7 @@ was rewritten to use library modules for core math routines. Any module which follows the same API as this can be used instead by using the following call: - use Math::BigInt Calc => BigNum; + use Math::BigInt lib => BigNum; =head1 EXPORT @@ -601,8 +705,32 @@ Input strings come in as unsigned but with prefix (i.e. as '123', '0xabc' or '0b1101'). Testing of input parameter validity is done by the caller, so you need not -worry about underflow (C<_sub()>, C<_dec()>) nor about division by zero or -similar cases. +worry about underflow (f.i. in C<_sub()>, C<_dec()>) nor about division by +zero or similar cases. + +The first parameter can be modified, that includes the possibility that you +return a reference to a completely different object instead. Although keeping +the reference the same is prefered. + +Return values are always references to objects or strings. Exceptions are +C<_lsft()> and C<_rsft()>, which return undef if they can not shift the +argument. This is used to delegate shifting of bases different than 10 back +to BigInt, which will use some generic code to calculate the result. + +=head1 WRAP YOUR OWN + +If you want to port your own favourite c-lib for big numbers to the +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 the following line: + + use Math::BigInt; + +by + + use Math::BigInt lib => 'yourlib'; + +This way you ensure that your library really works 100% within Math::BigInt. =head1 LICENSE @@ -617,6 +745,7 @@ Seperated from BigInt and shaped API with the help of John Peacock. =head1 SEE ALSO -L<Math::BigInt>, L<Math::BigFloat>. +L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect> and +L<Math::BigInt::Pari>. =cut diff --git a/lib/Math/BigInt/t/bigfltpm.t b/lib/Math/BigInt/t/bigfltpm.t index e8a1cc2462..a30563d21e 100755 --- a/lib/Math/BigInt/t/bigfltpm.t +++ b/lib/Math/BigInt/t/bigfltpm.t @@ -8,11 +8,11 @@ BEGIN $| = 1; unshift @INC, '../lib'; # for running manually # chdir 't' if -d 't'; - plan tests => 945; + plan tests => 1158; } -use Math::BigFloat; use Math::BigInt; +use Math::BigFloat; my ($x,$y,$f,@args,$ans,$try,$ans1,$ans1_str,$setup); while (<DATA>) @@ -47,10 +47,21 @@ while (<DATA>) $try .= "\$x;"; } elsif ($f eq "binf") { $try .= "\$x->binf('$args[1]');"; + } elsif ($f eq "bnan") { + $try .= "\$x->bnan();"; + } elsif ($f eq "numify") { + $try .= "\$x->numify();"; + } elsif ($f eq "bone") { + $try .= "\$x->bone('$args[1]');"; + } elsif ($f eq "bstr") { + $try .= "\$x->accuracy($args[1]); \$x->precision($args[2]);"; + $try .= '$x->bstr();'; } elsif ($f eq "bsstr") { - $try .= "\$x->bsstr();"; + $try .= '$x->bsstr();'; + } elsif ($f eq "parts") { + $try .= '($a,$b) = $x->parts(); "$a $b";'; } elsif ($f eq "fneg") { - $try .= "-\$x;"; + $try .= '$x->bneg();'; } elsif ($f eq "bfloor") { $try .= "\$x->bfloor();"; } elsif ($f eq "bceil") { @@ -59,6 +70,10 @@ while (<DATA>) $try .= "\$x->is_zero()+0;"; } elsif ($f eq "is_one") { $try .= "\$x->is_one()+0;"; + } elsif ($f eq "is_positive") { + $try .= "\$x->is_positive()+0;"; + } elsif ($f eq "is_negative") { + $try .= "\$x->is_negative()+0;"; } elsif ($f eq "is_odd") { $try .= "\$x->is_odd()+0;"; } elsif ($f eq "is_even") { @@ -66,7 +81,11 @@ while (<DATA>) } elsif ($f eq "as_number") { $try .= "\$x->as_number();"; } elsif ($f eq "fabs") { - $try .= "abs \$x;"; + $try .= '$x->babs();'; + } elsif ($f eq "finc") { + $try .= '++$x;'; + } elsif ($f eq "fdec") { + $try .= '--$x;'; }elsif ($f eq "fround") { $try .= "$setup; \$x->fround($args[1]);"; } elsif ($f eq "ffround") { @@ -153,15 +172,48 @@ __END__ -123.456:-123 -200:-200 &binf -1:+:+inf +1:+:inf 2:-:-inf -3:abc:+inf -&bsstr -+inf:+inf +3:abc:inf +&numify +0:0e+1 ++1:1e+0 +1234:1234e+0 +NaN:NaN ++inf:inf -inf:-inf +&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 +abcbsstr:NaN +1234.567:1234567e-3 +&bstr ++inf:::inf +-inf:::-inf +abcbsstr:::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 &fnorm -+inf:+inf ++inf:inf -inf:-inf +infinity:NaN +-inf:NaN @@ -201,6 +253,14 @@ abc:NaN -123456E-2:-1234.56 1e1:10 2e-11:0.00000000002 +# excercise _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 &fpow @@ -215,12 +275,14 @@ abc:NaN 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 ++inf:-123.45:inf -inf:-123.45:-inf &fneg -abc:NaN +fnegNaN:NaN ++inf:-inf +-inf:inf +0:0 +1:-1 -1:1 @@ -229,7 +291,9 @@ abc:NaN +123.456789:-123.456789 -123456.789:123456.789 &fabs -abc:NaN +fabsNaN:NaN ++inf:inf +-inf:inf +0:0 +1:1 -1:1 @@ -239,6 +303,10 @@ abc:NaN -123456.789:123456.789 &fround $rnd_mode = "trunc" ++inf:5:inf +-inf:5:-inf +0:5:0 +NaNfround:5:NaN +10123456789:5:10123000000 -10123456789:5:-10123000000 +10123456789.123:5:10123000000 @@ -294,6 +362,10 @@ $rnd_mode = "even" -60123456789.0123:5:-60123000000 &ffround $rnd_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 @@ -424,9 +496,9 @@ $rnd_mode = "even" 0.01234567:-9:0.01234567 0.01234567:-12:0.01234567 &fcmp -abc:abc: -abc:+0: -+0:abc: +fcmpNaN:fcmpNaN: +fcmpNaN:+0: ++0:fcmpNaN: +0:+0:0 -1:+0:-1 +0:-1:1 @@ -482,15 +554,43 @@ abc:+0: +inf:-54321.12345:1 +inf:+inf:0 -inf:-inf:0 ++inf:-inf:1 +-inf:+inf:-1 # return undef +inf:NaN: -NaN:+inf: +NaN:inf: -inf:NaN: NaN:-inf: +&fdec +fdecNaN:NaN ++inf:inf +-inf:-inf ++0:-1 ++1:0 +-1:-2 +1.23:0.23 +-1.23:-2.23 +&finc +fincNaN:NaN ++inf:inf +-inf:-inf ++0:1 ++1:2 +-1:0 +1.23:2.23 +-1.23:-0.23 &fadd abc:abc:NaN abc:+0:NaN +0:abc:NaN ++inf:-inf:0 +-inf:+inf:0 ++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 @@ -530,6 +630,14 @@ abc:+0:NaN abc:abc:NaN abc:+0:NaN +0:abc:NaN ++inf:-inf:inf +-inf:+inf:-inf ++inf:+inf:0 +-inf:-inf:0 +baddNaN:+inf:NaN +baddNaN:+inf:NaN ++inf:baddNaN:NaN +-inf:baddNaN:NaN +0:+0:0 +1:+0:1 +0:+1:-1 @@ -568,6 +676,22 @@ abc:+0:NaN 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 @@ -604,17 +728,23 @@ $div_scale = 40; $Math::BigFloat::rnd_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:NaN ++1:+0:inf ++3214:+0:inf +0:-1:0 --1:+0:NaN +-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 @@ -683,7 +813,7 @@ $div_scale = 40 -16:NaN -123.45:NaN nanfsqrt:NaN -+inf:+inf ++inf:inf -inf:NaN +1:1 +2:1.41421356237309504880168872420969807857 @@ -721,12 +851,39 @@ abc:0 -inf:0 123.456:0 -123.456:0 +&is_positive +0:1 +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 1 +1:1 0 +123:123 0 +-123:-123 0 +-1200:-12 2 &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 @@ -735,7 +892,7 @@ NaNzero:0 &bfloor 0:0 abc:NaN -+inf:+inf ++inf:inf -inf:-inf 1:1 -51:-51 @@ -744,7 +901,7 @@ abc:NaN &bceil 0:0 abc:NaN -+inf:+inf ++inf:inf -inf:-inf 1:1 -51:-51 diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t index cb880bab68..9c82d65e0d 100644 --- a/lib/Math/BigInt/t/bigintc.t +++ b/lib/Math/BigInt/t/bigintc.t @@ -8,66 +8,121 @@ BEGIN $| = 1; # chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 29; + plan tests => 52; } -# testing of Math::BigInt::Calc, primarily for interface/api and not for the +# testing of Math::BigInt::BitVect, primarily for interface/api and not for the # math functionality use Math::BigInt::Calc; -my $s123 = \'123'; my $s321 = \'321'; +my $C = 'Math::BigInt::Calc'; # pass classname to sub's + # _new and _str -my $x = _new($s123); my $u = _str($x); -ok ($$u,123); ok ($x->[0],123); ok (@$x,1); -my $y = _new($s321); +my $x = _new($C,\"123"); my $y = _new($C,\"321"); +ok (ref($x),'ARRAY'); ok (${_str($C,$x)},123); ok (${_str($C,$y)},321); # _add, _sub, _mul, _div -ok (${_str(_add($x,$y))},444); -ok (${_str(_sub($x,$y))},123); -ok (${_str(_mul($x,$y))},39483); -ok (${_str(_div($x,$y))},123); - -# division with reminder -my $z = _new(\"111"); - _mul($x,$y); -ok (${_str($x)},39483); -_add($x,$z); -ok (${_str($x)},39594); -my ($re,$rr) = _div($x,$y); +ok (${_str($C,_add($C,$x,$y))},444); +ok (${_str($C,_sub($C,$x,$y))},123); +ok (${_str($C,_mul($C,$x,$y))},39483); +ok (${_str($C,_div($C,$x,$y))},123); -ok (${_str($re)},123); ok (${_str($rr)},111); +ok (${_str($C,_mul($C,$x,$y))},39483); +ok (${_str($C,$x)},39483); +ok (${_str($C,$y)},321); +my $z = _new($C,\"2"); +ok (${_str($C,_add($C,$x,$z))},39485); +my ($re,$rr) = _div($C,$x,$y); -# _copy -$x = _new(\"12356"); -ok (${_str(_copy($x))},12356); - -# digit -$x = _new(\"123456789"); -ok (_digit($x,0),9); -ok (_digit($x,1),8); -ok (_digit($x,2),7); -ok (_digit($x,-1),1); -ok (_digit($x,-2),2); -ok (_digit($x,-3),3); +ok (${_str($C,$re)},123); ok (${_str($C,$rr)},2); # is_zero, _is_one, _one, _zero -$x = _new(\"12356"); -ok (_is_zero($x),0); -ok (_is_one($x),0); +ok (_is_zero($C,$x),0); +ok (_is_one($C,$x),0); -# _zeros -$x = _new(\"1256000000"); ok (_zeros($x),6); -$x = _new(\"152"); ok (_zeros($x),0); -$x = _new(\"123000"); ok (_zeros($x),3); +ok (_is_one($C,_one()),1); ok (_is_one($C,_zero()),0); +ok (_is_zero($C,_zero()),1); ok (_is_zero($C,_one()),0); + +# is_odd, is_even +ok (_is_odd($C,_one()),1); ok (_is_odd($C,_zero()),0); +ok (_is_even($C,_one()),0); ok (_is_even($C,_zero()),1); -ok (_is_one(_one()),1); ok (_is_one(_zero()),0); -ok (_is_zero(_zero()),1); ok (_is_zero(_one()),0); +# _digit +$x = _new($C,\"123456789"); +ok (_digit($C,$x,0),9); +ok (_digit($C,$x,1),8); +ok (_digit($C,$x,2),7); +ok (_digit($C,$x,-1),1); +ok (_digit($C,$x,-2),2); +ok (_digit($C,$x,-3),3); + +# _copy +$x = _new($C,\"12356"); +ok (${_str($C,_copy($C,$x))},12356); + +# _zeros +$x = _new($C,\"1256000000"); ok (_zeros($C,$x),6); +$x = _new($C,\"152"); ok (_zeros($C,$x),0); +$x = _new($C,\"123000"); ok (_zeros($C,$x),3); + +# _lsft, _rsft +$x = _new($C,\"10"); $y = _new($C,\"3"); +ok (${_str($C,_lsft($C,$x,$y,10))},10000); +$x = _new($C,\"20"); $y = _new($C,\"3"); +ok (${_str($C,_lsft($C,$x,$y,10))},20000); +$x = _new($C,\"128"); $y = _new($C,\"4"); +if (!defined _lsft($C,$x,$y,2)) + { + ok (1,1) + } +else + { + ok ('_lsft','undef'); + } +$x = _new($C,\"1000"); $y = _new($C,\"3"); +ok (${_str($C,_rsft($C,$x,$y,10))},1); +$x = _new($C,\"20000"); $y = _new($C,\"3"); +ok (${_str($C,_rsft($C,$x,$y,10))},20); +$x = _new($C,\"256"); $y = _new($C,\"4"); +if (!defined _rsft($C,$x,$y,2)) + { + ok (1,1) + } +else + { + ok ('_rsft','undef'); + } -ok (_check($x),0); -ok (_check(123),'123 is not a reference'); +# _acmp +$x = _new($C,\"123456789"); +$y = _new($C,\"987654321"); +ok (_acmp($C,$x,$y),-1); +ok (_acmp($C,$y,$x),1); +ok (_acmp($C,$x,$x),0); +ok (_acmp($C,$y,$y),0); + +# _div +$x = _new($C,\"3333"); $y = _new($C,\"1111"); +ok (${_str($C, scalar _div($C,$x,$y))},3); +$x = _new($C,\"33333"); $y = _new($C,\"1111"); ($x,$y) = _div($C,$x,$y); +ok (${_str($C,$x)},30); ok (${_str($C,$y)},3); +$x = _new($C,\"123"); $y = _new($C,\"1111"); +($x,$y) = _div($C,$x,$y); ok (${_str($C,$x)},0); ok (${_str($C,$y)},123); + +# _num +$x = _new($C,\"12345"); $x = _num($C,$x); ok (ref($x)||'',''); ok ($x,12345); + +# should not happen: +# $x = _new($C,\"-2"); $y = _new($C,\"4"); ok (_acmp($C,$x,$y),-1); + +# _check +$x = _new($C,\"123456789"); +ok (_check($C,$x),0); +ok (_check($C,123),'123 is not a reference'); # done 1; + diff --git a/lib/Math/BigInt/t/bigintpm.t b/lib/Math/BigInt/t/bigintpm.t index f2663de26d..9e84e20ee6 100755 --- a/lib/Math/BigInt/t/bigintpm.t +++ b/lib/Math/BigInt/t/bigintpm.t @@ -8,9 +8,9 @@ BEGIN $| = 1; # chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 1222; + plan tests => 1424; } -my $version = '1.36'; # for $VERSION tests, match current release (by hand!) +my $version = '1.40'; # for $VERSION tests, match current release (by hand!) ############################################################################## # for testing inheritance of _swap @@ -18,6 +18,7 @@ my $version = '1.36'; # for $VERSION tests, match current release (by hand!) package Math::Foo; use Math::BigInt; +#use Math::BigInt lib => 'BitVect'; # for testing use vars qw/@ISA/; @ISA = (qw/Math::BigInt/); @@ -46,9 +47,8 @@ package main; use Math::BigInt; #use Math::BigInt lib => 'BitVect'; # for testing -#use Math::BigInt lib => 'Small'; # for testing -my $CALC = Math::BigInt::_core_lib(); +my $CALC = Math::BigInt::_core_lib(); ok ($CALC,'Math::BigInt::Calc'); my (@args,$f,$try,$x,$y,$z,$a,$exp,$ans,$ans1,@a,$m,$e,$round_mode); @@ -81,10 +81,18 @@ while (<DATA>) $try .= '$x->is_odd()+0;'; } elsif ($f eq "is_even") { $try .= '$x->is_even()+0;'; + } elsif ($f eq "is_negative") { + $try .= '$x->is_negative()+0;'; + } elsif ($f eq "is_positive") { + $try .= '$x->is_positive()+0;'; } elsif ($f eq "is_inf") { $try .= "\$x->is_inf('$args[1]')+0;"; } elsif ($f eq "binf") { $try .= "\$x->binf('$args[1]');"; + } elsif ($f eq "bone") { + $try .= "\$x->bone('$args[1]');"; + } elsif ($f eq "bnan") { + $try .= "\$x->bnan();"; } elsif ($f eq "bfloor") { $try .= '$x->bfloor();'; } elsif ($f eq "bceil") { @@ -92,9 +100,9 @@ while (<DATA>) } elsif ($f eq "bsstr") { $try .= '$x->bsstr();'; } elsif ($f eq "bneg") { - $try .= '-$x;'; + $try .= '$x->bneg();'; } elsif ($f eq "babs") { - $try .= 'abs $x;'; + $try .= '$x->babs();'; } elsif ($f eq "binc") { $try .= '++$x;'; } elsif ($f eq "bdec") { @@ -130,6 +138,8 @@ while (<DATA>) $try .= "\$x * \$y;"; }elsif ($f eq "bdiv"){ $try .= "\$x / \$y;"; + }elsif ($f eq "bdiv-list"){ + $try .= 'join (",",$x->bdiv($y));'; }elsif ($f eq "bmod"){ $try .= "\$x % \$y;"; }elsif ($f eq "bgcd") @@ -199,7 +209,7 @@ while (<DATA>) } # endwhile data tests close DATA; -# XXX Tels 06/29/2001 following tests never fail or do not work :( +# XXX Tels 06/29/2001 following tests never fail or do not work :( !? # test whether use Math::BigInt qw/version/ works $try = "use Math::BigInt ($version.'1');"; @@ -214,21 +224,27 @@ $ans1 = eval $try; ok ( $ans1, "1427247692705959881058285969449495136382746624"); # test wether Math::BigInt::Small via use works (w/ dff. spellings of calc) -#$try = "use Math::BigInt ($version,'CALC','Small');"; +#$try = "use Math::BigInt ($version,'lib','Small');"; #$try .= ' $x = 2**10; $x = "$x";'; #$ans1 = eval $try; #ok ( $ans1, "1024"); -#$try = "use Math::BigInt ($version,'cAlC','Math::BigInt::Small');"; +#$try = "use Math::BigInt ($version,'LiB','Math::BigInt::Small');"; #$try .= ' $x = 2**10; $x = "$x";'; #$ans1 = eval $try; #ok ( $ans1, "1024"); # test wether calc => undef (array element not existing) works -#$try = "use Math::BigInt ($version,'CALC');"; +#$try = "use Math::BigInt ($version,'LIB');"; #$try = "require Math::BigInt; Math::BigInt::import($version,'CALC');"; #$try .= ' $x = Math::BigInt->new(2)**10; $x = "$x";'; #$ans1 = eval $try; #ok ( $ans1, 1024); +# test whether fallback to calc works +$try = "use Math::BigInt ($version,'lib','foo, bar , ');"; +$try .= ' Math::BigInt::_core_lib();'; +$ans1 = eval $try; +ok ( $ans1, "Math::BigInt::Calc"); + # test some more @a = (); for (my $i = 1; $i < 10; $i++) @@ -237,11 +253,16 @@ for (my $i = 1; $i < 10; $i++) } ok "@a", "1 2 3 4 5 6 7 8 9"; -# test whether selfmultiplication works correctly (result is 2**64) +# test whether self-multiplication works correctly (result is 2**64) $try = '$x = new Math::BigInt "+4294967296";'; $try .= '$a = $x->bmul($x);'; $ans1 = eval $try; print "# Tried: '$try'\n" if !ok ($ans1, Math::BigInt->new(2) ** 64); +# test self-pow +$try = '$x = Math::BigInt->new(10);'; +$try .= '$a = $x->bpow($x);'; +$ans1 = eval $try; +print "# Tried: '$try'\n" if !ok ($ans1, Math::BigInt->new(10) ** 10); # test whether op destroys args or not (should better not) @@ -343,6 +364,9 @@ $ans = eval $try; print "# For '$try'\n" if (!ok "$ans" , "ok" ); ############################################################################### +# the followin tests only make sense with Math::BigInt::Calc + +############################################################################### # check proper length of internal arrays $x = Math::BigInt->new(99999); is_valid($x); @@ -350,8 +374,7 @@ $x += 1; ok ($x,100000); is_valid($x); $x -= 1; ok ($x,99999); is_valid($x); ############################################################################### -# check numify, these tests only make sense with Math::BigInt::Calc, since -# only this uses $BASE +# check numify my $BASE = int(1e5); # should access Math::BigInt::Calc::BASE $x = Math::BigInt->new($BASE-1); ok ($x->numify(),$BASE-1); @@ -380,6 +403,25 @@ ok ($z, 100000); ok ($x, 23456); ############################################################################### +# bug in shortcut in mul() + +# construct a number with a zero-hole of BASE_LEN +my $bl = Math::BigInt::Calc::_base_len(); +$x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl; +$y = '1' x (2*$bl); +#print "$x * $y\n"; +$x = Math::BigInt->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; + } +#print "$y $d\n"; +$y .= $bl x (3*$bl-1) . $d . '0' x $bl; +ok ($x,$y); + +############################################################################### # bug with rest "-0" in div, causing further div()s to fail $x = Math::BigInt->new('-322056000'); ($x,$y) = $x->bdiv('-12882240'); @@ -477,6 +519,12 @@ ok ($x,-3); ok (ref($x),'Math::Foo'); ############################################################################### +# test whether +inf eq inf + +$y = 1e1000000; # create inf, since bareword inf does not work +$x = Math::BigInt->new('+inf'); ok ($x,$y); + +############################################################################### # all tests done ############################################################################### @@ -516,6 +564,20 @@ sub is_valid } __END__ +&is_negative +0:0 +-1:1 +1:0 ++inf:0 +-inf:1 +NaNneg:0 +&is_positive +0:1 +-1:0 +1:1 ++inf:1 +-inf:0 +NaNneg:0 &is_odd abc:0 0:0 @@ -548,6 +610,24 @@ abc:0 +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 # binary input @@ -561,6 +641,8 @@ abc:0 0b011:3 0b101:5 0b1000000000000000000000000000000:1073741824 +0b_101:NaN +0b1_0_1:5 # hex input -0x0:0 0xabcdefgh:NaN @@ -569,8 +651,10 @@ abc:0 -0xABCDEF:-11259375 -0x1234:-4660 0x12345678:305419896 +0x1_2_3_4_56_78:305419896 +0x_123:NaN # inf input -+inf:+inf ++inf:inf -inf:-inf 0inf:NaN # normal input @@ -621,10 +705,22 @@ E23:NaN -1010E-2:NaN -1.01E+1:NaN -1.01E-1:NaN +1234.00:1234 +&bnan +1:NaN +2:NaN +abc:NaN +&bone +2:+:+1 +2:-:-1 +boneNaN:-:-1 +boneNaN:+:+1 +2:abc:+1 +3::+1 &binf -1:+:+inf +1:+:inf 2:-:-inf -3:abc:+inf +3:abc:inf &is_inf +inf::1 -inf::1 @@ -677,6 +773,9 @@ abc:abc:NaN 100:1e+2 abc:NaN &bneg +bnegNaN:NaN ++inf:-inf +-inf:inf abd:NaN +0:+0 +1:-1 @@ -684,16 +783,18 @@ abd:NaN +123456789:-123456789 -123456789:+123456789 &babs -abc:NaN +babsNaN:NaN ++inf:inf +-inf:inf +0:+0 +1:+1 -1:+1 +123456789:+123456789 -123456789:+123456789 &bcmp -abc:abc: -abc:+0: -+0:abc: +bcmpNaN:bcmpNaN: +bcmpNaN:+0: ++0:bcmpNaN: +0:+0:0 -1:+0:-1 +0:-1:1 @@ -723,18 +824,24 @@ abc:+0: +inf:-5432112345:1 +inf:+inf:0 -inf:-inf:0 ++inf:-inf:1 +-inf:+inf:-1 # return undef +inf:NaN: -NaN:+inf: +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 @@ -742,6 +849,14 @@ abc:NaN abc:abc:NaN abc:+0:NaN +0:abc:NaN ++inf:-inf:0 +-inf:+inf:0 ++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 @@ -780,6 +895,10 @@ abc:+0:NaN abc:abc:NaN abc:+0:NaN +0:abc:NaN ++inf:-inf:inf +-inf:+inf:-inf ++inf:+inf:0 +-inf:-inf:0 +0:+0:+0 +1:+0:+1 +0:+1:-1 @@ -818,6 +937,14 @@ abc:+0:NaN 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 @@ -850,18 +977,23 @@ abc:+0:NaN +25:+25:+625 +12345:+12345:+152399025 +99999:+11111:+1111088889 +&bdiv-list +100:20:5,0 +4095:4095:1,0 +-4095:-4095:1,0 +4095:-4095:-1,0 +-4095:4095:-1,0 &bdiv abc:abc:NaN abc:+1:abc:NaN -# really? -#+5:0:+inf -#-5:0:-inf +1:abc:NaN +0:+0:NaN ++5:0:inf +-5:0:-inf ++1:+0:inf +0:+1:+0 -+1:+0:NaN +0:-1:+0 --1:+0:NaN +-1:+0:-inf +1:+1:+1 -1:-1:+1 +1:-1:-1 @@ -900,6 +1032,8 @@ abc:+1:abc:NaN 1:-3:-1 -5:3:-2 4:-3:-2 +123:+inf:0 +123:-inf:0 &bmod abc:abc:NaN abc:+1:abc:NaN @@ -948,6 +1082,7 @@ abc:+1:abc:NaN -2:-3:-2 4:-3:-2 1:-3:-2 +4095:4095:0 &bgcd abc:abc:NaN abc:+0:NaN @@ -983,6 +1118,12 @@ abc:0:NaN +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 &bior abc:abc:NaN abc:0:NaN @@ -992,6 +1133,11 @@ abc:0:NaN +281474976710656:+0:+281474976710656 +281474976710656:+1:+281474976710657 +281474976710656:+281474976710656:+281474976710656 +-2:-3:-1 +-1:-1:-1 +-6:-6:-6 +-7:4:-3 +-4:7:-1 &bxor abc:abc:NaN abc:0:NaN @@ -1001,11 +1147,21 @@ abc:0:NaN +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 &bnot abc:NaN +0:-1 +8:-9 +281474976710656:-281474976710657 +-1:0 +-2:1 +-12:11 &digit 0:0:0 12:0:2 @@ -1075,9 +1231,9 @@ abc:12:NaN -2:-1:NaN 2:-2:NaN -2:-2:NaN -+inf:1234500012:+inf ++inf:1234500012:inf -inf:1234500012:-inf -+inf:-12345000123:+inf ++inf:-12345000123:inf -inf:-12345000123:-inf # 1 ** -x => 1 / (1 ** x) -1:0:1 @@ -1124,6 +1280,10 @@ abc:12:NaN Nan: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 @@ -1201,11 +1361,16 @@ $round_mode('even') &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 @@ -1213,12 +1378,18 @@ NaNzero:0 # floor and ceil tests 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 diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t index 3948102f0e..51cf41b212 100644 --- a/lib/Math/BigInt/t/mbimbf.t +++ b/lib/Math/BigInt/t/mbimbf.t @@ -157,7 +157,7 @@ $z = $y - $x; ok ($z,530.9); $z = $y * $x; ok ($z,80780); $z = $x ** 2; ok ($z,15241); $z = $x * $x; ok ($z,15241); -# not yet: $z = -$x; ok ($z,-123.46); ok ($x,123.456); +# not: $z = -$x; ok ($z,-123.46); ok ($x,123.456); $z = $x->copy(); $z->{_a} = 2; $z = $z / 2; ok ($z,62); $x = Math::BigFloat->new(123456); $x->{_a} = 4; $z = $x->copy; $z++; ok ($z,123500); |