File Coverage

blib/lib/DSP/LinPred_XS.pm
Criterion Covered Total %
statement 68 97 70.1
branch 8 16 50.0
condition 8 9 88.8
subroutine 7 10 70.0
pod 5 7 71.4
total 96 139 69.0


line stmt bran cond sub pod time code
1             package DSP::LinPred_XS;
2 2     2   29696 use 5.008005;
  2         16  
  2         74  
3 2     2   2683 use Mouse;
  2         83318  
  2         12  
4             our $VERSION = "0.03";
5 2     2   723 use XSLoader;
  2         3  
  2         2656  
6             XSLoader::load(__PACKAGE__, $VERSION);
7              
8              
9              
10              
11             has 'mu' => (
12             is => 'rw',
13             isa => 'Num',
14             default => 0.001
15             );
16             has 'mu_mode' => (
17             is => 'rw',
18             isa => 'Int',
19             default => 0
20             );
21             has 'h_length' => (
22             is => 'rw',
23             isa => 'Int',
24             default => 100
25             );
26             has 'h' => (
27             is => 'rw',
28             isa => 'ArrayRef[Num]',
29             default => sub{[(0) x 100]}
30             );
31             has 'x_stack' => (
32             is => 'rw',
33             isa => 'ArrayRef[Num]',
34             default => sub{[(0) x 100]}
35             );
36             has 'x_count' => (
37             is => 'rw',
38             isa => 'Int',
39             default => 0
40             );
41             has 'current_error' => (
42             is => 'rw',
43             isa => 'Num',
44             default => 0
45             );
46             has 'dc' => (
47             is => 'rw',
48             isa => 'Num',
49             default => 0
50             );
51             has 'dc_init' => (
52             is => 'rw',
53             isa => 'Num',
54             default => 0
55             );
56             has 'stddev' => (
57             is => 'rw',
58             isa => 'Num',
59             default => 0
60             );
61             has 'stddev_init' => (
62             is => 'rw',
63             isa => 'Num',
64             default => 1
65             );
66             has 'est_mode' => (
67             is => 'rw',
68             isa => 'Num',
69             default => 1
70             );
71              
72              
73             # filter specification
74             # mu : step size
75             # h_length : filter size
76             sub set_filter{
77 1     1 1 9 my $self = shift;
78 1         3 my $conf = shift;
79 1 50       7 if(defined($conf->{filter_length})){
80 1         6 $self->h_length($conf->{filter_length});
81 1         26 $self->h([(0) x $conf->{filter_length}]);
82 1 50       7 if(defined($conf->{dc_init})){
83 0         0 $self->x_stack([($conf->{dc_init}) x $conf->{filter_length}]);
84             }else{
85 1         14 $self->x_stack([(0) x $conf->{filter_length}]);
86             }
87             }
88 1 50       8 if(defined($conf->{dc_init})){
89 0         0 $self->dc($conf->{dc_init});
90 0         0 $self->dc_init($conf->{dc_init});
91             }
92 1 50       8 if(defined($conf->{est_mode})){
93 1         6 $self->est_mode($conf->{est_mode});
94             }
95 1 50       6 if(defined($conf->{stddev_init})){
96 0         0 $self->stddev($conf->{stddev_init});
97 0         0 $self->stddev_init($conf->{stddev_init});
98             }
99             }
100              
101             # reset filter state
102             sub reset_state{
103 0     0 0 0 my $self = shift;
104 0         0 my $h_length = $self->h_length;
105 0         0 $self->h([(0) x $h_length]);
106 0         0 $self->x_stack([($self->dc_init) x $h_length]);
107 0         0 $self->current_error(0);
108 0         0 $self->dc($self->dc_init);
109 0         0 $self->x_count(0);
110 0         0 $self->stddev($self->stddev_init);
111             }
112              
113             # prediction only
114             # predict_num : number of output predicted values
115             # this method returns list reference of predicted values
116             sub predict{
117 1     1 1 10 my $self = shift;
118 1         3 my $predict_num = shift;
119 1         3 my $h = $self->h;
120 1         5 my $x_stack = $self->x_stack;
121 1         3 my $estimated;
122 1         5 for(0 .. $predict_num){
123 6         8 my $x_est = 0;
124 6   66     7 for( my $k = 0; $k <= $#{$h} and $k <= $self->x_count; $k++){
  606         2808  
125 600         1558 $x_est += $h->[$k] * ($x_stack->[$k] - $self->dc);
126             }
127 6         19 $x_est += $self->dc;
128 6         12 unshift(@$x_stack,$x_est);
129 6         13 push(@$estimated,$x_est);
130 6         16 pop(@$x_stack);
131             }
132 1         3 shift(@$estimated);
133 1         7 return($estimated);
134             }
135              
136             # update only
137             # x should be array reference
138              
139             sub update{
140 1     1 1 6 my $self = shift;
141 1         3 my $x = shift;
142 1         4 my $h_length = $self->h_length;
143 1         4 my $h = $self->h;
144 1         10 my $x_stack = $self->x_stack;
145            
146 1         2 for ( my $kx=0; $kx <= $#{$x}; $kx++){
  5001         13640  
147            
148 5000         9878 unshift(@$x_stack,$x->[$kx]);
149 5000         6422 pop(@$x_stack);
150 5000         17507 $self->x_count($self->x_count + 1);
151 5000 50       14971 if($self->est_mode == 1){
152 5000         10670 $self->dc_stddev_update;
153             }
154 5000         6478 my $x_est = 0;
155 5000   100     5976 for( my $k = 0; $k <= $#{$h} and $k <= $self->x_count;$k++){
  500149         2346751  
156 495149         1330363 $x_est += $h->[$k] * ($x_stack->[$k] - $self->dc);
157             }
158 5000         14772 my $error = $x->[$kx] - ($x_est + $self->dc);
159 5000         12851 $self->current_error($error);
160 5000         5886 my $h_new = $h;
161 5000         5491 my $tmp_coef = 1;
162 5000 50       15010 if($self->est_mode == 1){
163 5000         17299 $tmp_coef = $self->mu * $error / (1 + $self->stddev);
164             }else{
165 0         0 $tmp_coef = $self->mu * $error;
166             }
167 5000 50       14632 if($self->mu_mode == 1){
168 0         0 $tmp_coef = 10 * $self->mu / (1 + $self->h_length);
169             }
170            
171 5000   100     6766 for(my $k = 0;$k <= $#{$h} and $k <= $self->x_count; $k++){
  500149         2436693  
172 495149         1361629 $h_new->[$k] =
173             $h->[$k]
174             + $tmp_coef * ($x_stack->[$k] - $self->dc);
175             }
176 5000         32953 $self->h($h_new);
177             }
178             }
179              
180             ## DC component calculation and update
181             # using x_stack
182              
183             sub dc_stddev_update{
184 5000     5000 0 6288 my $self = shift;
185 5000         11537 my $x_stack = $self->x_stack;
186 5000         31963 my ($sum,$mean,$variance,$stddev) = &get_stat($x_stack);
187 5000         12914 $self->dc($mean);
188 5000         13776 $self->stddev($stddev);
189             }
190              
191              
192             ## calculation of mean value of filter
193             sub filter_dc{
194 0     0 1   my $self = shift;
195 0           my $h = $self->h;
196 0           my $mean = 0;
197 0           my $num = $#$h + 1;
198 0           for(0 .. $#$h){
199 0           $mean += $h->[$_];
200             }
201 0           return($mean / $num);
202             }
203              
204             ## calculation of stddev of filter
205             sub filter_stddev{
206 0     0 1   my $self = shift;
207 0           my $h = $self->h;
208 0           my $variance = 0;
209 0           my $num = $#$h + 1;
210 0           for(0 .. $#$h){
211 0           $variance += ($h->[$_])**2;
212             }
213 0           return(sqrt($variance / $num));
214             }
215              
216              
217              
218             1;
219             __END__