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         die "Missing PGN position data." if (!defined($pgn_file_number) || !defined($pgn_start_position));
  30         $root_pgn = read_root_pgn($pgn_file_number, $pgn_start_position);
  31 };
  32 if ($@) {
  33         $root_pgn = "Could not find root PGN. ($@)";
  34 }
  35
  36 # Explore one move out.
  37 my @json_moves = ();
  38 for my $move (@moves) {
  39         my ($np, $uci_move) = $pos->make_pretty_move($move);
  40         my $hex = unpack('H*', $np->bitpacked_fen);
  41         print $chld_in $hex, "\n";
  42         my $line = <$chld_out>;
  43         my ($white, $draw, $black, $opening_num, $white_avg_elo, $black_avg_elo, $num_elo) = split / /, $line;
  44         push @json_moves, {
  45                 move => $move,
  46                 white => $white * 1,
  47                 draw => $draw * 1,
  48                 black => $black * 1,
  49                 white_avg_elo => $white_avg_elo * 1,
  50                 black_avg_elo => $black_avg_elo * 1,
  51                 num_elo => $num_elo * 1
  52         };
  53 }
  54
  55 print $cgi->header(-type=>'application/json');
  56 print JSON::XS::encode_json({ moves => \@json_moves, opening => $opening, root_pgn => $root_pgn });
  57
  58 sub num {
  59         my $x = shift;
  60         return $x->{'white'} + $x->{'draw'} + $x->{'black'};
  61 }
  62
  63 sub read_openings {
  64         open my $fh, "../openings.txt"
  65                 or die "../openings.txt: $!";
  66         for my $line (<$fh>) {
  67                 chomp $line;
  68                 my ($hash, $eco, $opening, $variation, $subvariation) = split /\t/, $line;
  69                 if ($variation eq '') {
  70                         $openings{$hash} = $eco . ": " . $opening;
  71                 } else {
  72                         $openings{$hash} = $eco . ": " . $opening . ": " . $variation;
  73                 }
  74         }
  75         close $fh;
  76 }
  77
  78 sub read_root_pgn {
  79         my @pgnnames;
  80         open my $pgnnamesfh, "<", "../pgnnames.txt"
  81                 or die "../pgnnames.txt: $!";
  82         while (<$pgnnamesfh>) {
  83                 chomp;
  84                 push @pgnnames, $_;
  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 }