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