File Coverage

blib/lib/Math/Business/CCI.pm
Criterion Covered Total %
statement 56 60 93.3
branch 7 12 58.3
condition 5 9 55.5
subroutine 9 11 81.8
pod 0 7 0.0
total 77 99 77.7


line stmt bran cond sub pod time code
1             package Math::Business::CCI;
2              
3 1     1   4406 use strict;
  1         7  
  1         23  
4 1     1   4 use warnings;
  1         2  
  1         19  
5 1     1   4 use Carp;
  1         1  
  1         40  
6              
7 1     1   339 use Math::Business::SMA;
  1         2  
  1         446  
8              
9             1;
10              
11 0     0 0 0 sub tag { (shift)->{tag} }
12              
13 0     0 0 0 sub recommended { croak "no recommendation" }
14              
15             sub new {
16 1     1 0 21 my $class = shift;
17 1   50     7 my $days = shift || 20;
18 1   50     8 my $mul = shift || 0.015;
19              
20 1         13 my $this = bless {
21             sma => Math::Business::SMA->new($days),
22             }, $class;
23              
24 1         8 $this->set_days($days);
25 1         7 $this->set_scale($mul);
26              
27 1         5 return $this;
28             }
29              
30             sub set_days {
31 1     1 0 3 my $this = shift;
32 1         3 my $arg = shift;
33              
34 1 50       6 croak "days must be a positive non-zero integer" if $arg <= 0;
35              
36 1         9 $this->{sma}->set_days($arg);
37 1         4 $this->{len} = $arg;
38              
39 1 50       6 return unless exists $this->{mul};
40 0         0 my $s = sprintf("%0.0f", 1/$this->{mul});
41 0         0 $this->{tag} = "CCI($arg,$s)";
42             }
43              
44             sub set_scale {
45 1     1 0 2 my $this = shift;
46 1         4 my $scale = shift;
47              
48             # NOTE: "Lambertset the constant at 0.015 to ensure that approximately 70
49             # to 80 percent of CCI values would fall between −100 and +100"
50              
51 1         5 $this->{mul} = 1/$scale;
52              
53 1 50       6 return unless exists $this->{len};
54 1         12 my $s = sprintf("%0.0f", $scale);
55 1         7 $this->{tag} = "CCI($this->{len},$s)";
56             }
57              
58             sub insert {
59 43     43 0 520 my $this = shift;
60 43         88 my $sma = $this->{sma};
61 43         79 my $mul = $this->{mul};
62 43         89 my $len = $this->{len};
63              
64 43   100     125 my $hist = ($this->{pt_hist} ||= []);
65              
66 43         75 my $cci;
67 43         115 while( defined( my $point = shift ) ) {
68 43 50 33     211 croak "insert takes three tuple (high, low, close)" unless ref $point eq "ARRAY" and @$point == 3;
69 43         115 my ($t_high, $t_low, $t_close) = @$point;
70 43         192 my $pt = ($t_high + $t_low + $t_close) / 3;
71              
72 43         124 push @$hist, $pt;
73 43         143 shift @$hist while @$hist > $len;
74              
75 43         168 $sma->insert( $pt );
76 43 100       131 if( defined (my $v = $sma->query) ) {
77 24         60 my @mad = map { abs($v - $_) } @$hist;
  480         956  
78 24         55 my $mad = shift @mad;
79 24         139 $mad += $_ for @mad;
80 24         69 $mad /= @mad+1;
81              
82 24 50       71 if( @$hist == $len ) {
83 24         114 $cci = $mul * ( $pt - $v ) / $mad;
84             }
85             }
86             }
87              
88 43         99 $this->{CCI} = $cci;
89              
90 43         114 return;
91             }
92              
93             sub query {
94 43     43 0 210 my $this = shift;
95              
96 43         185 return $this->{CCI};
97             }
98              
99             __END__