File Coverage

blib/lib/Math/Summation.pm
Criterion Covered Total %
statement 56 56 100.0
branch 13 14 92.8
condition n/a
subroutine 9 9 100.0
pod 5 5 100.0
total 83 84 98.8


line stmt bran cond sub pod time code
1             # -*- coding: utf-8-unix
2              
3             package Math::Summation;
4              
5 2     2   133546 use strict;
  2         22  
  2         56  
6 2     2   11 use warnings;
  2         4  
  2         51  
7              
8 2     2   10 use Carp qw< croak >;
  2         4  
  2         79  
9 2     2   9 use Exporter;
  2         4  
  2         1366  
10              
11             our $VERSION = '0.01';
12              
13             our @ISA = qw< Exporter >;
14             our @EXPORT = ();
15             our @EXPORT_OK = qw< sum kahansum neumaiersum kleinsum pairwisesum >;
16             our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK, );
17              
18             =pod
19              
20             =encoding UTF-8
21              
22             =head1 NAME
23              
24             Math::Summation - add numbers in ways that give less numerical errors
25              
26             =head1 SYNOPSIS
27              
28             use Math::Summation 'sum'; # and/or 'kahansum' etc.
29              
30             my @values = (1, 1e100, 1, -1e100);
31              
32             # use the standard way of adding numbers
33             my $sum = sum(@values);
34              
35             # use the Kahan summation algorithm
36             my $sum_khn = kahansum(@values);
37              
38             # use the Neumaier summation algorithm
39             my $sum_nmr = neumaiersum(@values);
40              
41             # use the Klein summation algorithm
42             my $sum_kln = kleinsum(@values);
43              
44             # use the pairwise summation algorithm
45             my $sum_pws = pairwisesum(@values);
46              
47             =head1 DESCRIPTION
48              
49             This module implements various algorithms that significantly reduces the
50             numerical error in the total obtained by adding a sequence of finite-precision
51             floating-point numbers, compared to the obvious approach.
52              
53             No functions are exported by default. The desired functions can be imported
54             like in the following example:
55              
56             use Math::Summation 'sum'; # and/or 'kahansum' etc.
57              
58             To import all exportable functions, use the 'all' tag:
59              
60             use Math::Summation ':all'; # import all fucntions
61              
62             =head1 CLASS METHODS
63              
64             =head2 Constructors
65              
66             =over 4
67              
68             =item sum LIST
69              
70             Returns the sum of the elements in LIST. This is done by naively adding each
71             number directly to the accumulating total.
72              
73             =cut
74              
75             sub sum {
76              
77             # Prepare the accumulator.
78 7     7 1 3199 my $sum = 0.0;
79              
80 7         26 for (my $i = 0 ; $i <= $#_ ; ++$i) {
81 19         43 $sum += $_[$i];
82             }
83              
84 7         59 return $sum;
85             }
86              
87             =pod
88              
89             =item kahansum LIST
90              
91             Returns the sum of the elements in LIST.
92              
93             The Kahan summation algorithm, also known as "compensated summation",
94             significantly reduces the numerical error in the total obtained by adding a
95             sequence of finite-precision floating-point numbers, compared to the obvious
96             approach. This is done by keeping a separate running compensation (a variable
97             to accumulate small errors).
98              
99             This function is more accurate than a direct summation, but at the expence of
100             more computational complexity.
101              
102             =cut
103              
104             sub kahansum {
105              
106             # Prepare the accumulator.
107 7     7 1 3733 my $sum = 0.0;
108              
109             # A running compensation for lost low-order bits.
110 7         14 my $c = 0.0;
111              
112 7         21 for (my $i = 0 ; $i <= $#_ ; ++$i) {
113              
114             # $c is zero the first time around.
115 19         31 my $y = $_[$i] - $c;
116              
117             # Alas, $sum is big, $y small, so low-order digits of $y are lost.
118 19         29 my $t = $sum + $y;
119              
120             # ($t - $sum) cancels the high-order part of $y; subtracting y recovers
121             # negative (low part of $y)
122 19         25 $c = ($t - $sum) - $y;
123              
124             # Algebraically, $c should always be zero. Beware overly-aggressive
125             # optimizing compilers!
126 19         40 $sum = $t;
127              
128             # Next time around, the lost low part will be added to $y in a fresh attempt.
129             }
130              
131 7         49 return $sum;
132             }
133              
134             =pod
135              
136             =item neumaiersum LIST
137              
138             Returns the sum of the elements in LIST.
139              
140             Neumaier introduced an improved version of the Kahan algorithm, which Neumaier
141             calls an "improved Kahan–Babuška algorithm", which also covers the case when
142             the next term to be added is larger in absolute value than the running sum,
143             effectively swapping the role of what is large and what is small.
144              
145             The difference between Neumaier's algorithm vs. Kahan's algorithm can be seen
146             when summing the four numbers
147              
148             =cut
149              
150             sub neumaiersum {
151 7     7 1 3488 my $sum = 0.0;
152              
153             # A running compensation for lost low-order bits.
154 7         11 my $c = 0.0;
155              
156 7         24 for (my $i = 0 ; $i <= $#_ ; ++$i) {
157 19         37 my $t = $sum + $_[$i];
158 19 100       36 if (abs($sum) >= abs($_[$i])) {
159             # If $sum is bigger, low-order digits of $_[$i] are lost.
160 8         12 $c += ($sum - $t) + $_[$i];
161             } else {
162             # Else low-order digits of $sum are lost.
163 11         23 $c += ($_[$i] - $t) + $sum;
164             }
165 19         36 $sum = $t;
166             }
167              
168             # Correction only applied once in the very end.
169 7         50 return $sum + $c;
170             }
171              
172             =pod
173              
174             =item kleinsum LIST
175              
176             Returns the sum of the elements in LIST.
177              
178             Higher-order modifications of the above algorithms, to provide even better
179             accuracy are also possible. Klein suggested what he called a second-order
180             "iterative Kahan–Babuška algorithm".
181              
182             This method has some advantages over Kahan's and Neumaier's algorithms, but at
183             the expense of even more computational complexity.
184              
185             =cut
186              
187             sub kleinsum {
188 7     7 1 3573 my $s = 0.0;
189 7         11 my $cs = 0.0;
190 7         11 my $ccs = 0.0;
191 7         24 for (my $i = 0 ; $i <= $#_ ; ++$i) {
192 19         29 my ($c, $cc);
193 19         31 my $t = $s + $_[$i];
194 19 100       36 if (abs($s) >= abs($_[$i])) {
195 8         10 $c = ($s - $t) + $_[$i];
196             } else {
197 11         19 $c = ($_[$i] - $t) + $s;
198             }
199 19         24 $s = $t;
200 19         25 $t = $cs + $c;
201 19 100       29 if (abs($cs) >= abs($c)) {
202 18         25 $cc = ($cs - $t) + $c;
203             } else {
204 1         2 $cc = ($c - $t) + $cs;
205             }
206 19         22 $cs = $t;
207 19         43 $ccs = $ccs + $cc;
208             }
209              
210 7         50 return $s + $cs + $ccs;
211             }
212              
213             =pod
214              
215             =item pairwisesum LIST
216              
217             Returns the sum of the elements in LIST.
218              
219             The summation is done by recursively splitting the set in half and computing
220             the sum of each half.
221              
222             This algorithm has the same number of arithmetic operations as a direct
223             summation, but the recursion introduces some overhead.
224              
225             =cut
226              
227             sub pairwisesum {
228 17 100   17 1 3636 if (@_ > 2) {
229 5         17 my $i = int($#_ / 2);
230 5         17 return pairwisesum(@_[0 .. $i]) + pairwisesum(@_[$i+1 .. $#_]);
231             }
232              
233 12 100       54 return $_[0] + $_[1] if @_ == 2;
234 4 100       28 return $_[0] if @_ == 1;
235 1 50       12 return 0 if @_ == 0;
236             }
237              
238             =pod
239              
240             =back
241              
242             =head1 BUGS
243              
244             Please report any bugs through the web interface at
245             L
246             (requires login). We will be notified, and then you'll automatically be
247             notified of progress on your bug as I make changes.
248              
249             =head1 SUPPORT
250              
251             You can find documentation for this module with the perldoc command.
252              
253             perldoc Math::Summation
254              
255             You can also look for information at:
256              
257             =over 4
258              
259             =item * GitHub Source Repository
260              
261             L
262              
263             =item * RT: CPAN's request tracker
264              
265             L
266              
267             =item * CPAN Ratings
268              
269             L
270              
271             =item * MetaCPAN
272              
273             L
274              
275             =item * CPAN Testers Matrix
276              
277             L
278              
279             =back
280              
281             =head1 SEE ALSO
282              
283             =over
284              
285             =item *
286              
287             The Wikipedia page for Kahan summation, which describes the algorithms by
288             Kahan, Neumaier, and Klein
289             L.
290              
291             =item *
292              
293             The Wikipedia page for pairwise summation
294             L
295              
296             =back
297              
298             =head1 LICENSE AND COPYRIGHT
299              
300             Copyright (c) 2020 Peter John Acklam.
301              
302             This program is free software; you may redistribute it and/or modify it under
303             the same terms as Perl itself.
304              
305             =head1 AUTHOR
306              
307             Peter John Acklam Epjacklam (at) gmail.com.
308              
309             =cut
310              
311             1;