# Copyright 2006, 2007, 2009, 2010 Kevin Ryde
# This file is part of Chart.
#
# Chart is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License as published by the Free Software
# Foundation; either version 3, or (at your option) any later version.
#
# Chart is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Chart. If not, see <http://www.gnu.org/licenses/>.
package App::Chart::Series::Derived::ZigZag;
use 5.010;
use strict;
use warnings;
use Carp;
use Locale::TextDomain 1.17; # for __p()
use Locale::TextDomain ('App-Chart');
use base 'App::Chart::Series::Indicator';
# http://stockcharts.com/education/IndicatorAnalysis/indic_ZigZag.html
# Sample HPQ chart 1999/2000.
sub longname { __('Zig Zag') }
*shortname = \&longname;
sub manual { __p('manual-node','Zig Zag Indicator') }
use constant
{ type => 'average',
parameter_info => [ { name => __('% Change'),
key => 'zigzag_percent',
type => 'float',
type_hint => 'percent',
minimum => 0,
default => 5,
step => 1 },
{ name => __('Closes'),
key => 'zigzag_closes',
type => 'boolean',
default => 0 },
],
# default_linestyle => 'ZigZag',
line_colours => { values => 'solid' },
};
sub new {
my ($class, $parent, $percent, $closes_flag) = @_;
return $class->SUPER::new
(parent => $parent,
parameters => [ $percent, $closes_flag ],
arrays => { values => [] },
array_aliases => { });
}
# This does the whole series from start to end. It might be possible to
# work back looking for a PERCENT move which would establish the direction
# and hence a starting point in the middle of the data.
#
sub fill {
my ($self, $lo, $hi) = @_;
if ($self->{'filled'}) { return; }
$self->{'filled'} = 1;
my $parent = $self->{'parent'};
my ($percent, $closes_flag) = @{$self->{'parameters'}};
$hi = $self->hi;
$parent->fill (0, $hi);
my $p = $parent->values_array;
my $ph = $closes_flag ? $p : $parent->array('highs');
my $pl = $closes_flag ? $p : $parent->array('lows');
my $s = $self->values_array;
my $factor_increase = 1 + $percent / 100;
my $factor_decrease = 1 / $factor_increase;
my $direction = sub {};
my $extreme;
my $target;
my $extreme_pos;
my ($rising, $falling);
$rising = sub {
my ($pos, $high, $low) = @_;
if (! defined $extreme || $high > $extreme) {
$extreme = $high;
$extreme_pos = $pos;
$target = $extreme * $factor_decrease;
return;
}
if ($low <= $target) {
my $ret_pos = $extreme_pos;
my $ret_val = $extreme;
$direction = $falling;
$extreme = $low;
$extreme_pos = $pos;
$target = $extreme * $factor_increase;
return $ret_pos, $ret_val;
}
return;
};
$falling = sub {
my ($pos, $high, $low) = @_;
if (! defined $extreme || $low < $extreme) {
$extreme = $low;
$extreme_pos = $pos;
$target = $extreme * $factor_increase;
return;
}
if ($low >= $target) {
my $ret_pos = $extreme_pos;
my $ret_val = $extreme;
$direction = $rising;
$extreme = $high;
$extreme_pos = $pos;
$target = $extreme * $factor_decrease;
return $ret_pos, $ret_val;
}
return;
};
# decide initial direction rising or falling
{
my $high;
my $high_pos;
my $low;
my $low_pos;
foreach my $i (0 .. $hi) {
my $value = $p->[$i] // next;
my $this_high = $ph->[$i] // $value;
my $this_low = $pl->[$i] // $value;
if (! defined $high || $this_high > $high) {
$high = $this_high;
$high_pos = $i;
}
if (! defined $low || $this_low < $low) {
$low = $this_low;
$low_pos = $i;
}
if ($high >= $low * $factor_increase) {
if ($high_pos > $low_pos) {
$direction = $rising;
$s->[0] = $s->[$low_pos] = $low;
last;
}
if ($low_pos >= $high_pos) {
$direction = $falling;
$s->[0] = $s->[$high_pos] = $high;
last;
}
}
}
}
foreach my $i ($lo .. $hi) {
my $value = $p->[$i] // next;
my ($pos, $val) = $direction->($i,
$ph->[$i] // $value,
$pl->[$i] // $value);
if (defined $pos) {
$s->[$pos] = $val;
}
}
if ($extreme_pos) {
$s->[$extreme_pos] = $s->[$hi] = $extreme;
}
}
1;
__END__
# =head1 NAME
#
# App::Chart::Series::Derived::ZigZag -- zig zag indicator
#
# =head1 SYNOPSIS
#
# my $series = $parent->ZigZag;
#
# =head1 DESCRIPTION
#
# ...
#
# =head1 SEE ALSO
#
# L<App::Chart::Series>
#
# =cut