From ed531c37b5bfda999e40904fe5b7fb248ad9e3a3 Mon Sep 17 00:00:00 2001 From: Moritz Bunkus Date: Tue, 30 Sep 2014 17:46:31 +0200 Subject: [PATCH] =?utf8?q?Form::round=5Famount:=20Perls=20Wissen=20=C3=BCb?= =?utf8?q?er=20Stringifizierung=20nutzen?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 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. --- SL/Form.pm | 64 ++++++++++++++++++++----------------------- t/form/round_amount.t | 57 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 86 insertions(+), 35 deletions(-) diff --git a/SL/Form.pm b/SL/Form.pm index 7cbf60f8c..441ba7686 100644 --- 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 685013a44..d9c8edbb7 100644 --- 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; -- 2.20.1