use strict;
use warnings;
# - - - - - - - - - - - - - - - - - - - - - - - - - -
# e.g. if 'ibm' queried, script writes to files:
# ibm.html ibmdiff.jpg ibmlog.jpg ibm.csv
# - - - - - - - - - - - - - - - - - - - - - - - - - -
# stock symbol lookup: http://finance.yahoo.com/l
# e.g. aapl ko ibm msft rhat sunw
my $stocksymbol = "rhat";
my $startdate = "4-15-2002"; # since it's for historical date,
my $enddate = "6-30-2003"; # latest data may not be available
my $interval = "d"; # d: daily, w: weekly, m: monthly
my $agent = "Mozilla/4.0"; # your id sent to Yahoo Web server, enter something
my $q = quotes::get($stocksymbol, $startdate, $enddate, $interval, $agent);
my ($ma, $diff) = (20, 1); # lags for MA & differencing
open OUT, ">$stocksymbol.html";
print OUT chart::html($stocksymbol, $q, $ma, $diff); # expecting headers: Date,Open,High,Low,Close,Volume
close OUT;
print "done: $stocksymbol.html generated.\n";
{package quotes;
use LWP::UserAgent;
sub get {
my ($symbol, $startdate, $enddate, $agent) = @_;
print "fetching data...\n";
my $dat = _fetch($symbol, $startdate, $enddate, $agent); # csv file, 1st row = header
my @q = split /\n/, $dat;
my @header = split /,/, shift @q;
my %quotes = map { $_ => [] } @header;
for my $q (@q) {
my @val = split ',', $q;
unshift @{$quotes{$header[$_]}}, $val[$_] for 0..$#val; # unshift instead of push if data listed latest 1st & oldest last
}
open OUT, ">$symbol.csv";
print OUT $dat;
close OUT;
print "data written to $symbol.csv.\n";
return \%quotes;
}
sub _fetch {
my ($symbol, $startdate, $enddate, $interval, $agent) = @_;
my $url = "http://chart.yahoo.com/table.csv?";
my $freq = "g=$interval"; # d: daily, w: weekly, m: monthly
my $stock = "s=$symbol";
my @start = split '-', $startdate;
my @end = split '-', $enddate;
$startdate = "a=" . ($start[0]-1) . "&b=$start[1]&c=$start[2]";
$enddate = "d=" . ($end[0]-1) . "&e=$end[1]&f=$end[2]";
$url .= "$startdate&$enddate&$stock&y=0&$freq&ignore=.csv";
my $ua = new LWP::UserAgent(agent=>$agent);
my $request = new HTTP::Request('GET',$url);
my $response = $ua->request($request);
if ($response->is_success) {
return $response->content;
} else {
warn "Cannot fetch $url (status ", $response->code, " ", $response->message, ")\n";
return 0;
}
}
}
{package chart;
use GD::Graph::lines;
# my @headers = qw/ Date Open High Low Close Volume /; hardcoded in _tbl()
# $q->{Close} assumed exists in plotlog() & plotdiff()
sub html {
my ($stock, $q, $ma, $diff) = @_;
print "generating html...\n";
my $str = "";
$str .= "
$stock\n";
$str .= "\n";
$str .= "\n";
$str .= _tbl($stock, $q);
$str .= "\n";
return $str;
}
sub plotlog {
my ($stock, $q, $diff) = @_;
my $img = $stock . "log.jpg";
print "generating $img...\n";
my ($s, $lines) = ([],[]);
my $y_format = sub { sprintf " \$%.2f", exp $_[0] };
$s = ts::logs($q->{Close});
$lines->[0] = { name => 'Log of Closing Price', color => 'marine', data => $s };
$lines->[1] = { name => "MA($diff) (Moving Avg)", color => 'cyan', data => ts::ma($lines->[0]->{data}, $diff) };
plotlines($img, $stock, $q->{Date}, $lines, $y_format);
return $img;
}
sub plotdiff {
my ($stock, $q, $lag, $diff) = @_;
my $img = $stock . "diff.jpg";
print "generating $img...\n";
my ($s, $lines) = ([],[]);
my $y_format = sub { sprintf " %.2f", $_[0] };
$s = ts::logs($q->{Close});
$lines->[0] = { name => "Diff($diff)", color => 'marine', data => ts::diff($s, $diff) };
$lines->[1] = { name => "MA($lag) (Moving Avg)", color => 'cyan', data => ts::ma($lines->[0]->{data}, $lag) };
$s = ts::stdev($lines->[0]->{data}, $lag);
$s = ts::nstdev_ma($s, $lines->[1]->{data}, 2);
$lines->[2] = { name => 'MA + 2 Std Dev', color => 'lred', data => $s->[0] };
$lines->[3] = { name => 'MA - 2 Std Dev', color => 'lred', data => $s->[1] };
plotlines($img, $stock, $q->{Date}, $lines, $y_format);
return $img;
}
sub plotlines {
my ($file, $stock, $x, $lines, $y_format) = @_;
my @legend;
my ($data, $colors) = ([], []);
$data->[0] = $x; # x-axis labels
for (0..$#{$lines}) {
$data->[(1+$_)] = $lines->[$_]->{data};
$colors->[$_] = $lines->[$_]->{color};
$legend[$_] = $lines->[$_]->{name};
}
my $graph = GD::Graph::lines->new(740,420);
$graph->set (dclrs => $colors) or die $graph->error;
$graph->set_legend(@legend) or die $graph->error;
$graph->set (legend_placement => 'BC') or die $graph->error;
$graph->set(y_number_format => $y_format) if $y_format;
$graph->set (
title => "stock: $stock",
boxclr => 'black',
bgclr => 'dgray',
axislabelclr => 'white',
legendclr => 'white',
textclr => 'white',
r_margin => 20,
tick_length => -4,
y_long_ticks => 1,
axis_space => 10,
x_labels_vertical => 1,
x_label_skip => int(0.2*scalar(@{$data->[0]}))
) or die $graph->error;
my $gd = $graph->plot($data) or die $graph->error;
open (IMG, ">$file") or die $!;
binmode IMG;
print IMG $gd->jpeg(90);
return 1;
}
sub _tbl {
my ($stock, $q) = @_;
my $str = "";
my @headers = qw/ Date Open High Low Close Volume /;
my $tr_start = "\n";
$str .= "\n";
$str .= $tr_start . "";
$str .= "Stock: $stock | \n";
$str .= $tr_start;
$str .= "" . $headers[$_] . " | \n" for 0..$#headers;
$str .= "\n";
for my $i (reverse 0..$#{$q->{Date}}) {
$str .= $tr_start;
$str .= "" . $q->{$headers[$_]}->[$i] . " | \n" for 0..$#headers;
$str .= "\n";
}
$str .= "
\n";
return $str;
}
}
{package ts;
sub logs {
my $s = shift;
return [ map {log} @{$s}[0..$#{$s}] ];
}
sub diff {
my ($series, $lag) = @_;
my @diff = map {undef} 1..$lag;
push @diff, $series->[$_] - $series->[$_-$lag] for ( $lag..$#{$series} );
return \@diff;
}
sub ma {
my ($series, $lag) = @_;
my @ma = map {undef} 1..$lag;
for(@{$series}){unless($_){push @ma,undef}else{last}}
my $sum = 0;
for my $i ($#ma..$#{$series}) {
$sum += $series->[$i-$_] for (0..($lag-1));
push @ma, $sum/($lag);
$sum = 0;
}
return \@ma;
}
sub stdev {
my ($series, $lag) = @_;
my @stdev = map {undef} 1..$lag;
for(@{$series}){unless($_){push @stdev,undef}else{last}}
my ($sum, $sum2) = (0, 0);
for my $i ($#stdev..$#{$series}) {
for (0..($lag-1)) {
$sum2 += ($series->[$i-$_])**2;
$sum += $series->[$i-$_] ;
}
push @stdev, ($sum2/$lag - ($sum/$lag)**2)**0.5;
($sum, $sum2) = (0, 0);
}
return \@stdev;
}
sub nstdev_ma{
my ($sd, $ma, $n) = @_;
my $ans=[[],[]];
for (0..$#{$sd}) {
my $yn = defined $sd->[$_] && defined $ma->[$_];
$ans->[0][$_] = $yn ? $ma->[$_] + $n*($sd->[$_]) : undef;
$ans->[1][$_] = $yn ? $ma->[$_] - $n*($sd->[$_]) : undef;
}
return $ans;
}
}