1package Statistics::Descriptive::Smoother::Weightedexponential;
2$Statistics::Descriptive::Smoother::Weightedexponential::VERSION = '3.0800';
3use strict;
4use warnings;
5
6use Carp qw/ carp /;
7use parent 'Statistics::Descriptive::Smoother';
8
9sub _new
10{
11    my ( $class, $args ) = @_;
12
13    if ( scalar @{ $args->{data} } != scalar @{ $args->{samples} } )
14    {
15        carp("Number of data values and samples need to be the same\n");
16        return;
17    }
18
19    return bless $args || {}, $class;
20}
21
22# The name of the variables used in the code refers to the explanation in the pod
23sub get_smoothed_data
24{
25    my ($self) = @_;
26
27    my ( @smoothed_values, @Wts );
28
29    # W(0) = N(0)
30    push @Wts, @{ $self->{samples} }[0];
31
32    # S(0) = X(0)
33    push @smoothed_values, @{ $self->{data} }[0];
34    my $C = $self->get_smoothing_coeff();
35
36    foreach my $idx ( 1 .. ( $self->{count} - 1 ) )
37    {
38        my $Xt   = $self->{data}->[$idx];
39        my $Nt   = $self->{samples}->[$idx];
40        my $St_1 = $smoothed_values[-1];
41        my $Wt_1 = $Wts[-1];
42
43        push @Wts, $self->_get_Wt( $Wt_1, $Nt );
44
45        my $coeff_a = $self->_get_coeff_A( $Wt_1, $Nt );
46        my $coeff_b = $self->_get_coeff_B( $Wt_1, $Nt );
47
48        my $smoothed_value =
49            ( $St_1 * $coeff_a + $Xt * $coeff_b ) / ( $coeff_a + $coeff_b );
50        push @smoothed_values, $smoothed_value;
51    }
52    return @smoothed_values;
53}
54
55sub _get_Wt
56{
57    my ( $self, $Wt_1, $Nt ) = @_;
58
59    my $C       = $self->get_smoothing_coeff();
60    my $coeff_a = $self->_get_coeff_A( $Wt_1, $Nt );
61    my $coeff_b = $self->_get_coeff_B( $Wt_1, $Nt );
62
63    return ( ( $Wt_1 * $coeff_a + $Nt * $coeff_b ) / ( $coeff_a + $coeff_b ) );
64}
65
66sub _get_coeff_A
67{
68    my ( $self, $Wt_1, $Nt ) = @_;
69
70    my $C = $self->get_smoothing_coeff();
71    return $C * ( $Wt_1 / ( $Wt_1 + $Nt ) );
72}
73
74sub _get_coeff_B
75{
76    my ( $self, $Wt_1, $Nt ) = @_;
77
78    my $C = $self->get_smoothing_coeff();
79    return ( 1 - $C ) * ( $Nt / ( $Nt + $Wt_1 ) );
80}
81
821;
83
84__END__
85
86=pod
87
88=encoding UTF-8
89
90=head1 NAME
91
92Statistics::Descriptive::Smoother::Weigthedexponential - Implement weighted
93exponential smoothing
94
95=head1 VERSION
96
97version 3.0800
98
99=head1 SYNOPSIS
100
101  use Statistics::Descriptive::Smoother;
102  my $smoother = Statistics::Descriptive::Smoother->instantiate({
103           method   => 'weightedexponential',
104           coeff    => 0.5,
105           data     => [1, 2, 3, 4, 5],
106           samples  => [110, 120, 130, 140, 150],
107    });
108  my @smoothed_data = $smoother->get_smoothed_data();
109
110=head1 DESCRIPTION
111
112This module implement the weighted exponential smoothing algorithm to smooth
113the trend of a series of statistical data.
114
115This algorithm can help to control large swings in the unsmoothed data that
116arise from small samples for those data points.
117
118The algorithm implements the following formula:
119
120W(0) = N(0)
121
122W(t) = ( W(t-1) * CoeffA + N(t) * CoeffB ) / (CoeffA + CoeffB)
123
124CoeffA = C * ( W(t-1) / (W(t-1) + N(t) ) )
125
126CoeffB = (1 - C) * ( N(t) * (W(t-1) + N(t)) )
127
128S(t) = (S(t-1)*CoeffA + X(t)*CoeffB) / (CoeffA + CoeffB)
129
130where:
131
132=over 3
133
134=item * t = index in the series
135
136=item * S(t) = smoothed series value at position t
137
138=item * C = smoothing coefficient. Value in the [0;1] range. C<0> means that the series is not smoothed at all,
139while C<1> the series is universally equal to the initial unsmoothed value.
140
141=item * X(t) = unsmoothed series value at position t
142
143=back
144
145=head1 METHODS
146
147=over 5
148
149=item $stats->get_smoothed_data();
150
151Returns a copy of the smoothed data array.
152
153=back
154
155=head1 AUTHOR
156
157Fabio Ponciroli
158
159=head1 COPYRIGHT
160
161Copyright(c) 2012 by Fabio Ponciroli.
162
163=head1 LICENSE
164
165This file is licensed under the MIT/X11 License:
166http://www.opensource.org/licenses/mit-license.php.
167
168Permission is hereby granted, free of charge, to any person obtaining a copy of
169this software and associated documentation files (the "Software"), to deal in
170the Software without restriction, including without limitation the rights to
171use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
172of the Software, and to permit persons to whom the Software is furnished to do
173so, subject to the following conditions:
174
175The above copyright notice and this permission notice shall be included in all
176copies or substantial portions of the Software.
177
178THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
179IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
180FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
181AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
182LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
183OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
184SOFTWARE.
185
186=for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
187
188=head1 SUPPORT
189
190=head2 Websites
191
192The following websites have more information about this module, and may be of help to you. As always,
193in addition to those websites please use your favorite search engine to discover more resources.
194
195=over 4
196
197=item *
198
199MetaCPAN
200
201A modern, open-source CPAN search engine, useful to view POD in HTML format.
202
203L<https://metacpan.org/release/Statistics-Descriptive>
204
205=item *
206
207RT: CPAN's Bug Tracker
208
209The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN.
210
211L<https://rt.cpan.org/Public/Dist/Display.html?Name=Statistics-Descriptive>
212
213=item *
214
215CPANTS
216
217The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.
218
219L<http://cpants.cpanauthors.org/dist/Statistics-Descriptive>
220
221=item *
222
223CPAN Testers
224
225The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions.
226
227L<http://www.cpantesters.org/distro/S/Statistics-Descriptive>
228
229=item *
230
231CPAN Testers Matrix
232
233The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms.
234
235L<http://matrix.cpantesters.org/?dist=Statistics-Descriptive>
236
237=item *
238
239CPAN Testers Dependencies
240
241The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution.
242
243L<http://deps.cpantesters.org/?module=Statistics::Descriptive>
244
245=back
246
247=head2 Bugs / Feature Requests
248
249Please report any bugs or feature requests by email to C<bug-statistics-descriptive at rt.cpan.org>, or through
250the web interface at L<https://rt.cpan.org/Public/Bug/Report.html?Queue=Statistics-Descriptive>. You will be automatically notified of any
251progress on the request by the system.
252
253=head2 Source Code
254
255The code is open to the world, and available for you to hack on. Please feel free to browse it and play
256with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
257from your repository :)
258
259L<https://github.com/shlomif/perl-Statistics-Descriptive>
260
261  git clone git://github.com/shlomif/perl-Statistics-Descriptive.git
262
263=head1 AUTHOR
264
265Shlomi Fish <shlomif@cpan.org>
266
267=head1 BUGS
268
269Please report any bugs or feature requests on the bugtracker website
270L<https://github.com/shlomif/perl-Statistics-Descriptive/issues>
271
272When submitting a bug or request, please include a test-file or a
273patch to an existing test-file that illustrates the bug or desired
274feature.
275
276=head1 COPYRIGHT AND LICENSE
277
278This software is copyright (c) 1997 by Jason Kastner, Andrea Spinelli, Colin Kuskie, and others.
279
280This is free software; you can redistribute it and/or modify it under
281the same terms as the Perl 5 programming language system itself.
282
283=cut
284