X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMath%2FBigInt.pm;h=a1b7b8f18f88071f379d0869356bd2cb000515c9;hb=bb2cbcd1ec679f28ec7f1a4f685707a368d32502;hp=8a0d47f6b8874213668cb937d703ca4f58728c79;hpb=17baacb7566a50d23189ae645624597ecca41aab;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index 8a0d47f..a1b7b8f 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -10,7 +10,6 @@ # _a : accuracy # _p : precision # _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! @@ -19,21 +18,19 @@ package Math::BigInt; my $class = "Math::BigInt"; require 5.005; -$VERSION = '1.41'; +$VERSION = '1.47'; use Exporter; @ISA = qw( Exporter ); @EXPORT_OK = qw( bneg babs bcmp badd bmul bdiv bmod bnorm bsub - bgcd blcm - bround + bgcd blcm bround blsft brsft band bior bxor bnot bpow bnan bzero 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 - objectify _swap + length as_number objectify _swap ); #@EXPORT = qw( ); -use vars qw/$rnd_mode $accuracy $precision $div_scale/; +use vars qw/$round_mode $accuracy $precision $div_scale $rnd_mode/; use strict; # Inside overload, the first arg is always an object. If the original code had @@ -66,12 +63,18 @@ use overload '-=' => sub { $_[0]->bsub($_[1]); }, '*=' => sub { $_[0]->bmul($_[1]); }, '/=' => sub { scalar $_[0]->bdiv($_[1]); }, +'%=' => sub { $_[0]->bmod($_[1]); }, +'^=' => sub { $_[0]->bxor($_[1]); }, +'&=' => sub { $_[0]->band($_[1]); }, +'|=' => sub { $_[0]->bior($_[1]); }, '**=' => sub { $_[0]->bpow($_[1]); }, +'..' => \&_pointpoint, + '<=>' => sub { $_[2] ? - $class->bcmp($_[1],$_[0]) : - $class->bcmp($_[0],$_[1])}, -'cmp' => sub { + ref($_[0])->bcmp($_[1],$_[0]) : + ref($_[0])->bcmp($_[0],$_[1])}, +'cmp' => sub { $_[2] ? $_[1] cmp $_[0]->bstr() : $_[0]->bstr() cmp $_[1] }, @@ -106,9 +109,10 @@ use overload return $t; }, -qw( -"" bstr -0+ numify), # Order of arguments unsignificant +# the original qw() does not work with the TIESCALAR below, why? +# Order of arguments unsignificant +'""' => sub { $_[0]->bstr(); }, +'0+' => sub { $_[0]->numify(); } ; ############################################################################## @@ -122,59 +126,128 @@ my $nan = 'NaN'; # constants for easier life my $CALC = 'Math::BigInt::Calc'; # module to do low level math sub _core_lib () { return $CALC; } # for test suite -# Rounding modes, one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc' -$rnd_mode = 'even'; -$accuracy = undef; -$precision = undef; -$div_scale = 40; +$round_mode = 'even'; # one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc' +$accuracy = undef; +$precision = undef; +$div_scale = 40; + +############################################################################## +# the old code had $rnd_mode, so we need to support it, too + +$rnd_mode = 'even'; +sub TIESCALAR { my ($class) = @_; bless \$round_mode, $class; } +sub FETCH { return $round_mode; } +sub STORE { $rnd_mode = $_[0]->round_mode($_[1]); } + +BEGIN { tie $rnd_mode, 'Math::BigInt'; } + +############################################################################## sub round_mode { + no strict 'refs'; # make Class->round_mode() work - my $self = shift || $class; - # shift @_ if defined $_[0] && $_[0] eq $class; + my $self = shift; + my $class = ref($self) || $self || __PACKAGE__; if (defined $_[0]) { my $m = shift; die "Unknown round mode $m" if $m !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/; - $rnd_mode = $m; return; + ${"${class}::round_mode"} = $m; return $m; } - return $rnd_mode; + return ${"${class}::round_mode"}; + } + +sub div_scale + { + no strict 'refs'; + # make Class->round_mode() work + my $self = shift; + my $class = ref($self) || $self || __PACKAGE__; + if (defined $_[0]) + { + die ('div_scale must be greater than zero') if $_[0] < 0; + ${"${class}::div_scale"} = shift; + } + return ${"${class}::div_scale"}; } sub accuracy { - # $x->accuracy($a); ref($x) a - # $x->accuracy(); ref($x); - # Class::accuracy(); # not supported - #print "MBI @_ ($class)\n"; - my $x = shift; + # $x->accuracy($a); ref($x) $a + # $x->accuracy(); ref($x) + # Class->accuracy(); class + # Class->accuracy($a); class $a - die ("accuracy() needs reference to object as first parameter.") - if !ref $x; + my $x = shift; + my $class = ref($x) || $x || __PACKAGE__; + no strict 'refs'; + # need to set new value? if (@_ > 0) { - $x->{_a} = shift; - $x->round() if defined $x->{_a}; + my $a = shift; + die ('accuracy must not be zero') if defined $a && $a == 0; + if (ref($x)) + { + # $object->accuracy() or fallback to global + $x->bround($a) if defined $a; + $x->{_a} = $a; # set/overwrite, even if not rounded + $x->{_p} = undef; # clear P + } + else + { + # set global + ${"${class}::accuracy"} = $a; + } + return $a; # shortcut + } + + if (ref($x)) + { + # $object->accuracy() or fallback to global + return $x->{_a} || ${"${class}::accuracy"}; } - return $x->{_a}; + return ${"${class}::accuracy"}; } sub precision { - my $x = shift; + # $x->precision($p); ref($x) $p + # $x->precision(); ref($x) + # Class->precision(); class + # Class->precision($p); class $p - die ("precision() needs reference to object as first parameter.") - if !ref $x; + my $x = shift; + my $class = ref($x) || $x || __PACKAGE__; + no strict 'refs'; + # need to set new value? if (@_ > 0) { - $x->{_p} = shift; - $x->round() if defined $x->{_p}; + my $p = shift; + if (ref($x)) + { + # $object->precision() or fallback to global + $x->bfround($p) if defined $p; + $x->{_p} = $p; # set/overwrite, even if not rounded + $x->{_a} = undef; # clear P + } + else + { + # set global + ${"${class}::precision"} = $p; + } + return $p; # shortcut + } + + if (ref($x)) + { + # $object->precision() or fallback to global + return $x->{_p} || ${"${class}::precision"}; } - return $x->{_p}; + return ${"${class}::precision"}; } sub _scale_a @@ -222,7 +295,7 @@ sub copy { if ($k eq 'value') { - $self->{$k} = $CALC->_copy($x->{$k}); + $self->{value} = $CALC->_copy($x->{value}); } elsif (ref($x->{$k}) eq 'SCALAR') { @@ -270,10 +343,10 @@ sub new my $self = {}; bless $self, $class; # handle '+inf', '-inf' first - if ($wanted =~ /^[+-]inf$/) + if ($wanted =~ /^[+-]?inf$/) { $self->{value} = $CALC->_zero(); - $self->{sign} = $wanted; + $self->{sign} = $wanted; $self->{sign} = '+inf' if $self->{sign} eq 'inf'; return $self; } # split str in m mantissa, e exponent, i integer, f fraction, v value, s sign @@ -334,9 +407,8 @@ sub new } $self->{sign} = '+' if $$miv eq '0'; # normalize -0 => +0 $self->{value} = $CALC->_new($miv) if $self->{sign} =~ /^[+-]$/; - #print "$wanted => $self->{sign}\n"; # if any of the globals is set, use them to round and store them inside $self - $self->round($accuracy,$precision,$rnd_mode) + $self->round($accuracy,$precision,$round_mode) if defined $accuracy || defined $precision; return $self; } @@ -386,7 +458,6 @@ sub bzero return if $self->modify('bzero'); $self->{value} = $CALC->_zero(); $self->{sign} = '+'; - #print "result: $self\n"; return $self; } @@ -397,7 +468,6 @@ sub bone my $self = shift; my $sign = shift; $sign = '+' if !defined $sign || $sign ne '-'; $self = $class if !defined $self; - #print "bone $self\n"; if (!ref($self)) { @@ -406,7 +476,6 @@ sub bone return if $self->modify('bone'); $self->{value} = $CALC->_one(); $self->{sign} = $sign; - #print "result: $self\n"; return $self; } @@ -418,7 +487,8 @@ sub bsstr # (ref to BFLOAT or num_str ) return num_str # Convert number from internal format to scientific string format. # internal format is always normalized (no leading zeros, "-0E0" => "+0E0") - my ($self,$x) = objectify(1,@_); + my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); + # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); if ($x->{sign} !~ /^[+-]$/) { @@ -435,7 +505,9 @@ sub bsstr sub bstr { # make a string from bigint object - my $x = shift; $x = $class->new($x) unless ref $x; + my $x = shift; $class = ref($x) || $x; $x = $class->new(shift) if !ref($x); + # my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + if ($x->{sign} !~ /^[+-]$/) { return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN @@ -461,11 +533,12 @@ sub numify sub sign { # return the sign of the number: +/-/NaN - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + return $x->{sign}; } -sub round +sub _find_round_parameters { # After any operation or when calling round(), the result is rounded by # regarding the A & P from arguments, local parameters, or globals. @@ -482,18 +555,13 @@ sub round 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 + my $c = ref($self); # find out class of argument(s) unshift @args,$self; # add 'first' argument # leave bigfloat parts alone - return $self if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0; + return ($self) if exists $self->{_f} && $self->{_f} & MB_NEVER_ROUND != 0; no strict 'refs'; - my $z = "$c\::accuracy"; my $aa = $$z; my $ap = undef; - if (!defined $aa) - { - $z = "$c\::precision"; $ap = $$z; - } # now pick $a or $p, but only if we have got "arguments" if ((!defined $a) && (!defined $p) && (@args > 0)) @@ -507,41 +575,67 @@ sub round { foreach (@args) { - # take the defined one, or if both defined, the one that is smaller - $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} < $p); + # take the defined one, or if both defined, the one that is bigger + # -2 > -3, and 3 > 2 + $p = $_->{_p} if (defined $_->{_p}) && (!defined $p || $_->{_p} > $p); } # if none defined, use globals (#2) if (!defined $p) { - $a = $aa; $p = $ap; # save the check: if !defined $a; + my $z = "$c\::accuracy"; my $a = $$z; + if (!defined $a) + { + $z = "$c\::precision"; $p = $$z; + } } } # endif !$a } # endif !$a || !$P && args > 0 - # for clearity, this is not merged at place (#2) + my @params = ($self); + if (defined $a || defined $p) + { + $r = $r || ${"$c\::round_mode"}; + die "Unknown round mode '$r'" + if $r !~ /^(even|odd|\+inf|\-inf|zero|trunc)$/; + push @params, ($a,$p,$r); + } + return @params; + } + +sub round + { + # round $self according to given parameters, or given second argument's + # parameters or global defaults + my $self = shift; + + my @params = $self->_find_round_parameters(@_); + return $self->bnorm() if @params == 1; # no-op + # now round, by calling fround or ffround: - if (defined $a) + if (defined $params[1]) { - $self->{_a} = $a; $self->bround($a,$r); + $self->bround($params[1],$params[3]); } - elsif (defined $p) + else { - $self->{_p} = $p; $self->bfround($p,$r); + $self->bfround($params[2],$params[3]); } - return $self->bnorm(); + return $self->bnorm(); # after round, normalize } sub bnorm { - # (num_str or BINT) return BINT + # (numstr or BINT) return BINT # Normalize number -- no-op here - return $_[0]; + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + return $x; } sub babs { # (BINT or num_str) return BINT # make number absolute, or return absolute BINT from string - my $x = shift; $x = $class->new($x) unless ref $x; + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + return $x if $x->modify('babs'); # post-normalized abs for internal use (does nothing for NaN) $x->{sign} =~ s/^-/+/; @@ -552,7 +646,8 @@ sub bneg { # (BINT or num_str) return BINT # negate number or make a negated number from string - my $x = shift; $x = $class->new($x) unless ref $x; + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + return $x if $x->modify('bneg'); # for +0 dont negate (to have always normalized) return $x if $x->is_zero(); @@ -586,8 +681,19 @@ sub bcmp 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; + + # post-normalized compare for internal use (honors signs) + if ($x->{sign} eq '+') + { + return 1 if $y->{sign} eq '-'; # 0 check handled above + return $CALC->_acmp($x->{value},$y->{value}); + } + + # $x->{sign} eq '-' + return -1 if $y->{sign} eq '+'; + return $CALC->_acmp($y->{value},$x->{value}); # swaped + + # &cmp($x->{value},$y->{value},$x->{sign},$y->{sign}) <=> 0; } sub bacmp @@ -684,26 +790,60 @@ sub bsub my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); return $x if $x->modify('bsub'); - $x->badd($y->bneg()); # badd does not leave internal zeros - $y->bneg(); # refix y, assumes no one reads $y in between - return $x->round($a,$p,$r,$y); + + if (!$y->is_zero()) # don't need to do anything if $y is 0 + { + $y->{sign} =~ tr/+\-/-+/; # does nothing for NaN + $x->badd($y,$a,$p,$r); # badd does not leave internal zeros + $y->{sign} =~ tr/+\-/-+/; # refix $y (does nothing for NaN) + } + $x; # already rounded by badd() } sub binc { # increment arg by one - my ($self,$x,$a,$p,$r) = objectify(1,@_); - # my $x = shift; $x = $class->new($x) unless ref $x; my $self = ref($x); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('binc'); - $x->badd($self->__one())->round($a,$p,$r); + + if ($x->{sign} eq '+') + { + $x->{value} = $CALC->_inc($x->{value}); + return $x->round($a,$p,$r); + } + elsif ($x->{sign} eq '-') + { + $x->{value} = $CALC->_dec($x->{value}); + $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0 + return $x->round($a,$p,$r); + } + # inf, nan handling etc + $x->badd($self->__one(),$a,$p,$r); # does round } sub bdec { # decrement arg by one - my ($self,$x,$a,$p,$r) = objectify(1,@_); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); return $x if $x->modify('bdec'); - $x->badd($self->__one('-'))->round($a,$p,$r); + + my $zero = $CALC->_is_zero($x->{value}) && $x->{sign} eq '+'; + # <= 0 + if (($x->{sign} eq '-') || $zero) + { + $x->{value} = $CALC->_inc($x->{value}); + $x->{sign} = '-' if $zero; # 0 => 1 => -1 + $x->{sign} = '+' if $CALC->_is_zero($x->{value}); # -1 +1 => -0 => +0 + return $x->round($a,$p,$r); + } + # > 0 + elsif ($x->{sign} eq '+') + { + $x->{value} = $CALC->_dec($x->{value}); + return $x->round($a,$p,$r); + } + # inf, nan handling etc + $x->badd($self->__one('-'),$a,$p,$r); # does round } sub blcm @@ -721,7 +861,7 @@ sub blcm { $x = $class->new($y); } - while (@_) { $x = _lcm($x,shift); } + while (@_) { $x = __lcm($x,shift); } $x; } @@ -731,21 +871,15 @@ sub bgcd # does not modify arguments, but returns new object # GCD -- Euclids algorithm, variant C (Knuth Vol 3, pg 341 ff) - my $y = shift; my ($x); - if (ref($y)) - { - $x = $y->copy(); - } - else - { - $x = $class->new($y); - } - + my $y = shift; + $y = __PACKAGE__->new($y) if !ref($y); + my $self = ref($y); + my $x = $y->copy(); # keep arguments if ($CALC->can('_gcd')) { while (@_) { - $y = shift; $y = $class->new($y) if !ref($y); + $y = shift; $y = $self->new($y) if !ref($y); next if $y->is_zero(); return $x->bnan() if $y->{sign} !~ /^[+-]$/; # y NaN? $x->{value} = $CALC->_gcd($x->{value},$y->{value}); last if $x->is_one(); @@ -755,79 +889,80 @@ sub bgcd { while (@_) { - $x = __gcd($x,shift); last if $x->is_one(); # _gcd handles NaN + $y = shift; $y = $self->new($y) if !ref($y); + $x = __gcd($x,$y->copy()); last if $x->is_one(); # _gcd handles NaN } } $x->babs(); } -sub bmod - { - # modulus - # (BINT or num_str, BINT or num_str) return BINT - my ($self,$x,$y) = objectify(2,@_); - - return $x if $x->modify('bmod'); - (&bdiv($self,$x,$y))[1]; - } - sub bnot { # (num_str or BINT) return BINT # represent ~x as twos-complement number - my ($self,$x) = objectify(1,@_); + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (undef,@_) : objectify(1,@_); + return $x if $x->modify('bnot'); - $x->bneg(); $x->bdec(); # was: bsub(-1,$x);, time it someday - $x; + $x->bneg(); $x->bdec(); # was: bsub(-1,$x);, time it someday + return $x->round($a,$p,$r); } sub is_zero { # return true if arg (BINT or num_str) is zero (array '+', '0') - #my ($self,$x) = objectify(1,@_); - my $x = shift; $x = $class->new($x) unless ref $x; + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^\+$/; # -, NaN & +-inf aren't $CALC->_is_zero($x->{value}); - #return $CALC->_is_zero($x->{value}); } sub is_nan { # return true if arg (BINT or num_str) is NaN - #my ($self,$x) = objectify(1,@_); - my $x = shift; $x = $class->new($x) unless ref $x; - return ($x->{sign} eq $nan); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); + + return 1 if $x->{sign} eq $nan; + return 0; } sub is_inf { # return true if arg (BINT or num_str) is +-inf - #my ($self,$x) = objectify(1,@_); - my $x = shift; $x = $class->new($x) unless ref $x; - my $sign = shift || ''; + my ($self,$x,$sign) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); - return $x->{sign} =~ /^[+-]inf$/ if $sign eq ''; - return $x->{sign} =~ /^[$sign]inf$/; + $sign = '' if !defined $sign; + return 0 if $sign !~ /^([+-]|)$/; + + if ($sign eq '') + { + return 1 if ($x->{sign} =~ /^[+-]inf$/); + return 0; + } + $sign = quotemeta($sign.'inf'); + return 1 if ($x->{sign} =~ /^$sign$/); + return 0; } sub is_one { # return true if arg (BINT or num_str) is +1 # or -1 if sign is given - #my ($self,$x) = objectify(1,@_); - my $x = shift; $x = $class->new($x) unless ref $x; - my $sign = shift || ''; $sign = '+' if $sign ne '-'; + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x,$sign) = ref($_[0]) ? (undef,@_) : objectify(1,@_); + + $sign = '' if !defined $sign; $sign = '+' if $sign ne '-'; - return 0 if $x->{sign} ne $sign; + return 0 if $x->{sign} ne $sign; # -1 != +1, NaN, +-inf aren't either return $CALC->_is_one($x->{value}); } sub is_odd { # return true when arg (BINT or num_str) is odd, false for even - my $x = shift; $x = $class->new($x) unless ref $x; - #my ($self,$x) = objectify(1,@_); + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't return $CALC->_is_odd($x->{value}); @@ -836,8 +971,8 @@ sub is_odd sub is_even { # return true when arg (BINT or num_str) is even, false for odd - my $x = shift; $x = $class->new($x) unless ref $x; - #my ($self,$x) = objectify(1,@_); + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); return 0 if $x->{sign} !~ /^[+-]$/; # NaN & +-inf aren't return $CALC->_is_even($x->{value}); @@ -846,15 +981,21 @@ sub is_even sub is_positive { # return true when arg (BINT or num_str) is positive (>= 0) - my $x = shift; $x = $class->new($x) unless ref $x; - return ($x->{sign} =~ /^\+/); + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return 1 if $x->{sign} =~ /^\+/; + return 0; } sub is_negative { # return true when arg (BINT or num_str) is negative (< 0) - my $x = shift; $x = $class->new($x) unless ref $x; - return ($x->{sign} =~ /^-/); + # we don't need $self, so undef instead of ref($_[0]) make it slightly faster + my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); + + return 1 if ($x->{sign} =~ /^-/); + return 0; } ############################################################################### @@ -882,10 +1023,63 @@ sub bmul } $x->{sign} = $x->{sign} eq $y->{sign} ? '+' : '-'; # +1 * +1 or -1 * -1 => + + $x->{value} = $CALC->_mul($x->{value},$y->{value}); # do actual math return $x->round($a,$p,$r,$y); } +sub _div_inf + { + # helper function that handles +-inf cases for bdiv()/bmod() to reuse code + my ($self,$x,$y) = @_; + + # NaN if x == NaN or y == NaN or x==y==0 + return wantarray ? ($x->bnan(),$self->bnan()) : $x->bnan() + if (($x->is_nan() || $y->is_nan()) || + ($x->is_zero() && $y->is_zero())); + + # +inf / +inf == -inf / -inf == 1, remainder is 0 (A / A = 1, remainder 0) + if (($x->{sign} eq $y->{sign}) && + ($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) + { + return wantarray ? ($x->bone(),$self->bzero()) : $x->bone(); + } + # +inf / -inf == -inf / +inf == -1, remainder 0 + if (($x->{sign} ne $y->{sign}) && + ($x->{sign} =~ /^[+-]inf$/) && ($y->{sign} =~ /^[+-]inf$/)) + { + return wantarray ? ($x->bone('-'),$self->bzero()) : $x->bone('-'); + } + # x / +-inf => 0, remainder x (works even if x == 0) + if ($y->{sign} =~ /^[+-]inf$/) + { + my $t = $x->copy(); # binf clobbers up $x + return wantarray ? ($x->bzero(),$t) : $x->bzero() + } + + # 5 / 0 => +inf, -6 / 0 => -inf + # +inf / 0 = inf, inf, and -inf / 0 => -inf, -inf + # exception: -8 / 0 has remainder -8, not 8 + # exception: -inf / 0 has remainder -inf, not inf + if ($y->is_zero()) + { + # +-inf / 0 => special case for -inf + return wantarray ? ($x,$x->copy()) : $x if $x->is_inf(); + if (!$x->is_zero() && !$x->is_inf()) + { + my $t = $x->copy(); # binf clobbers up $x + return wantarray ? + ($x->binf($x->{sign}),$t) : $x->binf($x->{sign}) + } + } + + # last case: +-inf / ordinary number + my $sign = '+inf'; + $sign = '-inf' if substr($x->{sign},0,1) ne $y->{sign}; + $x->{sign} = $sign; + return wantarray ? ($x,$self->bzero()) : $x; + } + sub bdiv { # (dividend: BINT or num_str, divisor: BINT or num_str) return @@ -894,23 +1088,8 @@ sub bdiv return $x if $x->modify('bdiv'); - # 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->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()); + return $self->_div_inf($x,$y) + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()); # 0 / something return wantarray ? ($x,$self->bzero()) : $x if $x->is_zero(); @@ -932,36 +1111,73 @@ sub bdiv } # calc new sign and in case $y == +/- 1, return $x + my $xsign = $x->{sign}; # keep $x->{sign} = ($x->{sign} ne $y->{sign} ? '-' : '+'); # check for / +-1 (cant use $y->is_one due to '-' - if (($y == 1) || ($y == -1)) # slow! - #if ((@{$y->{value}} == 1) && ($y->{value}->[0] == 1)) + if (($y == 1) || ($y == -1)) # slow! { return wantarray ? ($x,$self->bzero()) : $x; } # call div here my $rem = $self->bzero(); - $rem->{sign} = $y->{sign}; - #($x->{value},$rem->{value}) = div($x->{value},$y->{value}); ($x->{value},$rem->{value}) = $CALC->_div($x->{value},$y->{value}); - # do not leave rest "-0"; - # $rem->{sign} = '+' if (@{$rem->{value}} == 1) && ($rem->{value}->[0] == 0); - $rem->{sign} = '+' if $CALC->_is_zero($rem->{value}); - if (($x->{sign} eq '-') and (!$rem->is_zero())) - { - $x->bdec(); - } + # do not leave result "-0"; + $x->{sign} = '+' if $CALC->_is_zero($x->{value}); $x->round($a,$p,$r,$y); + if (wantarray) { - $rem->round($a,$p,$r,$x,$y); - return ($x,$y-$rem) if $x->{sign} eq '-'; # was $x,$rem + if (! $CALC->_is_zero($rem->{value})) + { + $rem->{sign} = $y->{sign}; + $rem = $y-$rem if $xsign ne $y->{sign}; # one of them '-' + } + else + { + $rem->{sign} = '+'; # dont leave -0 + } + $rem->round($a,$p,$r,$x,$y); return ($x,$rem); } return $x; } +sub bmod + { + # modulus (or remainder) + # (BINT or num_str, BINT or num_str) return BINT + my ($self,$x,$y,$a,$p,$r) = objectify(2,@_); + + return $x if $x->modify('bmod'); + if (($x->{sign} !~ /^[+-]$/) || ($y->{sign} !~ /^[+-]$/) || $y->is_zero()) + { + my ($d,$r) = $self->_div_inf($x,$y); + return $r; + } + + if ($CALC->can('_mod')) + { + # calc new sign and in case $y == +/- 1, return $x + $x->{value} = $CALC->_mod($x->{value},$y->{value}); + my $xsign = $x->{sign}; + if (!$CALC->_is_zero($x->{value})) + { + $x->{sign} = $y->{sign}; + $x = $y-$x if $xsign ne $y->{sign}; # one of them '-' + } + else + { + $x->{sign} = '+'; # dont leave -0 + } + } + else + { + $x = (&bdiv($self,$x,$y))[1]; # slow way + } + $x->bround($a,$p,$r); + } + sub bpow { # (BINT or num_str, BINT or num_str) return BINT @@ -992,13 +1208,14 @@ sub bpow $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 - # works faster if numbers are small: we count trailing zeros (this step is - # O(1)..O(N), but in case of O(N) we save much more time due to this), - # stripping them out of the multiplication, and add $count * $y zeros - # afterwards like this: - # 300 ** 3 == 300*300*300 == 3*3*3 . '0' x 2 * 3 == 27 . '0' x 6 - # creates deep recursion? + +# based on the assumption that shifting in base 10 is fast, and that mul +# works faster if numbers are small: we count trailing zeros (this step is +# O(1)..O(N), but in case of O(N) we save much more time due to this), +# stripping them out of the multiplication, and add $count * $y zeros +# 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) # { @@ -1011,19 +1228,14 @@ sub bpow my $pow2 = $self->__one(); my $y1 = $class->new($y); - my ($res); + my $two = $self->new(2); while (!$y1->is_one()) { - #print "bpow: p2: $pow2 x: $x y: $y1 r: $res\n"; - #print "len ",$x->length(),"\n"; - ($y1,$res)=&bdiv($y1,2); - if (!$res->is_zero()) { &bmul($pow2,$x); } - if (!$y1->is_zero()) { &bmul($x,$x); } - #print "$x $y\n"; + $pow2->bmul($x) if $y1->is_odd(); + $y1->bdiv($two); + $x->bmul($x); } - #print "bpow: e p2: $pow2 x: $x y: $y1 r: $res\n"; - &bmul($x,$pow2) if (!$pow2->is_one()); - #print "bpow: e p2: $pow2 x: $x y: $y1 r: $res\n"; + $x->bmul($pow2) unless $pow2->is_one(); return $x->round($a,$p,$r); } @@ -1038,7 +1250,7 @@ sub blsft $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'); + my $t; $t = $CALC->_lsft($x->{value},$y->{value},$n) if $CALC->can('_lsft'); if (defined $t) { $x->{value} = $t; return $x; @@ -1058,7 +1270,7 @@ sub brsft $n = 2 if !defined $n; return $x->bnan() if $n <= 0 || $y->{sign} eq '-'; - my $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft'); + my $t; $t = $CALC->_rsft($x->{value},$y->{value},$n) if $CALC->can('_rsft'); if (defined $t) { $x->{value} = $t; return $x; @@ -1146,7 +1358,6 @@ sub bior $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; @@ -1191,7 +1402,6 @@ sub bxor $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; @@ -1200,12 +1410,9 @@ sub bxor sub length { - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); my $e = $CALC->_len($x->{value}); - # # fallback, since we do not know the underlying representation - #my $es = "$x"; my $c = 0; $c = 1 if $es =~ /^[+-]/; # if lib returns '+123' - #my $e = CORE::length($es)-$c; return wantarray ? ($e,0) : $e; } @@ -1224,7 +1431,7 @@ sub _trailing_zeros my $x = shift; $x = $class->new($x) unless ref $x; - return 0 if $x->is_zero() || $x->{sign} !~ /^[+-]$/; + return 0 if $x->is_zero() || $x->is_odd() || $x->{sign} !~ /^[+-]$/; return $CALC->_zeros($x->{value}) if $CALC->can('_zeros'); @@ -1237,7 +1444,7 @@ sub _trailing_zeros sub bsqrt { - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); return $x->bnan() if $x->{sign} =~ /\-|$nan/; # -x or NaN => NaN return $x->bzero() if $x->is_zero(); # 0 => 0 @@ -1265,9 +1472,13 @@ sub bsqrt sub exponent { # return a copy of the exponent (here always 0, NaN or 1 for $m == 0) - my ($self,$x) = objectify(1,@_); + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return bnan() if $x->is_nan(); + if ($x->{sign} !~ /^[+-]$/) + { + my $s = $x->{sign}; $s =~ s/^[+-]//; + return $self->new($s); # -inf,+inf => inf + } my $e = $class->bzero(); return $e->binc() if $x->is_zero(); $e += $x->_trailing_zeros(); @@ -1276,10 +1487,14 @@ sub exponent sub mantissa { - # return a copy of the mantissa (here always $self) - my ($self,$x) = objectify(1,@_); + # return the mantissa (compatible to Math::BigFloat, e.g. reduced) + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return bnan() if $x->is_nan(); + if ($x->{sign} !~ /^[+-]$/) + { + my $s = $x->{sign}; $s =~ s/^[+]//; + return $self->new($s); # +inf => inf + } my $m = $x->copy(); # that's inefficient my $zeros = $m->_trailing_zeros(); @@ -1289,11 +1504,10 @@ sub mantissa sub parts { - # return a copy of both the exponent and the mantissa (here 0 and self) - my $self = shift; - $self = $class->new($self) unless ref $self; + # return a copy of both the exponent and the mantissa + my ($self,$x) = ref($_[0]) ? (ref($_[0]),$_[0]) : objectify(1,@_); - return ($self->mantissa(),$self->exponent()); + return ($x->mantissa(),$x->exponent()); } ############################################################################## @@ -1302,15 +1516,21 @@ sub parts sub bfround { # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.' - # $n == 0 => round to integer + # $n == 0 || $n == 1 => round to integer my $x = shift; $x = $class->new($x) unless ref $x; - my ($scale,$mode) = $x->_scale_p($precision,$rnd_mode,@_); + my ($scale,$mode) = $x->_scale_p($x->precision(),$x->round_mode(),@_); return $x if !defined $scale; # no-op # no-op for BigInts if $n <= 0 - return $x if $scale <= 0; + if ($scale <= 0) + { + $x->{_p} = $scale; return $x; + } $x->bround( $x->length()-$scale, $mode); + $x->{_a} = undef; # bround sets {_a} + $x->{_p} = $scale; # so correct it + $x; } sub _scan_for_nonzero @@ -1347,37 +1567,43 @@ sub bround # and overwrite the rest with 0's, return normalized number # do not return $x->bnorm(), but $x my $x = shift; $x = $class->new($x) unless ref $x; - my ($scale,$mode) = $x->_scale_a($accuracy,$rnd_mode,@_); + my ($scale,$mode) = $x->_scale_a($x->accuracy(),$x->round_mode(),@_); return $x if !defined $scale; # no-op # 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->{sign} !~ /^[+-]$/ || $x->is_zero() || $scale == 0; # we have fewer digits than we want to scale to my $len = $x->length(); - # print "$len $scale\n"; - return $x if $len < abs($scale); + # print "$scale $len\n"; + # scale < 0, but > -len (not >=!) + if (($scale < 0 && $scale < -$len-1) || ($scale >= $len)) + { + $x->{_a} = $scale if !defined $x->{_a}; # if not yet defined overwrite + return $x; + } # count of 0's to pad, from left (+) or right (-): 9 - +6 => 3, or |-6| => 6 my ($pad,$digit_round,$digit_after); $pad = $len - $scale; - $pad = abs($scale)+1 if $scale < 0; + $pad = abs($scale-1) if $scale < 0; + # do not use digit(), it is costly for binary => decimal #$digit_round = '0'; $digit_round = $x->digit($pad) if $pad < $len; #$digit_after = '0'; $digit_after = $x->digit($pad-1) if $pad > 0; + my $xs = $CALC->_str($x->{value}); my $pl = -$pad-1; + + # print "pad $pad pl $pl scale $scale len $len\n"; # pad: 123: 0 => -1, at 1 => -2, at 2 => -3, at 3 => -4 # pad+1: 123: 0 => 0, at 1 => -1, at 2 => -2, at 3 => -3 $digit_round = '0'; $digit_round = substr($$xs,$pl,1) if $pad <= $len; $pl++; $pl ++ if $pad >= $len; $digit_after = '0'; $digit_after = substr($$xs,$pl,1) if $pad > 0; - - #my $d_round = '0'; $d_round = $x->digit($pad) if $pad < $len; - #my $d_after = '0'; $d_after = $x->digit($pad-1) if $pad > 0; - # print "$pad $pl $$xs $digit_round:$d_round $digit_after:$d_after\n"; + + # print "$pad $pl $$xs dr $digit_round da $digit_after\n"; # in case of 01234 we round down, for 6789 up, and only in case 5 we look # closer at the remaining digits of the original $x, remember decision @@ -1427,21 +1653,31 @@ sub bround { $x->bzero(); # round to '0' } - # print "res $pad $len $x $$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 if ($round_up) # what gave test above? { + #print " $pad => "; $pad = $len if $scale < 0; # tlr: whack 0.51=>1.0 # modify $x in place, undef, undef to avoid rounding # str creation much faster than 10 ** something + #print " $pad, $x => "; $x->badd( Math::BigInt->new($x->{sign}.'1'.'0'x$pad) ); + #print "$x\n"; # increment string in place, to avoid dec=>hex for the '1000...000' # $xs ...blah foo } # to here: #$x->{value} = $CALC->_new($xs); # put back in + + $x->{_a} = $scale if $scale >= 0; + if ($scale < 0) + { + $x->{_a} = $len+$scale; + $x->{_a} = 0 if $scale < -$len; + } $x; } @@ -1449,10 +1685,9 @@ sub bfloor { # return integer less or equal then number, since it is already integer, # always returns $self - my ($self,$x,$a,$p,$r) = objectify(1,@_); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); # not needed: return $x if $x->modify('bfloor'); - return $x->round($a,$p,$r); } @@ -1460,10 +1695,9 @@ sub bceil { # return integer greater or equal then number, since it is already integer, # always returns $self - my ($self,$x,$a,$p,$r) = objectify(1,@_); + my ($self,$x,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(1,@_); # not needed: return $x if $x->modify('bceil'); - return $x->round($a,$p,$r); } @@ -1474,7 +1708,7 @@ sub __one { # internal speedup, set argument to 1, or create a +/- 1 my $self = shift; - my $x = $self->bzero(); $x->{value} = $CALC->_one(); + my $x = $self->bone(); # $x->{value} = $CALC->_one(); $x->{sign} = shift || '+'; return $x; } @@ -1529,10 +1763,20 @@ sub objectify # $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. - + + # some shortcut for the common cases + + # $x->unary_op(); + return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]); + # $x->binary_op($y); + #return (ref($_[1]),$_[1],$_[2]) if (@_ == 3) && ($_[0]||0 == 2) + # && ref($_[1]) && ref($_[2]); + +# print "obj '",join ("' '", @_),"'\n"; + my $count = abs(shift || 0); - #print caller(),"\n"; +# print "MBI ",caller(),"\n"; my @a; # resulting array if (ref $_[0]) @@ -1574,6 +1818,7 @@ sub objectify #print "$count\n"; $count--; $k = shift; +# print "$k (",ref($k),") => \n"; if (!ref($k)) { $k = $a[0]->new($k); @@ -1583,6 +1828,7 @@ sub objectify # foreign object, try to convert to integer $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k); } + # print "$k (",ref($k),")\n"; push @a,$k; } push @a,@_; # return other params, too @@ -1622,8 +1868,8 @@ sub import } # any non :constant stuff is handled by our parent, Exporter # even if @_ is empty, to give it a chance - #$self->SUPER::import(@a); # does not work - $self->export_to_level(1,$self,@a); # need this instead + $self->SUPER::import(@a); # need it for subclasses + $self->export_to_level(1,$self,@a); # need it for MBF # try to load core math lib my @c = split /\s*,\s*/,$CALC; @@ -1638,13 +1884,13 @@ sub import # 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(); } + eval { require $mod; $lib->import( @c ); } } else { - eval "use $lib;"; + eval "use $lib @c;"; } - $CALC = $lib, last if $@ eq ''; + $CALC = $lib, last if $@ eq ''; # no error in loading lib? } } @@ -1729,7 +1975,7 @@ 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 + # strip leading/trailing whitespace, leading zeros, underscore and reject # invalid input my $x = shift; @@ -1758,7 +2004,8 @@ sub _split # 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 - #print "input: '$$x' "; + return if $$x =~ /[Ee].*[Ee]/; # more than one E => error + my ($m,$e) = split /[Ee]/,$$x; $e = '0' if !defined $e || $e eq ""; # print "m '$m' e '$e'\n"; @@ -1799,31 +2046,70 @@ sub as_number $self->copy(); } -############################################################################## -# internal calculation routines (others are in Math::BigInt::Calc etc) +sub as_hex + { + # return as hex string, with prefixed 0x + my $x = shift; $x = $class->new($x) if !ref($x); + + return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + return '0x0' if $x->is_zero(); + + my $es = ''; my $s = ''; + $s = $x->{sign} if $x->{sign} eq '-'; + if ($CALC->can('_as_hex')) + { + $es = ${$CALC->_as_hex($x->{value})}; + } + else + { + my $x1 = $x->copy()->babs(); my $xr; + my $x100 = Math::BigInt->new (0x100); + while (!$x1->is_zero()) + { + ($x1, $xr) = bdiv($x1,$x100); + $es .= unpack('h2',pack('C',$xr->numify())); + } + $es = reverse $es; + $es =~ s/^[0]+//; # strip leading zeros + $s .= '0x'; + } + $s . $es; + } -sub cmp +sub as_bin { - # post-normalized compare for internal use (honors signs) - # input: ref to value, ref to value, sign, sign - # output: <0, 0, >0 - my ($cx,$cy,$sx,$sy) = @_; + # return as binary string, with prefixed 0b + my $x = shift; $x = $class->new($x) if !ref($x); - if ($sx eq '+') + return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc + return '0b0' if $x->is_zero(); + + my $es = ''; my $s = ''; + $s = $x->{sign} if $x->{sign} eq '-'; + if ($CALC->can('_as_bin')) { - return 1 if $sy eq '-'; # 0 check handled above - return $CALC->_acmp($cx,$cy); + $es = ${$CALC->_as_bin($x->{value})}; } else { - # $sx eq '-' - return -1 if $sy eq '+'; - return $CALC->_acmp($cy,$cx); + my $x1 = $x->copy()->babs(); my $xr; + my $x100 = Math::BigInt->new (0x100); + while (!$x1->is_zero()) + { + ($x1, $xr) = bdiv($x1,$x100); + $es .= unpack('b8',pack('C',$xr->numify())); + } + $es = reverse $es; + $es =~ s/^[0]+//; # strip leading zeros + $s .= '0b'; } - 0; # equal + $s . $es; } -sub _lcm +############################################################################## +# internal calculation routines (others are in Math::BigInt::Calc etc) + +sub __lcm { # (BINT or num_str, BINT or num_str) return BINT # does modify first argument @@ -1837,10 +2123,10 @@ sub _lcm sub __gcd { # (BINT or num_str, BINT or num_str) return BINT - # does modify first arg + # does modify both arguments # GCD -- Euclids algorithm E, Knuth Vol 2 pg 296 - - my $x = shift; my $ty = $class->new(shift); # preserve y, but make class + my ($x,$ty) = @_; + return $x->bnan() if $x->{sign} !~ /^[+-]$/ || $ty->{sign} !~ /^[+-]$/; while (!$ty->is_zero()) @@ -1939,19 +2225,24 @@ Math::BigInt - Arbitrary size integer math package # The following do not modify their arguments: - bgcd(@values); # greatest common divisor - blcm(@values); # lowest common multiplicator - - $x->bstr(); # normalized string - $x->bsstr(); # normalized string in scientific notation + bgcd(@values); # greatest common divisor (no OO style) + blcm(@values); # lowest common multiplicator (no OO style) + $x->length(); # return number of digits in number - ($x,$f) = $x->length(); # length of number and length of fraction part + ($x,$f) = $x->length(); # length of number and length of fraction part, + # latter is always 0 digits long for BigInt's $x->exponent(); # return exponent as BigInt - $x->mantissa(); # return mantissa as BigInt + $x->mantissa(); # return (signed) mantissa as BigInt $x->parts(); # return (mantissa,exponent) as BigInt $x->copy(); # make a true copy of $x (unlike $y = $x;) $x->as_number(); # return as BigInt (in BigInt: same as copy()) + + # conversation to string + $x->bstr(); # normalized string + $x->bsstr(); # normalized string in scientific notation + $x->as_hex(); # as signed hexadecimal string with prefixed 0x + $x->as_bin(); # as signed binary string with prefixed 0b =head1 DESCRIPTION @@ -2167,7 +2458,7 @@ versions <= 5.7.2) is like this: again. Thus 124/3 with div_scale=1 will get you '41.3' based on the strange assumption that 124 has 3 significant digits, while 120/7 will get you '17', not '17.1' since 120 is thought to have 2 significant digits. - The rounding after the division then uses the reminder and $y to determine + The rounding after the division then uses the remainder and $y to determine wether it must round up or down. ? I have no idea which is the right way. That's why I used a slightly more ? simple scheme and tweaked the few failing testcases to match it. @@ -2299,11 +2590,11 @@ This is how it works now: following rounding modes (R): 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' * you can set and get the global R by using Math::SomeClass->round_mode() - or by setting $Math::SomeClass::rnd_mode + or by setting $Math::SomeClass::round_mode * after each operation, $result->round() is called, and the result may eventually be rounded (that is, if A or P were set either locally, globally or as parameter to the operation) - * to manually round a number, call $x->round($A,$P,$rnd_mode); + * to manually round a number, call $x->round($A,$P,$round_mode); this will round the number by using the appropriate rounding function and then normalize it. * rounding modifies the local settings of the number: @@ -2440,6 +2731,11 @@ Examples for rounding: print $x->copy()->bnorm(),"\n"; # 123.46 print $x->copy()->fround(),"\n"; # 123.46 +Examples for converting: + + my $x = Math::BigInt->new('0b1'.'01' x 123); + print "bin: ",$x->as_bin()," hex:",$x->as_hex()," dec: ",$x,"\n"; + =head1 Autocreating constants After C all the B decimal constants @@ -2605,13 +2901,25 @@ This also works for other subclasses, like Math::String. It is yet unlcear whether overloaded int() should return a scalar or a BigInt. +=item length + +The following will probably not do what you expect: + + $c = Math::BigInt->new(123); + print $c->length(),"\n"; # prints 30 + +It prints both the number of digits in the number and in the fraction part +since print calls C in list context. Use something like: + + print scalar $c->length(),"\n"; # prints 3 + =item bdiv The following will probably not do what you expect: print $c->bdiv(10000),"\n"; -It prints both quotient and reminder since print calls C in list +It prints both quotient and remainder since print calls C in list context. Also, C will modify $c, so be carefull. You probably want to use @@ -2625,10 +2933,12 @@ 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) - -3 / 4 => (-1, 1) - -3 / -4 => ( 0,-3) + 1 / 4 => ( 0, 1) + 1 / -4 => (-1,-3) + -3 / 4 => (-1, 1) + -3 / -4 => ( 0,-3) + -11 / 2 => (-5,1) + 11 /-2 => (-5,-1) As a consequence, the behavior of the operator % agrees with the behavior of Perl's built-in % operator (as documented in the perlop @@ -2637,7 +2947,9 @@ manpage), and the equation $x == ($x / $y) * $y + ($x % $y) holds true for any $x and $y, which justifies calling the two return -values of bdiv() the quotient and remainder. +values of bdiv() the quotient and remainder. The only exception to this rule +are when $y == 0 and $x is negative, then the remainder will also be +negative. See below under "infinity handling" for the reasoning behing this. Perl's 'use integer;' changes the behaviour of % and / for scalars, but will not change BigInt's way to do things. This is because under 'use integer' Perl @@ -2645,6 +2957,47 @@ will do what the underlying C thinks is right and this is different for each system. If you need BigInt's behaving exactly like Perl's 'use integer', bug the author to implement it ;) +=item infinity handling + +Here are some examples that explain the reasons why certain results occur while +handling infinity: + +The following table shows the result of the division and the remainder, so that +the equation above holds true. Some "ordinary" cases are strewn in to show more +clearly the reasoning: + + A / B = C, R so that C * B + R = A + ========================================================= + 5 / 8 = 0, 5 0 * 8 + 5 = 5 + 0 / 8 = 0, 0 0 * 8 + 0 = 0 + 0 / inf = 0, 0 0 * inf + 0 = 0 + 0 /-inf = 0, 0 0 * -inf + 0 = 0 + 5 / inf = 0, 5 0 * inf + 5 = 5 + 5 /-inf = 0, 5 0 * -inf + 5 = 5 + -5/ inf = 0, -5 0 * inf + -5 = -5 + -5/-inf = 0, -5 0 * -inf + -5 = -5 + inf/ 5 = inf, 0 inf * 5 + 0 = inf + -inf/ 5 = -inf, 0 -inf * 5 + 0 = -inf + inf/ -5 = -inf, 0 -inf * -5 + 0 = inf + -inf/ -5 = inf, 0 inf * -5 + 0 = -inf + 5/ 5 = 1, 0 1 * 5 + 0 = 5 + -5/ -5 = 1, 0 1 * -5 + 0 = -5 + inf/ inf = 1, 0 1 * inf + 0 = inf + -inf/-inf = 1, 0 1 * -inf + 0 = -inf + inf/-inf = -1, 0 -1 * -inf + 0 = inf + -inf/ inf = -1, 0 1 * -inf + 0 = -inf + 8/ 0 = inf, 8 inf * 0 + 8 = 8 + inf/ 0 = inf, inf inf * 0 + inf = inf + 0/ 0 = NaN + +These cases below violate the "remainder has the sign of the second of the two +arguments", since they wouldn't match up otherwise. + + A / B = C, R so that C * B + R = A + ======================================================== + -inf/ 0 = -inf, -inf -inf * 0 + inf = -inf + -8/ 0 = -inf, -8 -inf * 0 + 8 = -8 + =item Modifying and = Beware of: @@ -2785,9 +3138,13 @@ the same terms as Perl itself. =head1 SEE ALSO -L and L. +L and L as well as L, +L and L. -L and L. +The package at +L contains +more documentation including a full version history, testcases, empty +subclass files and benchmarks. =head1 AUTHORS