443 lines
15 KiB
Diff
443 lines
15 KiB
Diff
From c8e5f82f10959085f7ce3ec74b3caaaf72497693 Mon Sep 17 00:00:00 2001
|
|
From: Peter John Acklam <pjacklam@gmail.com>
|
|
Date: Tue, 5 Jul 2022 15:55:26 +0200
|
|
Subject: [PATCH] Improve handling of accuracy and precision
|
|
|
|
- More robust handling of input arguments to accuracy() and precision()
|
|
|
|
- Skip rounding only when the accuracy or precision is undefined.
|
|
|
|
- When the accuracy and/or precision is undefined, set the corresponding
|
|
instance value(s) to undef rather than deleting.
|
|
---
|
|
lib/Math/BigFloat.pm | 116 +++++++++++++++++++++----------------------
|
|
lib/Math/BigInt.pm | 49 +++++++++---------
|
|
2 files changed, 83 insertions(+), 82 deletions(-)
|
|
|
|
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
|
|
index b17b06f..6800f62 100644
|
|
--- a/lib/Math/BigFloat.pm
|
|
+++ b/lib/Math/BigFloat.pm
|
|
@@ -2189,16 +2189,16 @@ sub bdiv {
|
|
|
|
# shortcut to not run through _find_round_parameters again
|
|
if (defined $params[0]) {
|
|
- delete $x->{_a}; # clear before round
|
|
+ $x->{_a} = undef; # clear before round
|
|
$x = $x->bround($params[0], $params[2]); # then round accordingly
|
|
} else {
|
|
- delete $x->{_p}; # clear before round
|
|
+ $x->{_p} = undef; # clear before round
|
|
$x = $x->bfround($params[1], $params[2]); # then round accordingly
|
|
}
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
|
|
if (wantarray) {
|
|
@@ -2208,8 +2208,8 @@ sub bdiv {
|
|
}
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $rem->{_a};
|
|
- delete $rem->{_p};
|
|
+ $rem->{_a} = undef;
|
|
+ $rem->{_p} = undef;
|
|
}
|
|
$x = $downgrade -> new($x -> bdstr(), @r)
|
|
if defined($downgrade) && $x -> is_int();
|
|
@@ -2565,8 +2565,8 @@ sub blog {
|
|
if ($done) {
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
return $downgrade -> new($x -> bdstr(), @r)
|
|
if defined($downgrade) && $x->is_int();
|
|
@@ -2584,8 +2584,8 @@ sub blog {
|
|
$$pbr = undef;
|
|
# we also need to disable any set A or P on $x (_find_round_parameters took
|
|
# them already into account), since these would interfere, too
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
$done = 0;
|
|
|
|
@@ -2626,8 +2626,8 @@ sub blog {
|
|
}
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
# restore globals
|
|
$$abr = $ab;
|
|
@@ -2688,8 +2688,8 @@ sub bexp {
|
|
$$pbr = undef;
|
|
# we also need to disable any set A or P on $x (_find_round_parameters took
|
|
# them already into account), since these would interfere, too
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
# Disabling upgrading and downgrading is no longer necessary to avoid an
|
|
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
|
|
@@ -2810,8 +2810,8 @@ sub bexp {
|
|
}
|
|
} else {
|
|
# else just round the already computed result
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
# shortcut to not run through _find_round_parameters again
|
|
if (defined $params[0]) {
|
|
$x = $x->bround($params[0], $params[2]); # then round accordingly
|
|
@@ -2821,8 +2821,8 @@ sub bexp {
|
|
}
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
# restore globals
|
|
$$abr = $ab;
|
|
@@ -2910,8 +2910,8 @@ sub bsin {
|
|
$$pbr = undef;
|
|
# we also need to disable any set A or P on $x (_find_round_parameters took
|
|
# them already into account), since these would interfere, too
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
# Disabling upgrading and downgrading is no longer necessary to avoid an
|
|
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
|
|
@@ -2926,8 +2926,8 @@ sub bsin {
|
|
my $sign = 1; # start with -=
|
|
my $below = $class->new(6);
|
|
my $factorial = $class->new(4);
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
my $limit = $class->new("1E-". ($scale-1));
|
|
while (1) {
|
|
@@ -2959,8 +2959,8 @@ sub bsin {
|
|
}
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
# restore globals
|
|
$$abr = $ab;
|
|
@@ -3014,8 +3014,8 @@ sub bcos {
|
|
$$pbr = undef;
|
|
# we also need to disable any set A or P on $x (_find_round_parameters took
|
|
# them already into account), since these would interfere, too
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
my $over = $x * $x; # X ^ 2
|
|
my $x2 = $over->copy(); # X ^ 2; difference between terms
|
|
@@ -3023,8 +3023,8 @@ sub bcos {
|
|
my $below = $class->new(2);
|
|
my $factorial = $class->new(3);
|
|
$x = $x->bone();
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
my $limit = $class->new("1E-". ($scale-1));
|
|
#my $steps = 0;
|
|
@@ -3057,8 +3057,8 @@ sub bcos {
|
|
}
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
# restore globals
|
|
$$abr = $ab;
|
|
@@ -3167,8 +3167,8 @@ sub batan {
|
|
$$pbr = undef;
|
|
# We also need to disable any set A or P on $x (_find_round_parameters
|
|
# took them already into account), since these would interfere, too
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
# Disabling upgrading and downgrading is no longer necessary to avoid an
|
|
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
|
|
@@ -3183,8 +3183,8 @@ sub batan {
|
|
my $sign = 1; # start with -=
|
|
my $below = $class->new(3);
|
|
my $two = $class->new(2);
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
my $limit = $class->new("1E-". ($scale-1));
|
|
#my $steps = 0;
|
|
@@ -3225,8 +3225,8 @@ sub batan {
|
|
}
|
|
if ($fallback) {
|
|
# Clear a/p after round, since user did not request it.
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
|
|
# restore globals
|
|
@@ -3322,8 +3322,8 @@ sub batan2 {
|
|
$y = $y -> round(@r);
|
|
|
|
if ($fallback) {
|
|
- delete $y->{_a};
|
|
- delete $y->{_p};
|
|
+ $y->{_a} = undef;
|
|
+ $y->{_p} = undef;
|
|
}
|
|
|
|
return $y;
|
|
@@ -3380,8 +3380,8 @@ sub bsqrt {
|
|
$$pbr = undef;
|
|
# we also need to disable any set A or P on $x (_find_round_parameters took
|
|
# them already into account), since these would interfere, too
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
# Disabling upgrading and downgrading is no longer necessary to avoid an
|
|
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
|
|
@@ -3414,8 +3414,8 @@ sub bsqrt {
|
|
}
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
# re-enable A and P, upgrade is taken care of by "local"
|
|
${"$class\::accuracy"} = $ab;
|
|
@@ -3496,8 +3496,8 @@ sub bsqrt {
|
|
}
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
# restore globals
|
|
$$abr = $ab;
|
|
@@ -3567,8 +3567,8 @@ sub broot {
|
|
$$pbr = undef;
|
|
# we also need to disable any set A or P on $x (_find_round_parameters took
|
|
# them already into account), since these would interfere, too
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
# Disabling upgrading and downgrading is no longer necessary to avoid an
|
|
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
|
|
@@ -3623,8 +3623,8 @@ sub broot {
|
|
}
|
|
if ($done == 0) {
|
|
my $u = $class->bone()->bdiv($y, $scale+4);
|
|
- delete $u->{_a};
|
|
- delete $u->{_p};
|
|
+ $u->{_a} = undef;
|
|
+ $u->{_p} = undef;
|
|
$x = $x->bpow($u, $scale+4); # el cheapo
|
|
}
|
|
}
|
|
@@ -3638,8 +3638,8 @@ sub broot {
|
|
}
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
# restore globals
|
|
$$abr = $ab;
|
|
@@ -3995,7 +3995,7 @@ sub bround {
|
|
$m = $m->bround($scale, $mode); # round mantissa
|
|
$x->{_m} = $m->{value}; # get our mantissa back
|
|
$x->{_a} = $scale; # remember rounding
|
|
- delete $x->{_p}; # and clear P
|
|
+ $x->{_p} = undef; # and clear P
|
|
|
|
# bnorm() downgrades if necessary, so no need to check whether to downgrade.
|
|
$x->bnorm(); # del trailing zeros gen. by bround()
|
|
@@ -4040,7 +4040,7 @@ sub bfround {
|
|
}
|
|
|
|
$x->{_p} = $scale; # remember round in any case
|
|
- delete $x->{_a}; # and clear A
|
|
+ $x->{_a} = undef; # and clear A
|
|
if ($scale < 0) {
|
|
# round right from the '.'
|
|
|
|
@@ -5520,8 +5520,8 @@ sub _log {
|
|
|
|
last if $next->bacmp($limit) <= 0;
|
|
|
|
- delete $next->{_a};
|
|
- delete $next->{_p};
|
|
+ $next->{_a} = undef;
|
|
+ $next->{_p} = undef;
|
|
$x = $x->badd($next);
|
|
# calculate things for the next term
|
|
$over *= $u;
|
|
@@ -5792,8 +5792,8 @@ sub _pow {
|
|
$$pbr = undef;
|
|
# we also need to disable any set A or P on $x (_find_round_parameters took
|
|
# them already into account), since these would interfere, too
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
|
|
# Disabling upgrading and downgrading is no longer necessary to avoid an
|
|
# infinite recursion, but it avoids unnecessary upgrading and downgrading in
|
|
@@ -5843,8 +5843,8 @@ sub _pow {
|
|
}
|
|
if ($fallback) {
|
|
# clear a/p after round, since user did not request it
|
|
- delete $x->{_a};
|
|
- delete $x->{_p};
|
|
+ $x->{_a} = undef;
|
|
+ $x->{_p} = undef;
|
|
}
|
|
# restore globals
|
|
$$abr = $ab;
|
|
diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm
|
|
index 4dd8fec..c355c7a 100644
|
|
--- a/lib/Math/BigInt.pm
|
|
+++ b/lib/Math/BigInt.pm
|
|
@@ -350,27 +350,27 @@ sub accuracy {
|
|
if (@_ > 0) {
|
|
my $a = shift;
|
|
if (defined $a) {
|
|
- $a = $a->numify() if ref($a) && $a->can('numify');
|
|
+ $a = $a -> can('numify') ? $a -> numify() : 0 + "$a" if ref($a);
|
|
# also croak on non-numerical
|
|
- if (!$a || $a <= 0) {
|
|
- croak('Argument to accuracy must be greater than zero');
|
|
- }
|
|
- if (int($a) != $a) {
|
|
- croak('Argument to accuracy must be an integer');
|
|
- }
|
|
+ croak "accuracy must be a number, not '$a'"
|
|
+ unless $a =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
|
|
+ croak "accuracy must be an integer, not '$a'"
|
|
+ if $a != int $a;
|
|
+ croak "accuracy must be greater than zero, not '$a'"
|
|
+ if $a <= 0;
|
|
}
|
|
|
|
if (ref($x)) {
|
|
# Set instance variable.
|
|
- $x = $x->bround($a) if $a; # not for undef, 0
|
|
- $x->{_a} = $a; # set/overwrite, even if not rounded
|
|
- delete $x->{_p}; # clear P
|
|
+ $x = $x->bround($a) if defined $a;
|
|
+ $x->{_a} = $a; # set/overwrite, even if not rounded
|
|
+ $x->{_p} = undef; # clear P
|
|
# Why return class variable here? Fixme!
|
|
$a = ${"${class}::accuracy"} unless defined $a;
|
|
} else {
|
|
# Set class variable.
|
|
- ${"${class}::accuracy"} = $a; # set global A
|
|
- ${"${class}::precision"} = undef; # clear global P
|
|
+ ${"${class}::accuracy"} = $a; # set global A
|
|
+ ${"${class}::precision"} = undef; # clear global P
|
|
}
|
|
|
|
return $a; # shortcut
|
|
@@ -396,23 +396,24 @@ sub precision {
|
|
if (@_ > 0) {
|
|
my $p = shift;
|
|
if (defined $p) {
|
|
- $p = $p->numify() if ref($p) && $p->can('numify');
|
|
- if ($p != int $p) {
|
|
- croak('Argument to precision must be an integer');
|
|
- }
|
|
+ $p = $p -> can('numify') ? $p -> numify() : 0 + "$p" if ref($p);
|
|
+ croak "precision must be a number, not '$p'"
|
|
+ unless $p =~/^[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
|
|
+ croak "precision must be an integer, not '$p'"
|
|
+ if $p != int $p;
|
|
}
|
|
|
|
if (ref($x)) {
|
|
# Set instance variable.
|
|
- $x = $x->bfround($p) if $p; # not for undef, 0
|
|
- $x->{_p} = $p; # set/overwrite, even if not rounded
|
|
- delete $x->{_a}; # clear A
|
|
+ $x = $x->bfround($p) if defined $p;
|
|
+ $x->{_p} = $p; # set/overwrite, even if not rounded
|
|
+ $x->{_a} = undef; # clear A
|
|
# Why return class variable here? Fixme!
|
|
$p = ${"${class}::precision"} unless defined $p;
|
|
} else {
|
|
# Set class variable.
|
|
- ${"${class}::precision"} = $p; # set global P
|
|
- ${"${class}::accuracy"} = undef; # clear global A
|
|
+ ${"${class}::precision"} = $p; # set global P
|
|
+ ${"${class}::accuracy"} = undef; # clear global A
|
|
}
|
|
|
|
return $p; # shortcut
|
|
@@ -3770,7 +3771,7 @@ sub bfround {
|
|
# no-op for Math::BigInt objects if $n <= 0
|
|
$x = $x->bround($x->length()-$scale, $mode) if $scale > 0;
|
|
|
|
- delete $x->{_a}; # delete to save memory
|
|
+ $x->{_a} = undef;
|
|
$x->{_p} = $scale; # store new _p
|
|
$x;
|
|
}
|
|
@@ -4003,8 +4004,8 @@ sub mantissa {
|
|
return $class->new($x->{sign}, @r);
|
|
}
|
|
my $m = $x->copy();
|
|
- delete $m->{_p};
|
|
- delete $m->{_a};
|
|
+ $m -> precision(undef);
|
|
+ $m -> accuracy(undef);
|
|
|
|
# that's a bit inefficient:
|
|
my $zeros = $LIB->_zeros($m->{value});
|