Updated 2012-09-12 09:39:32 by LkpPo

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.

``` #!/usr/bin/tclsh

# An implementation of the Isolation board game by Jason Tang
# ([email protected]).
#
# Rules of the game:
#
# Two players ("X" and "O") each pick a starting square on an 8x6
# board.  They then take alternating turns moving their piece any
# number of squares in a straight line, horizontally, vertically, or
# diagonally.  When their piece leaves a square that originating
# square is marked as "captured".  A move may not jump over any
# captured squares nor over the opponent's piece.  The object of the
# game is to isolate the opponent such that on his turn he is unable
# to move anywhere.

######################################################################
# Model

# creates and returns a new isolation board
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
}

# Given the board and two tuples, starting and destination square in
# {r c} form, attempts to move the piece to the destination.  If the
# move is legal (i.e., in a straight line and not over any captured
# squares) then returns the new board and a status of 0.  Otherwise
# return the original board and a status of -1.
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))} {
# ensure that no intervening squares are filled
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]
}
}

# Given a board and a {r c} tuple returns 1 if the player cannot move
# (i.e., dead), or 0 if still alive.
foreach {r c} \$pos {}
}

# Given a board, a row, and a column, returns 1 if the player cannot
# move (i.e., dead), or 0 if still alive.
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
}

######################################################################
# View

# Pretty-prints the board with super-spiffy column and row header.
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
}
}

######################################################################
# Controller

# Fetches a starting legal square from a player (human or AI).
proc initSquare {board p1 p2 player} {
if {\$player == 1} {
return [getSquare \$board "X, pick a starting square> " \$p1 \$p2]
#        return [getInitAI \$board]
} else {
#        return [getSquare \$board "O, pick a starting square> " \$p1 \$p2]
return [getInitAI \$board]
}
}

# Fetches a move from a player -- does not actually check if move is
# legal, only that the square specified is on the board and is not
proc getMove {board p1 p2 player} {
if {\$player == 1} {
set square [getSquare \$board "X, move a square> " \$p1 \$p2]
#        return [getMoveAI \$board \$player \$p1 \$p2]
} else {
#        set square [getSquare \$board "O, move a square> " \$p1 \$p2]
return [getMoveAI \$board \$player \$p2 \$p1]
}
return \$square
}

# Prompts the user for a 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} {
set legalSquare 0
}
}
}
}
return \$square
}

######################################################################
# AI stuff

# The static board evaluator.  Returns an integer where bigger number
# is better for the owner at location {row col}.
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
}

# Randomly pick a starting square
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]
}
}
}

# Returns a tuple of where to move given the current board state and
# which player to examine.
proc getMoveAI {board player myrc opprc} {
# MAXDEPTH:  number of plies to search
set MAXDEPTH 3
puts "Computer is thinking hard (using depth \$MAXDEPTH)..."

# keep track of the best moves found thus far
set scores {}
# and keep track of the number of expanded nodes
set ::numNodesExpanded 0

foreach {row col} \$myrc {}
foreach {row2 col2} \$opprc {}
set opp [expr {-1 * \$player}]
# only try positions not already taken
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
}
}
# now pick the best score; in case of tie randomly choose one
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]]
}

# Perform a somewhat modified alpha-beta search on the board --
# modified in that the algorithm will short-circuit whenever it
# detects an ending condition.
proc getMoveAB {board r c r2 c2 me current alpha beta depth} {
# because this node was expanded increment the counter
incr ::numNodesExpanded
# check if search is at a terminal state
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
}

# else continue recursing by making another move
incr depth -1
set newCurrent [expr {-1 * \$current}]
if {\$me == \$current} {
# examining a max node -- do alpha pruning
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 {
# examining a min node -- do beta pruning
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
}
}

######################################################################
# Functions needed for tcl8.3 compatibility

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
}

######################################################################
# main script

set board [initBoard]
set p(1) {}
set p(-1) {}

# Get initial positions
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]

# Start game.
set gameOver 0
set player 1
while {1} {
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)```