File Coverage

blib/lib/Math/Business/BollingerBands.pm
Criterion Covered Total %
statement 65 69 94.2
branch 11 18 61.1
condition 1 3 33.3
subroutine 9 11 81.8
pod 0 7 0.0
total 86 108 79.6


line stmt bran cond sub pod time code
1             package Math::Business::BollingerBands;
2              
3 1     1   3415 use strict;
  1         5  
  1         20  
4 1     1   4 use warnings;
  1         1  
  1         17  
5 1     1   3 use Carp;
  1         2  
  1         226  
6              
7             1;
8              
9 0     0 0 0 sub tag { (shift)->{tag} }
10              
11             sub recommended {
12 0     0 0 0 my $class = shift;
13              
14 0         0 $class->new(20, 2);
15             }
16              
17             sub new {
18 1     1 0 12 my $class = shift;
19 1         6 my $this = bless {
20             dev => [],
21             val => [],
22             N => undef, # days in the average
23             K => undef, # deviations
24             }, $class;
25              
26 1 50       3 if( @_ == 2 ) {
27 1         5 $this->set_days($_[0]);
28 1         3 $this->set_deviations($_[1]);
29             }
30              
31 1         3 return $this;
32             }
33              
34             sub set_deviations {
35 1     1 0 2 my $this = shift;
36 1         2 my $arg = shift;
37              
38 1 50       3 croak "deviations must be a positive non-zero integer" if $arg <= 0;
39 1         2 $this->{K} = $arg;
40              
41 1         4 $this->{tag} = "BOLL($this->{K},$this->{N})";
42             }
43              
44             sub set_days {
45 1     1 0 1 my $this = shift;
46 1         3 my $arg = int shift;
47              
48 1 50       3 croak "days must be a positive non-zero integer" if $arg <= 0;
49 1         4 $this->{N} = $arg;
50              
51 1         2 $this->{val} = [];
52 1         2 $this->{dev} = [];
53              
54 1         2 delete $this->{M};
55 1         1 delete $this->{U};
56 1         1 delete $this->{L};
57              
58 1     1   5 no warnings 'uninitialized';
  1         2  
  1         302  
59 1         5 $this->{tag} = "BOLL($this->{K},$this->{N})";
60             }
61              
62             sub insert {
63 5     5 0 748 my $this = shift;
64 5         9 my $val = $this->{val};
65              
66 5         6 my $N = $this->{N};
67 5         14 my $K = $this->{K};
68              
69 5 50 33     16 croak "You must set the number of days and deviations before you try to insert" unless $N and $K;
70 5         10 while( defined(my $value = shift) ) {
71 42         44 push @$val, $value;
72              
73 42 100       66 if( @$val >= $N ) {
74 23 100       29 if( defined( my $s = $this->{M} ) ) {
75 22         23 my $old = shift @$val;
76 22         36 $this->{M} = my $M = $s - $old/$N + $value/$N;
77              
78 22         28 my @dev = map {($_-$M)**2} @$val;
  440         454  
79              
80 22         26 my $sum = 0;
81 22         69 $sum += $_ for @dev;
82 22         22 $sum /= $N;
83              
84 22 50       27 my $k_stddev = $K * ($sum<0.000_000_000_6 ? 0 : sqrt($sum));
85 22         23 $this->{L} = $M - $k_stddev;
86 22         52 $this->{U} = $M + $k_stddev;
87              
88             } else {
89 1         2 my $sum = 0;
90 1         17 $sum += $_ for @$val;
91              
92 1         5 $this->{M} = my $M = $sum/$N;
93 1         2 my @dev = map {($_-$M)**2} @$val;
  20         25  
94              
95 1         2 $sum = 0;
96 1         4 $sum += $_ for @dev;
97 1         2 $sum /= $N;
98              
99 1 50       6 my $k_stddev = $K * ($sum<0.000_000_000_6 ? 0 : sqrt($sum));
100 1         2 $this->{L} = $M - $k_stddev;
101 1         4 $this->{U} = $M + $k_stddev;
102             }
103             }
104             }
105             }
106              
107             sub query {
108 4     4 0 12 my $this = shift;
109              
110 4 50       12 return ($this->{L}, $this->{M}, $this->{U}) if wantarray;
111 0           return $this->{M};
112             }
113              
114             __END__