# Copyright 2007, 2008, 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 . package App::Chart::Series::Derived::Collapse; use 5.010; use strict; use warnings; use Carp; # use Locale::TextDomain ('App-Chart'); use App::Chart; use base 'App::Chart::Series'; # uncomment this to run the ### lines #use Smart::Comments; use constant DEBUG => 0; use constant { longname => 'Timebase Collapse', shortname => 'Collapse', manual => undef, type => 'special', }; sub new { my ($class, $parent, $timebase_class) = @_; if ($timebase_class !~ /::/) { $timebase_class = "App::Chart::Timebase::\u$timebase_class"; } require Module::Load; Module::Load::load ($timebase_class); my $parent_timebase = $parent->timebase; my $new_timebase = $timebase_class->new_from_timebase ($parent_timebase); my $self = $class->SUPER::new (parent => $parent, timebase => $new_timebase, arrays => { map {; ($_ => []) } $parent->array_names }, array_aliases => $parent->{'array_aliases'}); return $self; } sub name { my ($self) = @_; if (exists $self->{'name'}) { return $self->{'name'} } else { my $timebase = $self->timebase; my $parent = $self->{'parent'}; return ($self->{'name'} = join (' - ', $parent->name||'', $timebase->adjective)); } } sub hi { my ($self) = @_; my $self_timebase = $self->{'timebase'}; my $parent = $self->{'parent'}; my $parent_timebase = $parent->timebase; return $self_timebase->convert_from_ceil ($parent_timebase, $parent->hi); } sub range_default_names { my ($self) = @_; return $self->{'parent'}->range_default_names; } sub fill_part { my ($self, $lo, $hi) = @_; ### Collapse fill_part: "$lo $hi" my $timebase = $self->timebase; my $parent = $self->{'parent'}; my $parent_timebase = $parent->timebase; my $p_lo = $parent_timebase->convert_from_floor ($timebase, $lo); my $p_hi = $parent_timebase->convert_from_ceil ($timebase, $hi); ### parent has: "lo=$p_lo hi=$p_hi" $parent->fill ($p_lo, $p_hi); my $p_opens = $parent->array('opens') || []; my $p_highs = $parent->array('highs'); my $p_lows = $parent->array('lows'); my $p_values = $parent->values_array; my $p_volumes = $parent->array('volumes'); my $p_openints = $parent->array('openints'); my $s_opens = $self->array('opens'); my $s_highs = $self->array('highs'); my $s_lows = $self->array('lows'); my $s_values = $self->values_array; my $s_volumes = $self->array('volumes'); my $s_openints = $self->array('openints'); my $p_t = $p_lo; for (my $t = $lo; $t <= $hi; $t++) { my $p_t_next = $parent_timebase->convert_from_floor ($timebase, $t + 1); my $p_end = $p_t_next - 1; if (DEBUG) { print " at t=$t p_t=$p_t p_end=$p_end\n"; } if ($s_opens) { # Open is first day with an open or a close. Look at the close in case # a closes-only series as happens for various indexes and sources. if (DEBUG) { local $,=' '; print " p_opens", @{$p_opens}[$p_t..$p_end], "\n"; } foreach my $i ($p_t .. $p_end) { if (defined $p_opens->[$i]) { $s_opens->[$t] = $p_opens->[$i]; last; } if (defined $p_values->[$i]) { $s_values->[$t] = $p_values->[$i]; last; } } } # some data sources only give closes, so include them in the high/low # calc; likewise maybe some data sources might only offer opens+closes, # so include the opens # if ($s_highs) { $s_highs->[$t] = App::Chart::max_maybe (@$p_highs [$p_t .. $p_end], @$p_opens [$p_t .. $p_end], @$p_values[$p_t .. $p_end]); } if ($s_lows) { $s_lows->[$t] = App::Chart::min_maybe (@$p_lows [$p_t .. $p_end], @$p_opens [$p_t .. $p_end], @$p_values[$p_t .. $p_end]); } # FIXME: treat other named arrays likewise # # close is the last close in the period for (my $i = $p_end; $i >= $p_t; $i--) { if (defined $p_values->[$i]) { $s_values->[$t] = $p_values->[$i]; last; } } # volume is the total in the period, or undef if in period are undef # note List::Util::sum() unhelpfully returns empty string for no args if ($s_volumes) { my @volumes = grep {defined} @$p_volumes[$p_t .. $p_end]; if (@volumes) { $s_volumes->[$t] = List::Util::sum (@volumes); } } # openint i the last openint in the period # this might be on a different day than the final close ... if ($s_openints) { for (my $i = $p_end; $i >= $p_t; $i--) { if (defined $p_openints->[$i]) { $s_openints->[$t] = $p_openints->[$i]; last; } } } $p_t = $p_t_next; } } 1; __END__ =for stopwords OHLCVI =head1 NAME App::Chart::Series::Derived::Collapse -- series collapsed to coarser timebase =for test_synopsis my ($series) =head1 SYNOPSIS my $wseries = $series->collapse ('Weeks'); =head1 DESCRIPTION A C series collapses data in a given OHLCVI series down to a coarser timebase, for example daily data might be collapsed to weekly. =head1 SEE ALSO L =cut # =head1 FUNCTIONS # # =over 4 # # =item C<< App::Chart::Series::Collapse->derive ($series, $timebase_class) >> # # Create a new series which collapses C<$series> to the given # C<$new_timebase>. For example # # my $daily_series = App::Chart::Series::Database ('BHP.AX'); # my $weekly_timebase = App::Chart::Timebase::Weekly->new_from_timebase # ($daily_series->timebase); # # my $weekly_series = App::Chart::Series::Database # ($daily_series, $weekly_timebase); # # =back