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__ |