Form::round_amount: Perls Wissen über Stringifizierung nutzen

Perl weiß am besten, wann eine nicht ganz exakte Fließkommazahl
eigentlich eine für Menschen sinnvoll lesbare Fließkommazahl ist (also
dass mit 143.19999999999998863132 eigentlich 143.2 gemeint ist, wenn ich
143.2 übergebe). Also nutzen wir diese Tatsache, machen aus der
Fließkommazahl einen String und teilen diesen dann am
Dezimaltrennzeichen auf.

Danach kann mit Integerarithmetik weiter gerechnet werden. Auf die
Nachkommastellen wird entsprechend addiert, sofern die relevante Stelle
>= 5 ist, und der dabei potenziell entstehende Übertrag wird in einer
zweiten Addition auf den Vorkommaanteil addiert.

Erst zum Schluss werden diese beiden Integerzahlen mit Hilfe eines
Strings zu einer Fließkommazahl zusammengesetzt.

Dabei muss beachtet werden, dass auf 32bit-Architekturen Perls
automatische Integer-Umwandlung von Strings bei Stringlängen von 9
bereits auf die wissenschaftliche Schreibweise wechselt. Das wird
verhindert, indem das Math::BigInt-Modul in dem Moment für die
Berechnung verwendet wird, aber aus Performancegründen nur dann, wenn's
wirklich nötig ist.

diff --git a/SL/Form.pm b/SL/Form.pm
index 7cbf60f..441ba76 100644 (file)
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -41,11 +41,13 @@ use Carp;
 use Data::Dumper;
 
 use Carp;
+use Config;
 use CGI;
 use Cwd;
 use Encode;
 use File::Copy;
 use IO::File;
+use Math::BigInt;
 use SL::Auth;
 use SL::Auth::DB;
 use SL::Auth::LDAP;
@@ -950,41 +952,33 @@ sub parse_amount {
 sub round_amount {
   my ($self, $amount, $places) = @_;
 
-  # Rounding like "Kaufmannsrunden" (see http://de.wikipedia.org/wiki/Rundung )
-
-  # If you search for rounding in Perl, you'll likely get the first version of
-  # this algorithm:
-  #
-  # ($amount <=> 0) * int(abs($amount) * 10**$places) + .5) / 10**$places
-  #
-  # That doesn't work. It falls apart for certain values that are exactly 0.5
-  # over the cutoff, because the internal IEEE754 representation is slightly
-  # below the cutoff. Perl makes matters worse in that it really, really tries to
-  # recognize exact values for presentation to you, even if they are not.
-  #
-  # Example: take the value 64.475 and round to 2 places.
-  #
-  # printf("%.20f\n", 64.475) gives you 64.47499999999999431566
-  #
-  # Then 64.475 * 100 + 0.5 is 6447.99999999999909050530, and
-  # int(64.475 * 100 + 0.5) / 100 = 64.47
-  #
-  # Trying to round with more precision first only shifts the problem to rarer
-  # cases, which nevertheless exist.
-  #
-  # Now we exploit the presentation rounding of Perl. Since it really tries hard
-  # to recognize integers, we double $amount, and let Perl give us a representation.
-  # If Perl recognizes it as a slightly too small integer, and rounds up to the
-  # next odd integer, we follow suit and treat the fraction as .5 or greater.
-
-  my $sign               = $amount <=> 0;
-  $amount                = abs $amount;
-
-  my $shift              = 10 ** ($places);
-  my $shifted_and_double = $amount * $shift * 2;
-  my $rounding_bias      = sprintf('%f', $shifted_and_double) % 2;
-  $amount                = int($amount * $shift) + $rounding_bias;
-  $amount                = $amount / $shift * $sign;
+  # We use Perl's knowledge of string representation for
+  # rounding. First, convert the floating point number to a string
+  # with a high number of places. Then split the string on the decimal
+  # sign and use integer calculation for rounding the decimal places
+  # part. If an overflow occurs then apply that overflow to the part
+  # before the decimal sign as well using integer arithmetic again.
+
+  my $amount_str = sprintf '%.*f', $places + 10, abs($amount);
+
+  return $amount unless $amount_str =~ m{^(\d+)\.(\d+)$};
+
+  my ($pre, $post)      = ($1, $2);
+  my $decimals          = '1' . substr($post, 0, $places);
+
+  my $propagation_limit = $Config{i32size} == 4 ? 7 : 18;
+  my $add_for_rounding  = substr($post, $places, 1) >= 5 ? 1 : 0;
+
+  if ($places > $propagation_limit) {
+    $decimals = Math::BigInt->new($decimals)->badd($add_for_rounding);
+    $pre      = Math::BigInt->new($decimals)->badd(1) if substr($decimals, 0, 1) eq '2';
+
+  } else {
+    $decimals += $add_for_rounding;
+    $pre      += 1 if substr($decimals, 0, 1) eq '2';
+  }
+
+  $amount  = ("${pre}." . substr($decimals, 1)) * ($amount <=> 0);
 
   return $amount;
 }

diff --git a/t/form/round_amount.t b/t/form/round_amount.t
index 685013a..d9c8edb 100644 (file)
--- a/t/form/round_amount.t
+++ b/t/form/round_amount.t
@@ -45,6 +45,10 @@ is($::form->round_amount(44.9 * 0.75, 2), '33.68', '44.9 * 0.75 @ 2');
 is($::form->round_amount(44.9 * 0.75, 1), '33.7',  '44.9 * 0.75 @ 1');
 is($::form->round_amount(44.9 * 0.75, 0), '34',    '44.9 * 0.75 @ 0');
 
+is($::form->round_amount(143.20, 2), '143.2', '143.20 @ 2');
+is($::form->round_amount(143.20, 1), '143.2', '143.20 @ 1');
+is($::form->round_amount(143.20, 0), '143',   '143.20 @ 0');
+
 is($::form->round_amount(149.175, 2), '149.18', '149.175 @ 2');
 is($::form->round_amount(149.175, 1), '149.2',  '149.175 @ 1');
 is($::form->round_amount(149.175, 0), '149',    '149.175 @ 0');
@@ -78,6 +82,59 @@ is($::form->round_amount(-198.90 * 0.75, 2), '-149.18', '-198.90 * 0.75 @ 2');
 is($::form->round_amount(-198.90 * 0.75, 1), '-149.2',  '-198.90 * 0.75 @ 1');
 is($::form->round_amount(-198.90 * 0.75, 0), '-149',    '-198.90 * 0.75 @ 0');
 
+for my $sign (-1, 1) {
+  for ("00000".."09999") {
+    my $str = my $num = (99 * $sign) . $_;
+    $num /= 100;                 # shift decimal
+    $num /= 5; $num /= 3;        # calc a bit around
+    $num *= 5; $num *= 3;        # dumdidum
+
+    $str =~ s/(..)$/.$1/;       # insert dot
+    $str =~ s/0+$//;            # remove trailing 0
+    $str =~ s/\.$//;            # remove trailing .
+
+    is $::form->round_amount($num, 2), $str, "round($num, 2) == $str";
+  }
+}
+
+# what about number that might occur scientific notation?  yes we could just
+# check round_amount(1e-12, 2) and watch it blow up, but where's the fun? lets
+# check a few Cardano triplets. they are defined by:
+#
+# ∛(a + b√c) + ∛(a - b√c) - 1 = 0
+#
+# and the following are solutions for a,b,c:
+# (2,1,5)
+# (5,2,13)
+# (8,3,21)
+#
+# now calc that, and see what our round makes of the remaining number near zero
+#
+for ([2,1,5], [5,2,13], [8,3,21]) {
+  my ($a,$b,$c) = @$_;
+
+  my $result = ($a + $b * sqrt $c)**(1/3) - ($b * sqrt($c) - $a)**(1/3) - 1;
+
+  is $::form->round_amount($result, 2), '0', "$result => 0";
+}
+
+# round to any digit we like
+my $pi = atan2 0, -1;
+is $::form->round_amount($pi, 0),  '3',             "0 digits of π";
+is $::form->round_amount($pi, 1),  '3.1',           "1 digit of π";
+is $::form->round_amount($pi, 2),  '3.14',          "2 digits of π";
+is $::form->round_amount($pi, 3),  '3.142',         "3 digits of π";
+is $::form->round_amount($pi, 4),  '3.1416',        "4 digits of π";
+is $::form->round_amount($pi, 5),  '3.14159',       "5 digits of π";
+is $::form->round_amount($pi, 6),  '3.141593',      "6 digits of π";
+is $::form->round_amount($pi, 7),  '3.1415927',     "7 digits of π";
+is $::form->round_amount($pi, 8),  '3.14159265',    "8 digits of π";
+is $::form->round_amount($pi, 9),  '3.141592654',   "9 digits of π";
+is $::form->round_amount($pi, 10), '3.1415926536', "10 digits of π";
+
+# A LOT of places:
+is $::form->round_amount(1.2, 200), '1.2', '1.2 @ 200';
+
 done_testing;
 
 1;