From add0f69be977025f141c7ddb4803f642980a87a0 Mon Sep 17 00:00:00 2001 From: Moritz Bunkus Date: Thu, 25 Sep 2014 12:31:58 +0200 Subject: [PATCH] =?utf8?q?round=5Famount:=20Perls=20Repr=C3=A4sentationsal?= =?utf8?q?gorithmus=20f=C3=BCrs=20exakte=20Runden=20nutzen?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Als Erläuterung paste ich schlicht den relevanten Teil des Kommentars, der nun auch in der Funktion steht: 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. --- SL/Form.pm | 53 +++++++++++++++++++++++++++---------------- t/form/round_amount.t | 18 +++++++++++++++ 2 files changed, 51 insertions(+), 20 deletions(-) diff --git a/SL/Form.pm b/SL/Form.pm index 1368df738..7cbf60f8c 100644 --- a/SL/Form.pm +++ b/SL/Form.pm @@ -952,26 +952,39 @@ sub round_amount { # Rounding like "Kaufmannsrunden" (see http://de.wikipedia.org/wiki/Rundung ) - # Round amounts to eight places before rounding to the requested - # number of places. This gets rid of errors due to internal floating - # point representation. - $amount = $self->round_amount($amount, 8) if $places < 8; - - # Remember the amount's sign but calculate in positive values only. - my $sign = $amount <=> 0; - $amount = abs $amount; - - # Shift the amount left by $places+1 decimal places and truncate it - # to integer. Then to the integer equivalent of rounding to the next - # multiple of 10: first add half of it (5). Then truncate it back to - # the lower multiple of 10 by subtracting $amount modulo 10. - my $shift = 10 ** ($places + 1); - $amount = int($amount * $shift) + 5; - $amount -= $amount % 10; - - # Lastly shift the amount back right by $places+1 decimal places and - # restore its sign. Then we're done. - $amount = ($amount / $shift) * $sign; + # 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; return $amount; } diff --git a/t/form/round_amount.t b/t/form/round_amount.t index 2ba2334a2..685013a44 100644 --- a/t/form/round_amount.t +++ b/t/form/round_amount.t @@ -23,6 +23,24 @@ is($::form->round_amount(33.675, 2), '33.68', '33.675 @ 2'); is($::form->round_amount(33.675, 1), '33.7', '33.675 @ 1'); is($::form->round_amount(33.675, 0), '34', '33.675 @ 0'); +is($::form->round_amount(64.475, 2), '64.48', '64.475 @ 2'); +is($::form->round_amount(64.475, 1), '64.5', '64.475 @ 1'); +is($::form->round_amount(64.475, 0), '64', '64.475 @ 0'); + +is($::form->round_amount(64.475499, 5), '64.4755', '64.475499 @ 5'); +is($::form->round_amount(64.475499, 4), '64.4755', '64.475499 @ 4'); +is($::form->round_amount(64.475499, 3), '64.475', '64.475499 @ 3'); +is($::form->round_amount(64.475499, 2), '64.48', '64.475499 @ 2'); +is($::form->round_amount(64.475499, 1), '64.5', '64.475499 @ 1'); +is($::form->round_amount(64.475499, 0), '64', '64.475499 @ 0'); + +is($::form->round_amount(64.475999, 5), '64.476', '64.475999 @ 5'); +is($::form->round_amount(64.475999, 4), '64.476', '64.475999 @ 4'); +is($::form->round_amount(64.475999, 3), '64.476', '64.475999 @ 3'); +is($::form->round_amount(64.475999, 2), '64.48', '64.475999 @ 2'); +is($::form->round_amount(64.475999, 1), '64.5', '64.475999 @ 1'); +is($::form->round_amount(64.475999, 0), '64', '64.475999 @ 0'); + 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'); -- 2.20.1