# Copyright 2007, 2008, 2009, 2010, 2011 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::Adjust; use 5.010; use strict; use warnings; use Carp; use Locale::TextDomain ('App-Chart'); use App::Chart::DBI; use App::Chart::TZ; use base 'App::Chart::Series::OHLCVI'; # uncomment this to run the ### lines #use Smart::Comments; sub longname { __('Adjustments') } sub shortname { __('Adj') } sub manual { __p('manual-node','Dividends and Splits') } use constant { type => 'special', parameter_info => [ { name => __('Splits'), key => 'adj_splits', type => 'boolean', default => 1 }, { name => __('Divs'), key => 'adj_dividends', type => 'boolean', default => 1 }, { name => __('Imp'), key => 'adj_imputation', type => 'boolean', default => 1 }, { name => __('Roll'), key => 'adj_rollovers', type => 'boolean', default => 0 }], }; sub name { my ($self) = @_; return __x('{parent} - Adj {list}', parent => $self->{'parent'}->name, list => join (',', ($self->{'adjust_splits'} ? __('Splits') : ()), ($self->{'adjust_dividends'} ? __('Divs') : ()), ($self->{'adjust_dividends'} && $self->{'adjust_imputation'} ? __('Imp') : ()))); } sub symbol_name { my ($self) = @_; if (my $parent = $self->{'parent'}) { if (defined (my $symbol = $parent->{'symbol'})) { return App::Chart::Database->symbol_name ($symbol); } } return undef; } sub derive { my ($class, $parent, %options) = @_; my $adjust_splits = $options{'adjust_splits'}; my $adjust_dividends = $options{'adjust_dividends'}; if (! $adjust_splits && ! $adjust_dividends) { return $parent; } # Only go up to today (in the symbol's timezone) for adjustments. Stuff # in the future shouldn't be applied until then. Decide this at init time # in case we live long enough for the time to reach a new day. # my $symbol = $parent->{'symbol'}; my $timezone = App::Chart::TZ->for_symbol ($symbol); my $hi_iso = $timezone->iso_date; my $timebase = $parent->timebase; my $lo_iso = $timebase->to_iso (0); # if for each option it's either not wanted or there's no data for it, # then can just return unmodified $parent # if ((! $adjust_splits || ! App::Chart::DBI->read_single ('SELECT date FROM split WHERE (symbol=? AND (date BETWEEN ? AND ?)) LIMIT 1', $symbol, $lo_iso, $hi_iso)) && (! $adjust_dividends || ! App::Chart::DBI->read_single ('SELECT ex_date FROM dividend WHERE (symbol=? AND (ex_date BETWEEN ? AND ?)) LIMIT 1', $symbol, $lo_iso, $hi_iso))) { ### Adjust no splits or dividends to apply return $parent; } return $class->SUPER::new (parent => $parent, adj_hi_iso => $hi_iso, %options); } sub fill_part { my ($self, $lo, $hi) = @_; ### Adjust fill_part() "$lo $hi" my $dbh = App::Chart::DBI->instance; my $timebase = $self->timebase; my $parent = $self->{'parent'}; my $symbol = $parent->{'symbol'}; my $lo_iso = $timebase->to_iso ($lo); # requested $lo my $hi_iso = $self->{'adj_hi_iso'}; # all splits/divs to today my $splits = []; if ($self->{'adjust_splits'}) { my $sth = $dbh->prepare_cached ('SELECT date, new, old FROM split WHERE (symbol=? AND (date BETWEEN ? AND ?)) ORDER BY date DESC'); $splits = $dbh->selectall_arrayref ($sth, {Slice=>{}}, $symbol, $lo_iso, $hi_iso); $sth->finish; foreach my $row (@$splits) { $row->{'date'} = $timebase->from_iso_floor ($row->{'date'}); } } push @$splits, { date => $lo-1 }; # sentinel ### $splits my $dividends = []; if ($self->{'adjust_dividends'}) { my $sth = $dbh->prepare_cached ('SELECT ex_date, amount, imputation FROM dividend WHERE (symbol=? AND (ex_date BETWEEN ? AND ?)) ORDER BY ex_date DESC'); $dividends = $dbh->selectall_arrayref ($sth, {Slice=>{}}, $symbol, $lo_iso, $hi_iso); $sth->finish; foreach my $row (@$dividends) { $row->{'ex_date'} = $timebase->from_iso_floor ($row->{'ex_date'}); } } push @$dividends, { ex_date => $lo-1 }; # sentinel ### $dividends $hi = $parent->find_after($hi,1); $parent->fill ($lo, $hi); my $p_opens = $parent->array('opens'); my $p_closes = $parent->array('closes'); my $p_highs = $parent->array('highs'); my $p_lows = $parent->array('lows'); my $p_volumes = $parent->array('volumes'); my $p_openints = $parent->array('openints'); my $s_opens = $self->{'opens'}; my $s_closes = $self->{'closes'}; my $s_highs = $self->{'highs'}; my $s_lows = $self->{'lows'}; my $s_volumes = $self->{'volumes'}; my $s_openints = $self->{'openints'}; my $factor = 1; my $post_close; for (my $t = $hi; $t >= $lo; $t--) { if ($p_opens->[$t]) { $s_opens->[$t] = $p_opens->[$t] * $factor; } if ($p_highs->[$t]) { $s_highs->[$t] = $p_highs->[$t] * $factor; } if ($p_lows->[$t]) { $s_lows->[$t] = $p_lows->[$t] * $factor; } if ($p_closes->[$t]) { $post_close = $p_closes->[$t]; $s_closes->[$t] = $post_close * $factor; } if ($p_volumes->[$t]) { $s_volumes->[$t] = $p_volumes->[$t] / $factor;} if ($p_openints->[$t]){ $s_openints->[$t] = $p_openints->[$t] / $factor;} for ( ; $splits->[0]->{'date'} >= $t; shift @$splits) { $factor *= ($splits->[0]->{'old'} / $splits->[0]->{'new'}); ### factor now: $factor } for ( ; $dividends->[0]->{'ex_date'} >= $t; shift @$dividends) { my $div = $dividends->[0]->{'amount'}; Scalar::Util::looks_like_number ($div) or next; if ($self->{'adjust_imputation'}) { my $imp = $dividends->[0]->{'imputation'}; if (Scalar::Util::looks_like_number ($imp)) { $div += $imp; } } if (defined $post_close) { # factor chosen so if prev=post+div then prev*factor==post $factor *= $post_close / ($post_close + $div); ### dividend: $div ### $post_close ### factor now: $factor } } } } sub dividends { my ($self) = @_; return $self->{'parent'}->dividends; } sub splits { my ($self) = @_; return $self->{'parent'}->splits; } sub annotations { my ($self) = @_; return $self->{'parent'}->annotations; } sub Alerts_arrayref { my ($self) = @_; my $parent = $self->{'parent'}; if (my $func = $parent->can('Alerts_arrayref')) { return $parent->$func; } else { return []; } } # FIXME: Adjust endpoints per display sub AnnLines_arrayref { my ($self) = @_; my $parent = $self->{'parent'}; if (my $func = $parent->can('AnnLines_arrayref')) { return $parent->$func; } else { return []; } } 1; __END__ =head1 NAME App::Chart::Series::Derived::Adjust -- series adjustments for dividends, splits, etc =for test_synopsis my ($series) =head1 SYNOPSIS use App::Chart::Series::Derived::Adjust; my $adj_series = App::Chart::Series::Derived::Adjust->derive ($series, adjust_splits => 1); =head1 DESCRIPTION A C series applies adjustments to an underlying database series for stock splits, dividend reinvestment, etc. The split information etc is obtained from the database. =head1 FUNCTIONS =over 4 =item App::Chart::Series::Derived::Adjust->derive ($series, key=>value,...) Create a new series which applies adjustments to C<$series>, for some or all of dividends, splits, capital returns, etc. C<$series> must be a C object. The adjustments are controlled by the following options arguments taken in key/value style adjust_splits adjust for stock splits adjust_dividends adjust for dividends (as reinvested) adjust_imputation include imputation credits in dividends For example my $db_series = App::Chart::Series::Database->new ('BHP.AX'); my $adj_series = App::Chart::Series::Derived::Adjust->derive ($db_series, adjust_splits => 1, adjust_dividends => 1); If the options ask for no adjustments at all, or there's no splits etc in the database for the C<$series> symbol then C<$series> is simply returned. =back =head1 SEE ALSO L =cut