view release on metacpan or  search on metacpan

lib/App/Chart/Series/Derived/ZigZag.pm  view on Meta::CPAN

# 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;