line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Math::Business::SM::Stochastic; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
6040
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
4
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
22
|
|
5
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
56
|
|
6
|
|
|
|
|
|
|
|
7
|
1
|
|
|
1
|
|
475
|
use Math::Business::SMA; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
43
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
1; |
10
|
|
|
|
|
|
|
|
11
|
0
|
|
|
0
|
0
|
0
|
sub tag { (shift)->{tag} } |
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
5
|
use constant METHOD_LANE => 0; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
84
|
|
14
|
1
|
|
|
1
|
|
5
|
use constant METHOD_FAST => 1; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
50
|
|
15
|
1
|
|
|
1
|
|
4
|
use constant METHOD_SLOW => 2; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
16
|
1
|
|
|
1
|
|
4
|
use constant METHOD_FULL => 3; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
6653
|
|
17
|
|
|
|
|
|
|
|
18
|
0
|
|
|
0
|
0
|
0
|
sub recommended { my $class = shift; return $class->new(METHOD_LANE,5,3); } |
|
0
|
|
|
|
|
0
|
|
19
|
|
|
|
|
|
|
|
20
|
1
|
|
50
|
1
|
0
|
7
|
sub method_slow { my $class = shift; return $class->new(METHOD_SLOW,$_[0]||14,$_[1]||3); } |
|
1
|
|
50
|
|
|
7
|
|
21
|
1
|
|
50
|
1
|
0
|
1745
|
sub method_fast { my $class = shift; return $class->new(METHOD_FAST,$_[0]||14,$_[1]||3); } |
|
1
|
|
50
|
|
|
14
|
|
22
|
1
|
|
50
|
1
|
0
|
5
|
sub method_full { my $class = shift; return $class->new(METHOD_FULL,$_[0]||14,$_[1]||3,$_[2]||3); } |
|
1
|
|
50
|
|
|
11
|
|
|
|
|
50
|
|
|
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
sub new { |
25
|
3
|
|
|
3
|
0
|
7
|
my $class = shift; |
26
|
3
|
|
50
|
|
|
13
|
my $meth = shift || METHOD_LANE; |
27
|
3
|
|
50
|
|
|
8
|
my $kp = shift || 5; |
28
|
3
|
|
50
|
|
|
9
|
my $dp = shift || 3; |
29
|
3
|
|
100
|
|
|
15
|
my $xp = shift || 3; |
30
|
|
|
|
|
|
|
|
31
|
3
|
|
|
|
|
11
|
my $this = bless {}, $class; |
32
|
|
|
|
|
|
|
|
33
|
3
|
|
|
|
|
10
|
$this->set_method( $meth ); |
34
|
3
|
|
|
|
|
26
|
$this->set_days( $kp ); |
35
|
3
|
|
|
|
|
7
|
$this->set_dperiod( $dp ); |
36
|
3
|
|
|
|
|
9
|
$this->set_xperiod( $xp ); |
37
|
|
|
|
|
|
|
|
38
|
3
|
|
|
|
|
9
|
return $this; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
sub set_days { |
42
|
3
|
|
|
3
|
0
|
7
|
my $this = shift; |
43
|
3
|
|
|
|
|
4
|
my $arg = shift; |
44
|
|
|
|
|
|
|
|
45
|
3
|
50
|
|
|
|
9
|
croak "days must be a positive non-zero integer" if $arg <= 0; |
46
|
|
|
|
|
|
|
|
47
|
3
|
|
|
|
|
4
|
$this->{kp} = $arg; |
48
|
3
|
|
|
|
|
7
|
$this->set_tag; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub set_dperiod { |
52
|
3
|
|
|
3
|
0
|
4
|
my $this = shift; |
53
|
3
|
|
|
|
|
4
|
my $arg = shift; |
54
|
|
|
|
|
|
|
|
55
|
3
|
50
|
|
|
|
7
|
croak "days must be a positive non-zero integer" if $arg <= 0; |
56
|
|
|
|
|
|
|
|
57
|
3
|
|
|
|
|
5
|
$this->{dp} = $arg; |
58
|
3
|
|
|
|
|
6
|
$this->set_tag; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub set_xperiod { |
62
|
3
|
|
|
3
|
0
|
6
|
my $this = shift; |
63
|
3
|
|
|
|
|
4
|
my $arg = shift; |
64
|
|
|
|
|
|
|
|
65
|
3
|
50
|
|
|
|
6
|
croak "days must be a positive non-zero integer" if $arg <= 0; |
66
|
|
|
|
|
|
|
|
67
|
3
|
|
|
|
|
6
|
$this->{xp} = $arg; |
68
|
3
|
|
|
|
|
6
|
$this->set_tag; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub set_method { |
72
|
3
|
|
|
3
|
0
|
5
|
my $this = shift; |
73
|
3
|
|
|
|
|
5
|
my $meth = shift; |
74
|
|
|
|
|
|
|
|
75
|
3
|
50
|
|
|
|
6
|
croak "method not known" unless grep {$meth == $_} (METHOD_LANE, METHOD_FAST, METHOD_SLOW, METHOD_FULL); |
|
12
|
|
|
|
|
31
|
|
76
|
|
|
|
|
|
|
|
77
|
3
|
|
|
|
|
13
|
$this->{m} = $meth; |
78
|
|
|
|
|
|
|
|
79
|
3
|
|
|
|
|
5
|
delete $this->{ksma}; |
80
|
3
|
|
|
|
|
9
|
delete $this->{dsma}; |
81
|
|
|
|
|
|
|
|
82
|
3
|
|
|
|
|
23
|
$this->set_tag; |
83
|
|
|
|
|
|
|
|
84
|
3
|
|
|
|
|
4
|
return; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub set_tag { |
88
|
12
|
|
|
12
|
0
|
17
|
my $this = shift; |
89
|
|
|
|
|
|
|
|
90
|
12
|
100
|
|
|
|
23
|
return if grep { not defined } @$this{qw(kp dp xp)}; |
|
36
|
|
|
|
|
91
|
|
91
|
|
|
|
|
|
|
|
92
|
3
|
100
|
|
|
|
16
|
if( $this->{m} == METHOD_FULL ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
93
|
1
|
|
|
|
|
7
|
$this->{tag} = "FullSTO($this->{kp},$this->{dp},$this->{xp})"; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
} elsif( $this->{m} == METHOD_FAST ) { |
96
|
1
|
|
|
|
|
7
|
$this->{tag} = "FSTO($this->{kp},$this->{dp})"; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
} elsif( $this->{m} == METHOD_SLOW ) { |
99
|
1
|
|
|
|
|
6
|
$this->{tag} = "SSTO($this->{kp},$this->{dp})"; |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
} else { |
102
|
0
|
|
|
|
|
0
|
$this->{tag} = "STO($this->{kp},$this->{dp})"; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
{ |
107
|
|
|
|
|
|
|
my $method = { |
108
|
|
|
|
|
|
|
METHOD_LANE() => \&insert_lane, |
109
|
|
|
|
|
|
|
METHOD_FAST() => \&insert_fast, |
110
|
|
|
|
|
|
|
METHOD_SLOW() => \&insert_slow, |
111
|
|
|
|
|
|
|
METHOD_FULL() => \&insert_full, |
112
|
|
|
|
|
|
|
}; |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub insert { |
115
|
90
|
|
|
90
|
0
|
6121
|
my $this = shift; |
116
|
90
|
|
|
|
|
175
|
my $m = $method->{$this->{m}}; |
117
|
|
|
|
|
|
|
|
118
|
90
|
|
|
|
|
182
|
return $this->$m( @_ ); |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# {{{ sub insert_lane |
123
|
|
|
|
|
|
|
sub insert_lane { |
124
|
0
|
|
|
0
|
0
|
0
|
my $this = shift; |
125
|
|
|
|
|
|
|
|
126
|
0
|
|
0
|
|
|
0
|
my $l = ($this->{low_hist} ||= []); |
127
|
0
|
|
0
|
|
|
0
|
my $h = ($this->{high_hist} ||= []); |
128
|
0
|
|
|
|
|
0
|
my $kp = $this->{kp}; |
129
|
0
|
|
|
|
|
0
|
my $dp = $this->{dp}; |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
|
|
|
0
|
my ($K, $D); |
132
|
0
|
|
|
|
|
0
|
while( defined( my $point = shift ) ) { |
133
|
0
|
0
|
0
|
|
|
0
|
croak "insert takes three tuple (high, low, close)" unless ref $point eq "ARRAY" and @$point == 3; |
134
|
0
|
|
|
|
|
0
|
my ($t_high, $t_low, $t_close) = @$point; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
0
|
push @$l, $t_low; shift @$l while @$l > $kp; |
|
0
|
|
|
|
|
0
|
|
137
|
0
|
|
|
|
|
0
|
push @$h, $t_high; shift @$h while @$h > $kp; |
|
0
|
|
|
|
|
0
|
|
138
|
|
|
|
|
|
|
|
139
|
0
|
0
|
|
|
|
0
|
if( @$l == $kp ) { |
140
|
0
|
0
|
|
|
|
0
|
my $L = $l->[0]; for( 1 .. $#$l ) { $L = $l->[$_] if $l->[$_] < $L }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
141
|
0
|
0
|
|
|
|
0
|
my $H = $h->[0]; for( 1 .. $#$h ) { $H = $h->[$_] if $h->[$_] > $H }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
142
|
|
|
|
|
|
|
|
143
|
0
|
|
|
|
|
0
|
$K = 100 * ($t_close - $L)/($H-$L); |
144
|
|
|
|
|
|
|
|
145
|
0
|
0
|
|
|
|
0
|
$L = $l->[-$dp]; for( (-$dp+1) .. -1 ) { $L = $l->[$_] if $l->[$_] < $L }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
146
|
0
|
0
|
|
|
|
0
|
$H = $h->[-$dp]; for( (-$dp+1) .. -1 ) { $H = $h->[$_] if $h->[$_] > $H }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
147
|
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
0
|
$D = 100 * $H / $L; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
0
|
|
|
|
|
0
|
$this->{K} = $K; |
153
|
0
|
|
|
|
|
0
|
$this->{D} = $D; |
154
|
|
|
|
|
|
|
|
155
|
0
|
|
|
|
|
0
|
return; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
# }}} |
159
|
|
|
|
|
|
|
# {{{ sub insert_fast |
160
|
|
|
|
|
|
|
sub insert_fast { |
161
|
30
|
|
|
30
|
0
|
41
|
my $this = shift; |
162
|
|
|
|
|
|
|
|
163
|
30
|
|
100
|
|
|
90
|
my $l = ($this->{low_hist} ||= []); |
164
|
30
|
|
100
|
|
|
90
|
my $h = ($this->{high_hist} ||= []); |
165
|
30
|
|
|
|
|
47
|
my $kp = $this->{kp}; |
166
|
30
|
|
|
|
|
45
|
my $dp = $this->{dp}; |
167
|
|
|
|
|
|
|
|
168
|
30
|
|
66
|
|
|
88
|
my $dsma = ($this->{dsma} ||= Math::Business::SMA->new($dp)); |
169
|
|
|
|
|
|
|
|
170
|
30
|
|
|
|
|
34
|
my ($K, $D); |
171
|
30
|
|
|
|
|
74
|
while( defined( my $point = shift ) ) { |
172
|
30
|
50
|
33
|
|
|
155
|
croak "insert takes three tuple (high, low, close)" unless ref $point eq "ARRAY" and @$point == 3; |
173
|
30
|
|
|
|
|
58
|
my ($t_high, $t_low, $t_close) = @$point; |
174
|
|
|
|
|
|
|
|
175
|
30
|
|
|
|
|
54
|
push @$l, $t_low; shift @$l while @$l > $kp; |
|
30
|
|
|
|
|
93
|
|
176
|
30
|
|
|
|
|
46
|
push @$h, $t_high; shift @$h while @$h > $kp; |
|
30
|
|
|
|
|
93
|
|
177
|
|
|
|
|
|
|
|
178
|
30
|
100
|
|
|
|
86
|
if( @$l == $kp ) { |
179
|
17
|
100
|
|
|
|
30
|
my $L = $l->[0]; for( 1 .. $#$l ) { $L = $l->[$_] if $l->[$_] < $L }; |
|
17
|
|
|
|
|
194
|
|
|
221
|
|
|
|
|
599
|
|
180
|
17
|
100
|
|
|
|
30
|
my $H = $h->[0]; for( 1 .. $#$h ) { $H = $h->[$_] if $h->[$_] > $H }; |
|
17
|
|
|
|
|
34
|
|
|
221
|
|
|
|
|
497
|
|
181
|
|
|
|
|
|
|
|
182
|
17
|
|
|
|
|
43
|
$K = 100 * ($t_close - $L)/($H-$L); |
183
|
|
|
|
|
|
|
|
184
|
17
|
|
|
|
|
51
|
$dsma->insert($K); |
185
|
17
|
|
|
|
|
45
|
$D = $dsma->query; |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
30
|
|
|
|
|
46
|
$this->{K} = $K; |
190
|
30
|
|
|
|
|
42
|
$this->{D} = $D; |
191
|
|
|
|
|
|
|
|
192
|
30
|
|
|
|
|
74
|
return; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# }}} |
196
|
|
|
|
|
|
|
# {{{ sub insert_slow |
197
|
|
|
|
|
|
|
sub insert_slow { |
198
|
30
|
|
|
30
|
0
|
44
|
my $this = shift; |
199
|
|
|
|
|
|
|
|
200
|
30
|
|
100
|
|
|
81
|
my $l = ($this->{low_hist} ||= []); |
201
|
30
|
|
100
|
|
|
76
|
my $h = ($this->{high_hist} ||= []); |
202
|
30
|
|
|
|
|
49
|
my $kp = $this->{kp}; |
203
|
30
|
|
|
|
|
48
|
my $dp = $this->{dp}; |
204
|
|
|
|
|
|
|
|
205
|
30
|
|
66
|
|
|
215
|
my $dsma = ($this->{dsma} ||= Math::Business::SMA->new($dp)); |
206
|
30
|
|
66
|
|
|
618
|
my $ksma = ($this->{ksma} ||= Math::Business::SMA->new($dp)); |
207
|
|
|
|
|
|
|
|
208
|
30
|
|
|
|
|
35
|
my ($K, $D); |
209
|
30
|
|
|
|
|
73
|
while( defined( my $point = shift ) ) { |
210
|
30
|
50
|
33
|
|
|
145
|
croak "insert takes three tuple (high, low, close)" unless ref $point eq "ARRAY" and @$point == 3; |
211
|
30
|
|
|
|
|
50
|
my ($t_high, $t_low, $t_close) = @$point; |
212
|
|
|
|
|
|
|
|
213
|
30
|
|
|
|
|
50
|
push @$l, $t_low; shift @$l while @$l > $kp; |
|
30
|
|
|
|
|
85
|
|
214
|
30
|
|
|
|
|
47
|
push @$h, $t_high; shift @$h while @$h > $kp; |
|
30
|
|
|
|
|
78
|
|
215
|
|
|
|
|
|
|
|
216
|
30
|
100
|
|
|
|
88
|
if( @$l == $kp ) { |
217
|
17
|
100
|
|
|
|
27
|
my $L = $l->[0]; for( 1 .. $#$l ) { $L = $l->[$_] if $l->[$_] < $L }; |
|
17
|
|
|
|
|
32
|
|
|
221
|
|
|
|
|
524
|
|
218
|
17
|
100
|
|
|
|
27
|
my $H = $h->[0]; for( 1 .. $#$h ) { $H = $h->[$_] if $h->[$_] > $H }; |
|
17
|
|
|
|
|
46
|
|
|
221
|
|
|
|
|
465
|
|
219
|
|
|
|
|
|
|
|
220
|
17
|
|
|
|
|
287
|
$ksma->insert( 100 * ($t_close - $L)/($H-$L) ); |
221
|
17
|
|
|
|
|
49
|
$K = $ksma->query; |
222
|
|
|
|
|
|
|
|
223
|
17
|
|
|
|
|
83
|
$dsma->insert($K); |
224
|
17
|
|
|
|
|
44
|
$D = $dsma->query; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
30
|
|
|
|
|
41
|
$this->{K} = $K; |
229
|
30
|
|
|
|
|
45
|
$this->{D} = $D; |
230
|
|
|
|
|
|
|
|
231
|
30
|
|
|
|
|
72
|
return; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# }}} |
235
|
|
|
|
|
|
|
# {{{ sub insert_full |
236
|
|
|
|
|
|
|
sub insert_full { |
237
|
30
|
|
|
30
|
0
|
42
|
my $this = shift; |
238
|
|
|
|
|
|
|
|
239
|
30
|
|
100
|
|
|
73
|
my $l = ($this->{low_hist} ||= []); |
240
|
30
|
|
100
|
|
|
71
|
my $h = ($this->{high_hist} ||= []); |
241
|
30
|
|
|
|
|
47
|
my $kp = $this->{kp}; |
242
|
30
|
|
|
|
|
41
|
my $dp = $this->{dp}; |
243
|
30
|
|
33
|
|
|
73
|
my $xp = $this->{xp} || $this->{dp}; |
244
|
|
|
|
|
|
|
|
245
|
30
|
|
66
|
|
|
68
|
my $dsma = ($this->{dsma} ||= Math::Business::SMA->new($xp)); |
246
|
30
|
|
66
|
|
|
71
|
my $ksma = ($this->{ksma} ||= Math::Business::SMA->new($xp)); |
247
|
|
|
|
|
|
|
|
248
|
30
|
|
|
|
|
36
|
my ($K, $D); |
249
|
30
|
|
|
|
|
77
|
while( defined( my $point = shift ) ) { |
250
|
30
|
50
|
33
|
|
|
144
|
croak "insert takes three tuple (high, low, close)" unless ref $point eq "ARRAY" and @$point == 3; |
251
|
30
|
|
|
|
|
50
|
my ($t_high, $t_low, $t_close) = @$point; |
252
|
|
|
|
|
|
|
|
253
|
30
|
|
|
|
|
46
|
push @$l, $t_low; shift @$l while @$l > $kp; |
|
30
|
|
|
|
|
93
|
|
254
|
30
|
|
|
|
|
49
|
push @$h, $t_high; shift @$h while @$h > $kp; |
|
30
|
|
|
|
|
83
|
|
255
|
|
|
|
|
|
|
|
256
|
30
|
100
|
|
|
|
88
|
if( @$l == $kp ) { |
257
|
17
|
100
|
|
|
|
20
|
my $L = $l->[0]; for( 1 .. $#$l ) { $L = $l->[$_] if $l->[$_] < $L }; |
|
17
|
|
|
|
|
36
|
|
|
221
|
|
|
|
|
1395
|
|
258
|
17
|
100
|
|
|
|
32
|
my $H = $h->[0]; for( 1 .. $#$h ) { $H = $h->[$_] if $h->[$_] > $H }; |
|
17
|
|
|
|
|
36
|
|
|
221
|
|
|
|
|
583
|
|
259
|
|
|
|
|
|
|
|
260
|
17
|
|
|
|
|
74
|
$ksma->insert( 100 * ($t_close - $L)/($H-$L) ); |
261
|
17
|
|
|
|
|
42
|
$K = $ksma->query; |
262
|
|
|
|
|
|
|
|
263
|
17
|
|
|
|
|
42
|
$dsma->insert($K); |
264
|
17
|
|
|
|
|
51
|
$D = $dsma->query; |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
30
|
|
|
|
|
48
|
$this->{K} = $K; |
269
|
30
|
|
|
|
|
40
|
$this->{D} = $D; |
270
|
|
|
|
|
|
|
|
271
|
30
|
|
|
|
|
77
|
return; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# }}} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
sub query { |
277
|
90
|
|
|
90
|
0
|
11145
|
my $this = shift; |
278
|
|
|
|
|
|
|
|
279
|
90
|
|
|
|
|
352
|
return ($this->{D}, $this->{K}); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
__END__ |