rdt 2006.06.08 - removed the spam here.
Isolation is a simple board game. The object is to "isolate" the opponent such that he cannot make any legal moves. Here is a screenshot:
A B C D E F G H
1 * - - - - O * *
2 * * * * - - * *
3 - * * * - * - *
4 - - * * * - - -
5 - X * * * * * -
6 * * * * * * * *
X, move a square>
I challenge someone to write for me a nifty Tk interface.
The code design is based on
RS's
TkAlign4. The AI is a variant of my alpha-beta search from
iConnect4.
Blah blah blah copylefted GPL blah.
Source code below. For your convenience you can also download it from
http://tcl.jtang.org/isolation/isolation.tcl
proc initBoard {} {
set row {0 0 0 0 0 0 0 0}
for {set i 0} {$i < 6} {incr i} {
lappend board $row
}
return $board
}
proc makeMove {board pos newPos} {
foreach {or oc} $pos {}
foreach {nr nc} $newPos {}
set dy [expr {$or - $nr}]
set dx [expr {$oc - $nc}]
if {($dy == 0 && $dx != 0) || ($dx == 0 && $dy != 0) || (abs($dx) == abs($dy))} {
set y $or
set x $oc
set ex [expr {$dx > 0 ? -1 : $dx < 0 ? 1 : 0}]
set ey [expr {$dy > 0 ? -1 : $dy < 0 ? 1 : 0}]
while {$dx != 0 || $dy != 0} {
incr x $ex
incr y $ey
if {[lindex2 $board $y $x] == 1} {
return [list $board -1]
}
incr dx $ex
incr dy $ey
}
set board [lsetBoard $board $nr $nc 1]
return [list $board 0]
} else {
return [list $board -1]
}
}
proc isDead {board pos} {
foreach {r c} $pos {}
return [isDead2 $board $r $c]
}
proc isDead2 {board r c} {
foreach {dx dy} {1 0 -1 0 0 1 0 -1 1 1 -1 -1 1 -1 -1 1} {
set x [expr {$c + $dx}]
set y [expr {$r + $dy}]
if {$x >= 0 && $x < 8 && $y >= 0 && $y < 6 &&
[lindex2 $board $y $x] == 0} {
return 0
}
}
return 1
}
proc showBoard {board p1 p2} {
puts " A B C D E F G H"
puts ""
set rowNum 0
foreach row $board {
puts -nonewline [expr {$rowNum + 1}]
set colNum 0
foreach col $row {
puts -nonewline " "
set coord [list $rowNum $colNum]
if {$p1 == $coord} {
puts -nonewline "X"
} elseif {$p2 == $coord} {
puts -nonewline "O"
} else {
switch -- $col {
0 { puts -nonewline "-" }
1 { puts -nonewline "*" }
default { puts stderr "Illegal board"; exit -1 }
}
}
incr colNum
}
puts ""
incr rowNum
}
}
proc initSquare {board p1 p2 player} {
if {$player == 1} {
return [getSquare $board "X, pick a starting square> " $p1 $p2]
} else {
return [getInitAI $board]
}
}
proc getMove {board p1 p2 player} {
if {$player == 1} {
set square [getSquare $board "X, move a square> " $p1 $p2]
} else {
return [getMoveAI $board $player $p2 $p1]
}
return $square
}
proc getSquare {board prompt p1 p2} {
set legalSquare 0
showBoard $board $p1 $p2
puts ""
while {!$legalSquare} {
puts -nonewline $prompt
flush stdout
set line [gets stdin]
if {$line == "?"} {
showBoard $board $p1 $p2
puts ""
} else {
set col [string index $line 0]
set row [string index $line 1]
set legalSquare 1
switch -- $col {
"a" - "A" { set col 0 }
"b" - "B" { set col 1 }
"c" - "C" { set col 2 }
"d" - "D" { set col 3 }
"e" - "E" { set col 4 }
"f" - "F" { set col 5 }
"g" - "G" { set col 6 }
"h" - "H" { set col 7 }
default {
puts "Illegal column specified"
set legalSquare 0
}
}
if {$row == "" || ![string is digit $row] || $row < 1 || $row > 6} {
puts "Illegal row specified"
set legalSquare 0
} else {
incr row -1
}
if $legalSquare {
set square [list $row $col]
if {[lindex2 $board $row $col] != 0} {
puts "Specified location already taken"
set legalSquare 0
}
}
}
}
return $square
}
proc getScore {board row col} {
set sum 0
foreach {dx dy} {-1 0 1 0 0 -1 0 1 1 -1 -1 1 -1 -1 1 1} {
set y [expr {$row + $dy}]
set x [expr {$col + $dx}]
set score 1
while {$x >= 0 && $x <= 8 && $y >= 0 && $y <= 6} {
if {[lindex2 $board $y $x] == 0} {
set score [expr {$score << 1}]
} else {
break
}
incr x $dx
incr y $dy
}
incr sum $score
}
if {$sum == 8} {
return -10000
}
return $sum
}
proc getInitAI {board} {
while {1} {
set x [expr {int (rand () * 8)}]
set y [expr {int (rand () * 6)}]
if {[lindex2 $board $y $x] == 0} {
return [list $y $x]
}
}
}
proc getMoveAI {board player myrc opprc} {
set MAXDEPTH 3
puts "Computer is thinking hard (using depth $MAXDEPTH)..."
set scores {}
set ::numNodesExpanded 0
foreach {row col} $myrc {}
foreach {row2 col2} $opprc {}
set opp [expr {-1 * $player}]
foreach {dx dy} {-1 0 1 0 0 -1 0 1 1 -1 -1 1 -1 -1 1 1} {
set y [expr {$row + $dy}]
set x [expr {$col + $dx}]
while {$x >= 0 && $x <= 8 && $y >= 0 && $y <= 6} {
if {[lindex2 $board $y $x] == 0} {
set dupBoard [lsetBoard $board $y $x 1]
set result [getMoveAB $dupBoard $row2 $col2 $y $x
$player $opp -100001 100001 $MAXDEPTH]
lappend scores [list $result $y $x]
} else {
break
}
incr x $dx
incr y $dy
}
}
set bestMoves [list [lindex $scores 0]]
set bestScore [lindex2 $scores 0 0]
foreach currentTuple [lrange $scores 1 end] {
set currentScore [lindex $currentTuple 0]
if {$currentScore > $bestScore} {
set bestMoves [list $currentTuple]
set bestScore $currentScore
} elseif {$currentScore == $bestScore} {
lappend bestMoves $currentTuple
}
}
set choiceTuple [lindex $bestMoves [expr {int (rand () * [llength $bestMoves])}]]
puts "After searching $::numNodesExpanded nodes, best score was $bestScore"
return [list [lindex $choiceTuple 1] [lindex $choiceTuple 2]]
}
proc getMoveAB {board r c r2 c2 me current alpha beta depth} {
incr ::numNodesExpanded
if {$depth <= 0} {
set myscore [getScore $board $r $c]
if {$me != $current} {
set myscore [expr {-1 * $myscore}]
}
return $myscore
}
if {[isDead2 $board $r $c]} {
if {$me == $current} {
set myscore -10000
} else {
set myscore 10000
}
return $myscore
}
incr depth -1
set newCurrent [expr {-1 * $current}]
if {$me == $current} {
foreach {dx dy} {-1 0 1 0 0 -1 0 1 1 -1 -1 1 -1 -1 1 1} {
set y [expr {$r + $dy}]
set x [expr {$c + $dx}]
while {$x >= 0 && $x <= 8 && $y >= 0 && $y <= 6} {
if {[lindex2 $board $y $x] == 0} {
set dupBoard [lsetBoard $board $y $x 1]
set score [getMoveAB $dupBoard $r2 $c2 $y $x
$me $newCurrent $alpha $beta $depth]
if {$score > $alpha} {
set alpha $score
}
if {$alpha >= $beta} {
return $alpha
}
} else {
break
}
incr x $dx
incr y $dy
}
}
return $alpha
} else {
foreach {dx dy} {-1 0 1 0 0 -1 0 1 1 -1 -1 1 -1 -1 1 1} {
set y [expr {$r + $dy}]
set x [expr {$c + $dx}]
while {$x >= 0 && $x <= 8 && $y >= 0 && $y <= 6} {
if {[lindex2 $board $y $x] == 0} {
set dupBoard [lsetBoard $board $y $x 1]
set score [getMoveAB $dupBoard $r2 $c2 $y $x
$me $newCurrent $alpha $beta $depth]
if {$score < $beta} {
set beta $score
}
if {$beta <= $alpha} {
return $beta
}
} else {
break
}
incr x $dx
incr y $dy
}
}
return $beta
}
}
proc lindex2 {list ind1 ind2} {
return [lindex [lindex $list $ind1] $ind2]
}
proc lsetBoard {board row column newValue} {
set oldRow [lindex $board $row]
set newRow [lrange $oldRow 0 [expr {$column - 1}]]
lappend newRow $newValue
set newRow [concat $newRow [lrange $oldRow [expr {$column + 1}] end]]
set newBoard [lrange $board 0 [expr {$row - 1}]]
lappend newBoard $newRow
set newBoard [concat $newBoard [lrange $board [expr {$row + 1}] end]]
return $newBoard
}
set board [initBoard]
set p(1) {}
set p(-1) {}
set p(1) [initSquare $board $p(1) $p(-1) 1]
set board [lsetBoard $board [lindex $p(1) 0] [lindex $p(1) 1] 1]
set p(-1) [initSquare $board $p(1) $p(-1) -1]
set board [lsetBoard $board [lindex $p(-1) 0] [lindex $p(-1) 1] 1]
set gameOver 0
set player 1
while {1} {
if {[isDead $board $p($player)]} {
break
}
set square [getMove $board $p(1) $p(-1) $player]
foreach {board result} [makeMove $board $p($player) $square] {}
if {$result == -1} {
puts "Illegal move."
} else {
set p($player) $square
set player [expr {-1 * $player}]
}
}
if {$player == 1} {
puts "O is the winner!"
} else {
puts "X is the winner!"
}
showBoard $board $p(1) $p(-1)