[gnugo-devel] GTP Tcl integration (incl toy global alpha-beta)

[Douglas Ridgway]

GTP looks enough like Tcl ("command arg arg..." returns result) that an
integration might be useful. The Tcl script gtp.tcl (included below) does
this. After including it in a tclsh, and attaching a GTP engine with
gtp_init (the engine does all the work), you can intermix GTP and Tcl
almost freely.  It should be straightforward to work with other Tcl
packages (eg Tk for building a UI, network stuff, gluing to other systems
with Tcl interfaces, etc.) Applications include debugging, regression, and
building metamachines. A nice feature is that anything built this way
could work with any GTP compatible engine, although I've only tried it
with Gnu Go.

Some usage examples (I hope line wrapping isn't too messed up):

Here's trivial metamachine, useful for adding Tcl capabilities inside of
GTP clients like GoGui:

----
#!/usr/bin/tclsh

source gtp.tcl

gtp_init   # optional arg is path to engine, defaults to "gnugo --gtp"
start_loop # begins an interactive loop, necessary if the script is to run 
           # independently

----

Every GTP command becomes a Tcl command, and returns its result in the
usual way. See how the GTP commands all_legal and play get used in this
script, a random player metamachine: 

---- 
#!/usr/bin/tclsh

source gtp.tcl

proc genmove {color} {
    set ml [all_legal $color]
    if {[llength $ml] == 0} {
        set move PASS
    } else {
        set move [lindex $ml [expr {int(rand()*[llength $ml])}]]
    }
    play $color $move
    return $move
}

gtp_init
start_loop
----

With a scripting language, we could do complex logic in regression 
testing, like this example that checks the randomness of the move 
distribution:

----

boardsize 9
expr {srand([clock clicks])}
foreach x {E5 F5 G5 F6 G6 G7} {
    set move($x) 0
}
for {set i 0} {$i<100} {incr i} {
    set m [gg_genmove B [expr int(rand()*(1<<30))]]
    incr move($m)
}
if {$move(E5) < 10 || $move(E5) > 50} {
    puts "E5 distribution bad: $move(E5) / 100"
}
----

Here's a minimally featured twogtp function, showing how to attach and
work with multiple engines simultaneously:

----
proc twogtp {blackcmd whitecmd numgames {boardsize 19}} {
    set bw {}
    set ww {}
    set nr {}
    for {set i 0} {$i<$numgames} {incr i} {
        set black [gtp_init $blackcmd]
        set white [gtp_init $whitecmd]
        gtp_put $black boardsize $boardsize
        gtp_put $white boardsize $boardsize
        for {set bm {}} {$bm != "PASS" || $wm != "PASS"} {} {
            set bm [gtp_put $black genmove b]
            gtp_put $white play b $bm
            set wm [gtp_put $white genmove w]
            gtp_put $black play w $wm
        }
        set score [gtp_put $white score final]
        if {$score > 0} {
            lappend bw $sc
        } elseif {$score < 0} {
            lappend ww $sc
        } else {
            lappend nr $sc
        }
        catch {gtp_put $black quit}
        catch {gtp_put $white quit}
    }
    return [list $bw $ww $nr]
}

----

Here's a function which scores all intermediate positions in a game:

proc scoresgf {sgf} {
    if {[regexp {SZ\[([0-9]+)\]} $sgf {} sz]} {
        boardsize $sz
    } else {
        boardsize 19
    }
    while {[regexp {;[^;]*} $sgf node]} {
        regsub {;[^;]*} $sgf {} sgf
        if {[regexp {(B|W)\[([a-t][a-t])\]} $node {} color coord]} {
            play $color [sgf2coord $coord]
            lappend s [score $color]
        }
    }
    return $s
}

And finally, an ill-tested alpha-beta metamachine, inspired by SlugGo's
successes:


proc negascore {color} {
    return [expr {(2*[isBlack $color]-1)*[score $color]}]
}

proc eval_pos {color {depth 2} {width 5} {lower -999} {upper +999}} {
    if {$depth == 0 || [gg_genmove $color] == "PASS"} {
        return [negascore $color]
    }
    set best -999
    foreach {m v} [lrange [top_moves] 0 [expr {2*$width-1}]] {
        play $color $m
        set r [expr {-[eval_pos [other $color] [expr {$depth-1}] $width \
[expr {-$upper}] [expr {-$lower}]]}]
        undo
        if {$r>$best} {
            set best $r
        }
        if {$best > $lower} {
            set lower $best
        }
        if {$best > $upper} {
            break;
        }
    }
    return $best
}  

proc genmove {color} {
    global topwidth subwidth depth
    if {[gg_genmove $color] == "PASS"} {
        return PASS
    }
    set movelist {{PASS -999 -999}}
    foreach {m v} [lrange [top_moves] 0 [expr {2*$topwidth-1}]] {
        play $color $m
        set r [expr {-[eval_pos [other $color] $depth $subwidth]}]
        undo
        lappend movelist [list $m $v $r]
        log $movelist
    }
    set movelist [lsort -real -decreasing -index 2 $movelist]
    set m [lindex [lindex $movelist 0] 0]
    play $color $m
    return $m
}

You need to wrap it like the random move metamachine, and set topwidth, 
subwidth, and depth. Try 5, 1 and 7, maybe at level 1.

It has lots of issues (error handling, eg), and makes me want more from
GTP (introspection, eg.) but still, I'd be interested in hearing if this
is useful to anyone. All comments appreciated.

doug.


----

Here's gtp.tcl:

----
#!/usr/bin/tclsh

# open gtp engine process and init important variables
# multiple engines can be used
# by default, last engine initted is talked to for commands
proc gtp_init {{engine "gnugo --mode gtp"}} {
    global _gg
    set _gg [open "| $engine" RDWR]
    
    # default hook every command known
    
    foreach x [gnugo list_commands] {
        if {[info commands $x] ==  ""} {
            proc $x args "
            return \[eval gnugo $x \$args\]
            "
        }
    }  
    boardsize 19
    return $_gg
}

set _id {}
set tcl_prompt1 {}

# basic procs

proc gtp_format {result} {
  global _id
  return "=$_id $result\n"
}

proc gtp_error {errmsg} {
  global _id
  return "?$_id $errmsg\n"
}

#
# send command to gtp engine, return result
#
proc gtp_put {engine cmd args} {
  puts $engine [concat $cmd $args]
  flush $engine
  set rr {}
  set t [time {
      for {set r 1} {$r != {}} {} {
          set r [gets $engine]
          set rr "$rr\n$r"
      }  
  }]
  set rr [string trim $rr]
  if {![regexp {^=([0-9]*)(.*)} $rr {} {} r]} {
# should trim the ? off?
     error "gtp_put \"$engine $cmd $args\" gave error \"$rr\""
  }
  set r [string trim $r]

#  puts [list $cmd $args $rr]
#  return "$t: $rr"
  return $r
}

# use default engine
proc gnugo {cmd args} {
  global _gg
  return [eval gtp_put $_gg $cmd $args]
}


# and setup id handling

catch { rename unknown _unknown }
proc unknown args {
    global _id 
    if {[string is integer [lindex $args 0]]} {
        set _id [lindex $args 0]
        uplevel [lrange $args 1 end]
    } else {
        uplevel _unknown $args
    }
}


####
#
# default rehooks 

proc quit {} {
    gnugo quit
    exit
}

proc name {} {
  return "GTP.tcl script running [gnugo name] v. [gnugo version]"
}

proc version {} {
  return "0.1"
}

proc set_random_seed {seed} {
  expr {srand($seed)}
  gnugo set_random_seed $seed
}

# GTP doesn't allow boardsize inquiries, so hook everything which can 
# change
# it, and save a local copy

proc loadsgf {file args} {
    set pre [get_boardsize]
    set f [open $file]
    set s [read $f]
    close $f
    if {![regexp {SZ\[([0-9]+)\]} $s {} sz]} {
        set sz 19
    }
    boardsize $sz
    gnugo loadsgf $file $args
}

proc get_boardsize {} {
  global _boardsize
  return $_boardsize
}

proc boardsize {sz} {
  global _boardsize
  set _boardsize $sz
  gnugo boardsize $sz
}

# some useful functions

proc score {color {type estimate}} {
    switch $type {
        estimate {
            set s [estimate_score]
        }
        final {
            set s [final_score]
        }
    }
    if {![regexp {(B|W)\+([0-9]+\.[0-9]*)} $s {} winner score]} {
        error "can't parse score"
    }
    if {![isBlack $winner]} {
        return -$score
    } else {
        return $score
    }
}

proc isBlack {color} {
    if {[string match -nocase b* $color]} {
        return 1
    } elseif {[string match -nocase w* $color]} {
        return 0
    } else {
        error "$color is neither b or w"
    }
}

proc other {color} {
    if {[isBlack $color]} {
        return W
    }    else {
        return B
    }
}


proc sgf2coord {c} {
    global _boardsize
    set c [string tolower $c]
    binary scan $c cc j i
    binary scan "a" c a
   foreach v {i j} {
       set $v [expr $$v+1-$a]
   }
   if {$j>8} {
       set X [binary format c [expr $a+$j]]
   } else {
     set X [binary format c [expr $a+$j-1]]
   }
   return "$X[expr {$_boardsize+1-$i}]"
}


# a procedure to start interactive command loop, and never return
# 
proc start_loop {} {
    global tcl_interactive
    # it's unnecessary in an interactive shell, because there's already a 
# loop
    if {!$tcl_interactive} {
        while 1 {
            if {[catch {puts [gtp_format [eval [gets stdin]]]} err]} {
                puts [gtp_error $err]
            }
            set _id {}
        }
    }
}