X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=e1f36528b802f1c9023e6e81531cd2999ceb8976;hp=c35a0518694789ad9c37452599226fd65977033a;hb=9adc7fcb0912ea7fd3ec11f179107b401f91a247;hpb=a14f75fff599d1a5e16b2f3e73fb673a67434928 diff --git a/remoteglot.pl b/remoteglot.pl index c35a051..e1f3652 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -5,7 +5,7 @@ # analysis, or for live analysis of relayed games. (Do not use for # cheating! Cheating is bad for your karma, and your abuser flag.) # -# Copyright 2007 Steinar H. Gunderson +# Copyright 2007 Steinar H. Gunderson # Licensed under the GNU General Public License, version 2. # @@ -67,6 +67,7 @@ select(TBLOG); $| = 1; select(STDOUT); +umask 0022; # open the chess engine my $engine = open_engine($remoteglotconf::engine_cmdline, 'E1', sub { handle_uci(@_, 1); }); @@ -275,8 +276,12 @@ sub handle_pgn { } my $pgn = Chess::PGN::Parse->new(undef, $body); - if (!defined($pgn) || !$pgn->read_game() || $body !~ /^\[/) { - warn "Error in parsing PGN from $url\n"; + if (!defined($pgn)) { + warn "Error in parsing PGN from $url [body='$body']\n"; + } elsif (!$pgn->read_game()) { + warn "Error in reading PGN game from $url [body='$body']\n"; + } elsif ($body !~ /^\[/) { + warn "Malformed PGN from $url [body='$body']\n"; } else { eval { # Skip to the right game. @@ -286,7 +291,11 @@ sub handle_pgn { } $pgn->parse_game({ save_comments => 'yes' }); - my $pos = Position->start_pos($pgn->white, $pgn->black); + my $white = $pgn->white; + my $black = $pgn->black; + $white =~ s/,.*//; # Remove first name. + $black =~ s/,.*//; # Remove first name. + my $pos = Position->start_pos($white, $black); my $moves = $pgn->moves; my @uci_moves = (); my @repretty_moves = (); @@ -295,12 +304,14 @@ sub handle_pgn { push @uci_moves, $uci_move; # Re-prettyprint the move. - my ($from_col, $from_row, $to_col, $to_row, $promo) = parse_uci_move($uci_move); + my ($from_row, $from_col, $to_row, $to_col, $promo) = parse_uci_move($uci_move); my ($pretty, undef) = $pos->{'board'}->prettyprint_move($from_row, $from_col, $to_row, $to_col, $promo); push @repretty_moves, $pretty; $pos = $npos; } - $pos->{'result'} = $pgn->result; + if ($pgn->result eq '1-0' || $pgn->result eq '1/2-1/2' || $pgn->result eq '0-1') { + $pos->{'result'} = $pgn->result; + } $pos->{'pretty_history'} = \@repretty_moves; extract_clock($pgn, $pos); @@ -507,7 +518,7 @@ sub prettyprint_pv_no_cache { } my $pv = shift @pvs; - my ($from_col, $from_row, $to_col, $to_row, $promo) = parse_uci_move($pv); + my ($from_row, $from_col, $to_row, $to_col, $promo) = parse_uci_move($pv); my ($pretty, $nb) = $board->prettyprint_move($from_row, $from_col, $to_row, $to_col, $promo); return ( $pretty, prettyprint_pv_no_cache($nb, @pvs) ); } @@ -525,6 +536,61 @@ sub prettyprint_pv { } } +sub complete_using_tbprobe { + my ($pos, $info, $mpv) = @_; + + # We need Fathom installed to do standalone TB probes. + return if (!defined($remoteglotconf::fathom_cmdline)); + + # If we already have a mate, don't bother; in some cases, it would even be + # better than a tablebase score. + return if defined($info->{'score_mate' . $mpv}); + + # If we have a draw or near-draw score, there's also not much interesting + # we could add from a tablebase. We only really want mates. + return if ($info->{'score_cp' . $mpv} >= -12250 && $info->{'score_cp' . $mpv} <= 12250); + + # Run through the PV until we are at a 6-man position. + # TODO: We could in theory only have 5-man data. + my @pv = @{$info->{'pv' . $mpv}}; + my $key = join('', @pv); + my @moves = (); + if (exists($pos->{'tbprobe_cache'}{$key})) { + @moves = $pos->{'tbprobe_cache'}{$key}; + } else { + while ($pos->num_pieces() > 6 && $#pv > -1) { + my $move = shift @pv; + push @moves, $move; + $pos = $pos->make_move(parse_uci_move($move)); + } + + return if ($pos->num_pieces() > 6); + + my $fen = $pos->fen(); + my $pgn_text = `fathom --path=/srv/syzygy "$fen"`; + my $pgn = Chess::PGN::Parse->new(undef, $pgn_text); + return if (!defined($pgn) || !$pgn->read_game() || ($pgn->result ne '0-1' && $pgn->result ne '1-0')); + $pgn->quick_parse_game; + $info->{'pv' . $mpv} = \@moves; + + # Splice the PV from the tablebase onto what we have so far. + for my $move (@{$pgn->moves}) { + my $uci_move; + ($pos, $uci_move) = $pos->make_pretty_move($move); + push @moves, $uci_move; + } + } + + $info->{'pv' . $mpv} = \@moves; + + my $matelen = int((1 + scalar @moves) / 2); + if ((scalar @moves) % 2 == 0) { + $info->{'score_mate' . $mpv} = -$matelen; + } else { + $info->{'score_mate' . $mpv} = $matelen; + } +} + sub output { #return; @@ -589,6 +655,8 @@ sub output { for my $key (qw(pv score_cp score_mate nodes nps depth seldepth tbhits)) { if (exists($info->{$key . '1'})) { $info->{$key} = $info->{$key . '1'}; + } else { + delete $info->{$key}; } } } @@ -615,6 +683,17 @@ sub output { return; } + # Now do our own Syzygy tablebase probes to convert scores like +123.45 to mate. + if (exists($info->{'pv'})) { + complete_using_tbprobe($pos_calculating, $info, ''); + } + + my $mpv = 1; + while (exists($info->{'pv' . $mpv})) { + complete_using_tbprobe($pos_calculating, $info, $mpv); + ++$mpv; + } + output_screen(); output_json(0); $latest_update = [Time::HiRes::gettimeofday]; @@ -703,8 +782,8 @@ sub output_screen { my $info = $engine2->{'info'}; last if (!exists($info->{'pv' . $mpv})); eval { + complete_using_tbprobe($pos_calculating_second_engine, $info, $mpv); my $pv = $info->{'pv' . $mpv}; - my $pretty_move = join('', prettyprint_pv($pos_calculating_second_engine, $pv->[0])); my @pretty_pv = prettyprint_pv($pos_calculating_second_engine, @$pv); if (scalar @pretty_pv > 5) { @@ -756,9 +835,7 @@ sub output_json { if (defined($remoteglotconf::move_source_url)) { $json->{'move_source_url'} = $remoteglotconf::move_source_url; } - $json->{'score'} = long_score($info, $pos_calculating, ''); - $json->{'short_score'} = short_score($info, $pos_calculating, ''); - $json->{'plot_score'} = plot_score($info, $pos_calculating, ''); + $json->{'score'} = score_digest($info, $pos_calculating, ''); $json->{'using_lomonosov'} = defined($remoteglotconf::tb_serial_key); $json->{'nodes'} = $info->{'nodes'}; @@ -781,14 +858,14 @@ sub output_json { last if (!exists($info->{'pv' . $mpv})); eval { + complete_using_tbprobe($pos_calculating, $info, $mpv); my $pv = $info->{'pv' . $mpv}; my $pretty_move = join('', prettyprint_pv($pos_calculating, $pv->[0])); my @pretty_pv = prettyprint_pv($pos_calculating, @$pv); $refutation_lines{$pv->[0]} = { sort_key => $pretty_move, depth => $info->{'depth' . $mpv}, - score_sort_key => score_sort_key($info, $pos_calculating, $mpv, 0), - pretty_score => short_score($info, $pos_calculating, $mpv), + score => score_digest($info, $pos_calculating, $mpv), pretty_move => $pretty_move, pv_pretty => \@pretty_pv, }; @@ -809,8 +886,8 @@ sub output_json { my $ref = $dbh->selectrow_hashref($q, undef, $id); if (defined($ref)) { $score_history{$halfmove_num} = [ - $ref->{'plot_score'}, - $ref->{'short_score'} + $ref->{'score_type'}, + $ref->{'score_value'} ]; } ++$halfmove_num; @@ -841,6 +918,7 @@ sub output_json { } # Give out a list of other games going on. (Empty is fine.) + # TODO: Don't bother reading our own file, the data will be stale anyway. if (!$historic_json_only) { my @games = (); @@ -855,11 +933,18 @@ sub output_json { my $white = $other_game_json->{'position'}{'player_w'} // die 'Missing white'; my $black = $other_game_json->{'position'}{'player_b'} // die 'Missing black'; - push @games, { + my $game = { id => $ref->{'id'}, name => "$white–$black", - url => $ref->{'url'} + url => $ref->{'url'}, + hashurl => $ref->{'hash_url'}, }; + if (defined($other_game_json->{'position'}{'result'})) { + $game->{'result'} = $other_game_json->{'position'}{'result'}; + } else { + $game->{'score'} = $other_game_json->{'score'}; + } + push @games, $game; }; if ($@) { warn "Could not add external game " . $ref->{'json_path'} . ": $@"; @@ -897,16 +982,16 @@ sub output_json { $new_depth > $old_depth || ($new_depth == $old_depth && $new_nodes >= $old_nodes)) { atomic_set_contents($filename, $encoded); - if (defined($json->{'plot_score'})) { - $dbh->do('INSERT INTO scores (id, plot_score, short_score, engine, depth, nodes) VALUES (?,?,?,?,?,?) ' . + if (defined($json->{'score'})) { + $dbh->do('INSERT INTO scores (id, score_type, score_value, engine, depth, nodes) VALUES (?,?,?,?,?,?) ' . ' ON CONFLICT (id) DO UPDATE SET ' . - ' plot_score=EXCLUDED.plot_score, ' . - ' short_score=EXCLUDED.short_score, ' . + ' score_type=EXCLUDED.score_type, ' . + ' score_value=EXCLUDED.score_value, ' . ' engine=EXCLUDED.engine, ' . ' depth=EXCLUDED.depth, ' . ' nodes=EXCLUDED.nodes', undef, - $id, $json->{'plot_score'}, $json->{'short_score'}, + $id, $json->{'score'}[0], $json->{'score'}[1], $json->{'engine'}{'name'}, $new_depth, $new_nodes); } } @@ -977,30 +1062,28 @@ sub short_score { return undef; } -sub score_sort_key { - my ($info, $pos, $mpv, $invert) = @_; +# Sufficient for computing long_score, short_score, plot_score and +# (with side-to-play information) score_sort_key. +sub score_digest { + my ($info, $pos, $mpv) = @_; if (defined($info->{'score_mate' . $mpv})) { my $mate = $info->{'score_mate' . $mpv}; - my $score; - if ($mate > 0) { - # Side to move mates - $score = 99999 - $mate; - } else { - # Side to move is getting mated (note the double negative for $mate) - $score = -99999 - $mate; - } - if ($invert) { - $score = -$score; + if ($pos->{'toplay'} eq 'B') { + $mate = -$mate; } - return $score; + return ['m', $mate]; } else { if (exists($info->{'score_cp' . $mpv})) { my $score = $info->{'score_cp' . $mpv}; - if ($invert) { + if ($pos->{'toplay'} eq 'B') { $score = -$score; } - return $score; + if ($score == 0 && $info->{'tablebase'}) { + return ['d', undef]; + } else { + return ['cp', $score]; + } } } @@ -1339,5 +1422,5 @@ sub parse_uci_move { my $to_col = col_letter_to_num(substr($move, 2, 1)); my $to_row = row_letter_to_num(substr($move, 3, 1)); my $promo = substr($move, 4, 1); - return ($from_col, $from_row, $to_col, $to_row, $promo); + return ($from_row, $from_col, $to_row, $to_col, $promo); }