| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Math::Business::RSI; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 3 |  |  | 3 |  | 4768 | use strict; | 
|  | 3 |  |  |  |  | 12 |  | 
|  | 3 |  |  |  |  | 84 |  | 
| 4 | 3 |  |  | 3 |  | 16 | use warnings; | 
|  | 3 |  |  |  |  | 8 |  | 
|  | 3 |  |  |  |  | 79 |  | 
| 5 | 3 |  |  | 3 |  | 13 | use Carp; | 
|  | 3 |  |  |  |  | 5 |  | 
|  | 3 |  |  |  |  | 168 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 3 |  |  | 3 |  | 1047 | use Math::Business::SMA; | 
|  | 3 |  |  |  |  | 7 |  | 
|  | 3 |  |  |  |  | 70 |  | 
| 8 | 3 |  |  | 3 |  | 678 | use Math::Business::EMA; | 
|  | 3 |  |  |  |  | 6 |  | 
|  | 3 |  |  |  |  | 2004 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  | 1; | 
| 11 |  |  |  |  |  |  |  | 
| 12 | 0 |  |  | 0 | 0 | 0 | sub tag { (shift)->{tag} } | 
| 13 |  |  |  |  |  |  |  | 
| 14 |  |  |  |  |  |  | sub recommended { | 
| 15 | 1 |  |  | 1 | 0 | 5 | my $class = shift; | 
| 16 |  |  |  |  |  |  |  | 
| 17 | 1 |  |  |  |  | 2 | $class->new(14); | 
| 18 |  |  |  |  |  |  | } | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | sub new { | 
| 21 | 5 |  |  | 5 | 0 | 398 | my $class = shift; | 
| 22 | 5 |  |  |  |  | 48 | my $this  = bless { | 
| 23 |  |  |  |  |  |  | U   => Math::Business::EMA->new, | 
| 24 |  |  |  |  |  |  | D   => Math::Business::EMA->new, | 
| 25 |  |  |  |  |  |  | RSI => undef, | 
| 26 |  |  |  |  |  |  | cy  => undef, | 
| 27 |  |  |  |  |  |  | }, $class; | 
| 28 |  |  |  |  |  |  |  | 
| 29 | 5 |  |  |  |  | 9 | my $alpha = shift; | 
| 30 | 5 | 100 |  |  |  | 12 | if( defined $alpha ) { | 
| 31 | 4 |  |  |  |  | 8 | $this->set_alpha( $alpha ); | 
| 32 |  |  |  |  |  |  | } | 
| 33 |  |  |  |  |  |  |  | 
| 34 | 5 |  |  |  |  | 20 | return $this; | 
| 35 |  |  |  |  |  |  | } | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | sub set_alpha { | 
| 38 | 4 |  |  | 4 | 0 | 6 | my $this  = shift; | 
| 39 | 4 |  |  |  |  | 7 | my $alpha = shift; | 
| 40 |  |  |  |  |  |  |  | 
| 41 |  |  |  |  |  |  | # NOTE: this alpha is different than you might think ... it's really inverse alpha | 
| 42 |  |  |  |  |  |  | # Wilder uses alpha=14 instead of alpha=(1/14) like you might expect | 
| 43 |  |  |  |  |  |  |  | 
| 44 | 4 |  |  |  |  | 7 | my $days = 2*$alpha - 1; # so days is 2*$alpha-1 instead of the expected 2*(1/$alpha)-1 | 
| 45 |  |  |  |  |  |  |  | 
| 46 | 4 |  |  |  |  | 6 | eval { $this->set_days( $days ) }; | 
|  | 4 |  |  |  |  | 11 |  | 
| 47 | 4 | 50 |  |  |  | 10 | croak "set_alpha() is basically set_days(2*$alpha-1), which complained: $@" if $@; | 
| 48 | 4 |  |  |  |  | 9 | $this->set_tag; | 
| 49 |  |  |  |  |  |  | } | 
| 50 |  |  |  |  |  |  |  | 
| 51 |  |  |  |  |  |  | sub set_standard { | 
| 52 | 1 |  |  | 1 | 0 | 3 | my $this = shift; | 
| 53 | 1 |  |  |  |  | 6 | my $rm   = ref $this->{U}; | 
| 54 |  |  |  |  |  |  |  | 
| 55 | 1 | 50 |  |  |  | 7 | if( $rm =~ m/SMA/ ) { | 
| 56 | 1 |  |  |  |  | 5 | $this->{U} = Math::Business::EMA->new; | 
| 57 | 1 |  |  |  |  | 4 | $this->{D} = Math::Business::EMA->new; | 
| 58 |  |  |  |  |  |  |  | 
| 59 | 1 | 50 |  |  |  | 4 | if( my $d = $this->{days} ) { | 
| 60 | 1 |  |  |  |  | 2 | $this->set_days($d); | 
| 61 |  |  |  |  |  |  | } | 
| 62 |  |  |  |  |  |  | } | 
| 63 | 1 |  |  |  |  | 2 | $this->set_tag; | 
| 64 |  |  |  |  |  |  | } | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | sub set_cutler { | 
| 67 | 1 |  |  | 1 | 0 | 4 | my $this = shift; | 
| 68 | 1 |  |  |  |  | 2 | my $rm   = ref $this->{U}; | 
| 69 |  |  |  |  |  |  |  | 
| 70 | 1 | 50 |  |  |  | 4 | if( $rm =~ m/EMA/ ) { | 
| 71 | 1 |  |  |  |  | 6 | $this->{U} = Math::Business::SMA->new; | 
| 72 | 1 |  |  |  |  | 6 | $this->{D} = Math::Business::SMA->new; | 
| 73 |  |  |  |  |  |  |  | 
| 74 | 1 | 50 |  |  |  | 9 | if( my $d = $this->{days} ) { | 
| 75 | 1 |  |  |  |  | 4 | $this->set_days($d); | 
| 76 |  |  |  |  |  |  | } | 
| 77 |  |  |  |  |  |  | } | 
| 78 | 1 |  |  |  |  | 3 | $this->set_tag; | 
| 79 |  |  |  |  |  |  | } | 
| 80 |  |  |  |  |  |  |  | 
| 81 |  |  |  |  |  |  | sub set_days { | 
| 82 | 7 |  |  | 7 | 0 | 13 | my $this = shift; | 
| 83 | 7 |  |  |  |  | 13 | my $arg  = int(shift); | 
| 84 |  |  |  |  |  |  |  | 
| 85 | 7 | 50 |  |  |  | 15 | croak "days must be a positive non-zero integer" if $arg <= 0; | 
| 86 |  |  |  |  |  |  |  | 
| 87 | 7 |  |  |  |  | 36 | $this->{U}->set_days($this->{days} = $arg); | 
| 88 | 7 |  |  |  |  | 23 | $this->{D}->set_days($arg); | 
| 89 | 7 |  |  |  |  | 11 | delete $this->{cy}; | 
| 90 | 7 |  |  |  |  | 9 | delete $this->{RSI}; | 
| 91 | 7 |  |  |  |  | 18 | $this->set_tag; | 
| 92 |  |  |  |  |  |  | } | 
| 93 |  |  |  |  |  |  |  | 
| 94 |  |  |  |  |  |  | sub set_tag { | 
| 95 | 13 |  |  | 13 | 0 | 25 | my $this = shift; | 
| 96 |  |  |  |  |  |  |  | 
| 97 | 13 | 100 |  |  |  | 52 | if( $this->{U}->isa("Math::Business::EMA") ) { | 
| 98 | 11 |  |  |  |  | 34 | $this->{tag} = "RSI($this->{days})"; | 
| 99 |  |  |  |  |  |  |  | 
| 100 |  |  |  |  |  |  | } else { | 
| 101 | 2 |  |  |  |  | 7 | $this->{tag} = "RSI($this->{days},cutler)"; | 
| 102 |  |  |  |  |  |  | } | 
| 103 |  |  |  |  |  |  | } | 
| 104 |  |  |  |  |  |  |  | 
| 105 |  |  |  |  |  |  | sub insert { | 
| 106 | 2527 |  |  | 2527 | 0 | 3646 | my $this = shift; | 
| 107 | 2527 |  |  |  |  | 3009 | my $close_yesterday = $this->{cy}; | 
| 108 |  |  |  |  |  |  |  | 
| 109 | 2527 |  |  |  |  | 2782 | my $EMA_U = $this->{U}; | 
| 110 | 2527 |  |  |  |  | 2832 | my $EMA_D = $this->{D}; | 
| 111 |  |  |  |  |  |  |  | 
| 112 | 2527 | 50 |  |  |  | 3609 | croak "You must set the number of days before you try to insert" if not $this->{days}; | 
| 113 | 2527 |  |  |  |  | 3737 | while( defined( my $close_today = shift ) ) { | 
| 114 | 3277 | 100 |  |  |  | 4570 | if( defined $close_yesterday ) { | 
| 115 | 3271 |  |  |  |  | 4058 | my $delta = $close_today - $close_yesterday; | 
| 116 |  |  |  |  |  |  |  | 
| 117 | 3271 |  |  |  |  | 4365 | my ($U,$D) = (0,0); | 
| 118 | 3271 | 100 |  |  |  | 5148 | if( $delta > 0 ) { | 
|  |  | 100 |  |  |  |  |  | 
| 119 | 1619 |  |  |  |  | 1785 | $U = $delta; | 
| 120 | 1619 |  |  |  |  | 1743 | $D = 0; | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | } elsif( $delta < 0 ) { | 
| 123 | 1635 |  |  |  |  | 1750 | $U = 0; | 
| 124 | 1635 |  |  |  |  | 1839 | $D = abs $delta; | 
| 125 |  |  |  |  |  |  | } | 
| 126 |  |  |  |  |  |  |  | 
| 127 | 3271 |  |  |  |  | 6316 | $EMA_U->insert($U); | 
| 128 | 3271 |  |  |  |  | 5085 | $EMA_D->insert($D); | 
| 129 |  |  |  |  |  |  | } | 
| 130 |  |  |  |  |  |  |  | 
| 131 | 3277 | 100 |  |  |  | 5418 | if( defined(my $eu = $EMA_U->query) ) { | 
| 132 | 3187 |  |  |  |  | 4771 | my $ed = $EMA_D->query; | 
| 133 | 3187 | 50 |  |  |  | 5233 | my $rs = (($ed == 0) ? 100 : $eu/$ed ); # NOTE: This is by definition apparently. | 
| 134 |  |  |  |  |  |  |  | 
| 135 | 3187 |  |  |  |  | 4622 | $this->{RSI} = 100 - 100/(1+$rs); | 
| 136 |  |  |  |  |  |  | } | 
| 137 |  |  |  |  |  |  |  | 
| 138 | 3277 |  |  |  |  | 6232 | $close_yesterday = $close_today; | 
| 139 |  |  |  |  |  |  | } | 
| 140 |  |  |  |  |  |  |  | 
| 141 | 2527 |  |  |  |  | 4067 | $this->{cy} = $close_yesterday; | 
| 142 |  |  |  |  |  |  | } | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  | sub query { | 
| 145 | 2528 |  |  | 2528 | 0 | 2738 | my $this = shift; | 
| 146 |  |  |  |  |  |  |  | 
| 147 | 2528 |  |  |  |  | 4272 | return $this->{RSI}; | 
| 148 |  |  |  |  |  |  | } | 
| 149 |  |  |  |  |  |  |  | 
| 150 |  |  |  |  |  |  | __END__ |