From: Tels Date: Sun, 13 May 2007 14:34:11 +0000 (+0000) Subject: [PATCH] Math::BigInt v1.87 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2ebb273fc9aef31ef4d91202ea24b0155ec3118c;p=p5sagit%2Fp5-mst-13.2.git [PATCH] Math::BigInt v1.87 Date: Sun, 13 May 2007 14:34:11 +0000 Message-Id: <200705131434.11992@bloodgate.com> Subject: Re: [PATCH] Math::BigInt v1.87 (take 2) From: Tels Date: Mon, 14 May 2007 15:41:36 +0000 Message-Id: <200705141541.40678@bloodgate.com> Subject: Re: [PATCH] Math::BigInt v1.87 (take 3) From: Tels Date: Tue, 15 May 2007 19:02:54 +0000 Message-Id: <200705151902.57372@bloodgate.com> p4raw-id: //depot/perl@31222 --- diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index 7c2794c..b767766 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -12,7 +12,7 @@ package Math::BigFloat; # _a : accuracy # _p : precision -$VERSION = '1.57'; +$VERSION = '1.58'; require 5.006002; require Exporter; @@ -333,6 +333,12 @@ sub config # return (later set?) configuration data as hash ref my $class = shift || 'Math::BigFloat'; + if (@_ == 1 && ref($_[0]) ne 'HASH') + { + my $cfg = $class->SUPER::config(); + return $cfg->{$_[0]}; + } + my $cfg = $class->SUPER::config(@_); # now we need only to override the ones that are different from our parent diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm index f73af00..23454a6 100644 --- a/lib/Math/BigInt.pm +++ b/lib/Math/BigInt.pm @@ -18,7 +18,7 @@ package Math::BigInt; my $class = "Math::BigInt"; use 5.006002; -$VERSION = '1.86'; +$VERSION = '1.87'; @ISA = qw(Exporter); @EXPORT_OK = qw(objectify bgcd blcm); @@ -375,7 +375,7 @@ sub config my $class = shift || 'Math::BigInt'; no strict 'refs'; - if (@_ > 0) + if (@_ > 1 || (@_ == 1 && (ref($_[0]) eq 'HASH'))) { # try to set given options as arguments from hash @@ -428,6 +428,11 @@ sub config { $cfg->{$key} = ${"${class}::$key"}; }; + if (@_ == 1 && (ref($_[0]) ne 'HASH')) + { + # calls of the style config('lib') return just this value + return $cfg->{$_[0]}; + } $cfg; } @@ -1240,6 +1245,8 @@ sub blog return $x if $x->modify('blog'); + $base = $self->new($base) if defined $base && !ref $base; + # inf, -inf, NaN, <0 => NaN return $x->bnan() if $x->{sign} ne '+' || (defined $base && $base->{sign} ne '+'); diff --git a/lib/Math/BigInt/Calc.pm b/lib/Math/BigInt/Calc.pm index 3597367..89f1dde 100644 --- a/lib/Math/BigInt/Calc.pm +++ b/lib/Math/BigInt/Calc.pm @@ -4,7 +4,7 @@ use 5.006002; use strict; # use warnings; # dont use warnings for older Perls -our $VERSION = '0.50'; +our $VERSION = '0.51'; # Package to store unsigned big integers in decimal and do math with them @@ -22,19 +22,19 @@ our $VERSION = '0.50'; # correct result. # Beware of things like: -# $i = $i * $y + $car; $car = int($i / $MBASE); $i = $i % $MBASE; +# $i = $i * $y + $car; $car = int($i / $BASE); $i = $i % $BASE; # This works on x86, but fails on ARM (SA1100, iPAQ) due to whoknows what # reasons. So, use this instead (slower, but correct): -# $i = $i * $y + $car; $car = int($i / $MBASE); $i -= $MBASE * $car; +# $i = $i * $y + $car; $car = int($i / $BASE); $i -= $BASE * $car; ############################################################################## # global constants, flags and accessory -# announce that we are compatible with MBI v1.70 and up +# announce that we are compatible with MBI v1.83 and up sub api_version () { 2; } # constants for easier life -my ($BASE,$BASE_LEN,$MBASE,$RBASE,$MAX_VAL,$BASE_LEN_SMALL); +my ($BASE,$BASE_LEN,$RBASE,$MAX_VAL); my ($AND_BITS,$XOR_BITS,$OR_BITS); my ($AND_MASK,$XOR_MASK,$OR_MASK); @@ -48,50 +48,54 @@ sub _base_len my $b = shift; if (defined $b) { - # find whether we can use mul or div or none in mul()/div() - # (in last case reduce BASE_LEN_SMALL) - $BASE_LEN_SMALL = $b+1; + # avoid redefinitions + undef &_mul; + undef &_div; + + if ($] > 5.008 && $b > 7) + { + $BASE_LEN = $b; + *_mul = \&_mul_use_div_64; + *_div = \&_div_use_div_64; + $BASE = int("1e".$BASE_LEN); + $MAX_VAL = $BASE-1; + return $BASE_LEN unless wantarray; + return ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL, $BASE); + } + + # find whether we can use mul or div in mul()/div() + $BASE_LEN = $b+1; my $caught = 0; - while (--$BASE_LEN_SMALL > 5) + while (--$BASE_LEN > 5) { - $MBASE = int("1e".$BASE_LEN_SMALL); - $RBASE = abs('1e-'.$BASE_LEN_SMALL); # see USE_MUL + $BASE = int("1e".$BASE_LEN); + $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL $caught = 0; - $caught += 1 if (int($MBASE * $RBASE) != 1); # should be 1 - $caught += 2 if (int($MBASE / $MBASE) != 1); # should be 1 + $caught += 1 if (int($BASE * $RBASE) != 1); # should be 1 + $caught += 2 if (int($BASE / $BASE) != 1); # should be 1 last if $caught != 3; } - # BASE_LEN is used for anything else than mul()/div() - $BASE_LEN = $BASE_LEN_SMALL; - $BASE_LEN = shift if (defined $_[0]); # one more arg? $BASE = int("1e".$BASE_LEN); - - $MBASE = int("1e".$BASE_LEN_SMALL); - $RBASE = abs('1e-'.$BASE_LEN_SMALL); # see USE_MUL - $MAX_VAL = $MBASE-1; + $RBASE = abs('1e-'.$BASE_LEN); # see USE_MUL + $MAX_VAL = $BASE-1; - # avoid redefinitions - - undef &_mul; - undef &_div; - # ($caught & 1) != 0 => cannot use MUL # ($caught & 2) != 0 => cannot use DIV if ($caught == 2) # 2 { # must USE_MUL since we cannot use DIV - *{_mul} = \&_mul_use_mul; - *{_div} = \&_div_use_mul; + *_mul = \&_mul_use_mul; + *_div = \&_div_use_mul; } else # 0 or 1 { # can USE_DIV instead - *{_mul} = \&_mul_use_div; - *{_div} = \&_div_use_div; + *_mul = \&_mul_use_div; + *_div = \&_div_use_div; } } return $BASE_LEN unless wantarray; - return ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL, $BASE); + return ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL, $BASE); } sub _new @@ -126,9 +130,10 @@ BEGIN $e = 5 if $^O =~ /^uts/; # UTS get's some special treatment $e = 5 if $^O =~ /^unicos/; # unicos is also problematic (6 seems to work # there, but we play safe) - $e = 5 if $] < 5.006; # cap, for older Perls - $e = 7 if $e > 7; # cap, for VMS, OS/390 and other 64 bit systems - # 8 fails inside random testsuite, so take 7 + +# $e = 5 if $] < 5.006; # cap, for older Perls +# $e = 7 if $e > 7; # cap, for VMS, OS/390 and other 64 bit systems +# # 8 fails inside random testsuite, so take 7 __PACKAGE__->_base_len($e); # set and store @@ -323,7 +328,7 @@ sub _dec # Sub 1 from $x, modify $x in place my ($c,$x) = @_; - my $MAX = $BASE-1; # since MAX_VAL based on MBASE + my $MAX = $BASE-1; # since MAX_VAL based on BASE for my $i (@$x) { last if (($i -= 1) >= 0); # early out @@ -377,9 +382,9 @@ sub _mul_use_mul # works also if xv and yv are the same reference, and handles also $x == 0 if (@$xv == 1) { - if (($xv->[0] *= $yv->[0]) >= $MBASE) + if (($xv->[0] *= $yv->[0]) >= $BASE) { - $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $MBASE; + $xv->[0] = $xv->[0] - ($xv->[1] = int($xv->[0] * $RBASE)) * $BASE; }; return $xv; } @@ -393,7 +398,7 @@ sub _mul_use_mul my $y = $yv->[0]; my $car = 0; foreach my $i (@$xv) { - $i = $i * $y + $car; $car = int($i * $RBASE); $i -= $car * $MBASE; + $i = $i * $y + $car; $car = int($i * $RBASE); $i -= $car * $BASE; } push @$xv, $car if $car != 0; return $xv; @@ -415,7 +420,7 @@ sub _mul_use_mul # { # $prod = $xi * $yi + ($prod[$cty] || 0) + $car; # $prod[$cty++] = -# $prod - ($car = int($prod * RBASE)) * $MBASE; # 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; @@ -429,7 +434,7 @@ sub _mul_use_mul ## this is actually a tad slower ## $prod = $prod[$cty]; $prod += ($car + $xi * $yi); # no ||0 here $prod[$cty++] = - $prod - ($car = int($prod * $RBASE)) * $MBASE; # 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 || 0; # || 0 makes v5.005_3 happy @@ -440,6 +445,69 @@ sub _mul_use_mul $xv; } +sub _mul_use_div_64 + { + # (ref to int_num_array, ref to int_num_array) + # multiply two numbers in internal representation + # modifies first arg, second need not be different from first + # works for 64 bit integer with "use integer" + my ($c,$xv,$yv) = @_; + + use integer; + if (@$yv == 1) + { + # shortcut for two small numbers, also handles $x == 0 + if (@$xv == 1) + { + # shortcut for two very short numbers (improved by Nathan Zook) + # works also if xv and yv are the same reference, and handles also $x == 0 + if (($xv->[0] *= $yv->[0]) >= $BASE) + { + $xv->[0] = + $xv->[0] - ($xv->[1] = $xv->[0] / $BASE) * $BASE; + }; + return $xv; + } + # $x * 0 => 0 + if ($yv->[0] == 0) + { + @$xv = (0); + return $xv; + } + # multiply a large number a by a single element one, so speed up + my $y = $yv->[0]; my $car = 0; + foreach my $i (@$xv) + { + #$i = $i * $y + $car; $car = $i / $BASE; $i -= $car * $BASE; + $i = $i * $y + $car; $i -= ($car = $i / $BASE) * $BASE; + } + push @$xv, $car if $car != 0; + return $xv; + } + # shortcut for result $x == 0 => result = 0 + return $xv if ( ((@$xv == 1) && ($xv->[0] == 0)) ); + + # since multiplying $x with $x fails, make copy in this case + $yv = [@$xv] if $xv == $yv; # same references? + + my @prod = (); my ($prod,$car,$cty,$xi,$yi); + for $xi (@$xv) + { + $car = 0; $cty = 0; + # looping through this if $xi == 0 is silly - so optimize it away! + $xi = (shift @prod || 0), next if $xi == 0; + for $yi (@$yv) + { + $prod = $xi * $yi + ($prod[$cty] || 0) + $car; + $prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE; + } + $prod[$cty] += $car if $car; # need really to check for 0? + $xi = shift @prod || 0; # || 0 makes v5.005_3 happy + } + push @$xv, @prod; + $xv; + } + sub _mul_use_div { # (ref to int_num_array, ref to int_num_array) @@ -454,10 +522,10 @@ sub _mul_use_div { # shortcut for two very short numbers (improved by Nathan Zook) # works also if xv and yv are the same reference, and handles also $x == 0 - if (($xv->[0] *= $yv->[0]) >= $MBASE) + if (($xv->[0] *= $yv->[0]) >= $BASE) { $xv->[0] = - $xv->[0] - ($xv->[1] = int($xv->[0] / $MBASE)) * $MBASE; + $xv->[0] - ($xv->[1] = int($xv->[0] / $BASE)) * $BASE; }; return $xv; } @@ -471,9 +539,9 @@ sub _mul_use_div my $y = $yv->[0]; my $car = 0; foreach my $i (@$xv) { - # old, slower code (before use integer;) - $i = $i * $y + $car; $car = int($i / $MBASE); $i -= $car * $MBASE; - #$i = $i * $y + $car; $i -= ($car = $i / $MBASE) * $MBASE; + $i = $i * $y + $car; $car = int($i / $BASE); $i -= $car * $BASE; + # This (together with use integer;) does not work on 32-bit Perls + #$i = $i * $y + $car; $i -= ($car = $i / $BASE) * $BASE; } push @$xv, $car if $car != 0; return $xv; @@ -493,7 +561,7 @@ sub _mul_use_div for $yi (@$yv) { $prod = $xi * $yi + ($prod[$cty] || 0) + $car; - $prod[$cty++] = $prod - ($car = int($prod / $MBASE)) * $MBASE; + $prod[$cty++] = $prod - ($car = int($prod / $BASE)) * $BASE; } $prod[$cty] += $car if $car; # need really to check for 0? $xi = shift @prod || 0; # || 0 makes v5.005_3 happy @@ -547,7 +615,7 @@ sub _div_use_mul my $y = $yorg->[0]; my $b; while ($j-- > 0) { - $b = $r * $MBASE + $x->[$j]; + $b = $r * $BASE + $x->[$j]; $x->[$j] = int($b/$y); $r = $b % $y; } @@ -617,18 +685,18 @@ sub _div_use_mul my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0); $car = $bar = $prd = 0; - if (($dd = int($MBASE/($y->[-1]+1))) != 1) + if (($dd = int($BASE/($y->[-1]+1))) != 1) { for $xi (@$x) { $xi = $xi * $dd + $car; - $xi -= ($car = int($xi * $RBASE)) * $MBASE; # see USE_MUL + $xi -= ($car = int($xi * $RBASE)) * $BASE; # see USE_MUL } push(@$x, $car); $car = 0; for $yi (@$y) { $yi = $yi * $dd + $car; - $yi -= ($car = int($yi * $RBASE)) * $MBASE; # see USE_MUL + $yi -= ($car = int($yi * $RBASE)) * $BASE; # see USE_MUL } } else @@ -643,24 +711,24 @@ sub _div_use_mul $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; - $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$MBASE+$u1)/$v1)); - --$q while ($v2*$q > ($u0*$MBASE+$u1-$q*$v1)*$MBASE+$u2); + $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1)); + --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2); if ($q) { ($car, $bar) = (0,0); for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) { $prd = $q * $y->[$yi] + $car; - $prd -= ($car = int($prd * $RBASE)) * $MBASE; # see USE_MUL - $x->[$xi] += $MBASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + $prd -= ($car = int($prd * $RBASE)) * $BASE; # see USE_MUL + $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) { - $x->[$xi] -= $MBASE - if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $MBASE)); + $x->[$xi] -= $BASE + if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); } } } @@ -675,7 +743,7 @@ sub _div_use_mul $car = 0; for $xi (reverse @$x) { - $prd = $car * $MBASE + $xi; + $prd = $car * $BASE + $xi; $car = $prd - ($tmp = int($prd / $dd)) * $dd; # see USE_MUL unshift(@d, $tmp); } @@ -695,6 +763,199 @@ sub _div_use_mul $x; } +sub _div_use_div_64 + { + # ref to array, ref to array, modify first array and return remainder if + # in list context + # This version works on 64 bit integers + my ($c,$x,$yorg) = @_; + + use integer; + # the general div algorithmn here is about O(N*N) and thus quite slow, so + # we first check for some special cases and use shortcuts to handle them. + + # This works, because we store the numbers in a chunked format where each + # element contains 5..7 digits (depending on system). + + # if both numbers have only one element: + if (@$x == 1 && @$yorg == 1) + { + # shortcut, $yorg and $x are two small numbers + if (wantarray) + { + my $r = [ $x->[0] % $yorg->[0] ]; + $x->[0] = int($x->[0] / $yorg->[0]); + return ($x,$r); + } + else + { + $x->[0] = int($x->[0] / $yorg->[0]); + return $x; + } + } + # if x has more than one, but y has only one element: + if (@$yorg == 1) + { + my $rem; + $rem = _mod($c,[ @$x ],$yorg) if wantarray; + + # shortcut, $y is < $BASE + my $j = scalar @$x; my $r = 0; + my $y = $yorg->[0]; my $b; + while ($j-- > 0) + { + $b = $r * $BASE + $x->[$j]; + $x->[$j] = int($b/$y); + $r = $b % $y; + } + pop @$x if @$x > 1 && $x->[-1] == 0; # splice up a leading zero + return ($x,$rem) if wantarray; + return $x; + } + # now x and y have more than one element + + # check whether y has more elements than x, if yet, the result will be 0 + if (@$yorg > @$x) + { + my $rem; + $rem = [@$x] if wantarray; # make copy + splice (@$x,1); # keep ref to original array + $x->[0] = 0; # set to 0 + return ($x,$rem) if wantarray; # including remainder? + return $x; # only x, which is [0] now + } + # check whether the numbers have the same number of elements, in that case + # the result will fit into one element and can be computed efficiently + if (@$yorg == @$x) + { + my $rem; + # if $yorg has more digits than $x (it's leading element is longer than + # the one from $x), the result will also be 0: + if (length(int($yorg->[-1])) > length(int($x->[-1]))) + { + $rem = [@$x] if wantarray; # make copy + splice (@$x,1); # keep ref to org array + $x->[0] = 0; # set to 0 + return ($x,$rem) if wantarray; # including remainder? + return $x; + } + # now calculate $x / $yorg + + if (length(int($yorg->[-1])) == length(int($x->[-1]))) + { + # same length, so make full compare + + my $a = 0; my $j = scalar @$x - 1; + # manual way (abort if unequal, good for early ne) + while ($j >= 0) + { + last if ($a = $x->[$j] - $yorg->[$j]); $j--; + } + # $a contains the result of the compare between X and Y + # a < 0: x < y, a == 0: x == y, a > 0: x > y + if ($a <= 0) + { + $rem = [ 0 ]; # a = 0 => x == y => rem 0 + $rem = [@$x] if $a != 0; # a < 0 => x < y => rem = x + splice(@$x,1); # keep single element + $x->[0] = 0; # if $a < 0 + $x->[0] = 1 if $a == 0; # $x == $y + return ($x,$rem) if wantarray; # including remainder? + return $x; + } + # $x >= $y, so proceed normally + + } + } + + # all other cases: + + my $y = [ @$yorg ]; # always make copy to preserve + + my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0); + + $car = $bar = $prd = 0; + if (($dd = int($BASE/($y->[-1]+1))) != 1) + { + for $xi (@$x) + { + $xi = $xi * $dd + $car; + $xi -= ($car = int($xi / $BASE)) * $BASE; + } + push(@$x, $car); $car = 0; + for $yi (@$y) + { + $yi = $yi * $dd + $car; + $yi -= ($car = int($yi / $BASE)) * $BASE; + } + } + else + { + push(@$x, 0); + } + + # @q will accumulate the final result, $q contains the current computed + # part of the final result + + @q = (); ($v2,$v1) = @$y[-2,-1]; + $v2 = 0 unless $v2; + while ($#$x > $#$y) + { + ($u2,$u1,$u0) = @$x[-3..-1]; + $u2 = 0 unless $u2; + #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" + # if $v1 == 0; + $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1)); + --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2); + if ($q) + { + ($car, $bar) = (0,0); + for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) + { + $prd = $q * $y->[$yi] + $car; + $prd -= ($car = int($prd / $BASE)) * $BASE; + $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + } + if ($x->[-1] < $car + $bar) + { + $car = 0; --$q; + for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) + { + $x->[$xi] -= $BASE + if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); + } + } + } + pop(@$x); unshift(@q, $q); + } + if (wantarray) + { + @d = (); + if ($dd != 1) + { + $car = 0; + for $xi (reverse @$x) + { + $prd = $car * $BASE + $xi; + $car = $prd - ($tmp = int($prd / $dd)) * $dd; + unshift(@d, $tmp); + } + } + else + { + @d = @$x; + } + @$x = @q; + my $d = \@d; + __strip_zeros($x); + __strip_zeros($d); + return ($x,$d); + } + @$x = @q; + __strip_zeros($x); + $x; + } + sub _div_use_div { # ref to array, ref to array, modify first array and return remainder if @@ -734,7 +995,7 @@ sub _div_use_div my $y = $yorg->[0]; my $b; while ($j-- > 0) { - $b = $r * $MBASE + $x->[$j]; + $b = $r * $BASE + $x->[$j]; $x->[$j] = int($b/$y); $r = $b % $y; } @@ -805,18 +1066,18 @@ sub _div_use_div my ($car,$bar,$prd,$dd,$xi,$yi,@q,$v2,$v1,@d,$tmp,$q,$u2,$u1,$u0); $car = $bar = $prd = 0; - if (($dd = int($MBASE/($y->[-1]+1))) != 1) + if (($dd = int($BASE/($y->[-1]+1))) != 1) { for $xi (@$x) { $xi = $xi * $dd + $car; - $xi -= ($car = int($xi / $MBASE)) * $MBASE; + $xi -= ($car = int($xi / $BASE)) * $BASE; } push(@$x, $car); $car = 0; for $yi (@$y) { $yi = $yi * $dd + $car; - $yi -= ($car = int($yi / $MBASE)) * $MBASE; + $yi -= ($car = int($yi / $BASE)) * $BASE; } } else @@ -835,24 +1096,24 @@ sub _div_use_div $u2 = 0 unless $u2; #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n" # if $v1 == 0; - $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$MBASE+$u1)/$v1)); - --$q while ($v2*$q > ($u0*$MBASE+$u1-$q*$v1)*$MBASE+$u2); + $q = (($u0 == $v1) ? $MAX_VAL : int(($u0*$BASE+$u1)/$v1)); + --$q while ($v2*$q > ($u0*$BASE+$u1-$q*$v1)*$BASE+$u2); if ($q) { ($car, $bar) = (0,0); for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) { $prd = $q * $y->[$yi] + $car; - $prd -= ($car = int($prd / $MBASE)) * $MBASE; - $x->[$xi] += $MBASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); + $prd -= ($car = int($prd / $BASE)) * $BASE; + $x->[$xi] += $BASE if ($bar = (($x->[$xi] -= $prd + $bar) < 0)); } if ($x->[-1] < $car + $bar) { $car = 0; --$q; for ($yi = 0, $xi = $#$x-$#$y-1; $yi <= $#$y; ++$yi,++$xi) { - $x->[$xi] -= $MBASE - if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $MBASE)); + $x->[$xi] -= $BASE + if ($car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE)); } } } @@ -866,7 +1127,7 @@ sub _div_use_div $car = 0; for $xi (reverse @$x) { - $prd = $car * $MBASE + $xi; + $prd = $car * $BASE + $xi; $car = $prd - ($tmp = int($prd / $dd)) * $dd; unshift(@d, $tmp); } @@ -1518,47 +1779,65 @@ sub _log_int my $x_org = _copy($c,$x); # preserve x splice(@$x,1); $x->[0] = 1; # keep ref to $x - my $trial = _copy($c,$base); + # compute int ( length_in_base_10(X) / ( log(base) / log(10) ) ) + my $len = _len($c,$x_org); + my $log = log($base->[-1]) / log(10); - # XXX TODO this only works if $base has only one element - if (scalar @$base == 1) - { - # compute int ( length_in_base_10(X) / ( log(base) / log(10) ) ) - my $len = _len($c,$x_org); - my $res = int($len / (log($base->[0]) / log(10))) || 1; # avoid $res == 0 + # for each additional element in $base, we add $BASE_LEN to the result, + # based on the observation that log($BASE,10) is BASE_LEN and + # log(x*y) == log(x) + log(y): + $log += ((scalar @$base)-1) * $BASE_LEN; - $x->[0] = $res; - $trial = _pow ($c, _copy($c, $base), $x); - my $a = _acmp($x,$trial,$x_org); - return ($x,1) if $a == 0; - # we now know that $res is too small - if ($res < 0) - { - _mul($c,$trial,$base); _add($c, $x, [1]); - } - else - { - # or too big - _div($c,$trial,$base); _sub($c, $x, [1]); - } - # did we now get the right result? - $a = _acmp($x,$trial,$x_org); - return ($x,1) if $a == 0; # yes, exactly - # still too big - if ($a > 0) + # calculate now a guess based on the values obtained above: + my $res = int($len / $log); + + $x->[0] = $res; + my $trial = _pow ($c, _copy($c, $base), $x); + my $a = _acmp($c,$trial,$x_org); + +# print STDERR "# trial ", _str($c,$x)," was: $a (0 = exact, -1 too small, +1 too big)\n"; + + # found an exact result? + return ($x,1) if $a == 0; + + if ($a > 0) + { + # or too big + _div($c,$trial,$base); _dec($c, $x); + while (($a = _acmp($c,$trial,$x_org)) > 0) { - _div($c,$trial,$base); _sub($c, $x, [1]); +# print STDERR "# big _log_int at ", _str($c,$x), "\n"; + _div($c,$trial,$base); _dec($c, $x); } - } - - # simple loop that increments $x by two in each step, possible overstepping - # the real result by one + # result is now exact (a == 0), or too small (a < 0) + return ($x, $a == 0 ? 1 : 0); + } + + # else: result was to small + _mul($c,$trial,$base); + + # did we now get the right result? + $a = _acmp($c,$trial,$x_org); + + if ($a == 0) # yes, exactly + { + _inc($c, $x); + return ($x,1); + } + return ($x,0) if $a > 0; + + # Result still too small (we should come here only if the estimate above + # was very off base): + + # Now let the normal trial run obtain the real result + # Simple loop that increments $x by 2 in each step, possible overstepping + # the real result - my $a; - my $base_mul = _mul($c, _copy($c,$base), $base); + my $base_mul = _mul($c, _copy($c,$base), $base); # $base * $base while (($a = _acmp($c,$trial,$x_org)) < 0) { +# print STDERR "# small _log_int at ", _str($c,$x), "\n"; _mul($c,$trial,$base_mul); _add($c, $x, [2]); } @@ -1573,7 +1852,7 @@ sub _log_int { _dec($c, $x); } - $exact = 0 if $a != 0; + $exact = 0 if $a != 0; # a = -1 => not exact result, a = 0 => exact } ($x,$exact); # return result diff --git a/lib/Math/BigInt/t/bigintc.t b/lib/Math/BigInt/t/bigintc.t index 44c4364..5dbace0 100644 --- a/lib/Math/BigInt/t/bigintc.t +++ b/lib/Math/BigInt/t/bigintc.t @@ -277,7 +277,7 @@ ok ($C->_str($C->_root($x,$n)),'80'); $x = $C->_new("523347633027360537213511522"); ok ($C->_str($C->_root($x,$n)),'81'); -my $res = [ qw/ 9 31 99 316 999 3162 9999/ ]; +my $res = [ qw/9 31 99 316 999 3162 9999 31622 99999/ ]; # 99 ** 2 = 9801, 999 ** 2 = 998001 etc for my $i (2 .. 9) @@ -299,7 +299,7 @@ for my $i (2 .. 9) $x = '9' x $i; $x = $C->_new($x); $n = $C->_new("2"); - print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless + print "# BASE_LEN $BASE_LEN _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless ok ($C->_str($C->_root($x,$n)), $res->[$i-2]); } else diff --git a/lib/Math/BigInt/t/biglog.t b/lib/Math/BigInt/t/biglog.t index 6c99cb5..9478f76 100644 --- a/lib/Math/BigInt/t/biglog.t +++ b/lib/Math/BigInt/t/biglog.t @@ -37,7 +37,7 @@ BEGIN } print "# INC = @INC\n"; - plan tests => 68; + plan tests => 70; } use Math::BigFloat; @@ -141,11 +141,21 @@ ok ($cl->new('10')->bpow('0.6',10), '3.981071706'); # blog should handle bigint input is (Math::BigFloat::blog(Math::BigInt->new(100),10), 2, "blog(100)"); +############################################################################# # some integer results is ($cl->new(2)->bpow(32)->blog(2), '32', "2 ** 32"); is ($cl->new(3)->bpow(32)->blog(3), '32', "3 ** 32"); is ($cl->new(2)->bpow(65)->blog(2), '65', "2 ** 65"); +my $x = Math::BigInt->new( '777' ) ** 256; +my $base = Math::BigInt->new( '12345678901234' ); +is ($x->copy()->blog($base), 56, 'blog(777**256, 12345678901234)'); + +$x = Math::BigInt->new( '777' ) ** 777; +$base = Math::BigInt->new( '777' ); +is ($x->copy()->blog($base), 777, 'blog(777**777, 777)'); + +############################################################################# # test for bug in bsqrt() not taking negative _e into account test_bpow ('200','0.5',10, '14.14213562'); test_bpow ('20','0.5',10, '4.472135955'); diff --git a/lib/Math/BigInt/t/config.t b/lib/Math/BigInt/t/config.t index 68509c0..3bc9d2e 100644 --- a/lib/Math/BigInt/t/config.t +++ b/lib/Math/BigInt/t/config.t @@ -1,14 +1,14 @@ #!/usr/bin/perl -w use strict; -use Test; +use Test::More; BEGIN { $| = 1; chdir 't' if -d 't'; unshift @INC, '../lib'; # for running manually - plan tests => 51; + plan tests => 55; } # test whether Math::BigInt->config() and Math::BigFloat->config() works @@ -27,19 +27,27 @@ my $cfg = $mbi->config(); ok (ref($cfg),'HASH'); -ok ($cfg->{lib},'Math::BigInt::Calc'); -ok ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION); -ok ($cfg->{class},$mbi); -ok ($cfg->{upgrade}||'',''); -ok ($cfg->{div_scale},40); +is ($cfg->{lib},'Math::BigInt::Calc', 'lib'); +is ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION, 'lib_version'); +is ($cfg->{class},$mbi,'class'); +is ($cfg->{upgrade}||'','', 'upgrade'); +is ($cfg->{div_scale},40, 'div_Scale'); -ok ($cfg->{precision}||0,0); # should test for undef -ok ($cfg->{accuracy}||0,0); +is ($cfg->{precision}||0,0, 'precision'); # should test for undef +is ($cfg->{accuracy}||0,0,'accuracy'); +is ($cfg->{round_mode},'even','round_mode'); -ok ($cfg->{round_mode},'even'); +is ($cfg->{trap_nan},0, 'trap_nan'); +is ($cfg->{trap_inf},0, 'trap_inf'); -ok ($cfg->{trap_nan},0); -ok ($cfg->{trap_inf},0); +is ($mbi->config('lib'), 'Math::BigInt::Calc', 'config("lib")'); + +# can set via hash ref? +$cfg = $mbi->config( { trap_nan => 1 } ); +is ($cfg->{trap_nan},1, 'can set via hash ref'); + +# reset for later +$mbi->config( trap_nan => 0 ); ############################################################################## # BigFloat @@ -50,20 +58,28 @@ $cfg = $mbf->config(); ok (ref($cfg),'HASH'); -ok ($cfg->{lib},'Math::BigInt::Calc'); -ok ($cfg->{with},'Math::BigInt::Calc'); -ok ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION); -ok ($cfg->{class},$mbf); -ok ($cfg->{upgrade}||'',''); -ok ($cfg->{div_scale},40); +is ($cfg->{lib},'Math::BigInt::Calc', 'lib'); +is ($cfg->{with},'Math::BigInt::Calc', 'with'); +is ($cfg->{lib_version}, $Math::BigInt::Calc::VERSION, 'lib_version'); +is ($cfg->{class},$mbf,'class'); +is ($cfg->{upgrade}||'','', 'upgrade'); +is ($cfg->{div_scale},40, 'div_Scale'); + +is ($cfg->{precision}||0,0, 'precision'); # should test for undef +is ($cfg->{accuracy}||0,0,'accuracy'); +is ($cfg->{round_mode},'even','round_mode'); + +is ($cfg->{trap_nan},0, 'trap_nan'); +is ($cfg->{trap_inf},0, 'trap_inf'); -ok ($cfg->{precision}||0,0); # should test for undef -ok ($cfg->{accuracy}||0,0); +is ($mbf->config('lib'), 'Math::BigInt::Calc', 'config("lib")'); -ok ($cfg->{round_mode},'even'); +# can set via hash ref? +$cfg = $mbf->config( { trap_nan => 1 } ); +is ($cfg->{trap_nan},1, 'can set via hash ref'); -ok ($cfg->{trap_nan},0); -ok ($cfg->{trap_inf},0); +# reset for later +$mbf->config( trap_nan => 0 ); ############################################################################## # test setting values @@ -90,11 +106,11 @@ foreach my $key (keys %$test) # see if setting it in MBI leaves MBF alone if (($c->{$key}||0) ne $test->{$key}) { - ok (1,1); + is (1,1); } else { - ok ("$key eq $c->{$key}","$key ne $test->{$key}"); + is ("$key eq $c->{$key}","$key ne $test->{$key}", "$key"); } # see if setting in MBF works @@ -107,11 +123,11 @@ foreach my $key (keys %$test) $@ = ""; my $never_reached = 0; eval ("$mbi\->config( 'some_garbage' => 1 ); $never_reached = 1;"); -ok ($never_reached,0); +is ($never_reached,0); $@ = ""; $never_reached = 0; eval ("$mbf\->config( 'some_garbage' => 1 ); $never_reached = 1;"); -ok ($never_reached,0); +is ($never_reached,0); # this does not work. Why? #ok ($@ eq "Illegal keys 'some_garbage' passed to Math::BigInt->config() at ./config.t line 104", 1);