| Subject: | bpow doesn't handle negative first arguments correctly |
This file, BigIntTest.pl:
use Math::BigInt;
use PowFix;
sub ppow {
my $x = shift;
my $y = shift;
my $expect = shift;
my $res = Math::BigInt->bpow($x,$y);
my $myres = Math::BigInt->kpow($x,$y);
print "$x**$y = $res";
if ($res eq $expect) {
print " \t#as expected.\n";
} else {
print " \t#should this be $expect?\n";
}
if ($myres eq $expect) {
# print " \t#as expected.\n";
} else {
print "\t#oops, I get $x**$y=$myres not $expect?\n";
}
}
&ppow(-2,2,4);
&ppow('-inf',2,'inf');
&ppow('-inf',0,'NaN');
&ppow('-inf',-1,0);
&ppow('-inf','inf','NaN');
&ppow(2,'inf','inf');
&ppow(2,'-inf',0);
&ppow(0,'inf',0);
&ppow(0,'-inf','inf');
&ppow(-2,'inf','NaN');
&ppow(-2,'-inf',0);
&ppow(-1,'-inf','NaN');
&ppow(-1,'inf','NaN');
&ppow('-inf','NaN','NaN');
&ppow('inf','NaN','NaN');
&ppow(1,'inf',1);
&ppow(1,'-inf',1);
&ppow(0,0,1);
&ppow(-1,-1,-1);
&ppow(-2,3,-8);
Produces this output:
Show quoted text
> perl -w BigIntTest.pl
-2**2 = -4 #should this be 4?
-inf**2 = -inf #should this be inf?
-inf**0 = -inf #should this be NaN?
-inf**-1 = -inf #should this be 0?
-inf**inf = -inf #should this be NaN?
2**inf = 2 #should this be inf?
2**-inf = 2 #should this be 0?
0**inf = 0 #as expected.
0**-inf = 0 #should this be inf?
-2**inf = -2 #should this be NaN?
-2**-inf = -2 #should this be 0?
-1**-inf = 1 #should this be NaN?
-1**inf = 1 #should this be NaN?
-inf**NaN = -inf #should this be NaN?
inf**NaN = inf #should this be NaN?
1**inf = 1 #as expected.
1**-inf = 1 #as expected.
0**0 = 1 #as expected.
-1**-1 = -1 #as expected.
-2**3 = -8 #as expected.
With my proposed fix in the module PowFix.pm:
package Math::BigInt;
my $nan = "NaN";
my $CALC = 'Math::BigInt::Calc'; # module to do low level math
sub kpow
{
# (BINT or num_str, BINT or num_str) return BINT
# compute power of two numbers -- stolen from Knuth Vol 2 pg 233
# modifies first argument
# set up parameters
my ($self,$x,$y,@r) = (ref($_[0]),@_);
# objectify is costly, so avoid it
if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
{
($self,$x,$y,@r) = objectify(2,@_);
}
return $x if $x->modify('bpow');
return $upgrade->bpow($upgrade->new($x),$y,@r)
if defined $upgrade && !$y->isa($self);
$r[3] = $y; # no push!
#if x or y is NaN x**y = NaN
return $x->bnan() if ($x->{sign} eq $nan || $y->{sign} eq $nan);
#Now that NaNs are gone..
# if x==0, 0**y = inf/1/0 if y is <0/==0/>0
if($x->{sign} eq '+' && $CALC->_is_zero($x->{value})) {
# e.g., 0 ** -7 => ( 1 / (0 ** 7)) => 1 / 0 => +inf
return $x->binf() if $y->{sign} =~ /^-/; # -inf or y<0
# y=0: 0**0 = 1
return $x->bone() if $y->{sign} eq '+' && $CALC->_is_zero($y->{value});
# y>0 is only case left
# y==+inf or y>0: 0**y = 0
return $x;
}
if ($CALC->_is_one($x->{value})) {
#if x==1, 1**y = 1, even for y = +/-inf
return $x if $x->{sign} eq '+';
# if x == -1 ...
# -1 ** +/-inf = NaN since inf is neither odd nor even
return $x->bnan() if $y->{sign} =~ /^[-+]inf/; # x<0: x ** +inf
# -1 ** y = -1 if y is odd and 1 if y is even
my $new_sign = $y->is_odd() ? '-' : '+';
$x->{sign} = $new_sign; # -inf/+inf ** y odd/even
return $x;
}
# if y == inf
if ($y->{sign} eq '+inf') { # x ** +inf (x is not NaN, +/-Inf)
# x<0: x ** +inf = NaN
return $x->bnan() if $x->{sign} =~ /^-/;
# we have ruled out x is -inf, x<0, 0, 1, or NaN, so inf>x>1...
# x ** inf = inf for x > 1
return $x->binf(); # x>1: x ** +inf
}
# if y == -inf
if ($y->{sign} eq '-inf') {
# we have ruled out x is 0, -1, 1, or NaN, so |x|>1...
# x ** -inf = 0 for |x| > 1
return $x->bzero();
}
# if x == +/-inf
if ($x->{sign} =~ /^[+-]inf$/) {
# +/-inf ** 0 = NaN
return $x->bnan() if $CALC->_is_zero($y->{value});
# y<0: +/-inf ** y = 0
return $x->bzero() if $y->{sign} =~ /^-/;
# we have ruled out y is 0, <0, -Inf, NaN, or +inf, so y>0...
# inf>y>0: inf ** y = inf
# inf>y>0: -inf ** y = -inf if y is odd and 1 if y is even
if ($x->{sign} eq '-inf') {
my $new_sign = $y->is_odd() ? '-inf' : '+inf';
$x->{sign} = $new_sign; # -inf/+inf ** y odd/even
}
return $x;
}
# cases 0 ** Y, X ** 0, X ** 1, 1 ** Y are handled by Calc or Emu
# but we have handled 0 ** Y, 1 ** Y, and -1 ** Y already
my $new_sign = '+';
$new_sign = $y->is_odd() ? '-' : '+' if ($x->{sign} ne '+');
# |x|>1, y<0: x ** y => 1 / (x ** -y)
# so do test for negative $y after above's clause
return $x->bnan() if $y->{sign} eq '-'; #if rounding is allowed, shouldn't we round?
$x->{value} = $CALC->_pow($x->{value},$y->{value});
$x->{sign} = $new_sign;
$x->{sign} = '+' if $CALC->_is_zero($y->{value});
$x->round(@r) if !exists $x->{_f} || $x->{_f} & MB_NEVER_ROUND == 0;
$x;
}
1;
Show quoted text> perl -v
This is perl, v5.8.0 built for MSWin32-x86-multi-thread
(with 1 registered patch, see perl -V for more detail)
Copyright 1987-2002, Larry Wall
Binary build 805 provided by ActiveState Corp. http://www.ActiveState.com
Built 18:08:02 Feb 4 2003
I have also tried this on 5.00503. As well as under linux with perl 5.8.2.
Regards,
Jeff