line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Math::Business::LaguerreFilter; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
6762
|
use strict; |
|
2
|
|
|
|
|
12
|
|
|
2
|
|
|
|
|
38
|
|
4
|
2
|
|
|
2
|
|
6
|
use warnings; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
33
|
|
5
|
2
|
|
|
2
|
|
6
|
use Carp; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
92
|
|
6
|
|
|
|
|
|
|
use constant { |
7
|
2
|
|
|
|
|
918
|
ALPHA => 2, |
8
|
|
|
|
|
|
|
LENGTH => 3, |
9
|
|
|
|
|
|
|
F => -2, |
10
|
|
|
|
|
|
|
TAG => -1, |
11
|
2
|
|
|
2
|
|
9
|
}; |
|
2
|
|
|
|
|
2
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
1; |
14
|
|
|
|
|
|
|
|
15
|
0
|
|
|
0
|
0
|
0
|
sub tag { (shift)->[TAG] } |
16
|
|
|
|
|
|
|
|
17
|
0
|
|
|
0
|
0
|
0
|
sub recommended { croak "no recommendation" } |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub dnew { |
20
|
0
|
|
|
0
|
0
|
0
|
my $class = shift; |
21
|
0
|
0
|
|
|
|
0
|
my $days = int shift; $days = 4 unless $days > 1; |
|
0
|
|
|
|
|
0
|
|
22
|
0
|
|
|
|
|
0
|
my $this = $class->new(2/(1+$days)); |
23
|
|
|
|
|
|
|
|
24
|
0
|
|
|
|
|
0
|
return $this; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub new { |
28
|
4
|
|
|
4
|
0
|
586
|
my $class = shift; |
29
|
4
|
|
|
|
|
12
|
my $this = bless [ |
30
|
|
|
|
|
|
|
[], # [0] P-hist |
31
|
|
|
|
|
|
|
[], # [1] L0-L4 |
32
|
|
|
|
|
|
|
0, # [2] alpha |
33
|
|
|
|
|
|
|
0, # [3] adaptive length |
34
|
|
|
|
|
|
|
[], # [4] adaptive diff history |
35
|
|
|
|
|
|
|
undef, # [5] filter |
36
|
|
|
|
|
|
|
undef, # [6] tag |
37
|
|
|
|
|
|
|
], $class; |
38
|
|
|
|
|
|
|
|
39
|
4
|
|
|
|
|
7
|
my $alpha = shift; |
40
|
4
|
100
|
|
|
|
9
|
$alpha = 0.5 if not defined $alpha; |
41
|
4
|
|
|
|
|
12
|
$this->set_alpha( $alpha ); |
42
|
|
|
|
|
|
|
|
43
|
4
|
|
|
|
|
4
|
my $length = shift; |
44
|
4
|
100
|
|
|
|
9
|
if( defined $length ) { |
45
|
1
|
|
|
|
|
8
|
$this->set_adaptive( $length ); |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
4
|
|
|
|
|
9
|
return $this; |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub reset { |
52
|
6
|
|
|
6
|
0
|
6
|
my $this = shift; |
53
|
6
|
|
|
|
|
9
|
$this->[0] = []; |
54
|
6
|
|
|
|
|
8
|
$this->[1] = []; |
55
|
6
|
|
|
|
|
9
|
$this->[4] = []; |
56
|
|
|
|
|
|
|
return |
57
|
6
|
|
|
|
|
8
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub set_days { |
60
|
0
|
|
|
0
|
0
|
0
|
my $this = shift; |
61
|
0
|
|
|
|
|
0
|
my $arg = 0+shift; |
62
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
0
|
my $alpha = 2/(1+$arg); |
64
|
0
|
|
|
|
|
0
|
eval { $this->set_alpha( $alpha ) }; |
|
0
|
|
|
|
|
0
|
|
65
|
0
|
0
|
|
|
|
0
|
croak "set_days() is basically set_alpha(2/(1+$arg)), which complained: $@" if $@; |
66
|
|
|
|
|
|
|
|
67
|
0
|
|
|
|
|
0
|
$this->[TAG] = "LAG($arg)"; |
68
|
0
|
|
|
|
|
0
|
$this->reset |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub set_alpha { |
72
|
4
|
|
|
4
|
0
|
4
|
my $this = shift; |
73
|
4
|
|
|
|
|
10
|
my $alpha = 0+shift; |
74
|
|
|
|
|
|
|
|
75
|
4
|
50
|
33
|
|
|
24
|
croak "alpha must be a real between >=0 and <=1" unless $alpha >= 0 and $alpha <= 1; |
76
|
4
|
|
|
|
|
13
|
my $arg = int ( (1/$alpha)*2-1 ); # pretty sure... gah, algebra |
77
|
|
|
|
|
|
|
|
78
|
4
|
|
|
|
|
14
|
$this->[TAG] = "LAG($arg)"; |
79
|
4
|
|
|
|
|
12
|
$this->reset |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub set_adaptive { |
83
|
2
|
|
|
2
|
0
|
5
|
my $this = shift; |
84
|
2
|
|
|
|
|
10
|
my $that = int shift; |
85
|
|
|
|
|
|
|
|
86
|
2
|
50
|
|
|
|
7
|
croak "adaptive length must be an non-negative integer" unless $that >= 0; |
87
|
2
|
|
|
|
|
3
|
$this->[LENGTH] = $that; |
88
|
2
|
|
|
|
|
6
|
$this->reset |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub insert { |
92
|
7002
|
|
|
7002
|
0
|
270786
|
my $this = shift; |
93
|
7002
|
|
|
|
|
10116
|
my ($h, $L, $alpha, $length, $diff, $filter) = @$this; |
94
|
|
|
|
|
|
|
|
95
|
7002
|
50
|
|
|
|
10579
|
croak "You must set the number of days before you try to insert" if not defined $alpha; |
96
|
2
|
|
|
2
|
|
10
|
no warnings 'uninitialized'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
695
|
|
97
|
|
|
|
|
|
|
|
98
|
7002
|
|
|
|
|
9878
|
while( defined( my $P = shift ) ) { |
99
|
7002
|
50
|
|
|
|
9080
|
if( ref $P ) { |
100
|
0
|
0
|
|
|
|
0
|
my @a = eval {@$P}; croak $@ if $@; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
101
|
0
|
|
|
|
|
0
|
my $c = 0+@a; |
102
|
0
|
0
|
|
|
|
0
|
croak "high+low should only be two elements, not c=$c" unless $c == 2; |
103
|
0
|
|
|
|
|
0
|
$P = ($a[0]+$a[1])/$c; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
7002
|
100
|
|
|
|
9456
|
if( defined $L->[0] ) { |
107
|
|
|
|
|
|
|
# adapt alpha {{{ |
108
|
7000
|
100
|
100
|
|
|
12664
|
if( $length and defined($filter) ) { |
109
|
3497
|
|
|
|
|
5359
|
my $d = abs($P-$filter); |
110
|
3497
|
|
|
|
|
4198
|
push @$diff, $d; |
111
|
|
|
|
|
|
|
|
112
|
3497
|
|
|
|
|
3448
|
my $k = @$diff - $length; |
113
|
3497
|
100
|
|
|
|
5158
|
splice @$diff, 0, $k if $k>0; |
114
|
|
|
|
|
|
|
|
115
|
3497
|
100
|
|
|
|
4895
|
if( $k > 0 ) { # NOTE Ehler really does this, "CurrentBar > Length". See below. |
116
|
|
|
|
|
|
|
# IE, $k will only by >0 when we've moved past the 20th point |
117
|
3477
|
|
|
|
|
3346
|
my $HH = $d; |
118
|
3477
|
|
|
|
|
3042
|
my $LL = $d; |
119
|
|
|
|
|
|
|
|
120
|
3477
|
|
|
|
|
4419
|
for(@$diff) { |
121
|
69540
|
100
|
|
|
|
77246
|
$HH = $_ if $_ > $HH; |
122
|
69540
|
100
|
|
|
|
83344
|
$LL = $_ if $_ < $LL; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
3477
|
50
|
|
|
|
4146
|
if( $HH != $LL ) { |
126
|
|
|
|
|
|
|
# Ehler: If CurrentBar > Length and HH - LL <> 0 then alpha = Median(((Diff - LL) / (HH - LL)), 5); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# NOTE: wtf is a "5 bar median"? I guess it's this, or |
129
|
|
|
|
|
|
|
# pretty close to it. I imagine Median() runs through |
130
|
|
|
|
|
|
|
# the [] hist for Diff, LL, and HH, but I can't say for |
131
|
|
|
|
|
|
|
# sure without access to the programming language he |
132
|
|
|
|
|
|
|
# uses in the book. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# AVG # my $sum = ($diff->[-5]-$LL)/($HH-$LL); |
135
|
|
|
|
|
|
|
# AVG # $sum += ($diff->[$_]-$LL)/($HH-$LL) for (-4 .. -1); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# AVG # ($this->[ALPHA] = $alpha = $sum / 5); |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# NOTE (later): he appears to mean the median (not |
140
|
|
|
|
|
|
|
# average) of a scalar $HH/$LL against the last 5 @diff |
141
|
|
|
|
|
|
|
|
142
|
3477
|
|
|
|
|
4704
|
my @b5 = sort {$a<=>$b}map {(($diff->[$_]-$LL)/($HH-$LL))} -5 .. -1; |
|
25908
|
|
|
|
|
28377
|
|
|
17385
|
|
|
|
|
24821
|
|
143
|
|
|
|
|
|
|
|
144
|
3477
|
|
|
|
|
5464
|
$this->[ALPHA] = $alpha = $b5[2]; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
# }}} |
149
|
|
|
|
|
|
|
|
150
|
7000
|
|
|
|
|
9980
|
my $O = [ @$L ]; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# L0 = alpha*Price + (1 - alpha)*L0[1] = alpha*P + (1-alpha)*O[0] |
153
|
|
|
|
|
|
|
|
154
|
7000
|
|
|
|
|
10029
|
$L->[0] = $alpha*$P + (1-$alpha)*$O->[0]; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# L1 = (1 - alpha)*L1[1] - (1 - alpha)*L0 + L0[1] = (1 - alpha)*O[1] - (1 - alpha)*L[0] + O[0] |
157
|
|
|
|
|
|
|
# L2 = (1 - alpha)*L2[1] - (1 - alpha)*L1 + L1[1] = (1 - alpha)*O[2] - (1 - alpha)*L[1] + O[1] |
158
|
|
|
|
|
|
|
# L3 = (1 - alpha)*L3[1] - (1 - alpha)*L2 + L2[1] = (1 - alpha)*O[3] - (1 - alpha)*L[2] + O[2] |
159
|
|
|
|
|
|
|
|
160
|
7000
|
100
|
|
|
|
10416
|
$L->[1] = defined($O->[1]) ? (1 - $alpha)*$O->[1] - (1 - $alpha)*$L->[0] + $O->[0] : $O->[0]; |
161
|
7000
|
100
|
|
|
|
9467
|
$L->[2] = defined($O->[2]) ? (1 - $alpha)*$O->[2] - (1 - $alpha)*$L->[1] + $O->[1] : $O->[1]; |
162
|
7000
|
100
|
|
|
|
15293
|
$L->[3] = defined($O->[3]) ? (1 - $alpha)*$O->[3] - (1 - $alpha)*$L->[2] + $O->[2] : $O->[2]; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
} else { |
165
|
2
|
|
|
|
|
7
|
$L->[0] = $P; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
7002
|
100
|
|
|
|
8342
|
if( 4 == grep {defined $_} @$L ) { |
|
28002
|
|
|
|
|
36774
|
|
170
|
6996
|
|
|
|
|
12961
|
$this->[F] = ($L->[0] + 2*$L->[1] + 2*$L->[2] + $L->[3])/6; |
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub query { |
175
|
7002
|
|
|
7002
|
0
|
13819
|
my $this = shift; |
176
|
|
|
|
|
|
|
|
177
|
7002
|
|
|
|
|
8764
|
return $this->[F]; |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
__END__ |