## Bridg-it or Gale

The game of 'bridg-it'

computer AI from Martin Gardener ref. Mathematical Puzzles and Diversions models board as electrical circuit. Max voltage across resistance is computer's best move.

Ver 0.2 - minor improvement to handling window close - could leave the . window running in 0.1

Ver 0.3 - better alignment of user & computer move with the board and added option to allow random first move (get out of that!).

04.11.06 error in cget with 1 argument corrected.

```  proc help {{op stdout}} {
append all " Your aim is to complete a continuous line from top to bottom of the board -\n"
append all " joining the blue dots.\n\n"
append all " While the opponent aims to complete a continuous line from side to side,\n"
append all " joining the red dots.\n\n"
append all " Click to place a link between 2 blue dots.\n\n"
append all " Choose a smaller or larger board with the spinbox number and 'Restart'.\n\n"
append all " Once either of the players has succeeded, the other player cannot finish\n"
append all " The game can only end in victory for one or other player - draw is impossible.\n\n"
append all " Ref: Martin Gardner, Mathematical Puzzles and Diversions.\n"
tk_messageBox -message \$all
puts \$op \$all
}

# the artificial intelligence solves a linear set of equations, so load:.
package require math::linearalgebra
#
# cells
#        1        n+1        2n+2
#        2        n+2....
#        3        n+3...
#        4...
#
#
# resistances - n2 = n*(n-1) number of vertical resistances
#        0        n+1        2n+2
#             n2            n2+n
#        1        n+1....
#             n2+1            n2+n+1
#        2        n+2...
#             n2+2            n2+n+2
#        3...
#
# each cell forms a closed loop of resistances and has a current flowing round it
# the actual voltage across a reistance is R.(adjacent current-this current)..

proc calccurr {brd nx} { ;# make the computer's move
set nloops [expr {\$nx*(\$nx-1)+1}]
#puts "Computer moves for \$nx size board - \$nloops "
# this has nx*(nx-1)+1 loops to be solved for.
# we create a matrix and solve it
set mt [math::linearalgebra::mkMatrix \$nloops \$nloops 0.0]
set vc [math::linearalgebra::mkVector \$nloops 0.]
math::linearalgebra::setelem vc 0 1 ;# the driving voltage
set i 0
set rloop 0
while {\$i<\$nx} { ;# consider first loop. rshared to 'lower' side only
set iup [expr {\$i*\$nx}] ;# the shared resistor
set rloc [\$brd getres \$iup]
set rloop [expr {\$rloop+\$rloc}]
incr i
}
math::linearalgebra::setelem mt 0 0 \$rloop
set j 0
set iloop 0
while {\$j<\$nx-1} { ;# consider each loop row. Up sides already handled
set i 0
while {\$i<\$nx} { ;# consider each loop in row. Up side already handled
set iup [expr {\$i*\$nx+\$j+1}] ;# the shared resistor
set ithis [expr {\$i*(\$nx-1)+\$j+1}] ;# the local current
set rloc [\$brd getres \$iup]
math::linearalgebra::setelem mt \$ithis \$ithis [expr {[math::linearalgebra::getelem \$mt \$ithis \$ithis]+\$rloc}]
if {\$j<\$nx-2} { ;# there is nothing beneath nx-2.
}
if {\$i<\$nx-1} {
set iup [expr {\$nx*\$nx+\$i*(\$nx-1)+\$j }] ;# the shared resistor
set rloc [\$brd getres \$iup]
# then cover right except at end of row
math::linearalgebra::setelem mt \$ithis \$ithis [expr {[math::linearalgebra::getelem \$mt \$ithis \$ithis]+\$rloc}]
}
incr i
incr iloop
}
incr j
}
set currs [ math::linearalgebra::solveGauss \$mt \$vc ]
#now find voltage across each resistor - the biggest is the BEST computer move.
set imax -1
set vmax 0
for {set i 0} {\$i<\$nx*\$nx+(\$nx-1)*(\$nx-1)} { incr i} {
if {[\$brd getres \$i]==1} { ;# not yet cut or shorted.
# find shared currents. Difference is the voltage
if {\$i<\$nx*\$nx} { ;# a horizontal resistor
set ix [expr {\$i/\$nx}]
set jx [expr {\$i%\$nx}]
set iup [expr {\$jx==0?0:(\$i-\$ix)}]
set idn [expr {\$jx>\$nx-2?-1:\$i-\$ix+1}]
set v [expr {\$idn>0?[lindex \$currs \$iup]-[lindex \$currs \$idn]:[lindex \$currs \$iup]}]
} else { ;# vert resist.
set iii [expr {\$i-\$nx*\$nx}] ;# which ij
set ix [expr {\$iii/(\$nx-1)}]
set jx [expr {\$iii%(\$nx-1)}]
set iup [expr {\$ix*(\$nx-1)+\$jx+1}]
set idn [expr {\$iup+\$nx-1}]
set v [expr {[lindex \$currs \$iup]-[lindex \$currs \$idn]}]
}
if {abs(\$v)>abs(\$vmax)} {
set vmax \$v
set imax \$i
}
}
}
return [list \$imax [lindex \$currs 0]]
}

proc bridgit {w args} { ;# a game of bridgit, toplevel for the board
# and allows new smooth shaped buttons.
global \$w.props ;# an array of options specific to the bridgit game 'class'
global \$w.res ;# an array of resistors for the computer move
# set by .this -<option> <value>
array set \$w.props {-size 7 -spacing 50} ;        # define the option list and each default value
array set options {}
set bridArgs {} ;# list of arguments not specific to the class
foreach {opt val} \$args {
if {[array names \$w.props \$opt]!=""} {set options(\$opt) \$val
} else { lappend bridArgs \$opt \$val }
}

# make the base canvas.
eval toplevel \$w \$bridArgs ;# create the "procedure" w

bind \$w <Destroy> "\$w destroy %W"
interp hide {} \$w
# Install the alias:
interp alias {} \$w {} bridgitCmd \$w ;# bridgitsCmd are sub-commands for this class
foreach opt [array names options] {
\$w configure \$opt \$options(\$opt)
}
\$w makeboard
wm withdraw .
return \$w ;# the original object
}
proc bridgitCmd {self cmd args} {
switch -- \$cmd {
configure {eval bridgitConfigure \$self \$cmd \$args}
cget {eval bridgitCget \$self \$args}

{about} {return [help]  ;# return unit value
}
{size} {return [\$self cget -size]  ;# return unit value
}
{destroy} { ;# all destroy events come here - check that we are destroying the lowest level window.
if {\$self==[lindex \$args 0]} {
#tk_messageBox -message "\$self is being destroyed \$args<<\n[info level ]"
exit
}
}
{getid} {        set x [lindex \$args 0]
set y [lindex \$args 1]
set nx [lindex \$args 2] ;# which move has been made
# returns 0,nx-1 for first column of player moves; nx-2nx-1 for second
#>nx*nx for a horizontal move
# -1 for an invalid move.
set spacing [\$self cget -spacing]
set ix [expr {(\$x-\$spacing/2-2)/\$spacing}]
set iy [expr { (\$y-2)/\$spacing }]
set nc [expr {\$nx*\$nx}] ;# numbero fo vertical moves available to the player.
# identify side (top, bottom, L, R)
set ixrel [expr {(\$x-\$spacing*\$ix-\$spacing/2)}]
set iyrel [expr {(\$y-(\$spacing*\$iy))}]
if {\$ix>=-1 && \$ix<\$nx} {
if {\$iy>=0 && \$iy<\$nx} {
if {abs(\$ixrel-\$spacing/2)>abs(\$iyrel-\$spacing/2)} {
if {\$ixrel<\$spacing/2} { set sid "L" } else { set sid "R" }
} else {
if {\$iyrel<\$spacing/2} { set sid "T" } else { set sid "B" }
}
switch \$sid {
"L" {
if {\$ix>\$nx} {return -1} ;# invalid cell
if {\$ix<0} {return -2} ;# invalid cell
return [expr {\$ix*\$nx+\$iy}]
}
"R" {
if {\$ix<-1} {return -1} ;# invalid cell
if {\$ix>\$nx-1} {return -2} ;# invalid cell
return [expr {(\$ix+1)*\$nx+\$iy}]
}
"T" {
if {\$ix>=(\$nx-1)} {return -1} ;# invalid cell
if { \$ix<0 } {return -2} ;# invalid cell
if {\$iy<1} {return -3} ;# invalid cell
return [expr {\$nx*\$nx+\$ix*(\$nx-1)+\$iy-1}]
}
"B" {
if {\$ix>=(\$nx-1)} {return -1} ;# invalid cell
if { \$ix<0} {return -2} ;# invalid cell
if {\$iy>(\$nx-2)} {return -2} ;# invalid cell
return [expr {\$nx*\$nx+\$ix*(\$nx-1)+\$iy}]
}
}
}
}
return -1
}

{getcut} { return [eval \$self getid \$args] }
{makemove} {
set ishort [lindex \$args 0] ;# the resistor being cut.
set nx [\$self cget -size]
set spac [\$self cget -spacing]
if {\$ishort<\$nx*\$nx} { ;# H- move
set ix [expr {int(\$ishort/\$nx)}]
set iy [expr {int(\$ishort%\$nx)}]
\$self.froth.board create line [expr {\$ix*\$spac+5}] [expr {(\$iy+.5)*\$spac+5}] \
[expr {(\$ix+1)*\$spac+5}] [expr {(\$iy+.5)*\$spac+5}] -fill red -width 3

} else {
set nrel [expr {\$ishort-\$nx*\$nx}] ;# id relative to start of horizontal res.
set ix [expr {int(\$nrel/(\$nx-1))}]
set iy [expr {int(\$nrel%(\$nx-1))}]
\$self.froth.board create line [expr {(\$ix+1)*\$spac+5}] [expr {(\$iy+.5)*\$spac+5}] \
[expr {(\$ix+1)*\$spac+5}] [expr {(\$iy+1.5)*\$spac+5}] -fill red -width 3
}
}
{setres} {
global \$self.props
set \$self.props(res[lindex \$args 0]) [lindex \$args 1]
}
{getres} {
return [\$self cget res[lindex \$args 0] ]
}

{makeresists} {
set n [\$self cget -size]
# the algorithm depends on shorting out or cutting a set of resistors.
# each resistor represents a possible computer's move.
# A player's move cuts the resistor; the computer move at same place shorts out the resistor.
for {set i 0} {\$i<\$n*\$n+(\$n-1)*(\$n-1)} { incr i} {
\$self setres \$i 1
}
}
{makefirstm} {
set n [\$self cget -size]
set spacing [\$self cget -spacing]
\$self makeboard
# here we make a random move - get out of that!
set nx [expr {int(rand()*(\$n-1)*\$spacing+\$spacing/2.)}]; set ny [expr {int(rand()*(\$n-1)*\$spacing+\$spacing/2.)}]
\$self click \$nx \$ny
}
{makeboard} { ;# puts "\$self makeboard -- \$cmd \$args";
set n [\$self cget -size]
# insert symbols into a canvas.
set spacing [\$self cget -spacing]
catch {destroy \$self.froth}
set frm [frame \$self.froth]
pack [canvas \$frm.board -height [expr {\$spacing*\$n+10}] -width [expr {\$spacing*\$n+10}]] -padx 10 -pady 10
bind \$frm.board <ButtonPress-1> "\$self click %x %y"
bind \$frm.board <Motion> "\$self setcursor %x %y"
set i 0
while {\$i<=\$n} {
set x [expr {\$spacing*\$i+2.5}]
set j 0
while {\$j<\$n} {
set y [expr {\$spacing*(\$j+.5)+2.5}]
\$frm.board create oval \$x \$y [expr {\$x+5}] [expr {\$y+5}] -fill red
incr j
}
incr i
}
set i 0
while {\$i<\$n} {
set x [expr {\$spacing*(\$i+0.5)+2.5}]
set j 0
while {\$j<=\$n} {
set y [expr {\$spacing*\$j+2.5}]
\$frm.board create oval \$x \$y [expr {\$x+5}] [expr {\$y+5}] -fill blue
incr j
}
incr i
}
pack [ button \$frm.rest -text "Restart" -command "\$self makeboard "] -padx 10 -pady 1 -side left
pack [ button \$frm.refm -text "Make My First move" -command "\$self makefirstm "] -padx 10 -pady 1 -side left
pack [ spinbox \$frm.setsiz -from 3 -to 18 -command "\$self configure -size %s" -width 3] -padx 10 -pady 1 -side left
\$frm.setsiz set [\$self cget -size]
pack [ button \$frm.exit -text "Exit" -command "exit 1"] -padx 10 -pady 4 -side right
pack \$frm

\$self makeresists [\$self cget -size]
return
}
{setwin} {
set ::ival "[lindex \$args 0] Wins"
switch [lindex \$args 0] {
{Boris} {        \$self.froth.board configure -background green }
default {        \$self.froth.board configure -background cyan }
}
}
{setcursor} {
set nx [\$self cget -size]
set icut [\$self getcut [lindex \$args 0] [lindex \$args 1] \$nx]
if {\$icut<\$nx*\$nx} { \$self.froth.board configure -cursor sb_v_double_arrow
} else { \$self.froth.board configure -cursor sb_h_double_arrow }
}
{click} {
set x [lindex \$args 0]
set y [lindex \$args 1]
set nx [\$self cget -size] ;# xy are relative to the board (not window).
# identify nearest dot pair
# \$self.froth.board the game frame x,y are relative to \$self.froth.board.
set i1 [\$self getid \$x \$y \$nx]
set icut [\$self getcut \$x \$y \$nx ]
if {\$icut<\$nx*\$nx} { set horv "v"} else { set horv "h"}
if {\$icut>=0} {
if {[\$self getres \$icut]==1} {
\$self playerscut \$horv \$icut \$nx
\$self setres \$icut 1.e8 ;# my move - cuts out resistor
# computer move shorts the resistor
\$self computermove \$nx ;# calculate response
} else { set ::ival "Already used" }
} else {
set ::ival "Invalid Move \$icut"; update idletasks
}
}
{computermove} {
set nx [lindex \$args 0] ;# make the computer's move
set res [ calccurr \$self \$nx]
set imax [lindex \$res 0]
\$self setres \$imax 1.e-8
\$self makemove \$imax
set res [ calccurr \$self \$nx] ;# recalculate the current to check if computer has won.
set curmax [expr {abs([lindex \$res 1])}]
if {\$curmax<1.e-3} {
\$self setwin "You"
} elseif {\$curmax>1.e3} {
\$self setwin "Boris"
} else {
#puts "Best current is \$curmax"
}
}
{playerscut} {
set horv [lindex \$args 0]
set nres [lindex \$args 1]; set nx [lindex \$args 2]
set spac [\$self cget -spacing]
set ix [expr {int(\$nres/\$nx)}]
set iy [expr {int(\$nres%\$nx)}]
if {\$horv=="v"} {
set ix [expr {int(\$nres/\$nx)}]
set iy [expr {int(\$nres%\$nx)}]
\$self.froth.board create line [expr {(\$ix+.5)*\$spac+5}] [expr {\$iy*\$spac+5}] \
[expr {(\$ix+.5)*\$spac+5}] [expr {(\$iy+1)*\$spac+5}] -fill blue -width 3
} else { ;# a horizontal move
set nrel [expr {\$nres-\$nx*\$nx}] ;# id relative to start of horizontal res.
set ix [expr {int(\$nrel/(\$nx-1))}]
set iy [expr {int(\$nrel%(\$nx-1)+1)}]
\$self.froth.board create line [expr {(\$ix+0.5)*\$spac+5}] [expr {\$iy*\$spac+5}] \
[expr {(\$ix+1.5)*\$spac+5}] [expr {\$iy*\$spac+5}] -fill blue -width 3
}
}

{default} { ;# use \$cmd to canvas widget
#        puts "Action \$cmd \$args"
eval interp invokehidden {{}} \$self \$cmd \$args
}
}
}
proc bridgitConfigure {self cmd args} {
# 3 scenarios:
#
# \$args is empty       -> return all options with their values
# \$args is one element -> return current values
# \$args is 2+ elements -> configure the options
global \$self.props
switch [llength \$args] {
0 { ;# return all options
set result [array names \$self.props]

return \$result
}
1 { ;# return argument values
if {[array names \$self.props \$opt]!=""} { lappend opts [\$self cget \$args]
} else { puts "No option \$opt" }
return \$opts
}
default { ;# >1 arg - an option and its value
# go through each option:
foreach {option value} [lrange \$args 0 end] {
if {[array names \$self.props \$option]!=""} {
# set global array element for each option.
set \$self.props(\$option) \$value
} else {
\$self configure \$option \$value
}
}
return {}
}
}
}
proc bridgitCget {self args} {
# cget defaults done by the interp cget command
upvar #0 \$self.props props ;# get local address for global array
#puts "\$self get \$args [array names props]"
if {[array names props \$args ]!=""} {
#puts "CGoth \$self \$args; \$props(\$args)"
return \$props(\$args)
}
return [uplevel 1 [list interp invokehidden {} \$self cget \$args]]
}
#console show