Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision ed531c37

Von Moritz Bunkus vor mehr als 10 Jahren hinzugefügt

  • ID ed531c37b5bfda999e40904fe5b7fb248ad9e3a3
  • Vorgänger add0f69b
  • Nachfolger 6e351f32

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.

Unterschiede anzeigen:

SL/Form.pm
41 41
use Data::Dumper;
42 42

  
43 43
use Carp;
44
use Config;
44 45
use CGI;
45 46
use Cwd;
46 47
use Encode;
47 48
use File::Copy;
48 49
use IO::File;
50
use Math::BigInt;
49 51
use SL::Auth;
50 52
use SL::Auth::DB;
51 53
use SL::Auth::LDAP;
......
950 952
sub round_amount {
951 953
  my ($self, $amount, $places) = @_;
952 954

  
953
  # Rounding like "Kaufmannsrunden" (see http://de.wikipedia.org/wiki/Rundung )
954

  
955
  # If you search for rounding in Perl, you'll likely get the first version of
956
  # this algorithm:
957
  #
958
  # ($amount <=> 0) * int(abs($amount) * 10**$places) + .5) / 10**$places
959
  #
960
  # That doesn't work. It falls apart for certain values that are exactly 0.5
961
  # over the cutoff, because the internal IEEE754 representation is slightly
962
  # below the cutoff. Perl makes matters worse in that it really, really tries to
963
  # recognize exact values for presentation to you, even if they are not.
964
  #
965
  # Example: take the value 64.475 and round to 2 places.
966
  #
967
  # printf("%.20f\n", 64.475) gives you 64.47499999999999431566
968
  #
969
  # Then 64.475 * 100 + 0.5 is 6447.99999999999909050530, and
970
  # int(64.475 * 100 + 0.5) / 100 = 64.47
971
  #
972
  # Trying to round with more precision first only shifts the problem to rarer
973
  # cases, which nevertheless exist.
974
  #
975
  # Now we exploit the presentation rounding of Perl. Since it really tries hard
976
  # to recognize integers, we double $amount, and let Perl give us a representation.
977
  # If Perl recognizes it as a slightly too small integer, and rounds up to the
978
  # next odd integer, we follow suit and treat the fraction as .5 or greater.
979

  
980
  my $sign               = $amount <=> 0;
981
  $amount                = abs $amount;
982

  
983
  my $shift              = 10 ** ($places);
984
  my $shifted_and_double = $amount * $shift * 2;
985
  my $rounding_bias      = sprintf('%f', $shifted_and_double) % 2;
986
  $amount                = int($amount * $shift) + $rounding_bias;
987
  $amount                = $amount / $shift * $sign;
955
  # We use Perl's knowledge of string representation for
956
  # rounding. First, convert the floating point number to a string
957
  # with a high number of places. Then split the string on the decimal
958
  # sign and use integer calculation for rounding the decimal places
959
  # part. If an overflow occurs then apply that overflow to the part
960
  # before the decimal sign as well using integer arithmetic again.
961

  
962
  my $amount_str = sprintf '%.*f', $places + 10, abs($amount);
963

  
964
  return $amount unless $amount_str =~ m{^(\d+)\.(\d+)$};
965

  
966
  my ($pre, $post)      = ($1, $2);
967
  my $decimals          = '1' . substr($post, 0, $places);
968

  
969
  my $propagation_limit = $Config{i32size} == 4 ? 7 : 18;
970
  my $add_for_rounding  = substr($post, $places, 1) >= 5 ? 1 : 0;
971

  
972
  if ($places > $propagation_limit) {
973
    $decimals = Math::BigInt->new($decimals)->badd($add_for_rounding);
974
    $pre      = Math::BigInt->new($decimals)->badd(1) if substr($decimals, 0, 1) eq '2';
975

  
976
  } else {
977
    $decimals += $add_for_rounding;
978
    $pre      += 1 if substr($decimals, 0, 1) eq '2';
979
  }
980

  
981
  $amount  = ("${pre}." . substr($decimals, 1)) * ($amount <=> 0);
988 982

  
989 983
  return $amount;
990 984
}
t/form/round_amount.t
45 45
is($::form->round_amount(44.9 * 0.75, 1), '33.7',  '44.9 * 0.75 @ 1');
46 46
is($::form->round_amount(44.9 * 0.75, 0), '34',    '44.9 * 0.75 @ 0');
47 47

  
48
is($::form->round_amount(143.20, 2), '143.2', '143.20 @ 2');
49
is($::form->round_amount(143.20, 1), '143.2', '143.20 @ 1');
50
is($::form->round_amount(143.20, 0), '143',   '143.20 @ 0');
51

  
48 52
is($::form->round_amount(149.175, 2), '149.18', '149.175 @ 2');
49 53
is($::form->round_amount(149.175, 1), '149.2',  '149.175 @ 1');
50 54
is($::form->round_amount(149.175, 0), '149',    '149.175 @ 0');
......
78 82
is($::form->round_amount(-198.90 * 0.75, 1), '-149.2',  '-198.90 * 0.75 @ 1');
79 83
is($::form->round_amount(-198.90 * 0.75, 0), '-149',    '-198.90 * 0.75 @ 0');
80 84

  
85
for my $sign (-1, 1) {
86
  for ("00000".."09999") {
87
    my $str = my $num = (99 * $sign) . $_;
88
    $num /= 100;                 # shift decimal
89
    $num /= 5; $num /= 3;        # calc a bit around
90
    $num *= 5; $num *= 3;        # dumdidum
91

  
92
    $str =~ s/(..)$/.$1/;       # insert dot
93
    $str =~ s/0+$//;            # remove trailing 0
94
    $str =~ s/\.$//;            # remove trailing .
95

  
96
    is $::form->round_amount($num, 2), $str, "round($num, 2) == $str";
97
  }
98
}
99

  
100
# what about number that might occur scientific notation?  yes we could just
101
# check round_amount(1e-12, 2) and watch it blow up, but where's the fun? lets
102
# check a few Cardano triplets. they are defined by:
103
#
104
# ∛(a + b√c) + ∛(a - b√c) - 1 = 0
105
#
106
# and the following are solutions for a,b,c:
107
# (2,1,5)
108
# (5,2,13)
109
# (8,3,21)
110
#
111
# now calc that, and see what our round makes of the remaining number near zero
112
#
113
for ([2,1,5], [5,2,13], [8,3,21]) {
114
  my ($a,$b,$c) = @$_;
115

  
116
  my $result = ($a + $b * sqrt $c)**(1/3) - ($b * sqrt($c) - $a)**(1/3) - 1;
117

  
118
  is $::form->round_amount($result, 2), '0', "$result => 0";
119
}
120

  
121
# round to any digit we like
122
my $pi = atan2 0, -1;
123
is $::form->round_amount($pi, 0),  '3',             "0 digits of π";
124
is $::form->round_amount($pi, 1),  '3.1',           "1 digit of π";
125
is $::form->round_amount($pi, 2),  '3.14',          "2 digits of π";
126
is $::form->round_amount($pi, 3),  '3.142',         "3 digits of π";
127
is $::form->round_amount($pi, 4),  '3.1416',        "4 digits of π";
128
is $::form->round_amount($pi, 5),  '3.14159',       "5 digits of π";
129
is $::form->round_amount($pi, 6),  '3.141593',      "6 digits of π";
130
is $::form->round_amount($pi, 7),  '3.1415927',     "7 digits of π";
131
is $::form->round_amount($pi, 8),  '3.14159265',    "8 digits of π";
132
is $::form->round_amount($pi, 9),  '3.141592654',   "9 digits of π";
133
is $::form->round_amount($pi, 10), '3.1415926536', "10 digits of π";
134

  
135
# A LOT of places:
136
is $::form->round_amount(1.2, 200), '1.2', '1.2 @ 200';
137

  
81 138
done_testing;
82 139

  
83 140
1;

Auch abrufbar als: Unified diff