Commit | Line | Data |
---|---|---|
7eeb782e AT |
1 | #! /usr/bin/perl -w |
2 | ||
3 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # | |
4 | # This program is distributed with GNU Go, a Go program. # | |
5 | # # | |
6 | # Write gnugo@gnu.org or see http://www.gnu.org/software/gnugo/ # | |
7 | # for more information. # | |
8 | # # | |
9 | # Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 # | |
10 | # 2008 and 2009 by the Free Software Foundation. # | |
11 | # # | |
12 | # This program is free software; you can redistribute it and/or # | |
13 | # modify it under the terms of the GNU General Public License # | |
14 | # as published by the Free Software Foundation - version 3, # | |
15 | # or (at your option) any later version. # | |
16 | # # | |
17 | # This program is distributed in the hope that it will be # | |
18 | # useful, but WITHOUT ANY WARRANTY; without even the implied # | |
19 | # warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR # | |
20 | # PURPOSE. See the GNU General Public License in file COPYING # | |
21 | # for more details. # | |
22 | # # | |
23 | # You should have received a copy of the GNU General Public # | |
24 | # License along with this program; if not, write to the Free # | |
25 | # Software Foundation, Inc., 51 Franklin Street, Fifth Floor, # | |
26 | # Boston, MA 02111, USA. # | |
27 | # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # | |
28 | # | |
29 | # matcher_check info: | |
30 | # | |
31 | # Plays one gtp program against itself or lets it analzye a saved .sgf-file, | |
32 | # and watches for bad status transitions. | |
33 | # | |
34 | # FIXME: if the vertex by which a dragon is named ever changes, | |
35 | # the hash table used will consider it new. therefore, if the | |
36 | # vertex changes at the same time an illegal state change occurs, | |
37 | # it will get missed. Also, it is possible that a dragon would | |
38 | # be captured, and that vertex go unused until a new piece was | |
39 | # played in that spot, resulting in a false positive. However, | |
40 | # this should be rare (?). | |
41 | ||
42 | package TWOGTP_A; | |
43 | ||
44 | use IPC::Open2; | |
45 | use Getopt::Long; | |
46 | use FileHandle; | |
47 | use strict; | |
48 | use warnings; | |
49 | use Carp; | |
50 | ||
51 | STDOUT->autoflush(1); | |
52 | ||
53 | #following added globally to allow "use strict" : | |
54 | my $vertex; | |
55 | my $first; | |
56 | my $sgfmove; | |
57 | my $sgffilename; | |
58 | my $pidp; | |
59 | my $sgffile; | |
60 | my $handicap_stones; | |
61 | my $result; | |
62 | my @vertices; | |
63 | my $second; | |
64 | my %game_list; | |
65 | #end of "use strict" repairs | |
66 | ||
67 | my $program; | |
68 | my $size = 19; | |
69 | my $verbose = 0; | |
70 | my $komi = 5.5; | |
71 | my $handicap = 0; | |
72 | my $games = 1; | |
73 | my $wanthelp; | |
74 | ||
75 | #added for matcher_check | |
76 | my %match_hist; | |
77 | my $loadfile; | |
78 | my $movenum; | |
79 | my $movecount; | |
80 | my $move; | |
81 | my $toplay; | |
82 | my $randseed; | |
83 | my $stable; | |
84 | my $pids; | |
85 | my $stable_move = ""; | |
86 | my $noilcheck; | |
87 | my $color; | |
88 | ||
89 | my $helpstring = " | |
90 | ||
91 | Run with: | |
92 | ||
93 | matchercheck --program \'<path to program> --mode gtp [program options]\' \\ | |
94 | [matcher_check options] | |
95 | ||
96 | Possible matcher_check options: | |
97 | ||
98 | --verbose 1 (to list moves) or --verbose 2 (to draw board) | |
99 | --komi <amount> | |
100 | --handicap <amount> | |
101 | --size <board size> (default 19) | |
102 | --games <number of games to play> (-1 to play forever) | |
103 | --sgffile <filename> (file to save games as) | |
104 | --loadsgf <filename> (file to analyze) | |
105 | --movecount <number of moves to check> | |
106 | --randseed <number> (sets the random seed) | |
107 | --stable \'<path to stable version> --mode gtp [program options]\' | |
108 | --noilcheck (turns off illegal transition checks) | |
109 | --color <color> (only replay for color; has no effect | |
110 | without --noilcheck and --loadsgf) | |
111 | --help (show this) | |
112 | ||
113 | ||
114 | "; | |
115 | ||
116 | GetOptions( | |
117 | "program|p=s" => \$program, | |
118 | "verbose|v=i" => \$verbose, | |
119 | "komi|k=f" => \$komi, | |
120 | "handicap|h=i" => \$handicap, | |
121 | "size|boardsize|s=i" => \$size, | |
122 | "sgffile|o=s" => \$sgffilename, | |
123 | "loadsgf|l=s" => \$loadfile, | |
124 | "games=i" => \$games, | |
125 | "movecount=i" => \$movecount, | |
126 | "randseed=i" => \$randseed, | |
127 | "stable=s" => \$stable, | |
128 | "noilcheck" => \$noilcheck, | |
129 | "color=s" => \$color, | |
130 | "help" => \$wanthelp, | |
131 | ); | |
132 | ||
133 | if ($wanthelp) { | |
134 | print $helpstring; | |
135 | exit; | |
136 | } | |
137 | ||
138 | ||
139 | if (!$program) { | |
140 | $program = '../gnugo --mode gtp --quiet'; | |
141 | warn "Defaulting program to: $program\n"; | |
142 | } | |
143 | ||
144 | if (defined($color) and (!defined($noilcheck) or !defined($loadfile))) { | |
145 | print "Error: --color requires --noilcheck and --loadsgf"; | |
146 | exit; | |
147 | } | |
148 | ||
149 | ||
150 | # create FileHandles | |
151 | my $prog_in = new FileHandle; # stdin of program | |
152 | my $prog_out = new FileHandle; # stdout of program | |
153 | my $stable_in = new FileHandle; # stdin of stable version | |
154 | my $stable_out = new FileHandle; # stdout of stable version | |
155 | ||
156 | ||
157 | if ($loadfile) | |
158 | { | |
159 | #we need to analyze an sgf file | |
160 | if (not defined $movecount) { | |
161 | print "Error: When analyzing an sgf file with --loadsgf <filename>, you also need to | |
162 | specify the number of moves to check with --movecount <n>. | |
163 | "; | |
164 | exit; | |
165 | } | |
166 | ||
167 | $pidp = open2($prog_out, $prog_in, $program); | |
168 | $pids = open2($stable_out, $stable_in, $stable) if defined($stable); | |
169 | print "program pid: $pidp\n" if $verbose; | |
170 | print "stable pid: $pids\n" if (defined($stable) and $verbose); | |
171 | ||
172 | if (defined($randseed)) { | |
173 | print $prog_in "set_random_seed $randseed\n"; | |
174 | eat_no_response($prog_out); | |
175 | } else { | |
176 | print $prog_in "get_random_seed\n"; | |
177 | $randseed = eat_one_line($prog_out); | |
178 | print "random seed $randseed\n"; | |
179 | } | |
180 | ||
181 | if (defined($stable)) { | |
182 | $randseed =~ s/^= //smg; | |
183 | print $stable_in "set_random_seed $randseed\n"; | |
184 | eat_no_response($stable_out); | |
185 | } | |
186 | ||
187 | for ($movenum = 1; $movenum <= $movecount + 1; $movenum++) | |
188 | { | |
189 | #load the file, check the statuses, next move. | |
190 | my $lmove = $movenum + 1;#number to load up to | |
191 | print "loading move $movenum\n" if $verbose; | |
192 | print $prog_in "loadsgf $loadfile $lmove\n"; | |
193 | eat_no_response($prog_out); | |
194 | if (!defined($noilcheck)) { | |
195 | check_matcher($prog_in, $prog_out); | |
196 | print "done checking status.\n" if ($verbose); | |
197 | } | |
198 | ||
199 | #do stable checks | |
200 | if (defined($stable)) { | |
201 | print $stable_in "loadsgf $loadfile $lmove\n"; | |
202 | $toplay = eat_one_line($stable_out); | |
203 | $toplay =~ s/^=//smg; | |
204 | $toplay =~ s/ //smg; | |
205 | if (!defined($color) or ($color eq $toplay)) { | |
206 | print $prog_in "genmove_$toplay\n"; | |
207 | print $stable_in "genmove_$toplay\n"; | |
208 | $move = eat_move($prog_out); | |
209 | $stable_move = eat_move($stable_out); | |
210 | if ($move ne $stable_move and defined ($stable)) { | |
211 | print "At move $movenum, $toplay\:\n"; | |
212 | print "Test version played $move\n"; | |
213 | print "Stable version played $stable_move\n"; | |
214 | if ($verbose eq 2) { | |
215 | print $prog_in "showboard\n"; | |
216 | print eat_response($prog_out); | |
217 | } | |
218 | } else { | |
219 | print "$toplay plays $move\n" if $verbose; | |
220 | } | |
221 | } | |
222 | } | |
223 | } | |
224 | ||
225 | print "done reading sgf file\n" if ($verbose); | |
226 | exit; | |
227 | } | |
228 | ||
229 | ||
230 | while ($games > 0) { | |
231 | %match_hist = (); | |
232 | $pidp = open2($prog_out, $prog_in, $program); | |
233 | print "program pid: $pidp\n" if $verbose; | |
234 | ||
235 | if (defined($stable)) { | |
236 | $pids = open2($stable_out, $stable_in, $stable); | |
237 | print "stable pid: $pids\n" if $verbose; | |
238 | } | |
239 | ||
240 | $sgffile = rename_sgffile($games, $sgffilename) if defined $sgffilename; | |
241 | ||
242 | if ((defined $sgffilename) && !open(SGFFILEHANDLE, ">$sgffile")) { | |
243 | printf("can't open $sgffile\n"); | |
244 | undef($sgffilename); | |
245 | } | |
246 | ||
247 | #set autoflushing for sgf file | |
248 | SGFFILEHANDLE->autoflush(1); | |
249 | ||
250 | if (!defined $komi) { | |
251 | if ($handicap > 0) { | |
252 | $komi = 0.5; | |
253 | } | |
254 | else { | |
255 | $komi = 5.5; | |
256 | } | |
257 | } | |
258 | ||
259 | print $prog_in "boardsize $size\n"; | |
260 | eat_no_response($prog_out); | |
261 | print $prog_in "komi $komi\n"; | |
262 | eat_no_response($prog_out); | |
263 | ||
264 | if (defined($stable)) { | |
265 | print $stable_in "komi $komi\n"; | |
266 | eat_no_response($stable_out); | |
267 | print $stable_in "boardsize $size\n"; | |
268 | eat_no_response($stable_out); | |
269 | } | |
270 | ||
271 | if (defined($randseed)) { | |
272 | print $prog_in "set_random_seed $randseed\n"; | |
273 | eat_no_response($prog_out); | |
274 | } else { | |
275 | print $prog_in "get_random_seed\n"; | |
276 | $randseed = eat_one_line($prog_out); | |
277 | $randseed =~ s/^= //smg; | |
278 | print "random seed $randseed\n"; | |
279 | } | |
280 | ||
281 | if (defined($stable)) { | |
282 | print $stable_in "set_random_seed $randseed\n"; | |
283 | eat_no_response($stable_out); | |
284 | } | |
285 | ||
286 | undef $randseed; #if more than one game, get a new seed next time. | |
287 | ||
288 | print SGFFILEHANDLE "(;GM[1]FF[4]RU[Japanese]SZ[$size]HA[$handicap]KM[$komi]" | |
289 | if defined $sgffilename; | |
290 | ||
291 | my $pass = 0; | |
292 | $move = ""; | |
293 | ||
294 | if ($handicap < 2) { | |
295 | $toplay = "black"; | |
296 | } | |
297 | else { | |
298 | $toplay = "white"; | |
299 | print $prog_in "fixed_handicap $handicap\n"; | |
300 | ||
301 | $handicap_stones = eat_handicap($prog_out); | |
302 | my $stable_stones = $handicap_stones; | |
303 | ||
304 | if (defined($stable)) { | |
305 | print $stable_in "fixed_handicap $handicap\n"; | |
306 | $stable_stones = eat_handicap($stable_out); | |
307 | } | |
308 | ||
309 | if ($stable_stones ne $handicap_stones) { | |
310 | print "Handicap discrepancy:\n"; | |
311 | print "Test: $handicap_stones\n"; | |
312 | print "Stable: $stable_stones\n"; | |
313 | } | |
314 | ||
315 | if (defined $sgffilename) { | |
316 | print SGFFILEHANDLE $handicap_stones; | |
317 | } | |
318 | } | |
319 | ||
320 | $movenum = 1; | |
321 | while ($pass < 2) { | |
322 | print $prog_in "genmove_$toplay\n"; | |
323 | $move = eat_move($prog_out); | |
324 | ||
325 | if (defined($stable)) { | |
326 | print $stable_in "genmove_$toplay\n" if defined($stable); | |
327 | $stable_move = eat_move($stable_out); | |
328 | print $stable_in "undo\n"; | |
329 | eat_no_response($stable_out); | |
330 | } | |
331 | ||
332 | if ($move ne $stable_move and defined ($stable)) { | |
333 | print "At move $movenum, $toplay\:\n"; | |
334 | print "Test version played $move\n"; | |
335 | print "Stable version played $stable_move\n"; | |
336 | if ($verbose eq 2) { | |
337 | print $prog_in "showboard\n"; | |
338 | print eat_response($prog_out); | |
339 | } | |
340 | } else { | |
341 | print "$toplay plays $move\n" if $verbose; | |
342 | } | |
343 | ||
344 | $sgfmove = standard_to_sgf($move); | |
345 | my $tpc = "B"; #toplay char | |
346 | $tpc = "W" if ($toplay eq "white"); | |
347 | print SGFFILEHANDLE ";$tpc\[$sgfmove\]\n" if defined $sgffilename; | |
348 | ||
349 | print $stable_in "$toplay $move\n" if defined($stable); | |
350 | eat_no_response($stable_out) if defined($stable); | |
351 | ||
352 | if ($toplay eq "black") { | |
353 | $toplay = "white"; | |
354 | } else { | |
355 | $toplay = "black"; | |
356 | } | |
357 | ||
358 | if ($move =~ /PASS/i) { | |
359 | $pass++; | |
360 | } else { | |
361 | $pass = 0; | |
362 | } | |
363 | ||
364 | if ($verbose > 2) { | |
365 | print $prog_in "showboard\n"; | |
366 | eat_no_response($prog_out); | |
367 | if (defined($stable)) { | |
368 | print $stable_in "showboard\n"; | |
369 | eat_no_response($stable_out); | |
370 | } | |
371 | } | |
372 | ||
373 | check_matcher($prog_in, $prog_out) if !defined($noilcheck); | |
374 | $movenum++; | |
375 | } | |
376 | print $prog_in "estimate_score\n"; | |
377 | $result = eat_score($prog_out); | |
378 | if (defined($stable)) { | |
379 | print $stable_in "estimate_score\n"; | |
380 | my $stable_result = eat_score($stable_out); | |
381 | print "scoring discrepancy. Stable score: $stable_result.\n" if ($stable_result ne $result); | |
382 | } | |
383 | ||
384 | print "Result: $result\n"; | |
385 | print $prog_in "quit\n"; | |
386 | print $stable_in "quit\n" if defined($stable); | |
387 | ||
388 | if (defined $sgffilename) { | |
389 | print "sgf file: $sgffile\n"; | |
390 | print SGFFILEHANDLE ")"; | |
391 | close SGFFILEHANDLE; | |
392 | $game_list{$sgffile} = $result; | |
393 | } | |
394 | $games-- if $games > 0; | |
395 | ||
396 | #make sure gnugo dies correctly. | |
397 | close $prog_in; | |
398 | close $prog_out; | |
399 | close $stable_in if defined($stable); | |
400 | close $stable_out if defined($stable); | |
401 | waitpid $pidp, 0; | |
402 | waitpid $pids, 0; | |
403 | ||
404 | print "games remaining: $games\n"; | |
405 | } | |
406 | ||
407 | if (defined $sgffilename) { | |
408 | my $index_out = new FileHandle; | |
409 | open ($index_out, "> " . index_name($sgffilename)); | |
410 | print $index_out | |
411 | "<HTML><HEAD><TITLE>game results</TITLE></HEAD> | |
412 | <BODY><H3>Game Results</H3> | |
413 | <H4>White: ".html_encode($program)."</H4> | |
414 | <H4>Black: ".html_encode($program)."</H4> | |
415 | <TABLE border=1> | |
416 | <TR> | |
417 | <TD>SGF file</TD> | |
418 | <TD>Result</TD> | |
419 | </TR> | |
420 | "; | |
421 | foreach (sort by_result keys(%game_list)) { | |
422 | print $index_out "<TR><TD><A href=\"$_\">$_</A></TD>" . | |
423 | "<TD>".html_encode(game_result($_))."</TD></TR>\n"; | |
424 | } | |
425 | print $index_out "</TABLE></BODY></HTML>\n"; | |
426 | } | |
427 | ||
428 | exit; | |
429 | #all done here. | |
430 | ||
431 | sub game_result { | |
432 | $_ = shift; | |
433 | $_ = $game_list{$_}; | |
434 | #i.e.: B+13.5 (upper bound: -13.5, lower: -13.5)|B+13.5 (upper bound: -13.5, lower: -13.5) | |
435 | #Make sure that all 4 values are the same. I've not seen them different yet. | |
436 | #If they are ever different, need to improve the HTML output (now just -999) - | |
437 | # an explanation of the score mismatch problem would be appropriate. | |
438 | $_ =~ /^.*upper bound..([0-9+.\-]*)..lower..\1.\|.*upper bound..\1..lower..\1./; | |
439 | if (defined($1)) { | |
440 | return $1; | |
441 | } else { | |
442 | return -999; | |
443 | } | |
444 | } | |
445 | ||
446 | sub by_result { | |
447 | game_result($a) <=> game_result($b) || $a cmp $b; | |
448 | } | |
449 | ||
450 | sub html_encode { | |
451 | #print shift; | |
452 | my $r = shift; | |
453 | $r =~ s/&/&/g; | |
454 | $r =~ s/</</g; | |
455 | $r =~ s/>/>/g; | |
456 | return $r; | |
457 | } | |
458 | ||
459 | sub eat_no_response { | |
460 | my $h = shift; | |
461 | ||
462 | # ignore empty lines | |
463 | my $line = ""; | |
464 | while ($line eq "") { | |
465 | chop($line = <$h>) or die "No response!"; | |
466 | $line =~ s/(\s|\n)*$//smg; | |
467 | } | |
468 | } | |
469 | ||
470 | sub eat_response { | |
471 | my $h = shift; | |
472 | my $response = ""; | |
473 | # ignore empty lines | |
474 | my $line = ""; | |
475 | while ($line eq "") { | |
476 | chop($line = <$h>) or die "No response!"; | |
477 | $line =~ s/(\s|\n)*$//smg; | |
478 | } | |
479 | while ($line ne "") { | |
480 | $response = "$response$line\n"; | |
481 | chop($line = <$h>) or die "No response!"; | |
482 | $line =~ s/(\s|\n)*$//smg; | |
483 | } | |
484 | return $response; | |
485 | } | |
486 | ||
487 | sub eat_one_line { | |
488 | my $h = shift; | |
489 | # ignore empty lines | |
490 | my $line = ""; | |
491 | while ($line eq "") { | |
492 | chop($line = <$h>) or die "No response!"; | |
493 | $line =~ s/(\s|\n)*$//smg; | |
494 | } | |
495 | return $line; | |
496 | } | |
497 | ||
498 | sub eat_move { | |
499 | my $h = shift; | |
500 | # ignore empty lines | |
501 | my $line = ""; | |
502 | while ($line eq "") { | |
503 | if (!defined($line = <$h>)) { | |
504 | print SGFFILEHANDLE ")"; | |
505 | close SGFFILEHANDLE; | |
506 | die "Engine crashed!\n"; | |
507 | } | |
508 | $line =~ s/(\s|\n)*$//smg; | |
509 | } | |
510 | my ($equals, $move) = split(' ', $line, 2); | |
511 | $line = <$h>; | |
512 | defined($move) or confess "no move found: line was: '$line'"; | |
513 | return $move; | |
514 | } | |
515 | ||
516 | sub eat_handicap { | |
517 | my $h = shift; | |
518 | my $sgf_handicap = "AB"; | |
519 | # ignore empty lines, die if process is gone | |
520 | my $line = ""; | |
521 | while ($line eq "") { | |
522 | chop($line = <$h>) or die "No response!"; | |
523 | } | |
524 | @vertices = split(" ", $line); | |
525 | foreach $vertex (@vertices) { | |
526 | if (!($vertex eq "=")) { | |
527 | $vertex = standard_to_sgf($vertex); | |
528 | $sgf_handicap = "$sgf_handicap\[$vertex\]"; | |
529 | } | |
530 | } | |
531 | return "$sgf_handicap;"; | |
532 | } | |
533 | ||
534 | sub eat_score { | |
535 | my $h = shift; | |
536 | # ignore empty lines, die if process is gone | |
537 | my $line = ""; | |
538 | while ($line eq "") { | |
539 | chop($line = <$h>) or die "No response!"; | |
540 | $line =~ s/^\s*//msg; | |
541 | $line =~ s/\s*$//msg; | |
542 | } | |
543 | $line =~ s/\s*$//; | |
544 | my ($equals, $result) = split(' ', $line, 2); | |
545 | $line = <$h>; | |
546 | return $result; | |
547 | } | |
548 | ||
549 | sub standard_to_sgf { | |
550 | for (@_) { confess "Yikes!" if !defined($_); } | |
551 | for (@_) { tr/A-Z/a-z/ }; | |
552 | $_ = shift(@_); | |
553 | /([a-z])([0-9]+)/; | |
554 | return "tt" if $_ eq "pass"; | |
555 | ||
556 | $first = ord $1; | |
557 | if ($first > 104) { | |
558 | $first = $first - 1; | |
559 | } | |
560 | $first = chr($first); | |
561 | $second = chr($size+1-$2+96); | |
562 | return "$first$second"; | |
563 | } | |
564 | ||
565 | sub rename_sgffile { | |
566 | my $nogames = int shift(@_); | |
567 | $_ = shift(@_); | |
568 | s/\.sgf$//; | |
569 | # Annoying to loose _001 on game #1 in multi-game set. | |
570 | # Could record as an additional parameter. | |
571 | # return "$_.sgf" if ($nogames == 1); | |
572 | return sprintf("$_" . "_%03d.sgf", $nogames); | |
573 | } | |
574 | ||
575 | sub index_name { | |
576 | $_ = shift; | |
577 | s/\.sgf$//; | |
578 | return $_ . "_index.html"; | |
579 | } | |
580 | ||
581 | sub check_matcher { | |
582 | #check for illegal transitions, and print things if they happen | |
583 | my $in = shift; | |
584 | my $out = shift; | |
585 | my $line = ""; | |
586 | my $legality = "illegal"; | |
587 | my $vertex = " "; | |
588 | my $new_status = " "; | |
589 | my $old_status; | |
590 | my $il_vertex = ""; | |
591 | my $il_move = ""; | |
592 | ||
593 | #send command | |
594 | print $in "dragon_status\n"; | |
595 | ||
596 | while ($line eq "") { | |
597 | chop($line = <$out>); | |
598 | $line =~ s/^\s*//smg; | |
599 | $line =~ s/\s*$//smg; | |
600 | } | |
601 | ||
602 | while ($line ne "") | |
603 | { | |
604 | print "parsing a line\n" if ($verbose); | |
605 | $line =~ s/= //g; #zap the "= " at the front of the response | |
606 | $line =~ s/\n//g; #zap newlines... | |
607 | $line =~ s/://g; #zap the : | |
608 | print $line . "\n" if ($verbose); | |
609 | ($vertex, $new_status) = split(" ", $line); #and split on spaces | |
610 | #extra get trashed | |
611 | $old_status = $match_hist{$vertex} if (exists($match_hist{$vertex})); | |
612 | ||
613 | #debug output | |
614 | if ($verbose > 1) | |
615 | { | |
616 | print "Vertex: $vertex\n"; | |
617 | print "Old Status: $old_status\n" if (exists($match_hist{$vertex})); | |
618 | print "New Status: $new_status\n"; | |
619 | } | |
620 | ||
621 | #if it's new, we don't care | |
622 | if (!exists($match_hist{$vertex})) { | |
623 | print "$vertex is new.\n" if ($verbose > 0); | |
624 | $match_hist{$vertex} = $new_status; | |
625 | next; | |
626 | } | |
627 | ||
628 | #ok, so it's old | |
629 | ||
630 | $legality = "illegal"; | |
631 | if ($old_status eq "critical") {$legality = "legal"}; | |
632 | if ($new_status eq "critical") {$legality = "legal"}; | |
633 | if ($new_status eq "unknown") {$legality = "legal"}; | |
634 | if ($old_status eq "unknown") { | |
635 | if ($new_status eq "alive") {$legality = "legal";} | |
636 | if ($new_status eq "critical") {$legality = "legal";} | |
637 | } | |
638 | if ($old_status eq "alive" and $new_status eq "dead") { | |
639 | $legality = "killed"; | |
640 | } | |
641 | ||
642 | if ($match_hist{$vertex} eq $new_status) | |
643 | { | |
644 | #state didn't change -- valid result | |
645 | print "$vertex remained unchanged.\n" if ($verbose > 0); | |
646 | } else | |
647 | { | |
648 | #state changed | |
649 | if ($legality eq "legal") | |
650 | { | |
651 | #legal state change | |
652 | if ($verbose > 1) | |
653 | { | |
654 | print "Legal state change:\n"; | |
655 | print "Games remaining: $games\n"; | |
656 | print "Move: $movenum\n"; | |
657 | print "Vertex: $vertex\n"; | |
658 | print "Old Status: $old_status\n"; | |
659 | print "New Status: $new_status\n"; | |
660 | print "\n"; | |
661 | } | |
662 | } else | |
663 | { | |
664 | #illegal state change -- alive to dead or vice versa | |
665 | print "Illegal state change:\n"; | |
666 | print "Games remaining: $games\n"; | |
667 | print "Move: $movenum\n"; | |
668 | print "Vertex: $vertex\n"; | |
669 | print "Old Status: $old_status\n"; | |
670 | print "New Status: $new_status\n"; | |
671 | print "\n"; | |
672 | ||
673 | #now print gtp output | |
674 | #FIXME: doesn't work with --loadsgf because we don't have | |
675 | #the move list available (it's hidden by using GTP loadsgf). | |
676 | #FIXME: currently, only produces GTP output for one transition | |
677 | #per move. This is because we have to finish parsing the | |
678 | #entire output of dragon_status before dealing with finding | |
679 | #missed attacks. Using arrays instead would fix it. | |
680 | if ($legality eq "killed" and !defined($loadfile)) { | |
681 | #The type we deal with now. | |
682 | #FIXME: check for defensive errors too. | |
683 | $il_move = $move; | |
684 | $il_vertex = $vertex; | |
685 | } | |
686 | } | |
687 | $match_hist{$vertex} = $new_status; | |
688 | } | |
689 | } continue { | |
690 | chop($line = <$out>); | |
691 | } | |
692 | ||
693 | if ($il_move ne "") { | |
694 | print "attempting gtp output.\n"; | |
695 | #undo the move, check owl_does_attack | |
696 | #and owl_attack, if they disagree, | |
697 | #output a regression test. | |
698 | print $in "undo\n"; | |
699 | eat_no_response($out); | |
700 | my $oa_result = ""; | |
701 | my $oda_result = ""; | |
702 | print $in "owl_attack $il_vertex\n"; | |
703 | $oa_result = eat_one_line($out); | |
704 | print "owl_attack $il_vertex\: $oa_result\n"; | |
705 | print $in "owl_does_attack $il_move $il_vertex\n"; | |
706 | $oda_result = eat_one_line($out); | |
707 | print "owl_does_attack $il_move $il_vertex\: $oda_result\n"; | |
708 | ||
709 | #now try to do something with it | |
710 | if ($oa_result eq "= 0" and $oda_result ne "= 0") { | |
711 | print "found a missed attack.\n\n"; | |
712 | print "loadsgf $sgffile $movenum\n"; | |
713 | print "owl_attack $il_vertex\n"; | |
714 | print "#$oa_result\n"; | |
715 | print "#? [1 $move]*\n\n"; | |
716 | } else { | |
717 | print "no missed attack found.\n\n"; | |
718 | } | |
719 | ||
720 | #cancel the undo | |
721 | my $last_played = "black"; | |
722 | if ($toplay eq "B") { $last_played = "white"; } | |
723 | print $in "genmove_$last_played\n"; | |
724 | eat_move($out); | |
725 | } | |
726 | ||
727 | print "\n" if ($verbose > 0); | |
728 | } | |
729 |