File Coverage

blib/lib/Statistics/Running/Tiny.pm
Criterion Covered Total %
statement 130 138 94.2
branch 16 22 72.7
condition 5 8 62.5
subroutine 29 30 96.6
pod 20 25 80.0
total 200 223 89.6


line stmt bran cond sub pod time code
1             package Statistics::Running::Tiny;
2              
3 3     3   107998 use 5.006;
  3         12  
4 3     3   18 use strict;
  3         6  
  3         95  
5 3     3   16 use warnings;
  3         5  
  3         383  
6              
7             our $VERSION = '0.04';
8              
9             use overload
10 3         30 '+' => \&concatenate,
11             '==' => \&equals,
12             '""' => \&stringify,
13 3     3   2288 ;
  3         6812  
14              
15 3     3   364 use constant SMALL_NUMBER_FOR_EQUALITY => 1E-10;
  3         7  
  3         7305  
16              
17             # creates an obj. There are no input params
18             sub new {
19 8     8 1 755037 my $class = $_[0];
20              
21 8   100     52 my $parent = ( caller(1) )[3] || "N/A";
22 8         44 my $whoami = ( caller(0) )[3];
23              
24 8         68 my $self = {
25             # these are internal variables to store mean etc. or used to calculate Kurtosis
26             'M1' => 0.0,
27             'M2' => 0.0,
28             'M3' => 0.0,
29             'M4' => 0.0,
30             'SUM' => 0.0,
31             'ABS-SUM' => 0.0,
32             'MIN' => 0.0,
33             'MAX' => 0.0,
34             'N' => 0, # number of data items inserted
35             };
36 8         19 bless($self, $class);
37 8         35 $self->clear();
38 8         25 return $self
39             }
40             # push Data: a sample and process/update mean and all other stat measures
41             sub add {
42 506     506 1 1134 my $self = $_[0];
43 506         729 my $x = $_[1];
44              
45             # ADDED 22/02/2019
46 506 50       4405 if( ! defined $x ){ print STDERR "add() : attempted to push undefined value."; return }
  0         0  
  0         0  
47              
48 506         756 my $aref = ref($x);
49              
50 506 100       931 if( $aref eq '' ){
    50          
51             # a scalar input
52 503         791 my ($delta, $delta_n, $delta_n2, $term1);
53 503         806 my $n1 = $self->{'N'};
54 503 100       857 if( $n1 == 0 ){ $self->{'MIN'} = $self->{'MAX'} = $x }
  5         15  
55             else {
56 498 100       1023 if( $x < $self->{'MIN'} ){ $self->{'MIN'} = $x }
  13         23  
57 498 100       1062 if( $x > $self->{'MAX'} ){ $self->{'MAX'} = $x }
  108         179  
58             }
59 503         762 $self->{'SUM'} += $x; # add x to the total SUM
60 503         809 $self->{'ABS-SUM'} += abs($x); # add abs-value x to the total ABS-SUM
61 503         1438 $self->{'N'} += 1; # increment sample size push in
62 503         774 my $n0 = $self->{'N'};
63              
64 503         750 $delta = $x - $self->{'M1'};
65 503         762 $delta_n = $delta / $n0;
66 503         720 $delta_n2 = $delta_n * $delta_n;
67 503         777 $term1 = $delta * $delta_n * $n1;
68 503         776 $self->{'M1'} += $delta_n;
69             $self->{'M4'} += $term1 * $delta_n2 * ($n0*$n0 - 3*$n0 + 3)
70             + 6 * $delta_n2 * $self->{'M2'}
71 503         1124 - 4 * $delta_n * $self->{'M3'}
72             ;
73             $self->{'M3'} += $term1 * $delta_n * ($n0 - 2)
74 503         1064 - 3 * $delta_n * $self->{'M2'}
75             ;
76 503         1357 $self->{'M2'} += $term1;
77             } elsif( $aref eq 'ARRAY' ){
78             # an array input
79 3         8 foreach (@$x){ $self->add($_) }
  302         521  
80             } else {
81 0         0 die "add(): only ARRAY and SCALAR can be handled (input was type '$aref')."
82             }
83             }
84             # copies input(=src) Running obj into current/self overwriting our data, this is not a clone()!
85             sub copy_from {
86 1     1 1 5 my $self = $_[0];
87 1         2 my $src = $_[1];
88 1         3 $self->{'M1'} = $src->M1();
89 1         4 $self->{'M2'} = $src->M2();
90 1         3 $self->{'M3'} = $src->M3();
91 1         3 $self->{'M4'} = $src->M4();
92 1         13 $self->set_N($src->get_N());
93             }
94             # clones current obj into a new Running obj with same values
95             sub clone {
96 1     1 1 2 my $self = $_[0];
97 1         4 my $newO = Statistics::Running::Tiny->new();
98 1         6 $newO->{'M1'} = $self->M1();
99 1         5 $newO->{'M2'} = $self->M2();
100 1         4 $newO->{'M3'} = $self->M3();
101 1         3 $newO->{'M4'} = $self->M4();
102 1         4 $newO->set_N($self->get_N());
103 1         2 return $newO
104             }
105             # clears all data entered/calculated including histogram
106             sub clear {
107 10     10 1 20 my $self = $_[0];
108 10         78 $self->{'M1'} = 0.0;
109 10         21 $self->{'M2'} = 0.0;
110 10         20 $self->{'M3'} = 0.0;
111 10         16 $self->{'M4'} = 0.0;
112 10         20 $self->{'MIN'} = 0.0;
113 10         16 $self->{'MAX'} = 0.0;
114 10         17 $self->{'SUM'} = 0.0;
115 10         15 $self->{'ABS-SUM'} = 0.0;
116 10         22 $self->{'N'} = 0;
117             }
118             # return the mean of the data entered so far
119 6     6 1 34 sub mean { return $_[0]->{'M1'} }
120 5     5 1 20 sub sum { return $_[0]->{'SUM'} }
121 2     2 1 13 sub abs_sum { return $_[0]->{'ABS-SUM'} }
122 6     6 1 25 sub min { return $_[0]->{'MIN'} }
123 6     6 1 24 sub max { return $_[0]->{'MAX'} }
124             # get number of total elements entered so far
125 20     20 1 72 sub get_N { return $_[0]->{'N'} }
126             sub variance {
127 6     6 1 11 my $self = $_[0];
128 6         14 my $m = $self->{'N'};
129 6 100       20 if( $m == 1 ){ return 0 }
  2         28  
130 4         18 return $self->{'M2'}/($m-1.0)
131             }
132 6     6 1 19 sub standard_deviation { return sqrt($_[0]->variance()) }
133             sub skewness {
134 5     5 1 10 my $self = $_[0];
135 5         11 my $m = $self->{'M2'};
136 5 50       15 if( $m == 0 ){ return 0 }
  5         58  
137             return sqrt($self->{'N'})
138 0         0 * $self->{'M3'} / ($m ** 1.5)
139             ;
140             }
141             sub kurtosis {
142 6     6 1 12 my $self = $_[0];
143 6         13 my $m = $self->{'M2'};
144 6 50       20 if( $m == 0 ){ return 0 }
  6         22  
145             return $self->{'N'}
146 0         0 * $self->{'M4'}
147             / ($m * $m)
148             - 3.0
149             ;
150             }
151             # concatenates another Running obj with current
152             # returns a new Running obj with concatenated stats
153             # input objs are not modified.
154             sub concatenate {
155 2     2 1 7 my $self = $_[0]; # us
156 2         22 my $other = $_[1]; # another Running obj
157              
158 2         5 my $combined = Statistics::Running::Tiny->new();
159              
160 2         4 my $selfN = $self->get_N();
161 2         6 my $otherN = $other->get_N();
162 2         6 my $selfM2 = $self->M2();
163 2         4 my $otherM2 = $other->M2();
164 2         4 my $selfM3 = $self->M3();
165 2         5 my $otherM3 = $other->M3();
166              
167 2         5 my $combN = $selfN + $otherN;
168 2         6 $combined->set_N($combN);
169            
170 2         4 my $delta = $other->M1() - $self->M1();
171 2         4 my $delta2 = $delta*$delta;
172 2         5 my $delta3 = $delta*$delta2;
173 2         3 my $delta4 = $delta2*$delta2;
174              
175 2         5 $combined->{'M1'} = ($selfN*$self->M1() + $otherN*$other->M1()) / $combN;
176              
177 2         7 $combined->{'M2'} = $selfM2 + $otherM2 +
178             $delta2 * $selfN * $otherN / $combN;
179            
180 2         8 $combined->{'M3'} = $selfM3 + $otherM3 +
181             $delta3 * $selfN * $otherN * ($selfN - $otherN)/($combN*$combN) +
182             3.0*$delta * ($selfN*$otherM2 - $otherN*$selfM2) / $combN
183             ;
184            
185 2         10 $combined->{'M4'} = $self->{'M4'} + $other->{'M4'}
186             + $delta4*$selfN*$otherN * ($selfN*$selfN - $selfN*$otherN + $otherN*$otherN) /
187             ($combN*$combN*$combN)
188             + 6.0*$delta2 * ($selfN*$selfN*$otherM2 + $otherN*$otherN*$selfM2)/($combN*$combN) +
189             4.0*$delta*($selfN*$otherM3 - $otherN*$selfM3) / $combN
190             ;
191              
192 2         5 $combined->{'SUM'} = $self->{'SUM'} + $other->{'SUM'};
193 2         5 $combined->{'ABS-SUM'} = $self->{'ABS-SUM'} + $other->{'ABS-SUM'};
194 2 50       25 $combined->{'MIN'} = $self->{'MIN'} < $other->{'MIN'} ? $self->{'MIN'} : $other->{'MIN'};
195 2 50       6 $combined->{'MAX'} = $self->{'MAX'} > $other->{'MAX'} ? $self->{'MAX'} : $other->{'MAX'};
196            
197 2         13 return $combined;
198             }
199             # appends another Running obj INTO current
200             # current obj (self) IS MODIFIED
201             sub append {
202 0     0 1 0 my $self = $_[0]; # us
203 0         0 my $other = $_[1]; # another Running obj
204 0         0 $self->copy_from($self+$other);
205             }
206             # equality only wrt to stats BUT NOT histogram
207             sub equals {
208 4     4 1 15 my $self = $_[0]; # us
209 4         6 my $other = $_[1]; # another Running obj
210             return
211 4   66     9 $self->get_N() == $other->get_N() &&
212             $self->equals_statistics($other)
213             }
214             sub equals_statistics {
215 5     5 1 15 my $self = $_[0]; # us
216 5         13 my $other = $_[1]; # another Running obj
217             return
218 5   33     10 abs($self->M1()-$other->M1()) < Statistics::Running::Tiny::SMALL_NUMBER_FOR_EQUALITY &&
219             abs($self->M2()-$other->M2()) < Statistics::Running::Tiny::SMALL_NUMBER_FOR_EQUALITY &&
220             abs($self->M3()-$other->M3()) < Statistics::Running::Tiny::SMALL_NUMBER_FOR_EQUALITY &&
221             abs($self->M4()-$other->M4()) < Statistics::Running::Tiny::SMALL_NUMBER_FOR_EQUALITY
222             }
223             # print object as a string, string concat/printing is overloaded on this method
224             sub stringify {
225 3     3 1 12 my $self = $_[0];
226 3         8 return "N: ".$self->get_N()
227             .", mean: ".$self->mean()
228             .", range: ".$self->min()." to ".$self->max()
229             .", sum: ".$self->sum()
230             .", standard deviation: ".$self->standard_deviation()
231             .", kurtosis: ".$self->kurtosis()
232             .", skewness: ".$self->skewness()
233             }
234             # internal methods, no need for anyone to know or use externally
235 4     4 0 10 sub set_N { $_[0]->{'N'} = $_[1] }
236 20     20 0 76 sub M1 { return $_[0]->{'M1'} }
237 16     16 0 49 sub M2 { return $_[0]->{'M2'} }
238 16     16 0 63 sub M3 { return $_[0]->{'M3'} }
239 12     12 0 78 sub M4 { return $_[0]->{'M4'} }
240              
241             1;
242             __END__