git.sesse.net Git - remoteglot-book/blob - www/opening-stats.pl

   1 #! /usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use CGI;
   5 use JSON::XS;
   6 use lib '..';
   7 use Position;
   8 use IPC::Open2;
   9
  10 our %openings = ();
  11 read_openings();
  12
  13 my $cgi = CGI->new;
  14 my ($chld_out, $chld_in);
  15 my $pid = IPC::Open2::open2($chld_out, $chld_in, "../binlookup", "../open.mtbl", "40");
  16
  17 # Root position. Basically ignore everything except the opening (and later some root game stuff).
  18 my $fen = $cgi->param('fen') // 'rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - 0 1';
  19 my $pos = Position->from_fen($fen);
  20 my $hex = unpack('H*', $pos->bitpacked_fen);
  21 print $chld_in $hex, "\n";
  22 chomp (my $line = <$chld_out>);
  23
  24 my ($white, $draw, $black, $opening_num, $white_avg_elo, $black_avg_elo, $num_elo, $timestamp, $pgn_file_number, $pgn_start_position, @moves) = split / /, $line;
  25 my $opening = $openings{$opening_num} // 'A00: Start position';
  26
  27 my $root_pgn;
  28 eval {
  29         $root_pgn = read_root_pgn($pgn_file_number, $pgn_start_position);
  30 };
  31 if ($@) {
  32         $root_pgn = "Could not find root PGN. ($@)";
  33 }
  34
  35 # Explore one move out.
  36 my @json_moves = ();
  37 for my $move (@moves) {
  38         my ($np, $uci_move) = $pos->make_pretty_move($move);
  39         my $hex = unpack('H*', $np->bitpacked_fen);
  40         print $chld_in $hex, "\n";
  41         my $line = <$chld_out>;
  42         my ($white, $draw, $black, $opening_num, $white_avg_elo, $black_avg_elo, $num_elo) = split / /, $line;
  43         push @json_moves, {
  44                 move => $move,
  45                 white => $white * 1,
  46                 draw => $draw * 1,
  47                 black => $black * 1,
  48                 white_avg_elo => $white_avg_elo * 1,
  49                 black_avg_elo => $black_avg_elo * 1,
  50                 num_elo => $num_elo * 1
  51         };
  52 }
  53
  54 print $cgi->header(-type=>'application/json');
  55 print JSON::XS::encode_json({ moves => \@json_moves, opening => $opening, root_pgn => $root_pgn });
  56
  57 sub num {
  58         my $x = shift;
  59         return $x->{'white'} + $x->{'draw'} + $x->{'black'};
  60 }
  61
  62 sub read_openings {
  63         open my $fh, "../openings.txt"
  64                 or die "../openings.txt: $!";
  65         for my $line (<$fh>) {
  66                 chomp $line;
  67                 my ($hash, $eco, $opening, $variation, $subvariation) = split /\t/, $line;
  68                 if ($variation eq '') {
  69                         $openings{$hash} = $eco . ": " . $opening;
  70                 } else {
  71                         $openings{$hash} = $eco . ": " . $opening . ": " . $variation;
  72                 }
  73         }
  74         close $fh;
  75 }
  76
  77 sub read_root_pgn {
  78         my @pgnnames;
  79         open my $pgnnamesfh, "<", "../pgnnames.txt"
  80                 or die "../pgnnames.txt: $!";
  81         while (<$pgnnamesfh>) {
  82                 chomp;
  83                 push @pgnnames, $_;
  84                 warn "PGN name: $_";
  85         }
  86         close $pgnnamesfh;
  87
  88         if ($pgn_file_number > $#pgnnames) {
  89                 die "Unknown PGN file number $pgn_file_number";
  90         }
  91
  92         my $root_pgn;
  93         open my $pgnfh, "<", "../" . $pgnnames[$pgn_file_number]
  94                 or die $pgnnames[$pgn_file_number] . ": $!";
  95         sysseek($pgnfh, $pgn_start_position, 0)
  96                 or die "Could not seek to $pgn_start_position: $!";
  97         sysread($pgnfh, $root_pgn, 32768)
  98                 or die "Could not read PGN from $pgn_start_position at $pgnnames[$pgn_file_number]: $!";
  99         close $pgnfh;
 100         $root_pgn =~ s/^.*?(\[Event )/$1/s;
 101         $root_pgn =~ s/^(.+?)\[Event .*/$1/s;
 102
 103         return $root_pgn;
 104 }