From 2e02751eebe4f5ed406e0f61c6f6eadae0193a41 Mon Sep 17 00:00:00 2001 From: "Steinar H. Gunderson" Date: Fri, 14 Nov 2014 00:55:47 +0100 Subject: [PATCH] =?utf8?q?=C2=A0Add=20support=20for=20looking=20up=20into?= =?utf8?q?=20the=20Lomonosov=20tablebase=20set.=20Requires=20a=20valid=20l?= =?utf8?q?icense=20key.?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- Board.pm | 13 +++++ Position.pm | 5 ++ config.pm | 1 + remoteglot.pl | 137 +++++++++++++++++++++++++++++++++++++++++++++++++- 4 files changed, 155 insertions(+), 1 deletion(-) diff --git a/Board.pm b/Board.pm index 655b7f1..2edc07d 100644 --- a/Board.pm +++ b/Board.pm @@ -425,6 +425,19 @@ sub prettyprint_move { return ($pretty, $nb); } +sub num_pieces { + my ($board) = @_; + + my $num = 0; + for my $row (0..7) { + for my $col (0..7) { + my $piece = $board->[$row][$col]; + ++$num if ($piece ne '-'); + } + } + return $num; +} + sub _prettyprint_move_no_check_or_mate { my ($board, $from_row, $from_col, $to_row, $to_col, $promo) = @_; my $piece = $board->[$from_row][$from_col]; diff --git a/Position.pm b/Position.pm index 6b772a6..90e7c1c 100644 --- a/Position.pm +++ b/Position.pm @@ -127,6 +127,11 @@ sub parse_pretty_move { return $pos->{'board'}->parse_pretty_move($move, $pos->{'toplay'}); } +sub num_pieces { + my ($pos) = @_; + return $pos->{'board'}->num_pieces(); +} + # Returns a new Position object. sub make_move { my ($pos, $from_row, $from_col, $to_row, $to_col, $promo) = @_; diff --git a/config.pm b/config.pm index 2c3bedf..f73a5f5 100644 --- a/config.pm +++ b/config.pm @@ -32,6 +32,7 @@ our @masters = ( 'Sesse', ); +our $tb_serial_key = undef; eval { require 'config.local.pm'; diff --git a/remoteglot.pl b/remoteglot.pl index 10dead9..0729409 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -19,6 +19,7 @@ use FileHandle; use IPC::Open2; use Time::HiRes; use JSON::XS; +use URI::Escape; require 'Position.pm'; require 'Engine.pm'; require 'config.pm'; @@ -30,6 +31,9 @@ no warnings qw(once); $SIG{ALRM} = sub { output(); }; my $latest_update = undef; my $http_timer = undef; +my $tb_retry_timer = undef; +my %tb_cache = (); +my $tb_lookup_running = 0; $| = 1; @@ -44,6 +48,13 @@ open(UCILOG, ">ucilog.txt") print UCILOG "Log starting.\n"; select(UCILOG); $| = 1; + +open(TBLOG, ">tblog.txt") + or die "tblog.txt: $!"; +print TBLOG "Log starting.\n"; +select(TBLOG); +$| = 1; + select(STDOUT); # open the chess engine @@ -251,6 +262,8 @@ sub handle_position { $engine->{'info'} = {}; $last_move = time; + schedule_tb_lookup(); + # # Output a command every move to note that we're # still paying attention -- this is a good tradeoff, @@ -385,6 +398,46 @@ sub output { } my $info = $engine->{'info'}; + + # + # If we have tablebase data from a previous lookup, replace the + # engine data with the data from the tablebase. + # + my $fen = $pos_calculating->fen(); + if (exists($tb_cache{$fen})) { + for my $key (qw(pv score_cp score_mate nodes nps depth seldepth tbhits)) { + delete $info->{$key . '1'}; + delete $info->{$key}; + } + $info->{'nodes'} = 0; + $info->{'nps'} = 0; + $info->{'depth'} = 0; + $info->{'seldepth'} = 0; + $info->{'tbhits'} = 0; + + my $t = $tb_cache{$fen}; + my $pv = $t->{'pv'}; + my $matelen = int((1 + scalar @$pv) / 2); + if ($t->{'result'} eq '1/2-1/2') { + $info->{'score_cp'} = 0; + } elsif ($t->{'result'} eq '1-0') { + if ($pos_calculating->{'toplay'} eq 'B') { + $info->{'score_mate'} = -$matelen; + } else { + $info->{'score_mate'} = $matelen; + } + } else { + if ($pos_calculating->{'toplay'} eq 'B') { + $info->{'score_mate'} = $matelen; + } else { + $info->{'score_mate'} = -$matelen; + } + } + $info->{'pv'} = $pv; + $info->{'tablebase'} = 1; + } else { + $info->{'tablebase'} = 0; + } # # Some programs _always_ report MultiPV, even with only one PV. @@ -556,6 +609,7 @@ sub output_json { $json->{'depth'} = $info->{'depth'}; $json->{'tbhits'} = $info->{'tbhits'}; $json->{'seldepth'} = $info->{'seldepth'}; + $json->{'tablebase'} = $info->{'tablebase'}; # single-PV only for now $json->{'pv_uci'} = $info->{'pv'}; @@ -678,7 +732,11 @@ sub long_score { if (exists($info->{'score_cp' . $mpv})) { my $score = $info->{'score_cp' . $mpv} * 0.01; if ($score == 0) { - return "Score: 0.00"; + if ($info->{'tablebase'}) { + return "Theoretical draw"; + } else { + return "Score: 0.00"; + } } if ($pos->{'toplay'} eq 'B') { $score = -$score; @@ -742,6 +800,83 @@ sub book_info { return $text; } +sub schedule_tb_lookup { + return if (!defined($remoteglotconf::tb_serial_key)); + my $pos = $pos_waiting // $pos_calculating; + return if (exists($tb_cache{$pos->fen()})); + + # If there's more than seven pieces, there's not going to be an answer, + # so don't bother. + return if ($pos->num_pieces() > 7); + + # Max one at a time. If it's still relevant when it returns, + # schedule_tb_lookup() will be called again. + return if ($tb_lookup_running); + + $tb_lookup_running = 1; + my $url = 'http://158.250.18.203:6904/tasks/addtask?auth.login=' . + $remoteglotconf::tb_serial_key . + '&auth.password=aquarium&type=0&fen=' . + URI::Escape::uri_escape($pos->fen()); + print TBLOG "Downloading $url...\n"; + AnyEvent::HTTP::http_get($url, sub { + handle_tb_lookup_return(@_, $pos, $pos->fen()); + }); +} + +sub handle_tb_lookup_return { + my ($body, $header, $pos, $fen) = @_; + print TBLOG "Response for [$fen]:\n"; + print TBLOG $header . "\n\n"; + print TBLOG $body . "\n\n"; + eval { + my $response = JSON::XS::decode_json($body); + if ($response->{'ErrorCode'} != 0) { + die "Unknown tablebase server error: " . $response->{'ErrorDesc'}; + } + my $state = $response->{'Response'}{'StateString'}; + if ($state eq 'COMPLETE') { + my $pgn = Chess::PGN::Parse->new(undef, $response->{'Response'}{'Moves'}); + if (!defined($pgn) || !$pgn->read_game()) { + warn "Error in parsing PGN\n"; + } else { + $pgn->quick_parse_game; + my $pvpos = $pos; + my $moves = $pgn->moves; + my @uci_moves = (); + for my $move (@$moves) { + my ($from_row, $from_col, $to_row, $to_col, $promo) = $pvpos->parse_pretty_move($move); + push @uci_moves, Board::move_to_uci_notation($from_row, $from_col, $to_row, $to_col, $promo); + $pvpos = $pvpos->make_move($from_row, $from_col, $to_row, $to_col, $promo); + } + $tb_cache{$fen} = { + result => $pgn->result, + pv => \@uci_moves + }; + output(); + } + } elsif ($state =~ /QUEUED/ || $state =~ /PROCESSING/) { + # Try again in a second. Note that if we have changed + # position in the meantime, we might query a completely + # different position! But that's fine. + } else { + die "Unknown response state state " . $response->{'Response'}{'StateString'}; + } + + # Wait a second before we schedule another one. + $tb_retry_timer = AnyEvent->timer(after => 1.0, cb => sub { + $tb_lookup_running = 0; + schedule_tb_lookup(); + }); + }; + if ($@) { + warn "Error in tablebase lookup: $@"; + + # Don't try this one again, but don't block new lookups either. + $tb_lookup_running = 0; + } +} + sub open_engine { my ($cmdline, $tag, $cb) = @_; return undef if (!defined($cmdline)); -- 2.39.2