· 8 years ago · Nov 26, 2017, 04:42 PM
1#! /usr/bin/env perl
2#
3use strict;
4use warnings qw(FATAL);
5
6
7my $VERSION = "1.2-vanilla";
8
9
10my @gnuplot = ("gnuplot", "-p");
11
12
13=pod
14
15=head1 NAME
16
17bpi.pl - download and plot MOEX Best Private Investor contest data
18
19=head1 SYNOPSIS
20
21 perl bpi.pl --update[=YEAR]
22 perl bpi.pl [OPTIONS] SYMBOL
23
24=head2 OPTIONS
25
26=over
27
28=item C<--update[=YEAR]>
29
30Download new data and add it to database. If year is not given current
31year is assumed.
32
33=item C<-b, --bond=PRICE>
34
35Specify nominal bond price (aka "face value").
36
37=item C<-i, --interval=MINUTES>
38
39Candle time interval (in minutes). Intervals are measured from
40midnight and won't cross day boundary. Default is 1440 minutes (1
41day).
42
43=item C<-f, --from=DATETIME>
44
45Start time in format C<YYYY-MM-DD> or C<YYYY-MM-DD hh:mm>. Start time
46is inclusive. Default is the beginning of data.
47
48=item C<-t, --to=DATETIME>
49
50End time in format C<YYYY-MM-DD> or C<YYYY-MM-DD hh:mm>. End time is
51not inclusive. Default is the end of data.
52
53=item C<-c, --commission=PERCENTS>
54
55Transaction commission in percents. Default is 0%.
56
57=item C<-l, --long=PERCENTS>
58
59Long margin annual interest rate in percents. Default is 0%.
60
61=item C<-s, --short=PERCENTS>
62
63Short margin annual interest rate in percents. Default is 0%.
64
65=item C<--dividend=YYYY-MM-DD:MONEY>
66
67Specify share dividend. C<YYYY-MM-DD> is a cutoff day (the day after
68which the price will (usually) drop) and C<MONEY> is a per share sum.
69For instance
70
71 --dividend=2017-10-17:224.2
72
73Only one dividend event is supported.
74
75=item C<--image=EXT,WIDTH,HEIGHT>
76
77Create image file named F<SYMBOL.EXT> with size C<WIDTH> by C<HEIGHT>
78pixels. For example:
79
80 --image=png,1920,1080 MGNT
81
82will create 1920x1080 F<MGNT.png>, and
83
84 --image=svg,1600,1200 AFLT
85
86will create scalable F<AFLT.svg> with base dimensions 1600x1200.
87
88When C<--image> is not given (the default) the graph will be shown in
89an interactive window.
90
91=item C<--fontscale=SCALE>
92
93Scale font by C<SCALE> factor (float). Default is 1.0. You may set
94this to lower value if labels overlap.
95
96=item C<-r, --root=DIR>
97
98Directory of F<YEAR.db> file(s) and where to put PNG file(s).
99Default is the directory where this script is located.
100
101Do not remove F<YEAR.db-journal> file if it exists or database will
102become corrupt.
103
104=item C<-h, --help>
105
106Print this message and exit.
107
108=back
109
110=cut
111
112
113use Getopt::Long qw(:config gnu_getopt);
114use Pod::Usage;
115use FindBin;
116use Net::FTP;
117use Net::HTTP;
118use Archive::Zip;
119use Archive::Zip::MemberRead;
120use DBI;
121
122
123my %option = (
124 update => undef,
125 bond => 0,
126 interval => 1440,
127 from => "",
128 to => "",
129 commission => 0,
130 long => 0,
131 short => 0,
132 dividend => "",
133 image => "",
134 fontscale => 1.0,
135 root => $FindBin::Bin,
136);
137if (! GetOptions(\%option, qw(update:0 bond|b=i interval|i=i from|f=s to|t=s
138 commission|c=f long|l=f short|s=f dividend=s
139 image=s fontscale=f root|r=s help|h))
140 || @ARGV != (defined $option{update} ? 0 : 1)) {
141 pod2usage(1);
142}
143if (exists $option{help}) {
144 pod2usage(0);
145 exit;
146}
147$option{interval} *= 60;
148$option{interval} = 60 if $option{interval} < 60;
149$option{interval} = 86400 if $option{interval} > 86400;
150my %commission = (
151 long => 1 + $option{commission} / 100,
152 short => 1 - $option{commission} / 100
153);
154my %overnight = (
155 long => exp(log(1 + $option{long} / 100) / 365.25),
156 short => exp(log(1 - $option{short} / 100) / 365.25),
157) if $option{long} || $option{short};
158my ($dividend_date_time, $dividend_per_share) = (4294967295);
159
160
161my $year;
162unless (defined ($year = $option{update})) {
163 ($year) = $option{from} =~ /^(\d{4})/;
164 ($year) = $option{to} =~ /^(\d{4})/ unless $year;
165}
166$year = (localtime)[5] + 1900 unless $year;
167
168
169chdir($option{root})
170 or die "Can't change to directory $option{root}: $!";
171
172
173my $attrs = { AutoCommit => 1,
174 PrintError => 0,
175 RaiseError => 1 };
176my $dbh = DBI->connect("DBI:SQLite:dbname=$year.db", "", "", $attrs);
177$dbh->do(q{
178 PRAGMA page_size = 4096
179});
180$dbh->do(q{
181 CREATE TABLE IF NOT EXISTS source (
182 id INTEGER NOT NULL PRIMARY KEY,
183 dir INTEGER NOT NULL,
184 market INTEGER NOT NULL,
185 trader INTEGER NOT NULL,
186
187 UNIQUE (trader, market, dir)
188 )
189});
190$dbh->do(q{
191 CREATE TABLE IF NOT EXISTS contest (
192 source_id INTEGER NOT NULL REFERENCES source (id),
193 date_time INTEGER NOT NULL,
194 symbol TEXT NOT NULL,
195 amount INTEGER NOT NULL,
196 price FLOAT NOT NULL
197 )
198});
199$dbh->do(q{
200 CREATE VIEW IF NOT EXISTS vcontest AS
201 SELECT contest.rowid AS rowid, dir, market, trader,
202 datetime(date_time, 'unixepoch') AS date_time, symbol, amount, price
203 FROM contest JOIN source ON source_id = id
204});
205
206
207if (defined $option{update}) {
208 update_db();
209} else {
210 if ($option{dividend} =~ /^(\d{4}-\d\d-\d\d):(\d+(?:\.\d*)?|\.\d+)$/) {
211 $dividend_per_share = $2;
212 ($dividend_date_time) = $dbh->selectrow_array(q{
213 SELECT strftime('%s', ?, '+1 day')
214 }, undef, $1);
215 } else {
216 $option{dividend} = "--";
217 }
218 plot_graph();
219}
220
221exit 0;
222
223
224sub update_db {
225 $dbh->do(q{
226 PRAGMA synchronous = OFF
227 });
228
229 my $source_exists = $dbh->prepare(q{
230 SELECT 1
231 FROM source
232 WHERE dir = ? AND market = ? AND trader = ?
233 });
234 my $source_insert = $dbh->prepare(q{
235 INSERT INTO source (dir, market, trader)
236 VALUES (?, ?, ?)
237 });
238 my $contest_insert = $dbh->prepare(q{
239 INSERT INTO contest (source_id, date_time, symbol, amount, price)
240 VALUES (?, strftime('%s', ?), ?, ?, ?)
241 });
242
243 my $ftp_host = "ftp.moex.com";
244 my $ftp_path = "/pub/info/stats_contest/$year";
245 my $traders = "trader.csv";
246
247 my $ftp = Net::FTP->new($ftp_host)
248 or die "Can't connect to $ftp_host: $@";
249 $ftp->login
250 or die "Can't login to $ftp_host: ", $ftp->message;
251 $ftp->cwd($ftp_path)
252 or die "Can't change remote directory to $ftp_path: ", $ftp->message;
253
254 $| = 1;
255 $ftp->binary;
256
257 foreach my $dir ($ftp->ls) {
258 next unless $dir =~ /^20\d{6}$/;
259 my @ls = $ftp->ls($dir);
260 foreach my $file (@ls) {
261 my ($market, $trader) = $file =~ /^([123])_(\d+)\.zip$/
262 or next;
263
264 next if $dbh->selectrow_array($source_exists, undef,
265 $dir, $market, $trader);
266
267 print "Fetching $dir/$file...";
268 $dbh->begin_work;
269
270 $source_insert->execute($dir, $market, $trader);
271 my $source_id = $dbh->last_insert_id(undef, undef, undef, undef);
272
273 $ftp->get("$dir/$file", "tmp.zip")
274 or die "Can't fetch $dir/$file: ", $ftp->message;
275 my $zip = Archive::Zip->new("tmp.zip");
276 my $csv = Archive::Zip::MemberRead->new($zip,
277 "${market}_$trader.csv");
278 while (my $line = $csv->getline) {
279 my ($date_time, $symbol, $amount, $price) = split /;/, $line;
280 $symbol =~ s/\s+//g;
281 $contest_insert->execute($source_id, $date_time, $symbol,
282 $amount, $price);
283 }
284
285 $dbh->commit;
286 print "done\n";
287 }
288 }
289 unlink "tmp.zip" if -e "tmp.zip";
290
291 print "Fetching $traders...";
292 $ftp->get($traders, "tmp.csv")
293 or die "Can't fetch $traders: ", $ftp->message;
294 $ftp->quit;
295 print "done\n";
296
297 # To avoid possible encoding problems on Windows we hardcode
298 # market names as sequences of UTF-8 bytes.
299 my %market_name2index = (
300 # Fondovy
301 "\x{d0}\x{a4}\x{d0}\x{be}\x{d0}\x{bd}\x{d0}\x{b4}\x{d0}\x{be}"
302 . "\x{d0}\x{b2}\x{d1}\x{8b}\x{d0}\x{b9}" => 1,
303 # Srochny
304 "\x{d0}\x{a1}\x{d1}\x{80}\x{d0}\x{be}\x{d1}\x{87}\x{d0}\x{bd}"
305 . "\x{d1}\x{8b}\x{d0}\x{b9}" => 2,
306 # Valutny
307 "\x{d0}\x{92}\x{d0}\x{b0}\x{d0}\x{bb}\x{d1}\x{8e}\x{d1}\x{82}"
308 . "\x{d0}\x{bd}\x{d1}\x{8b}\x{d0}\x{b9}" => 3
309 );
310
311 open(my $fh, "<", "tmp.csv")
312 or die "Can't open file tmp.csv: $!";
313 while (<$fh>) {
314 my ($trader) = /;(\d+)/;
315
316 next if $dbh->selectrow_array($source_exists, undef, 0, 0, $trader);
317
318 print "Fetching initial portfolio for $trader...";
319 $dbh->begin_work;
320
321 $source_insert->execute(0, 0, $trader);
322
323 my @market_source_id;
324
325 my $dates = fetch_json("GetDates",
326 "{'traderId':$trader,'isMy':0,'tableId':6}");
327 my ($date) = $dates =~ /\\"(\d{4}-\d\d-\d\d)\\"}\]"}$/;
328 unless ($date) {
329 $dbh->rollback;
330 print "missing\n";
331 next;
332 }
333
334 my $portfolio = fetch_json("GetPortfolioData",
335 "{'traderId':$trader,'date':'$date','tableId':6}");
336
337 $portfolio =~ s/^{"d":"\[//;
338 while ($portfolio =~ /\G[^{]*({[^}]*})/g) {
339 my $rec = $1;
340
341 my ($pos, $change) = $rec =~ /"pos\\?"[^"]+"(-?\d+)\s+\(([+-]\d*)/;
342 $pos -= $change if $change ne "-";
343 next if $pos == 0;
344
345 my ($seccode) = $rec =~ /"seccode\\?"[^"]+"([^ \\"]+)/;
346
347 my ($cost) = $rec =~ /"cost\\?"[^"]+"(-?\d*(?:\.\d*)?)/;
348 my ($saldo) = $rec =~ /"saldo\\?"[^\d+-]+([+-]?\d+(?:\.\d*)?)/;
349 my $price = $cost ne "-" ? ($cost - $saldo) / $pos : 0;
350
351 my ($contype_name) = $rec =~ /"contype_name\\?"[^"]+"([^ \\"]+)/;
352 my $market = $market_name2index{$contype_name};
353
354 unless (defined $market_source_id[$market]) {
355 $source_insert->execute(0, $market, $trader);
356 $market_source_id[$market] =
357 $dbh->last_insert_id(undef, undef, undef, undef);
358 }
359 $contest_insert->execute($market_source_id[$market],
360 "$date 00:00:00", $seccode, $pos, $price);
361 }
362
363 $dbh->commit;
364 print "done\n";
365 }
366 close $fh;
367 unlink "tmp.csv";
368}
369
370
371sub fetch_json {
372 my ($name, $request) = @_;
373
374 my $http_host = "investor.moex.com";
375 my $http_path = "/ru/statistics/$year/portfolio.aspx/$name";
376
377 my $http = Net::HTTP->new(Host => $http_host)
378 or die "Can't connect to $http_host: $@";
379 $http->write_request(POST => $http_path,
380 "Content-Type" => "application/json", $request)
381 or die "Can't POST $http_path: $@";
382 my ($status, $message) = $http->read_response_headers;
383 $status == 200 or die "$http_path request failed: $status $message";
384 my $json = "";
385 while (1) {
386 my $buf;
387 my $res = $http->read_entity_body($buf, 1024);
388 defined $res or die "$http_path response read failed: $!";
389 last unless $res;
390 $json .= $buf;
391 }
392 return $json;
393}
394
395
396sub plot_graph {
397 open(my $plot, "|-", @gnuplot)
398 or die "Can't start @gnuplot: $!";
399 print $plot "\$data << EOD\n"
400 or die "Can't pipe to @gnuplot: $!";
401
402 my %position = (
403 total_amount_long => 0,
404 total_amount_short => 0,
405 total_money_long => 0,
406 total_money_short => 0,
407 max_money_short => 0,
408 );
409 my $initial_seen = 1;
410 my $interval_start = 0;
411 my $interval_end = 0;
412 my $x_tic = 0;
413 my $x_tic_day = 0;
414 my ($candle_open, $candle_low, $candle_high, $candle_close) = (0, 0, 0, 0);
415
416 my $output_tic_points = sub {
417 my ($no_labels) = @_;
418
419 my $amount_long = $position{total_amount_long};
420 my $price_long = ($amount_long
421 ? $position{total_money_long} / $amount_long
422 : "NaN");
423 my $amount_short = -$position{total_amount_short};
424 my $price_short = ($amount_short
425 ? -$position{total_money_short} / $amount_short
426 : "NaN");
427
428 my $x_label = "";
429 my $x2_label = "";
430 unless ($no_labels) {
431 my @date_time = gmtime($interval_start);
432 $x_label = sprintf("%02d:%02d", @date_time[2, 1]);
433 my $day = int($interval_start / 86400);
434 if ($x_tic_day != $day) {
435 $x_tic_day = $day;
436 $x_label = sprintf("%02d/%02d $x_label",
437 $date_time[4] + 1, $date_time[3]);
438 }
439
440 my $ratio = " ";
441 if ($amount_long && $amount_short) {
442 if ($amount_long == $amount_short) {
443 $ratio = "==";
444 } else {
445 $ratio = sprintf("%.1f", ($amount_long > $amount_short
446 ? $amount_long / $amount_short
447 : -$amount_short / $amount_long));
448 }
449 }
450 my $gain_loss = "";
451 if ($x_tic) {
452 my $money_start = ($position{total_money_long}
453 + $position{max_money_short}
454 # Minus negative $position{total_money_short}.
455 + $position{total_money_short});
456 my $money_end = ($candle_close * ($amount_long - $amount_short)
457 + $position{max_money_short});
458 $gain_loss = sprintf("(%.2f%%)",
459 ($money_end / $money_start - 1) * 100);
460 }
461 $x2_label = "$ratio $gain_loss";
462 }
463
464 my $data = join(" ", $x_tic, qq{"$x_label"}, qq{"$x2_label"},
465 $price_long, $price_short, $amount_long, $amount_short);
466 $data .= join(" ", "",
467 $candle_open, $candle_low, $candle_high, $candle_close)
468 unless $initial_seen;
469 print $plot $data, "\n"
470 or die "Can't pipe to @gnuplot: $!";
471 };
472
473 my $select = $dbh->prepare(qq{
474 SELECT dir = 0, trader, date_time, amount, price,
475 @{[ $option{from} ? "date_time >= strftime('%s', ?)" : "?" ]}
476 FROM contest JOIN source ON source_id = id
477 WHERE symbol = ?
478 AND @{[ $option{to} ? "date_time < strftime('%s', ?)" : "?" ]}
479 ORDER BY date_time, contest.rowid
480 });
481 $select->execute($option{from} || 1, $ARGV[0], $option{to} || 1);
482 $select->bind_columns(\my ($initial, $trader, $date_time,
483 $amount, $price, $in_range));
484 my $bond_face2percent = 100 / $option{bond} if $option{bond};
485 my $next_day_start = 0;
486 while ($select->fetch) {
487 $price *= $bond_face2percent if $bond_face2percent && $initial;
488
489 if (%overnight && $date_time >= $next_day_start
490 || $date_time >= $dividend_date_time) {
491 if ($in_range) {
492 $output_tic_points->(1) if $x_tic;
493 $initial_seen = 1;
494 }
495
496 if (%overnight && $date_time >= $next_day_start) {
497 my $next = $date_time - $date_time % 86400 + 86400;
498 my $nights = ($next - $next_day_start) / 86400;
499 $next_day_start = $next;
500
501 # On first hit total_money_* is zero, so computation is no-op.
502 $position{total_money_long} *= $overnight{long} ** $nights;
503 $position{total_money_short} *= $overnight{short} ** $nights;
504 }
505 if ($date_time >= $dividend_date_time) {
506 $dividend_date_time = 4294967295;
507 $position{total_money_long} -=
508 $position{total_amount_long} * $dividend_per_share;
509 # total_amount_short is negative.
510 $position{total_money_short} -=
511 $position{total_amount_short} * $dividend_per_share;
512 }
513 }
514
515 if ($in_range) {
516 if ($initial) {
517 unless ($initial_seen) {
518 $output_tic_points->(1) if $x_tic;
519 $initial_seen = 1;
520 }
521 } elsif ($date_time >= $interval_end) {
522 ($interval_start, $interval_end) = interval($date_time);
523 $output_tic_points->(); # Flush either candle or step.
524 $initial_seen = 0;
525 ++$x_tic;
526
527 $candle_open = $price;
528 $candle_low = $price;
529 $candle_high = $price;
530 $candle_close = $price;
531
532 $position{max_money_short} = 0;
533 } else {
534 $candle_low = $price if $candle_low > $price;
535 $candle_high = $price if $candle_high < $price;
536 $candle_close = $price;
537 }
538 }
539
540 position_update(\%position, $trader, $amount, $price);
541
542 my $mms = -$position{total_amount_short} * $price;
543 $position{max_money_short} = $mms if $position{max_money_short} < $mms;
544 }
545 if ($x_tic) {
546 $interval_start = $interval_end;
547 $output_tic_points->(); # Flush either final candle or step.
548 }
549
550 print $plot "EOD\n" or die "Can't pipe to @gnuplot: $!";
551
552 die "No data to plot\n" unless $x_tic;
553
554 my $traders = keys %{$position{t}};
555
556 if (my ($type, $size) = $option{image} =~ /^([^,]+),(\d+,\d+)$/) {
557 print $plot qq{
558 set terminal $type size $size
559 set output "$ARGV[0].$type"
560 } or die "Can't pipe to @gnuplot: $!";
561 }
562 print $plot qq{
563 set termoption fontscale $option{fontscale}
564 set grid xtics
565 set xtics nomirror out rotate right
566 set x2tics nomirror out rotate
567 set ytics nomirror out
568 set y2tics nomirror out
569 set format y "%.0f"
570 set boxwidth 0.65
571 set key outside center top horizontal height 2 \\
572 title "$ARGV[0] ($year) $traders traders (C=$option{commission}% L=$option{long}% S=$option{short}% D=$option{dividend}) [bpi.pl v$VERSION]"
573 set x2label \\
574 "Amount ratio (>1: long/short; <-1: -short/long), gain/loss percent"
575 set ylabel "Amount"
576 set y2label "Price"
577
578 plot \$data using (\$1-0.5):8:9:10:11 axes x1y2 title "Price candle" \\
579 with candlesticks lc rgb "#0000ff", \\
580 \$data using 1:4 axes x1y2 title "Long average price" \\
581 with lines lw 2 lc rgb "#00ff00", \\
582 \$data using 1:5 axes x1y2 title "Short average price" \\
583 with lines lw 2 lc rgb "#ff0000", \\
584 \$data using 1:6:xtic(2) axes x1y1 title "Long amount" \\
585 with lines lc rgb "#00a000" dt 3, \\
586 \$data using 1:7:x2tic(3) axes x1y1 title "Short amount" \\
587 with lines lc rgb "#a00000" dt 3
588 } or die "Can't pipe to @gnuplot: $!";
589}
590
591
592sub position_update {
593 my ($position, $trader, $amount, $price) = @_;
594
595 $position->{t}{$trader} = { amount => 0, money => 0 }
596 unless $position->{t}{$trader};
597
598 my $old_type = $position->{t}{$trader}{amount} > 0 ? "long" : "short";
599 $position->{"total_amount_$old_type"} -= $position->{t}{$trader}{amount};
600 $position->{"total_money_$old_type"} -= $position->{t}{$trader}{money};
601
602 $position->{t}{$trader}{amount} += $amount;
603
604 my $new_type = $position->{t}{$trader}{amount} > 0 ? "long" : "short";
605 if ($position->{t}{$trader}{amount} && $new_type eq $old_type) {
606 $position->{t}{$trader}{money} +=
607 $amount * $price * $commission{$new_type};
608 } else {
609 # Position has been closed or flipped, reset any previous gain/loss.
610 $position->{t}{$trader}{money} =
611 $position->{t}{$trader}{amount} * $price * $commission{$new_type};
612 }
613
614 $position->{"total_amount_$new_type"} += $position->{t}{$trader}{amount};
615 $position->{"total_money_$new_type"} += $position->{t}{$trader}{money};
616}
617
618
619sub interval {
620 my ($date_time) = @_;
621
622 # There are no daylight saving times and leap seconds to worry about.
623 my $day_start = $date_time - $date_time % 86400;
624 my $interval_start =
625 $date_time - ($date_time - $day_start) % $option{interval};
626 my $interval_end = $interval_start + $option{interval};
627 $interval_end = $day_start + 86400 if $interval_end > $day_start + 86400;
628 return ($interval_start, $interval_end);
629}