File Coverage

blib/lib/Statistics/Descriptive/Smoother/Weightedexponential.pm
Criterion Covered Total %
statement 48 48 100.0
branch 2 2 100.0
condition 1 2 50.0
subroutine 9 9 100.0
pod 1 1 100.0
total 61 62 98.3


line stmt bran cond sub pod time code
1             package Statistics::Descriptive::Smoother::Weightedexponential;
2             $Statistics::Descriptive::Smoother::Weightedexponential::VERSION = '3.0801';
3 2     2   15 use strict;
  2         4  
  2         75  
4 2     2   12 use warnings;
  2         5  
  2         71  
5              
6 2     2   13 use Carp qw/ carp /;
  2         4  
  2         121  
7 2     2   464 use parent 'Statistics::Descriptive::Smoother';
  2         311  
  2         15  
8              
9             sub _new
10             {
11 5     5   14 my ( $class, $args ) = @_;
12              
13 5 100       10 if ( scalar @{ $args->{data} } != scalar @{ $args->{samples} } )
  5         12  
  5         16  
14             {
15 1         244 carp("Number of data values and samples need to be the same\n");
16 1         44 return;
17             }
18              
19 4   50     27 return bless $args || {}, $class;
20             }
21              
22             # The name of the variables used in the code refers to the explanation in the pod
23             sub get_smoothed_data
24             {
25 3     3 1 24 my ($self) = @_;
26              
27 3         6 my ( @smoothed_values, @Wts );
28              
29             # W(0) = N(0)
30 3         6 push @Wts, @{ $self->{samples} }[0];
  3         13  
31              
32             # S(0) = X(0)
33 3         6 push @smoothed_values, @{ $self->{data} }[0];
  3         7  
34 3         10 my $C = $self->get_smoothing_coeff();
35              
36 3         14 foreach my $idx ( 1 .. ( $self->{count} - 1 ) )
37             {
38 27         45 my $Xt = $self->{data}->[$idx];
39 27         41 my $Nt = $self->{samples}->[$idx];
40 27         43 my $St_1 = $smoothed_values[-1];
41 27         35 my $Wt_1 = $Wts[-1];
42              
43 27         53 push @Wts, $self->_get_Wt( $Wt_1, $Nt );
44              
45 27         59 my $coeff_a = $self->_get_coeff_A( $Wt_1, $Nt );
46 27         51 my $coeff_b = $self->_get_coeff_B( $Wt_1, $Nt );
47              
48 27         52 my $smoothed_value =
49             ( $St_1 * $coeff_a + $Xt * $coeff_b ) / ( $coeff_a + $coeff_b );
50 27         57 push @smoothed_values, $smoothed_value;
51             }
52 3         21 return @smoothed_values;
53             }
54              
55             sub _get_Wt
56             {
57 27     27   49 my ( $self, $Wt_1, $Nt ) = @_;
58              
59 27         56 my $C = $self->get_smoothing_coeff();
60 27         51 my $coeff_a = $self->_get_coeff_A( $Wt_1, $Nt );
61 27         48 my $coeff_b = $self->_get_coeff_B( $Wt_1, $Nt );
62              
63 27         61 return ( ( $Wt_1 * $coeff_a + $Nt * $coeff_b ) / ( $coeff_a + $coeff_b ) );
64             }
65              
66             sub _get_coeff_A
67             {
68 54     54   97 my ( $self, $Wt_1, $Nt ) = @_;
69              
70 54         103 my $C = $self->get_smoothing_coeff();
71 54         132 return $C * ( $Wt_1 / ( $Wt_1 + $Nt ) );
72             }
73              
74             sub _get_coeff_B
75             {
76 54     54   476 my ( $self, $Wt_1, $Nt ) = @_;
77              
78 54         111 my $C = $self->get_smoothing_coeff();
79 54         113 return ( 1 - $C ) * ( $Nt / ( $Nt + $Wt_1 ) );
80             }
81              
82             1;
83              
84             __END__