# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# This program is distributed with GNU Go, a Go program. #
# Write gnugo@gnu.org or see http://www.gnu.org/software/gnugo/ #
# for more information. #
# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 #
# 2008 and 2009 by the Free Software Foundation. #
# This program is free software; you can redistribute it and/or #
# modify it under the terms of the GNU General Public License #
# as published by the Free Software Foundation - version 3, #
# or (at your option) any later version. #
# This program is distributed in the hope that it will be #
# useful, but WITHOUT ANY WARRANTY; without even the implied #
# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR #
# PURPOSE. See the GNU General Public License in file COPYING #
# You should have received a copy of the GNU General Public #
# License along with this program; if not, write to the Free #
# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, #
# Boston, MA 02111, USA. #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Plays one gtp program against itself or lets it analzye a saved .sgf-file,
# and watches for bad status transitions.
# FIXME: if the vertex by which a dragon is named ever changes,
# the hash table used will consider it new. therefore, if the
# vertex changes at the same time an illegal state change occurs,
# it will get missed. Also, it is possible that a dragon would
# be captured, and that vertex go unused until a new piece was
# played in that spot, resulting in a false positive. However,
# this should be rare (?).
#following added globally to allow "use strict" :
#end of "use strict" repairs
matchercheck --program \'<path to program> --mode gtp [program options]\' \\
Possible matcher_check options:
--verbose 1 (to list moves) or --verbose 2 (to draw board)
--size <board size> (default 19)
--games <number of games to play> (-1 to play forever)
--sgffile <filename> (file to save games as)
--loadsgf <filename> (file to analyze)
--movecount <number of moves to check>
--randseed <number> (sets the random seed)
--stable \'<path to stable version> --mode gtp [program options]\'
--noilcheck (turns off illegal transition checks)
--color <color> (only replay for color; has no effect
without --noilcheck and --loadsgf)
"program|p=s" => \
$program,
"verbose|v=i" => \
$verbose,
"handicap|h=i" => \
$handicap,
"size|boardsize|s=i" => \
$size,
"sgffile|o=s" => \
$sgffilename,
"loadsgf|l=s" => \
$loadfile,
"movecount=i" => \
$movecount,
"randseed=i" => \
$randseed,
"noilcheck" => \
$noilcheck,
$program = '../gnugo --mode gtp --quiet';
warn "Defaulting program to: $program\n";
if (defined($color) and (!defined($noilcheck) or !defined($loadfile))) {
print "Error: --color requires --noilcheck and --loadsgf";
my $prog_in = new FileHandle
; # stdin of program
my $prog_out = new FileHandle
; # stdout of program
my $stable_in = new FileHandle
; # stdin of stable version
my $stable_out = new FileHandle
; # stdout of stable version
#we need to analyze an sgf file
if (not defined $movecount) {
print "Error: When analyzing an sgf file with --loadsgf <filename>, you also need to
specify the number of moves to check with --movecount <n>.
$pidp = open2
($prog_out, $prog_in, $program);
$pids = open2
($stable_out, $stable_in, $stable) if defined($stable);
print "program pid: $pidp\n" if $verbose;
print "stable pid: $pids\n" if (defined($stable) and $verbose);
if (defined($randseed)) {
print $prog_in "set_random_seed $randseed\n";
eat_no_response
($prog_out);
print $prog_in "get_random_seed\n";
$randseed = eat_one_line
($prog_out);
print "random seed $randseed\n";
print $stable_in "set_random_seed $randseed\n";
eat_no_response
($stable_out);
for ($movenum = 1; $movenum <= $movecount + 1; $movenum++)
#load the file, check the statuses, next move.
my $lmove = $movenum + 1;#number to load up to
print "loading move $movenum\n" if $verbose;
print $prog_in "loadsgf $loadfile $lmove\n";
eat_no_response
($prog_out);
if (!defined($noilcheck)) {
check_matcher
($prog_in, $prog_out);
print "done checking status.\n" if ($verbose);
print $stable_in "loadsgf $loadfile $lmove\n";
$toplay = eat_one_line
($stable_out);
if (!defined($color) or ($color eq $toplay)) {
print $prog_in "genmove_$toplay\n";
print $stable_in "genmove_$toplay\n";
$move = eat_move
($prog_out);
$stable_move = eat_move
($stable_out);
if ($move ne $stable_move and defined ($stable)) {
print "At move $movenum, $toplay\:\n";
print "Test version played $move\n";
print "Stable version played $stable_move\n";
print $prog_in "showboard\n";
print eat_response
($prog_out);
print "$toplay plays $move\n" if $verbose;
print "done reading sgf file\n" if ($verbose);
$pidp = open2
($prog_out, $prog_in, $program);
print "program pid: $pidp\n" if $verbose;
$pids = open2
($stable_out, $stable_in, $stable);
print "stable pid: $pids\n" if $verbose;
$sgffile = rename_sgffile
($games, $sgffilename) if defined $sgffilename;
if ((defined $sgffilename) && !open(SGFFILEHANDLE
, ">$sgffile")) {
printf("can't open $sgffile\n");
#set autoflushing for sgf file
SGFFILEHANDLE
->autoflush(1);
print $prog_in "boardsize $size\n";
eat_no_response
($prog_out);
print $prog_in "komi $komi\n";
eat_no_response
($prog_out);
print $stable_in "komi $komi\n";
eat_no_response
($stable_out);
print $stable_in "boardsize $size\n";
eat_no_response
($stable_out);
if (defined($randseed)) {
print $prog_in "set_random_seed $randseed\n";
eat_no_response
($prog_out);
print $prog_in "get_random_seed\n";
$randseed = eat_one_line
($prog_out);
print "random seed $randseed\n";
print $stable_in "set_random_seed $randseed\n";
eat_no_response
($stable_out);
undef $randseed; #if more than one game, get a new seed next time.
print SGFFILEHANDLE
"(;GM[1]FF[4]RU[Japanese]SZ[$size]HA[$handicap]KM[$komi]"
print $prog_in "fixed_handicap $handicap\n";
$handicap_stones = eat_handicap
($prog_out);
my $stable_stones = $handicap_stones;
print $stable_in "fixed_handicap $handicap\n";
$stable_stones = eat_handicap
($stable_out);
if ($stable_stones ne $handicap_stones) {
print "Handicap discrepancy:\n";
print "Test: $handicap_stones\n";
print "Stable: $stable_stones\n";
if (defined $sgffilename) {
print SGFFILEHANDLE
$handicap_stones;
print $prog_in "genmove_$toplay\n";
$move = eat_move
($prog_out);
print $stable_in "genmove_$toplay\n" if defined($stable);
$stable_move = eat_move
($stable_out);
print $stable_in "undo\n";
eat_no_response
($stable_out);
if ($move ne $stable_move and defined ($stable)) {
print "At move $movenum, $toplay\:\n";
print "Test version played $move\n";
print "Stable version played $stable_move\n";
print $prog_in "showboard\n";
print eat_response
($prog_out);
print "$toplay plays $move\n" if $verbose;
$sgfmove = standard_to_sgf
($move);
my $tpc = "B"; #toplay char
$tpc = "W" if ($toplay eq "white");
print SGFFILEHANDLE
";$tpc\[$sgfmove\]\n" if defined $sgffilename;
print $stable_in "$toplay $move\n" if defined($stable);
eat_no_response
($stable_out) if defined($stable);
if ($toplay eq "black") {
print $prog_in "showboard\n";
eat_no_response
($prog_out);
print $stable_in "showboard\n";
eat_no_response
($stable_out);
check_matcher
($prog_in, $prog_out) if !defined($noilcheck);
print $prog_in "estimate_score\n";
$result = eat_score
($prog_out);
print $stable_in "estimate_score\n";
my $stable_result = eat_score
($stable_out);
print "scoring discrepancy. Stable score: $stable_result.\n" if ($stable_result ne $result);
print "Result: $result\n";
print $stable_in "quit\n" if defined($stable);
if (defined $sgffilename) {
print "sgf file: $sgffile\n";
$game_list{$sgffile} = $result;
#make sure gnugo dies correctly.
close $stable_in if defined($stable);
close $stable_out if defined($stable);
print "games remaining: $games\n";
if (defined $sgffilename) {
my $index_out = new FileHandle
;
open ($index_out, "> " . index_name
($sgffilename));
"<HTML><HEAD><TITLE>game results</TITLE></HEAD>
<BODY><H3>Game Results</H3>
<H4>White: ".html_encode
($program)."</H4>
<H4>Black: ".html_encode
($program)."</H4>
foreach (sort by_result
keys(%game_list)) {
print $index_out "<TR><TD><A href=\"$_\">$_</A></TD>" .
"<TD>".html_encode
(game_result
($_))."</TD></TR>\n";
print $index_out "</TABLE></BODY></HTML>\n";
#i.e.: B+13.5 (upper bound: -13.5, lower: -13.5)|B+13.5 (upper bound: -13.5, lower: -13.5)
#Make sure that all 4 values are the same. I've not seen them different yet.
#If they are ever different, need to improve the HTML output (now just -999) -
# an explanation of the score mismatch problem would be appropriate.
$_ =~ /^.*upper bound..([0-9+.\-]*)..lower..\1.\|.*upper bound..\1..lower..\1./;
game_result
($a) <=> game_result
($b) || $a cmp $b;
chop($line = <$h>) or die "No response!";
$line =~ s/(\s|\n)*$//smg;
chop($line = <$h>) or die "No response!";
$line =~ s/(\s|\n)*$//smg;
$response = "$response$line\n";
chop($line = <$h>) or die "No response!";
$line =~ s/(\s|\n)*$//smg;
chop($line = <$h>) or die "No response!";
$line =~ s/(\s|\n)*$//smg;
if (!defined($line = <$h>)) {
$line =~ s/(\s|\n)*$//smg;
my ($equals, $move) = split(' ', $line, 2);
defined($move) or confess
"no move found: line was: '$line'";
# ignore empty lines, die if process is gone
chop($line = <$h>) or die "No response!";
@vertices = split(" ", $line);
foreach $vertex (@vertices) {
$vertex = standard_to_sgf
($vertex);
$sgf_handicap = "$sgf_handicap\[$vertex\]";
# ignore empty lines, die if process is gone
chop($line = <$h>) or die "No response!";
my ($equals, $result) = split(' ', $line, 2);
for (@_) { confess
"Yikes!" if !defined($_); }
for (@_) { tr/A-Z/a-z/ };
return "tt" if $_ eq "pass";
$second = chr($size+1-$2+96);
my $nogames = int shift(@_);
# Annoying to loose _001 on game #1 in multi-game set.
# Could record as an additional parameter.
# return "$_.sgf" if ($nogames == 1);
return sprintf("$_" . "_%03d.sgf", $nogames);
return $_ . "_index.html";
#check for illegal transitions, and print things if they happen
my $legality = "illegal";
print $in "dragon_status\n";
print "parsing a line\n" if ($verbose);
$line =~ s/= //g; #zap the "= " at the front of the response
$line =~ s/\n//g; #zap newlines...
$line =~ s/://g; #zap the :
print $line . "\n" if ($verbose);
($vertex, $new_status) = split(" ", $line); #and split on spaces
$old_status = $match_hist{$vertex} if (exists($match_hist{$vertex}));
print "Vertex: $vertex\n";
print "Old Status: $old_status\n" if (exists($match_hist{$vertex}));
print "New Status: $new_status\n";
#if it's new, we don't care
if (!exists($match_hist{$vertex})) {
print "$vertex is new.\n" if ($verbose > 0);
$match_hist{$vertex} = $new_status;
if ($old_status eq "critical") {$legality = "legal"};
if ($new_status eq "critical") {$legality = "legal"};
if ($new_status eq "unknown") {$legality = "legal"};
if ($old_status eq "unknown") {
if ($new_status eq "alive") {$legality = "legal";}
if ($new_status eq "critical") {$legality = "legal";}
if ($old_status eq "alive" and $new_status eq "dead") {
if ($match_hist{$vertex} eq $new_status)
#state didn't change -- valid result
print "$vertex remained unchanged.\n" if ($verbose > 0);
if ($legality eq "legal")
print "Legal state change:\n";
print "Games remaining: $games\n";
print "Move: $movenum\n";
print "Vertex: $vertex\n";
print "Old Status: $old_status\n";
print "New Status: $new_status\n";
#illegal state change -- alive to dead or vice versa
print "Illegal state change:\n";
print "Games remaining: $games\n";
print "Move: $movenum\n";
print "Vertex: $vertex\n";
print "Old Status: $old_status\n";
print "New Status: $new_status\n";
#FIXME: doesn't work with --loadsgf because we don't have
#the move list available (it's hidden by using GTP loadsgf).
#FIXME: currently, only produces GTP output for one transition
#per move. This is because we have to finish parsing the
#entire output of dragon_status before dealing with finding
#missed attacks. Using arrays instead would fix it.
if ($legality eq "killed" and !defined($loadfile)) {
#The type we deal with now.
#FIXME: check for defensive errors too.
$match_hist{$vertex} = $new_status;
print "attempting gtp output.\n";
#undo the move, check owl_does_attack
#and owl_attack, if they disagree,
#output a regression test.
print $in "owl_attack $il_vertex\n";
$oa_result = eat_one_line
($out);
print "owl_attack $il_vertex\: $oa_result\n";
print $in "owl_does_attack $il_move $il_vertex\n";
$oda_result = eat_one_line
($out);
print "owl_does_attack $il_move $il_vertex\: $oda_result\n";
#now try to do something with it
if ($oa_result eq "= 0" and $oda_result ne "= 0") {
print "found a missed attack.\n\n";
print "loadsgf $sgffile $movenum\n";
print "owl_attack $il_vertex\n";
print "#? [1 $move]*\n\n";
print "no missed attack found.\n\n";
my $last_played = "black";
if ($toplay eq "B") { $last_played = "white"; }
print $in "genmove_$last_played\n";
print "\n" if ($verbose > 0);