lib/Math/BigInt/t/bigintpm.t See if BigInt.pm works
lib/Math/BigInt/t/bigints.t See if BigInt.pm works
lib/Math/BigInt/t/biglog.t Test the log function
+lib/Math/BigInt/t/bigroot.t Test the broot function
lib/Math/BigInt/t/calling.t Test calling conventions
lib/Math/BigInt/t/config.t Test Math::BigInt->config()
lib/Math/BigInt/t/constant.t Test Math::BigInt/BigFloat under :constant
$VERSION = '1.42';
require 5.005;
-use Exporter;
+
+require Exporter;
@ISA = qw(Exporter Math::BigInt);
use strict;
sub broot
{
# calculate $y'th root of $x
- my ($self,$x,$y,$a,$p,$r) = ref($_[0]) ? (ref($_[0]),@_) : objectify(2,@_);
+
+ # set up parameters
+ my ($self,$x,$y,$a,$p,$r) = (ref($_[0]),@_);
+ # objectify is costly, so avoid it
+ if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1])))
+ {
+ ($self,$x,$y,$a,$p,$r) = objectify(2,@_);
+ }
# NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
}
else
{
- my $u = $self->bone()->bdiv($y,$scale+4);
- delete $u->{_a}; delete $u->{_p}; # otherwise it conflicts
- $x->bpow($u,$scale+4); # el cheapo
+ # calculate the broot() as integer result first, and if it fits, return
+ # it rightaway (but only if $x and $y are integer):
+
+ my $done = 0; # not yet
+ if ($y->is_int() && $x->is_int())
+ {
+ my $int = $x->{_m}->copy();
+ $int->blsft($x->{_e},10) unless $x->{_e}->is_zero();
+ $int->broot($y->as_number());
+ # if ($exact)
+ if ($int->copy()->bpow($y) == $x)
+ {
+ # found result, return it
+ $x->{_m} = $int;
+ $x->{_e} = $MBI->bzero();
+ $x->bnorm();
+ $done = 1;
+ }
+ }
+ if ($done == 0)
+ {
+ my $u = $self->bone()->bdiv($y,$scale+4);
+ delete $u->{_a}; delete $u->{_p}; # otherwise it conflicts
+ $x->bpow($u,$scale+4); # el cheapo
+ }
}
$x->bneg() if $sign == 1;
'bool' => sub {
# this kludge is needed for perl prior 5.6.0 since returning 0 here fails :-/
# v5.6.1 dumps on this: return !$_[0]->is_zero() || undef; :-(
- my $t = !$_[0]->is_zero();
- undef $t if $t == 0;
+ my $t = undef;
+ $t = 1 if !$_[0]->is_zero();
$t;
},
# objectify is costly, so avoid it
if ((!ref($x)) || (ref($x) ne ref($y)))
{
- ($self,$x,$y,@r) = $self->objectify(2,@_);
+ ($self,$x,$y,@r) = objectify(2,$self || $class,@_);
}
return $x if $x->modify('broot');
}
###############################################################################
-# check routine to test internal state of corruptions
+# check routine to test internal state for corruptions
sub _check
{
$i++;
}
return "Illegal part '$e' at pos $i (tested: $try)" if $i < $j;
- return 0;
+ 0;
}
}
elsif ($b == 1)
{
- # else need to go trough all elements: O(N), but loop is a bit simplified
+ # else need to go through all elements: O(N), but loop is a bit simplified
my $r = 0;
foreach (@$x)
{
}
else
{
- # else need to go trough all elements: O(N)
+ # else need to go through all elements: O(N)
my $r = 0; my $bm = 1;
foreach (@$x)
{
$trial = _pow ($c, _copy($c, $base), $x);
my $a = _acmp($x,$trial,$x_org);
return ($x,1) if $a == 0;
- # we now that $res is too small
+ # we now know that $res is too small
if ($res < 0)
{
_mul($c,$trial,$base); _add($c, $x, [1]);
return $x;
}
- # X is more than one element
+ # we know now that X is more than one element long
+
# if $n is a power of two, we can repeatedly take sqrt($X) and find the
# proper result, because sqrt(sqrt($x)) == root($x,4)
my $b = _as_bin($c,$n);
- if ($$b =~ /0b1(0+)/)
+ if ($$b =~ /0b1(0+)$/)
{
my $count = CORE::length($1); # 0b100 => len('00') => 2
my $cnt = $count; # counter for loop
else
{
# trial computation by starting with 2,4,8,16 etc until we overstep
-
- my $step = _two();
+ my $step;
my $trial = _two();
- _mul($c, $trial, $step)
- while (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) < 0);
-
- # hit exactly?
- if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) == 0)
+ # while still to do more than X steps
+ do
{
- @$x = @$trial; # make copy while preserving ref to $x
- return $x;
- }
- # overstepped, so go back on step
- _div($c, $trial, $step);
+ $step = _two();
+ while (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) < 0)
+ {
+ _mul ($c, $step, [2]);
+ _add ($c, $trial, $step);
+ }
+
+ # hit exactly?
+ if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) == 0)
+ {
+ @$x = @$trial; # make copy while preserving ref to $x
+ return $x;
+ }
+ # overstepped, so go back on step
+ _sub($c, $trial, $step);
+ } while (scalar @$step > 1 || $step->[0] > 128);
+ # reset step to 2
+ $step = _two();
# add two, because $trial cannot be exactly the result (otherwise we would
# alrady have found it)
_add($c, $trial, $step);
- # and now add more and more (2,4,6,8, etc)
- _add($c, $trial, $step)
- while (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) < 0);
+ # and now add more and more (2,4,6,8,10 etc)
+ while (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) < 0)
+ {
+ _add ($c, $trial, $step);
+ }
# hit not exactly? (overstepped)
- # 80 too small, 81 slightly too big, 82 too big
if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) > 0)
{
_dec($c,$trial);
}
- # 80 too small, 81 slightly too big
+
+ # hit not exactly? (overstepped)
+ # 80 too small, 81 slightly too big, 82 too big
if (_acmp($c, _pow($c, _copy($c, $trial), $n), $x) > 0)
{
- _dec($c,$trial);
+ _dec ($c, $trial);
}
-
+
@$x = @$trial; # make copy while preserving ref to $x
return $x;
}
use vars qw/$VERSION/;
-$VERSION = '0.01';
+$VERSION = '0.02';
# See SYNOPSIS below.
# proper result, because sqrt(sqrt($x)) == root($x,4)
# See Calc.pm for more details
my $b = $y->as_bin();
- if ($b =~ /0b1(0+)/)
+ if ($b =~ /0b1(0+)$/)
{
my $count = CORE::length($1); # 0b100 => len('00') => 2
my $cnt = $count; # counter for loop
}
else
{
- # Should compute a guess of the result (by rule of thumb), then improve it
- # via Newton's method or something similiar.
- # XXX TODO
- warn ('broot() not fully implemented in BigInt.');
+ # trial computation by starting with 2,4,6,8,10 etc until we overstep
+ my $step;
+ my $trial = $self->new(2);
+ my $two = $self->new(2);
+ my $s_128 = $self->new(128);
+
+ local undef $Math::BigInt::accuracy;
+ local undef $Math::BigInt::precision;
+
+ # while still to do more than X steps
+ do
+ {
+ $step = $self->new(2);
+ while ( $trial->copy->bpow($y)->bacmp($x) < 0)
+ {
+ $step->bmul($two);
+ $trial->badd($step);
+ }
+
+ # hit exactly?
+ if ( $trial->copy->bpow($y)->bacmp($x) == 0)
+ {
+ $x->{value} = $trial->{value}; # make copy while preserving ref to $x
+ return $x->round(@r);
+ }
+ # overstepped, so go back on step
+ $trial->bsub($step);
+ } while ($step > $s_128);
+
+ $step = $two->copy();
+ while ( $trial->copy->bpow($y)->bacmp($x) < 0)
+ {
+ $trial->badd($step);
+ }
+
+ # not hit exactly?
+ if ( $x->bacmp( $trial->copy()->bpow($y) ) < 0)
+ {
+ $trial->bdec();
+ }
+ # copy result into $x (preserve ref)
+ $x->{value} = $trial->{value};
}
$x->round(@r);
}
is ($x->is_pos(), 1, '123 is positive');
is ($x->is_neg(), 0, '123 is not negative');
is ($x->as_int(), 123, '123 is 123 as int');
-is (ref($x->as_int()), $CL, '123 is scalar as int');
+is (ref($x->as_int()), $CL, "as_int(123) is of class '$CL'");
$x->bneg();
is ($x->is_pos(), 0, '-123 is not positive');
is ($x->is_neg(), 1, '-123 is negative');
}
print "# INC = @INC\n";
- plan tests => 2760;
+ plan tests => 2766;
}
use Math::BigInt lib => 'BareCalc';
# fourths root
16:4:2
81:4:3
+# see t/bigroot() for more tests
&fsqrt
+0:0
-1:NaN
# fourths root
16:4:2
81:4:3
-# 2 ** 32
+# 2 ** 64
18446744073709551616:4:65536
18446744073709551616:8:256
18446744073709551616:16:16
18446744073709551616:32:4
18446744073709551616:64:2
18446744073709551616:128:1
+# 213 ** 15
+84274086103068221283760416414557757:15:213
+# see t/bigroot for more tests
&bsqrt
145:12
144:12
152399026:12345
152399025:12345
152399024:12344
+# 2 ** 64 => 2 ** 32
+18446744073709551616:4294967296
+84274086103068221283760416414557757:290299993288095377
1:1
0:0
-2:NaN
my $location = $0; $location =~ s/bigintpm.t//;
unshift @INC, $location; # to locate the testing files
chdir 't' if -d 't';
- plan tests => 2760;
+ plan tests => 2766;
}
use Math::BigInt;
--- /dev/null
+#!/usr/bin/perl -w
+
+# Test broot function (and bsqrt() function, since it is used by broot()).
+
+# It is too slow to be simple included in bigfltpm.inc, where it would get
+# executed 3 times.
+
+# But it is better to test the numerical functionality, instead of not testing
+# it at all.
+
+use Test;
+use strict;
+
+BEGIN
+ {
+ $| = 1;
+ # to locate the testing files
+ my $location = $0; $location =~ s/bigroot.t//i;
+ if ($ENV{PERL_CORE})
+ {
+ # testing with the core distribution
+ @INC = qw(../lib);
+ }
+ unshift @INC, '../lib';
+ if (-d 't')
+ {
+ chdir 't';
+ require File::Spec;
+ unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
+ }
+ else
+ {
+ unshift @INC, $location;
+ }
+ print "# INC = @INC\n";
+
+ plan tests => 4 * 2;
+ }
+
+use Math::BigFloat;
+use Math::BigInt;
+
+my $cl = "Math::BigFloat";
+my $c = "Math::BigInt";
+
+# 2 ** 240 =
+# 1766847064778384329583297500742918515827483896875618958121606201292619776
+
+# takes way too long
+#test_broot ('2','240', 8, undef, '1073741824');
+#test_broot ('2','240', 9, undef, '106528681.3099908308759836475139583940127');
+#test_broot ('2','120', 9, undef, '10321.27324073880096577298929482324664787');
+#test_broot ('2','120', 17, undef, '133.3268493632747279600707813049418888729');
+
+test_broot ('2','120', 8, undef, '32768');
+test_broot ('2','60', 8, undef, '181.0193359837561662466161566988413540569');
+test_broot ('2','60', 9, undef, '101.5936673259647663841091609134277286651');
+test_broot ('2','60', 17, undef, '11.54672461623965153271017217302844672562');
+
+sub test_broot
+ {
+ my ($x,$n,$y,$scale,$result) = @_;
+
+ my $s = $scale || 'undef';
+ print "# Try: $cl $x->bpow($n)->broot($y,$s) == $result:\n";
+ ok ($cl->new($x)->bpow($n)->broot($y,$scale),$result);
+ $result =~ s/\..*//;
+ print "# Try: $c $x->bpow($n)->broot($y,$s) == $result:\n";
+ ok ($c->new($x)->bpow($n)->broot($y,$scale),$result);
+ }
+
}
print "# INC = @INC\n";
- plan tests => 2760
+ plan tests => 2766
+ 5; # +5 own tests
}
projects / p5sagit/p5-mst-13.2.git / commitdiff