X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=f42b7244aab08a810b5a0c0981ed22c04c10b2d8;hp=bd10cd020475f50a4b3ca0db6e08108e3babead6;hb=bf26f1b3ef29a518e1ee9f71c42c9cf344d2e987;hpb=9e923c34a6788eb9780a151316b196d4a18c3bbd diff --git a/remoteglot.pl b/remoteglot.pl index bd10cd0..f42b724 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -13,6 +13,7 @@ use Net::Telnet; use FileHandle; use IPC::Open2; use Time::HiRes; +use JSON::XS; use strict; use warnings; @@ -20,9 +21,12 @@ use warnings; my $server = "freechess.org"; my $target = "GMCarlsen"; my $engine_cmdline = "'./Deep Rybka 4 SSE42 x64'"; +my $engine2_cmdline = "./stockfish_13111119_x64_modern_sse42"; my $telltarget = undef; # undef to be silent my @tell_intervals = (5, 20, 60, 120, 240, 480, 960); # after each move my $uci_assume_full_compliance = 0; # dangerous :-) +my $update_max_interval = 2.0; +my $second_engine_start_depth = 8; my @masters = ( 'Sesse', 'Sessse', @@ -32,7 +36,8 @@ my @masters = ( ); # Program starts here -$SIG{ALRM} = sub { output_screen(); }; +$SIG{ALRM} = sub { output(); }; +my $latest_update = undef; $| = 1; @@ -50,13 +55,13 @@ $| = 1; select(STDOUT); # open the chess engine -my $engine = open_engine($engine_cmdline); -my %uciinfo = (); -my %uciid = (); +my $engine = open_engine($engine_cmdline, 'E1'); +my $engine2 = open_engine($engine2_cmdline, 'E2'); my ($last_move, $last_tell); my $last_text = ''; my $last_told_text = ''; -my ($pos_waiting, $pos_calculating); +my ($pos_waiting, $pos_calculating, $move_calculating_second_engine); +my %refutation_moves = (); uciprint($engine, "setoption name UCI_AnalyseMode value true"); # uciprint($engine, "setoption name NalimovPath value /srv/tablebase"); @@ -65,6 +70,14 @@ uciprint($engine, "setoption name Hash value 1024"); # uciprint($engine, "setoption name MultiPV value 2"); uciprint($engine, "ucinewgame"); +uciprint($engine2, "setoption name UCI_AnalyseMode value true"); +# uciprint($engine2, "setoption name NalimovPath value /srv/tablebase"); +uciprint($engine2, "setoption name NalimovUsage value Rarely"); +uciprint($engine2, "setoption name Hash value 1024"); +uciprint($engine2, "setoption name Threads value 8"); +# uciprint($engine2, "setoption name MultiPV value 2"); +uciprint($engine2, "ucinewgame"); + print "Chess engine ready.\n"; # now talk to FICS @@ -87,6 +100,7 @@ while (1) { my $rin = ''; my $rout; vec($rin, fileno($engine->{'read'}), 1) = 1; + vec($rin, fileno($engine2->{'read'}), 1) = 1; vec($rin, fileno($t), 1) = 1; my ($nfound, $timeleft) = select($rout=$rin, undef, undef, 5.0); @@ -99,7 +113,7 @@ while (1) { chomp $line; $line =~ tr/\r//d; if ($line =~ /^<12> /) { - my $pos = style12_to_fen($line); + my $pos = style12_to_pos($line); # if this is already in the queue, ignore it next if (defined($pos_waiting) && $pos->{'fen'} eq $pos_waiting->{'fen'}); @@ -131,7 +145,16 @@ while (1) { $pos_calculating = $pos; } - %uciinfo = (); + %refutation_moves = calculate_refutation_moves($pos); + if (defined($move_calculating_second_engine)) { + uciprint($engine2, "stop"); + $move_calculating_second_engine = undef; + } else { + give_new_move_to_second_engine($pos); + } + + $engine->{'info'} = {}; + $engine2->{'info'} = {}; $last_move = time; # @@ -164,71 +187,77 @@ while (1) { # any fun on the UCI channel? if ($nfound > 0 && vec($rout, fileno($engine->{'read'}), 1) == 1) { - # - # Read until we've got a full line -- if the engine sends part of - # a line and then stops we're pretty much hosed, but that should - # never happen. - # - my $line = ''; - while ($line !~ /\n/) { - my $tmp; - my $ret = sysread $engine->{'read'}, $tmp, 1; - - if (!defined($ret)) { - next if ($!{EINTR}); - die "error in reading from the UCI engine: $!"; - } elsif ($ret == 0) { - die "EOF from UCI engine"; - } - - $line .= $tmp; + my @lines = read_lines($engine); + for my $line (@lines) { + next if $line =~ /(upper|lower)bound/; + handle_uci($engine, $line, 1); } + $sleep = 0; - $line =~ tr/\r\n//d; - handle_uci($line); + output(); + } + if ($nfound > 0 && vec($rout, fileno($engine2->{'read'}), 1) == 1) { + my @lines = read_lines($engine2); + for my $line (@lines) { + next if $line =~ /(upper|lower)bound/; + handle_uci($engine2, $line, 0); + } $sleep = 0; - # don't update too often - Time::HiRes::alarm(0.2); + output(); } sleep $sleep; } sub handle_uci { - my ($line) = @_; + my ($engine, $line, $primary) = @_; chomp $line; $line =~ tr/\r//d; $line =~ s/ / /g; # Sometimes needed for Zappa Mexico - print UCILOG localtime() . " <= $line\n"; + print UCILOG localtime() . " $engine->{'tag'} <= $line\n"; if ($line =~ /^info/) { my (@infos) = split / /, $line; shift @infos; - parse_infos(@infos); + parse_infos($engine, @infos); } if ($line =~ /^id/) { my (@ids) = split / /, $line; shift @ids; - parse_ids(@ids); + parse_ids($engine, @ids); } - if ($line =~ /^bestmove/ && $uci_assume_full_compliance) { - if (defined($pos_waiting)) { - uciprint($engine, "position fen " . $pos_waiting->{'fen'}); - uciprint($engine, "go infinite"); + if ($line =~ /^bestmove/) { + if ($primary) { + return if (!$uci_assume_full_compliance); + if (defined($pos_waiting)) { + uciprint($engine, "position fen " . $pos_waiting->{'fen'}); + uciprint($engine, "go infinite"); - $pos_calculating = $pos_waiting; - $pos_waiting = undef; + $pos_calculating = $pos_waiting; + $pos_waiting = undef; + } + } else { + if (defined($move_calculating_second_engine)) { + my $move = $refutation_moves{$move_calculating_second_engine}; + $move->{'pv'} = $engine->{'info'}{'pv'} // $engine->{'info'}{'pv1'}; + $move->{'score_cp'} = $engine->{'info'}{'score_cp'} // $engine->{'info'}{'score_cp1'} // 0; + $move->{'score_mate'} = $engine->{'info'}{'score_mate'} // $engine->{'info'}{'score_mate1'}; + $move->{'toplay'} = $pos_calculating->{'toplay'}; + } + give_new_move_to_second_engine($pos_waiting // $pos_calculating); } } } sub parse_infos { - my (@x) = @_; + my ($engine, @x) = @_; my $mpv = ''; + my $info = $engine->{'info'}; + while (scalar @x > 0) { if ($x[0] =~ 'multipv') { shift @x; @@ -238,28 +267,28 @@ sub parse_infos { if ($x[0] =~ /^(currmove|currmovenumber|cpuload)$/) { my $key = shift @x; my $value = shift @x; - $uciinfo{$key} = $value; + $info->{$key} = $value; next; } if ($x[0] =~ /^(depth|seldepth|hashfull|time|nodes|nps|tbhits)$/) { my $key = shift @x; my $value = shift @x; - $uciinfo{$key . $mpv} = $value; + $info->{$key . $mpv} = $value; next; } if ($x[0] eq 'score') { shift @x; - delete $uciinfo{'score_cp' . $mpv}; - delete $uciinfo{'score_mate' . $mpv}; + delete $info->{'score_cp' . $mpv}; + delete $info->{'score_mate' . $mpv}; while ($x[0] =~ /^(cp|mate|lowerbound|upperbound)$/) { if ($x[0] eq 'cp') { shift @x; - $uciinfo{'score_cp' . $mpv} = shift @x; + $info->{'score_cp' . $mpv} = shift @x; } elsif ($x[0] eq 'mate') { shift @x; - $uciinfo{'score_mate' . $mpv} = shift @x; + $info->{'score_mate' . $mpv} = shift @x; } else { shift @x; } @@ -267,7 +296,7 @@ sub parse_infos { next; } if ($x[0] eq 'pv') { - $uciinfo{'pv' . $mpv} = [ @x[1..$#x] ]; + $info->{'pv' . $mpv} = [ @x[1..$#x] ]; last; } if ($x[0] eq 'string' || $x[0] eq 'UCI_AnalyseMode' || $x[0] eq 'setting' || $x[0] eq 'contempt') { @@ -282,13 +311,13 @@ sub parse_infos { } sub parse_ids { - my (@x) = @_; + my ($engine, @x) = @_; while (scalar @x > 0) { if ($x[0] =~ /^(name|author)$/) { my $key = shift @x; my $value = join(' ', @x); - $uciid{$key} = $value; + $engine->{'id'}{$key} = $value; last; } @@ -297,16 +326,31 @@ sub parse_ids { } } -sub style12_to_fen { +sub style12_to_pos { my $str = shift; my %pos = (); my (@x) = split / /, $str; $pos{'board'} = [ @x[1..8] ]; $pos{'toplay'} = $x[9]; - + $pos{'ep_file_num'} = $x[10]; + $pos{'white_castle_k'} = $x[11]; + $pos{'white_castle_q'} = $x[12]; + $pos{'black_castle_k'} = $x[13]; + $pos{'black_castle_q'} = $x[14]; + $pos{'time_to_100move_rule'} = $x[15]; + $pos{'move_num'} = $x[26]; + $pos{'last_move'} = $x[29]; + $pos{'fen'} = make_fen(\%pos); + + return \%pos; +} + +sub make_fen { + my $pos = shift; + # the board itself - my (@board) = @x[1..8]; + my (@board) = @{$pos->{'board'}}; for my $rank (0..7) { $board[$rank] =~ s/(-+)/length($1)/ge; } @@ -314,14 +358,14 @@ sub style12_to_fen { # white/black to move $fen .= " "; - $fen .= lc($x[9]); + $fen .= lc($pos->{'toplay'}); # castling my $castling = ""; - $castling .= "K" if ($x[11] == 1); - $castling .= "Q" if ($x[12] == 1); - $castling .= "k" if ($x[13] == 1); - $castling .= "q" if ($x[14] == 1); + $castling .= "K" if ($pos->{'white_castle_k'} == 1); + $castling .= "Q" if ($pos->{'white_castle_q'} == 1); + $castling .= "k" if ($pos->{'black_castle_k'} == 1); + $castling .= "q" if ($pos->{'black_castle_q'} == 1); $castling = "-" if ($castling eq ""); # $castling = "-"; # chess960 $fen .= " "; @@ -329,11 +373,11 @@ sub style12_to_fen { # en passant my $ep = "-"; - if ($x[10] != -1) { - my $col = $x[10]; + if ($pos->{'ep_file_num'} != -1) { + my $col = $pos->{'ep_file_num'}; my $nep = (qw(a b c d e f g h))[$col]; - if ($x[9] eq 'B') { + if ($pos->{'toplay'} eq 'B') { $nep .= "3"; } else { $nep .= "6"; @@ -346,12 +390,12 @@ sub style12_to_fen { # not, just lie -- it doesn't matter anyway. I'm unsure what's the # "right" thing as per the standard, though. # - if ($x[9] eq 'B') { - $ep = $nep if ($col > 0 && substr($pos{'board'}[4], $col-1, 1) eq 'p'); - $ep = $nep if ($col < 7 && substr($pos{'board'}[4], $col+1, 1) eq 'p'); + if ($pos->{'toplay'} eq 'B') { + $ep = $nep if ($col > 0 && substr($pos->{'board'}[4], $col-1, 1) eq 'p'); + $ep = $nep if ($col < 7 && substr($pos->{'board'}[4], $col+1, 1) eq 'p'); } else { - $ep = $nep if ($col > 0 && substr($pos{'board'}[3], $col-1, 1) eq 'P'); - $ep = $nep if ($col < 7 && substr($pos{'board'}[3], $col+1, 1) eq 'P'); + $ep = $nep if ($col > 0 && substr($pos->{'board'}[3], $col-1, 1) eq 'P'); + $ep = $nep if ($col < 7 && substr($pos->{'board'}[3], $col+1, 1) eq 'P'); } } $fen .= " "; @@ -359,43 +403,27 @@ sub style12_to_fen { # half-move clock $fen .= " "; - $fen .= $x[15]; + $fen .= $pos->{'time_to_100move_rule'}; # full-move clock $fen .= " "; - $fen .= $x[26]; + $fen .= $pos->{'move_num'}; - $pos{'fen'} = $fen; - $pos{'move_num'} = $x[26]; - $pos{'last_move'} = $x[29]; - - return \%pos; + return $fen; } -sub prettyprint_pv { - my ($board, @pvs) = @_; - - if (scalar @pvs == 0 || !defined($pvs[0])) { - return (); - } - - my @nb = @$board; - - my $pv = shift @pvs; - my $from_col = ord(substr($pv, 0, 1)) - ord('a'); - my $from_row = 7 - (ord(substr($pv, 1, 1)) - ord('1')); - my $to_col = ord(substr($pv, 2, 1)) - ord('a'); - my $to_row = 7 - (ord(substr($pv, 3, 1)) - ord('1')); - - my $pretty; +sub make_move { + my ($board, $from_row, $from_col, $to_row, $to_col, $promo) = @_; + my $move = move_to_uci_notation($from_row, $from_col, $to_row, $to_col, $promo); my $piece = substr($board->[$from_row], $from_col, 1); + my @nb = @$board; if ($piece eq '-') { - die "Invalid move $pv"; + die "Invalid move $move"; } # white short castling - if ($pv eq 'e1g1' && $piece eq 'K') { + if ($move eq 'e1g1' && $piece eq 'K') { # king substr($nb[7], 4, 1, '-'); substr($nb[7], 6, 1, $piece); @@ -404,11 +432,11 @@ sub prettyprint_pv { substr($nb[7], 7, 1, '-'); substr($nb[7], 5, 1, 'R'); - return ('0-0', prettyprint_pv(\@nb, @pvs)); + return \@nb; } # white long castling - if ($pv eq 'e1c1' && $piece eq 'K') { + if ($move eq 'e1c1' && $piece eq 'K') { # king substr($nb[7], 4, 1, '-'); substr($nb[7], 2, 1, $piece); @@ -417,11 +445,11 @@ sub prettyprint_pv { substr($nb[7], 0, 1, '-'); substr($nb[7], 3, 1, 'R'); - return ('0-0-0', prettyprint_pv(\@nb, @pvs)); + return \@nb; } # black short castling - if ($pv eq 'e8g8' && $piece eq 'k') { + if ($move eq 'e8g8' && $piece eq 'k') { # king substr($nb[0], 4, 1, '-'); substr($nb[0], 6, 1, $piece); @@ -430,11 +458,11 @@ sub prettyprint_pv { substr($nb[0], 7, 1, '-'); substr($nb[0], 5, 1, 'r'); - return ('0-0', prettyprint_pv(\@nb, @pvs)); + return \@nb; } # black long castling - if ($pv eq 'e8c8' && $piece eq 'k') { + if ($move eq 'e8c8' && $piece eq 'k') { # king substr($nb[0], 4, 1, '-'); substr($nb[0], 2, 1, $piece); @@ -443,15 +471,13 @@ sub prettyprint_pv { substr($nb[0], 0, 1, '-'); substr($nb[0], 3, 1, 'r'); - return ('0-0-0', prettyprint_pv(\@nb, @pvs)); + return \@nb; } # check if the from-piece is a pawn if (lc($piece) eq 'p') { # attack? if ($from_col != $to_col) { - $pretty = substr($pv, 0, 1) . 'x' . substr($pv, 2, 2); - # en passant? if (substr($board->[$to_row], $to_col, 1) eq '-') { if ($piece eq 'p') { @@ -460,6 +486,72 @@ sub prettyprint_pv { substr($nb[$to_row - 1], $to_col, 1, '-'); } } + } else { + if ($promo ne '') { + if ($piece eq 'p') { + $piece = $promo; + } else { + $piece = uc($promo); + } + } + } + } + + # update the board + substr($nb[$from_row], $from_col, 1, '-'); + substr($nb[$to_row], $to_col, 1, $piece); + + return \@nb; +} + +sub prettyprint_pv { + my ($board, @pvs) = @_; + + if (scalar @pvs == 0 || !defined($pvs[0])) { + return (); + } + + my $pv = shift @pvs; + my $from_col = col_letter_to_num(substr($pv, 0, 1)); + my $from_row = row_letter_to_num(substr($pv, 1, 1)); + my $to_col = col_letter_to_num(substr($pv, 2, 1)); + my $to_row = row_letter_to_num(substr($pv, 3, 1)); + my $promo = substr($pv, 4, 1); + + my $nb = make_move($board, $from_row, $from_col, $to_row, $to_col, $promo); + my $piece = substr($board->[$from_row], $from_col, 1); + + if ($piece eq '-') { + die "Invalid move $pv"; + } + + # white short castling + if ($pv eq 'e1g1' && $piece eq 'K') { + return ('0-0', prettyprint_pv($nb, @pvs)); + } + + # white long castling + if ($pv eq 'e1c1' && $piece eq 'K') { + return ('0-0-0', prettyprint_pv($nb, @pvs)); + } + + # black short castling + if ($pv eq 'e8g8' && $piece eq 'k') { + return ('0-0', prettyprint_pv($nb, @pvs)); + } + + # black long castling + if ($pv eq 'e8c8' && $piece eq 'k') { + return ('0-0-0', prettyprint_pv($nb, @pvs)); + } + + my $pretty; + + # check if the from-piece is a pawn + if (lc($piece) eq 'p') { + # attack? + if ($from_col != $to_col) { + $pretty = substr($pv, 0, 1) . 'x' . substr($pv, 2, 2); } else { $pretty = substr($pv, 2, 2); @@ -520,24 +612,41 @@ sub prettyprint_pv { $pretty .= substr($pv, 2, 2); } - # update the board - substr($nb[$from_row], $from_col, 1, '-'); - substr($nb[$to_row], $to_col, 1, $piece); - - if (in_mate(\@nb)) { + if (in_mate($nb)) { $pretty .= '#'; - } elsif (in_check(\@nb) ne 'none') { + } elsif (in_check($nb) ne 'none') { $pretty .= '+'; } - - return ($pretty, prettyprint_pv(\@nb, @pvs)); + return ($pretty, prettyprint_pv($nb, @pvs)); } -sub output_screen { +sub output { #return; - + return if (!defined($pos_calculating)); + # Don't update too often. + my $age = Time::HiRes::tv_interval($latest_update); + if ($age < $update_max_interval) { + Time::HiRes::alarm($update_max_interval + 0.01 - $age); + return; + } + + my $info = $engine->{'info'}; + + # + # Some programs _always_ report MultiPV, even with only one PV. + # In this case, we simply use that data as if MultiPV was never + # specified. + # + if (exists($info->{'pv1'}) && !exists($info->{'pv2'})) { + for my $key (qw(pv score_cp score_mate nodes nps depth seldepth tbhits)) { + if (exists($info->{$key . '1'})) { + $info->{$key} = $info->{$key . '1'}; + } + } + } + # # Check the PVs first. if they're invalid, just wait, as our data # is most likely out of sync. This isn't a very good solution, as @@ -545,21 +654,30 @@ sub output_screen { # eval { my $dummy; - if (exists($uciinfo{'pv'})) { - $dummy = prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv'}}); + if (exists($info->{'pv'})) { + $dummy = prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv'}}); } my $mpv = 1; - while (exists($uciinfo{'pv' . $mpv})) { - $dummy = prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv' . $mpv}}); + while (exists($info->{'pv' . $mpv})) { + $dummy = prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv' . $mpv}}); ++$mpv; } }; if ($@) { - %uciinfo = (); + $engine->{'info'} = {}; return; } + output_screen(); + output_json(); + $latest_update = [Time::HiRes::gettimeofday]; +} + +sub output_screen { + my $info = $engine->{'info'}; + my $id = $engine->{'id'}; + my $text = 'Analysis'; if ($pos_calculating->{'last_move'} ne 'none') { if ($pos_calculating->{'toplay'} eq 'W') { @@ -567,85 +685,102 @@ sub output_screen { } else { $text .= sprintf ' after %u. %s', $pos_calculating->{'move_num'}, $pos_calculating->{'last_move'}; } - if (exists($uciid{'name'})) { + if (exists($id->{'name'})) { $text .= ','; } } - if (exists($uciid{'name'})) { - $text .= " by $uciid{'name'}:\n\n"; + if (exists($id->{'name'})) { + $text .= " by $id->{'name'}:\n\n"; } else { $text .= ":\n\n"; } return unless (exists($pos_calculating->{'board'})); - # - # Some programs _always_ report MultiPV, even with only one PV. - # In this case, we simply use that data as if MultiPV was never - # specified. - # - if (exists($uciinfo{'pv1'}) && !exists($uciinfo{'pv2'})) { - for my $key qw(pv score_cp score_mate nodes nps depth seldepth tbhits) { - if (exists($uciinfo{$key . '1'}) && !exists($uciinfo{$key})) { - $uciinfo{$key} = $uciinfo{$key . '1'}; - } - } - } - - if (exists($uciinfo{'pv1'}) && exists($uciinfo{'pv2'})) { + if (exists($info->{'pv1'}) && exists($info->{'pv2'})) { # multi-PV my $mpv = 1; - while (exists($uciinfo{'pv' . $mpv})) { + while (exists($info->{'pv' . $mpv})) { $text .= sprintf " PV%2u", $mpv; - my $score = short_score(\%uciinfo, $pos_calculating, $mpv); + my $score = short_score($info, $pos_calculating, $mpv); $text .= " ($score)" if (defined($score)); my $tbhits = ''; - if (exists($uciinfo{'tbhits' . $mpv}) && $uciinfo{'tbhits' . $mpv} > 0) { - if ($uciinfo{'tbhits' . $mpv} == 1) { + if (exists($info->{'tbhits' . $mpv}) && $info->{'tbhits' . $mpv} > 0) { + if ($info->{'tbhits' . $mpv} == 1) { $tbhits = ", 1 tbhit"; } else { - $tbhits = sprintf ", %u tbhits", $uciinfo{'tbhits' . $mpv}; + $tbhits = sprintf ", %u tbhits", $info->{'tbhits' . $mpv}; } } - if (exists($uciinfo{'nodes' . $mpv}) && exists($uciinfo{'nps' . $mpv}) && exists($uciinfo{'depth' . $mpv})) { + if (exists($info->{'nodes' . $mpv}) && exists($info->{'nps' . $mpv}) && exists($info->{'depth' . $mpv})) { $text .= sprintf " (%5u kn, %3u kn/s, %2u ply$tbhits)", - $uciinfo{'nodes' . $mpv} / 1000, $uciinfo{'nps' . $mpv} / 1000, $uciinfo{'depth' . $mpv}; + $info->{'nodes' . $mpv} / 1000, $info->{'nps' . $mpv} / 1000, $info->{'depth' . $mpv}; } $text .= ":\n"; - $text .= " " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv' . $mpv}})) . "\n"; + $text .= " " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv' . $mpv}})) . "\n"; $text .= "\n"; ++$mpv; } } else { # single-PV - my $score = long_score(\%uciinfo, $pos_calculating, ''); + my $score = long_score($info, $pos_calculating, ''); $text .= " $score\n" if defined($score); - $text .= " PV: " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv'}})); + $text .= " PV: " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv'}})); $text .= "\n"; - if (exists($uciinfo{'nodes'}) && exists($uciinfo{'nps'}) && exists($uciinfo{'depth'})) { + if (exists($info->{'nodes'}) && exists($info->{'nps'}) && exists($info->{'depth'})) { $text .= sprintf " %u nodes, %7u nodes/sec, depth %u ply", - $uciinfo{'nodes'}, $uciinfo{'nps'}, $uciinfo{'depth'}; + $info->{'nodes'}, $info->{'nps'}, $info->{'depth'}; } - if (exists($uciinfo{'tbhits'}) && $uciinfo{'tbhits'} > 0) { - if ($uciinfo{'tbhits'} == 1) { + if (exists($info->{'seldepth'})) { + $text .= sprintf " (%u selective)", $info->{'seldepth'}; + } + if (exists($info->{'tbhits'}) && $info->{'tbhits'} > 0) { + if ($info->{'tbhits'} == 1) { $text .= ", one Nalimov hit"; } else { - $text .= sprintf ", %u Nalimov hits", $uciinfo{'tbhits'}; + $text .= sprintf ", %u Nalimov hits", $info->{'tbhits'}; } } - if (exists($uciinfo{'seldepth'})) { - $text .= sprintf " (%u selective)", $uciinfo{'seldepth'}; - } - $text .= "\n\n"; + $text .= "\n\n"; } #$text .= book_info($pos_calculating->{'fen'}, $pos_calculating->{'board'}, $pos_calculating->{'toplay'}); + my @refutation_lines = (); + for my $move (keys %refutation_moves) { + eval { + my $m = $refutation_moves{$move}; + die if ($m->{'depth'} < $second_engine_start_depth); + my $pretty_move = join('', prettyprint_pv($pos_calculating->{'board'}, $move)); + my @pretty_pv = prettyprint_pv($pos_calculating->{'board'}, $move, @{$m->{'pv'}}); + if (scalar @pretty_pv > 5) { + @pretty_pv = @pretty_pv[0..4]; + push @pretty_pv, "..."; + } + #my $key = score_sort_key($refutation_moves{$move}, $pos_calculating, '', 1); + my $key = $pretty_move; + my $line = sprintf(" %-6s %6s %3s %s", + $pretty_move, + short_score($refutation_moves{$move}, $pos_calculating, '', 1), + "d" . $m->{'depth'}, + join(', ', @pretty_pv)); + push @refutation_lines, [ $key, $line ]; + }; + } + + if ($#refutation_lines >= 0) { + $text .= "Shallow search of all legal moves:\n\n"; + for my $line (sort { $a->[0] cmp $b->[0] } @refutation_lines) { + $text .= $line->[1] . "\n"; + } + $text .= "\n\n"; + } + if ($last_text ne $text) { print ""; # clear the screen print $text; @@ -657,36 +792,36 @@ sub output_screen { my $tell_text = ''; - if (exists($uciid{'name'})) { - $tell_text .= "Analysis by $uciid{'name'} -- see http://analysis.sesse.net/ for more information\n"; + if (exists($id->{'name'})) { + $tell_text .= "Analysis by $id->{'name'} -- see http://analysis.sesse.net/ for more information\n"; } else { $tell_text .= "Computer analysis -- http://analysis.sesse.net/ for more information\n"; } - if (exists($uciinfo{'pv1'}) && exists($uciinfo{'pv2'})) { + if (exists($info->{'pv1'}) && exists($info->{'pv2'})) { # multi-PV my $mpv = 1; - while (exists($uciinfo{'pv' . $mpv})) { + while (exists($info->{'pv' . $mpv})) { $tell_text .= sprintf " PV%2u", $mpv; - my $score = short_score(\%uciinfo, $pos_calculating, $mpv); + my $score = short_score($info, $pos_calculating, $mpv); $tell_text .= " ($score)" if (defined($score)); - if (exists($uciinfo{'depth' . $mpv})) { - $tell_text .= sprintf " (%2u ply)", $uciinfo{'depth' . $mpv}; + if (exists($info->{'depth' . $mpv})) { + $tell_text .= sprintf " (%2u ply)", $info->{'depth' . $mpv}; } $tell_text .= ": "; - $tell_text .= join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv' . $mpv}})); + $tell_text .= join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv' . $mpv}})); $tell_text .= "\n"; ++$mpv; } } else { # single-PV - my $score = long_score(\%uciinfo, $pos_calculating, ''); + my $score = long_score($info, $pos_calculating, ''); $tell_text .= " $score\n" if defined($score); - $tell_text .= " PV: " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$uciinfo{'pv'}})); - if (exists($uciinfo{'depth'})) { - $tell_text .= sprintf " (depth %u ply)", $uciinfo{'depth'}; + $tell_text .= " PV: " . join(', ', prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv'}})); + if (exists($info->{'depth'})) { + $tell_text .= sprintf " (depth %u ply)", $info->{'depth'}; } $tell_text .= "\n"; } @@ -711,6 +846,54 @@ sub output_screen { } } +sub output_json { + my $info = $engine->{'info'}; + + my $json = {}; + $json->{'position'} = $pos_calculating; + $json->{'id'} = $engine->{'id'}; + $json->{'score'} = long_score($info, $pos_calculating, ''); + + $json->{'nodes'} = $info->{'nodes'}; + $json->{'nps'} = $info->{'nps'}; + $json->{'depth'} = $info->{'depth'}; + $json->{'tbhits'} = $info->{'tbhits'}; + $json->{'seldepth'} = $info->{'seldepth'}; + + # single-PV only for now + $json->{'pv_uci'} = $info->{'pv'}; + $json->{'pv_pretty'} = [ prettyprint_pv($pos_calculating->{'board'}, @{$info->{'pv'}}) ]; + + my %refutation_lines = (); + for my $move (keys %refutation_moves) { + my $m = $refutation_moves{$move}; + my $pretty_move = ""; + my @pretty_pv = (); + eval { + $pretty_move = join('', prettyprint_pv($pos_calculating->{'board'}, $move)); + @pretty_pv = prettyprint_pv($pos_calculating->{'board'}, $move, @{$m->{'pv'}}); + }; + $refutation_lines{$move} = { + sort_key => $pretty_move, + depth => $m->{'depth'}, + score_sort_key => score_sort_key($refutation_moves{$move}, $pos_calculating, '', 1), + pretty_score => short_score($refutation_moves{$move}, $pos_calculating, '', 1), + pretty_move => $pretty_move, + pv_pretty => \@pretty_pv, + }; + eval { + $refutation_lines{$move}->{'pv_uci'} = [ $move, @{$m->{'pv'}} ]; + }; + } + $json->{'refutation_lines'} = \%refutation_lines; + + open my $fh, ">analysis.json.tmp" + or return; + print $fh JSON::XS::encode_json($json); + close $fh; + rename("analysis.json.tmp", "analysis.json"); +} + sub find_kings { my $board = shift; my ($wkr, $wkc, $bkr, $bkc); @@ -873,11 +1056,17 @@ sub can_reach { return (can_reach($board, 'R', $from_row, $from_col, $to_row, $to_col) || can_reach($board, 'B', $from_row, $from_col, $to_row, $to_col)); } + + # TODO: en passant if ($piece eq 'p') { # black pawn if ($to_col == $from_col && $to_row == $from_row + 1) { return ($dest_piece eq '-'); } + if ($to_col == $from_col && $from_row == 1 && $to_row == 3) { + my $middle_piece = substr($board->[2], $to_col, 1); + return ($dest_piece eq '-' && $middle_piece eq '-'); + } if (abs($to_col - $from_col) == 1 && $to_row == $from_row + 1) { return ($dest_piece ne '-'); } @@ -888,6 +1077,10 @@ sub can_reach { if ($to_col == $from_col && $to_row == $from_row - 1) { return ($dest_piece eq '-'); } + if ($to_col == $from_col && $from_row == 6 && $to_row == 4) { + my $middle_piece = substr($board->[5], $to_col, 1); + return ($dest_piece eq '-' && $middle_piece eq '-'); + } if (abs($to_col - $from_col) == 1 && $to_row == $from_row - 1) { return ($dest_piece ne '-'); } @@ -901,18 +1094,30 @@ sub can_reach { sub uciprint { my ($engine, $msg) = @_; print { $engine->{'write'} } "$msg\n"; - print UCILOG localtime() . " => $msg\n"; + print UCILOG localtime() . " $engine->{'tag'} => $msg\n"; } sub short_score { - my ($uciinfo, $pos, $mpv) = @_; + my ($info, $pos, $mpv, $invert) = @_; + + $invert //= 0; + if ($pos->{'toplay'} eq 'B') { + $invert = !$invert; + } - if (defined($uciinfo{'score_mate' . $mpv})) { - return sprintf "M%3d", $uciinfo{'score_mate' . $mpv}; + if (defined($info->{'score_mate' . $mpv})) { + if ($invert) { + return sprintf "M%3d", -$info->{'score_mate' . $mpv}; + } else { + return sprintf "M%3d", $info->{'score_mate' . $mpv}; + } } else { - if (exists($uciinfo{'score_cp' . $mpv})) { - my $score = $uciinfo{'score_cp' . $mpv} * 0.01; - if ($pos->{'toplay'} eq 'B') { + if (exists($info->{'score_cp' . $mpv})) { + my $score = $info->{'score_cp' . $mpv} * 0.01; + if ($score == 0) { + return " 0.00"; + } + if ($invert) { $score = -$score; } return sprintf "%+5.2f", $score; @@ -922,11 +1127,41 @@ sub short_score { return undef; } +sub score_sort_key { + my ($info, $pos, $mpv, $invert) = @_; + + $invert //= 0; + if ($pos->{'toplay'} eq 'B') { + $invert = !$invert; + } + + if (defined($info->{'score_mate' . $mpv})) { + if ($invert) { + return -(99999 - $info->{'score_mate' . $mpv}); + } else { + return 99999 - $info->{'score_mate' . $mpv}; + } + } else { + if (exists($info->{'score_cp' . $mpv})) { + my $score = $info->{'score_cp' . $mpv}; + if ($score == 0) { + return " 0.00"; + } + if ($invert) { + $score = -$score; + } + return $score; + } + } + + return undef; +} + sub long_score { - my ($uciinfo, $pos, $mpv) = @_; + my ($info, $pos, $mpv) = @_; - if (defined($uciinfo{'score_mate' . $mpv})) { - my $mate = $uciinfo{'score_mate' . $mpv}; + if (defined($info->{'score_mate' . $mpv})) { + my $mate = $info->{'score_mate' . $mpv}; if ($pos->{'toplay'} eq 'B') { $mate = -$mate; } @@ -936,8 +1171,8 @@ sub long_score { return sprintf "Black mates in %u", -$mate; } } else { - if (exists($uciinfo{'score_cp' . $mpv})) { - my $score = $uciinfo{'score_cp' . $mpv} * 0.01; + if (exists($info->{'score_cp' . $mpv})) { + my $score = $info->{'score_cp' . $mpv} * 0.01; if ($pos->{'toplay'} eq 'B') { $score = -$score; } @@ -1001,14 +1236,18 @@ sub book_info { } sub open_engine { - my $cmdline = shift; + my ($cmdline, $tag) = @_; my ($uciread, $uciwrite); my $pid = IPC::Open2::open2($uciread, $uciwrite, $cmdline); my $engine = { pid => $pid, read => $uciread, - write => $uciwrite + readbuf => '', + write => $uciwrite, + info => {}, + ids => {}, + tag => $tag, }; uciprint($engine, "uci"); @@ -1016,8 +1255,122 @@ sub open_engine { # gobble the options while (<$uciread>) { /uciok/ && last; - handle_uci($_); + handle_uci($engine, $_); } return $engine; } + +sub read_lines { + my $engine = shift; + + # + # Read until we've got a full line -- if the engine sends part of + # a line and then stops we're pretty much hosed, but that should + # never happen. + # + while ($engine->{'readbuf'} !~ /\n/) { + my $tmp; + my $ret = sysread $engine->{'read'}, $tmp, 4096; + + if (!defined($ret)) { + next if ($!{EINTR}); + die "error in reading from the UCI engine: $!"; + } elsif ($ret == 0) { + die "EOF from UCI engine"; + } + + $engine->{'readbuf'} .= $tmp; + } + + # Blah. + my @lines = (); + while ($engine->{'readbuf'} =~ s/^([^\n]*)\n//) { + my $line = $1; + $line =~ tr/\r\n//d; + push @lines, $line; + } + return @lines; +} + +# Find all possible legal moves. +sub calculate_refutation_moves { + my $pos = shift; + my $board = $pos->{'board'}; + my %refutation_moves = (); + for my $col (0..7) { + for my $row (0..7) { + my $piece = substr($board->[$row], $col, 1); + + # Check that there's a piece of the right color on this square. + next if ($piece eq '-'); + if ($pos->{'toplay'} eq 'W') { + next if ($piece ne uc($piece)); + } else { + next if ($piece ne lc($piece)); + } + + for my $to_col (0..7) { + for my $to_row (0..7) { + next if ($col == $to_col && $row == $to_row); + next unless (can_reach($board, $piece, $row, $col, $to_row, $to_col)); + + my $promo = ""; # FIXME + my $nb = make_move($board, $row, $col, $to_row, $to_col, $promo); + my $check = in_check($nb); + next if ($check eq 'both'); + if ($pos->{'toplay'} eq 'W') { + next if ($check eq 'white'); + } else { + next if ($check eq 'black'); + } + my $move = move_to_uci_notation($row, $col, $to_row, $to_col, $promo); + $refutation_moves{$move} = { depth => $second_engine_start_depth - 1, score_cp => 0, pv => '' }; + } + } + } + } + return %refutation_moves; +} + +sub give_new_move_to_second_engine { + my $pos = shift; + + # Find the move that's been analyzed the shortest but is most promising. + # Tie-break on UCI move representation. + my $best_move = undef; + for my $move (sort keys %refutation_moves) { + if (!defined($best_move)) { + $best_move = $move; + next; + } + my $best = $refutation_moves{$best_move}; + my $this = $refutation_moves{$move}; + + if ($this->{'depth'} < $best->{'depth'} || + ($this->{'depth'} == $best->{'depth'} && $this->{'score_cp'} < $best->{'score_cp'})) { + $best_move = $move; + next; + } + } + + my $m = $refutation_moves{$best_move}; + ++$m->{'depth'}; + uciprint($engine2, "position fen " . $pos->{'fen'} . " moves " . $best_move); + uciprint($engine2, "go depth " . $m->{'depth'}); + $move_calculating_second_engine = $best_move; +} + +sub col_letter_to_num { + return ord(shift) - ord('a'); +} + +sub row_letter_to_num { + return 7 - (ord(shift) - ord('1')); +} + +sub move_to_uci_notation { + my ($from_row, $from_col, $to_row, $to_col, $promo) = @_; + $promo //= ""; + return sprintf("%c%d%c%d%s", ord('a') + $from_col, 8 - $from_row, ord('a') + $to_col, 8 - $to_row, $promo); +}