view release on metacpan or  search on metacpan

examples/precursor-bayesian-nightmare-stockmonkey.pl  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
use Finance::QuoteHist;
use Storable qw(freeze thaw);
use Math::Business::RSI;
use Math::Business::LaguerreFilter;
use Math::Business::BollingerBands;
use Math::Business::ConnorRSI;
use Math::Business::ADX;
use MySQL::Easy;
use Date::Manip;
use Algorithm::NaiveBayes;
use List::Util qw(min max sum);
use GD::Graph::lines;
use GD::Graph::Hooks;

my $dbo     = MySQL::Easy->new("scratch"); # reads .my.cnf for password and host
my @tickers = split(m/[^A-Z]/, shift || "JPM,SCTY,P,TSLA,ATVI,HIMX,ZNGA,BEARX");
my $phist   = shift || 180; # final plot history items
my $slurpp  = "10 years"; # data we want to fetch
my @proj    = map {[map {int $_} split m{/}]} @ARGV; # projections

# proj is a list of projections to consider, days/percent
@proj = (
    [10,3],[10,5],[10,10],
    [20,3],[20,5],[20,10],
);

if( $ENV{NEWK} ) {
    $dbo->do("drop table if exists stockplop");
    $dbo->do("drop table if exists stockplop_annotations");
    $dbo->do("drop table if exists stockplop_glaciers");
}

find_quotes_for()      unless $ENV{NO_FETCH};
annotate_all_tickers() unless $ENV{NO_ANNOTATE};
plot_result();

# {{{ sub find_quotes_for
sub find_quotes_for {
    for my $ticker (@tickers) {
        my $lf   = Math::Business::LaguerreFilter->new(2/(1+4));
        my $ls   = Math::Business::LaguerreFilter->new(2/(1+8));
        my $bb   = Math::Business::BollingerBands->recommended;
        my $crsi = Math::Business::ConnorRSI->recommended;
        my $adx  = Math::Business::ADX->recommended;
        my $rsi  = Math::Business::RSI->recommended;

        # NOTE: if you add to indicies, you probably need to 'newk'
        my @indicies = ($lf, $ls, $crsi, $rsi, $bb, $adx);
        my %picky_insert = (
            $adx->tag => sub {
                my ($open, $high, $low, $close, $volume) = @_;
                $adx->insert([$high, $low, $close]); # curry picky inserts
            }
        );

        my %has_multi_column_output = ( $bb->tag => 1 );
        my $time = $slurpp;

        # {{{ SCHEMA:
        SCHEMA: {
            my @moar_columns;
            for( @indicies ) {
                my $tag  = $_->tag;
                my $type = $has_multi_column_output{$tag} ? "varchar(50)" : "decimal(6,4)";

                push @moar_columns, "`$tag` $type,";
            }

            $dbo->do("create table if not exists stockplop(
                rowid int unsigned not null auto_increment primary key,
                seqno int not null default '0',

                ticker  char(5) not null,
                qtime   date not null,
                open    decimal(6,2) unsigned not null,
                high    decimal(6,2) unsigned not null,
                low     decimal(6,2) unsigned not null,
                close   decimal(6,2) unsigned not null,
                volume  int unsigned not null,

examples/precursor-bayesian-nightmare-stockmonkey.pl  view on Meta::CPAN

            description text not null,

            primary key(rowid)
        )^);
    }

    my $keep     = max(map($_->[0], @proj)); my %uniq;
    my @proj_ud  = grep {!$uniq{$_->[0]}++} @proj;
    my $sql_cols = join(", ", map {"t$_->[0].close t$_->[0]_close, t$_->[0].rowid t$_->[0]_rowid"} @proj_ud);
    my @sql_join = map {"join t$_->[0] using (seqno)"} @proj_ud;

    my $ins = $dbo->ready("insert into stockplop_annotations set rowid=?, description=?");
    my $sth = $dbo->ready(my $cross_product_sql =
        "select stockplop.*, $sql_cols from stockplop @sql_join where ticker=?");

    # DESCRIBE SITUATIONS WITH TECHNICAL ANALYSIS

    for my $ticker ($dbo->firstcol("select distinct(ticker) from stockplop")) {
        print "\nannotating $ticker\n";

        my %instance_history;

        for(@proj_ud) {
            print "creating temporary table t$_->[0]\n";
            $dbo->do("drop table if exists t$_->[0]");
            $dbo->do("create temporary table t$_->[0]
                select (seqno-$_->[0])seqno,qtime,close,rowid
                    from (select seqno,qtime,close,rowid from stockplop where ticker=? and seqno>$_->[0]
                        order by qtime desc)
                            the_future
            order by qtime asc", $ticker);
        }

        my $t = $cross_product_sql;
        $t =~ s{\?}{'$ticker'};
        print "executing fetch ($t)\n";
        $sth->execute($ticker);

        print "analyzing result rows\n";

        my @events;
        my %events;
        my @last;
        while( my $row = $sth->fetchrow_hashref ) {
            if( defined (my $rsi = $row->{'RSI(27)'}) ) {
                for (90,80,70) { $events{"rsi_$_"} = 1 if $rsi >= $_ }
                for (10,20,30) { $events{"rsi_$_"} = 1 if $rsi <= $_ }
            }

            if( defined (my $rsi = $row->{'CRSI(3,2,100)'}) ) {
                for (90,80,70) { $events{"crsi_$_"} = 1 if $rsi >= $_ }
                for (10,20,30) { $events{"crsi_$_"} = 1 if $rsi <= $_ }
            }

            if( defined (my $adx = $row->{'ADX(14)'}) ) {
                $adx = int(100 * $adx);
                for (10, 20, 30, 40, 50) { $events{"adx_$_"} = 1 if $adx >= $_ }
            }

            if( defined ( my $bbs = $row->{'BOLL(2,20)'}) ) {
                my ($L, $M, $U) = map {$_ eq "-" ? undef : (0.0+$_)} split m{/}, $bbs;
                if( defined $L and defined $M and defined $U ) {
                    $events{boll_overbought} = 1 if $row->{close} >= $U;
                    $events{boll_oversold}   = 1 if $row->{close} <= $L;
                }
            }

            if( @last ) {
                if( defined $last[-1]{"LAG(8)"} and defined $last[-1]{"LAG(4)"} ) {
                    $events{lag_break_up} = 1
                        if $last[-1]{'LAG(4)'} < $last[-1]{"LAG(8)"} and $row->{'LAG(4)'} > $row->{"LAG(8)"};

                    $events{lag_break_down} = 1
                        if $last[-1]{'LAG(4)'} > $last[-1]{"LAG(8)"} and $row->{'LAG(4)'} < $row->{"LAG(8)"};
                }

                for( 10, 20, 30 ) {
                    $events{rsi_up}    = 1 if     $events[-1]{"rsi_$_"}  and not $events{"rsi_$_"};
                    $events{rsi_down}  = 1 if not $events[-1]{"rsi_$_"}  and     $events{"rsi_$_"};
                    $events{crsi_up}   = 1 if     $events[-1]{"crsi_$_"} and not $events{"crsi_$_"};
                    $events{crsi_down} = 1 if not $events[-1]{"crsi_$_"} and     $events{"crsi_$_"};
                }

                for( 90, 80, 70 ) {
                    $events{rsi_up}    = 1 if not $events[-1]{"rsi_$_"}  and     $events{"rsi_$_"};
                    $events{rsi_down}  = 1 if     $events[-1]{"rsi_$_"}  and not $events{"rsi_$_"};
                    $events{crsi_up}   = 1 if not $events[-1]{"crsi_$_"} and     $events{"crsi_$_"};
                    $events{crsi_down} = 1 if     $events[-1]{"crsi_$_"} and not $events{"crsi_$_"};
                }

                for (10, 20, 30, 40, 50) {
                    $events{adx_up}   = 1 if not $events[-1]{"adx_$_"} and     $events{"adx_$_"};
                    $events{adx_down} = 1 if     $events[-1]{"adx_$_"} and not $events{"adx_$_"};
                }


                # TODO:
                # - other concepts like: we had a lag break and there was an rsi break x days ago
                # - looking for divergences in the various indexes would go here
                # - support levels on closing prices goes here
            }

            my @desc = sort keys %events;
            $ins->execute($row->{rowid}, "@desc");

            # train using items from @last, far enough back to avoid data snooping bias
            for(@proj) {
                my ($days, $percent) = @$_;
                if( @last >= $days ) {
                    my $_row = $last[-$days]   || die "bad maths";
                    my $_ev  = $events[-$days] || die "bad maths";

                    if( keys %$_ev ) {
                        if( $row->{close} >= $_row->{close} * (1 + ($percent/100)) ) {
                            my %d = (attributes=>$_ev, label=>my $l = "p$_->[0]_$_->[1]");
                            push @{$instance_history{$l}}, \%d;
                        }

                        elsif( $row->{close} <= $_row->{close} * (1 - ($percent/100)) ) {
                            my %d = (attributes=>$_ev, label=>my $l = "m$_->[0]_$_->[1]");
                            push @{$instance_history{$l}}, \%d;