[This article was first published on DataPunks.com » R, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Once you become addicted to chess game analysis, it becomes very easy to swamp yourselves with questions regarding different aspects of the game. Testing out different hypothesis like preference of mobility versus positional advantage requires a bit of manual chess game mining, which could potentially be analyzed using R.
With the help of websites like chessgames.com, one could download saved games in PGN format (portable game notation), analyze player behavior towards certain game strategies and positions, and break them down by player strength and so on.
Well, that was my initial intention, although my attention these days migrated towards other interesting hobbies and whatnot. I’m posting my code on this blog for posterity, and maybe I’ll come back later when the interest comes back.
The intended usage was:
g <- ChessGame('test.pgn')
g$event # returns metadata information stored in PGN file
move.to(g, 10) # advance game g to move 10
material(g, "white") # returns a score for white
mobility(g, "relative") # returns a score of mobility white vs. black pieces |
Here it is. Although the following is probably buggy, it could be useful to the chess hobbyists online.
library(R.oo)
PIECE_VALUES <- list(Q=9, R=5, B=3, N=3, P=1)
PIECES <- list("K", "Q", "R", "B", "N", "P")
ChessPiece <- function(color=NULL, piece=NULL, r=NULL, f=NULL) {
o <- list(color=color, piece=piece, r=r, f=f)
class(o) <- "ChessPiece"
return(o)
}
ChessBoard <- function() {
o <- list(ChessPiece())
length(o) <- 64
dim(o) <- c(8,8)
class(o) <- "ChessBoard"
rownames(o) <- c("a", "b", "c", "d", "e", "f", "g", "h")
o <- reset(o)
return(o)
}
summary.ChessPiece <- function(o) {
paste(o$color, o$piece, sep='')
}
getPieceInfo <- function(x) {
if (is.null(x)) " " else summary(x)
}
print.ChessPiece <- function(o) {
print(paste(o$color, o$piece))
}
print.ChessBoard <- function(o) {
print.table(array(lapply(o[,8], getPieceInfo)))
print.table(array(lapply(o[,7], getPieceInfo)))
print.table(array(lapply(o[,6], getPieceInfo)))
print.table(array(lapply(o[,5], getPieceInfo)))
print.table(array(lapply(o[,4], getPieceInfo)))
print.table(array(lapply(o[,3], getPieceInfo)))
print.table(array(lapply(o[,2], getPieceInfo)))
print.table(array(lapply(o[,1], getPieceInfo)))
}
reset <- function(o) {
UseMethod("reset", o)
}
reset.ChessBoard <- function(o) {
o[["a", 1]] <- ChessPiece(color="W", piece="R", r=1, f=1)
o[["b", 1]] <- ChessPiece(color="W", piece="N", r=1, f=2)
o[["c", 1]] <- ChessPiece(color="W", piece="B", r=1, f=3)
o[["d", 1]] <- ChessPiece(color="W", piece="Q", r=1, f=4)
o[["e", 1]] <- ChessPiece(color="W", piece="K", r=1, f=5)
o[["f", 1]] <- ChessPiece(color="W", piece="B", r=1, f=6)
o[["g", 1]] <- ChessPiece(color="W", piece="N", r=1, f=7)
o[["h", 1]] <- ChessPiece(color="W", piece="R", r=1, f=8)
o[["a", 2]] <- ChessPiece(color="W", piece="P", r=2, f=1)
o[["b", 2]] <- ChessPiece(color="W", piece="P", r=2, f=2)
o[["c", 2]] <- ChessPiece(color="W", piece="P", r=2, f=3)
o[["d", 2]] <- ChessPiece(color="W", piece="P", r=2, f=4)
o[["e", 2]] <- ChessPiece(color="W", piece="P", r=2, f=5)
o[["f", 2]] <- ChessPiece(color="W", piece="P", r=2, f=6)
o[["g", 2]] <- ChessPiece(color="W", piece="P", r=2, f=7)
o[["h", 2]] <- ChessPiece(color="W", piece="P", r=2, f=8)
o[["a", 8]] <- ChessPiece(color="B", piece="R", r=8, f=1)
o[["b", 8]] <- ChessPiece(color="B", piece="N", r=8, f=2)
o[["c", 8]] <- ChessPiece(color="B", piece="B", r=8, f=3)
o[["d", 8]] <- ChessPiece(color="B", piece="Q", r=8, f=4)
o[["e", 8]] <- ChessPiece(color="B", piece="K", r=8, f=5)
o[["f", 8]] <- ChessPiece(color="B", piece="B", r=8, f=6)
o[["g", 8]] <- ChessPiece(color="B", piece="N", r=8, f=7)
o[["h", 8]] <- ChessPiece(color="B", piece="R", r=8, f=8)
o[["a", 7]] <- ChessPiece(color="B", piece="P", r=7, f=1)
o[["b", 7]] <- ChessPiece(color="B", piece="P", r=7, f=2)
o[["c", 7]] <- ChessPiece(color="B", piece="P", r=7, f=3)
o[["d", 7]] <- ChessPiece(color="B", piece="P", r=7, f=4)
o[["e", 7]] <- ChessPiece(color="B", piece="P", r=7, f=5)
o[["f", 7]] <- ChessPiece(color="B", piece="P", r=7, f=6)
o[["g", 7]] <- ChessPiece(color="B", piece="P", r=7, f=7)
o[["h", 7]] <- ChessPiece(color="B", piece="P", r=7, f=8)
#o$white_pieces <- c(o[, 1:2])
#o$black_pieces <- c(o[, 7:8])
return(o)
}
pieces.ChessBoard <- function(x, color="all") {
if (color == "white") {
return(x.white_pieces)
} else if (color == "black") {
return(x.black_pieces)
} else {
return(c(x.white_pieces, x.black_pieces))
}
}
is.occupied <- function(board, r, f) {
!is.null(board[[r, f]])
}
ChessGame <- function(f=NULL) {
o <- list()
class(o) <- "ChessGame"
if (!is.null(f))
loadPGN(o, f)
o$board <- ChessBoard()
o$whitePieces <- array(o$board[, 1:2])
o$blackPieces <- array(o$board[, 7:8])
o$current_position <- 0
return(o)
}
loadPGN <- function(game, f) {
pat <- "\\[(.*) \".*\"\\]"
e <- readLines(f)
<- e[grep(pat, e)]
a <- getMeta(meta)
moves <- e[grep(pat, e, invert=TRUE)]
moves <- moves[grep("^$", moves, invert=TRUE)]
getMoves(moves)
}
getMeta <- function(l) {
mapply(parseMetaLine, l)
}
parseMetaLine <- function(l) {
pat <- "\\[(.*) \"(.*)\"\\]"
tag <- gsub(pat, "\\1", l)
value <- gsub(pat, "\\2", l)
c(tag, value)
}
applyMove <- function(board, move, color=white) {
if (!is.element(substr(move, 1, 1), PIECES)) {
move <- paste("P", move, sep="")
}
mp <- substr(move, 1, 1)
}
moveTo <- function(game, nb, black=TRUE) {
}
mobility <- function(x, ...) UseMethod("mobility", x)
mobility.ChessBoard <- function(x, ...) {
}
mobility.ChessGame <- function(x, ...) {
}
material <- function(x, ...) UseMethod("material", x)
material.ChessPiece <- function(x, ...) {
return(PIECE_VALUES[[x.piece]])
}
material.list <- function(x, ...) {
sapply(x, material)
}
material.ChessBoard <- function(x, color="relative") {
if (color != "relative") {
return(sum(material(pieces(x, color=color))))
} else {
return(sum(material(pieces(x, color="white"))) - sum(material(pieces(x, color="black"))))
}
}
material.ChessGame <- function(x, color="relative") {
}
getMoves <- function(moves) {
moves <- gsub(';.*$', '', moves)
moves <- gsub('\\{.*?\\}', '', moves)
s <- paste(moves, collapse=" ")
moves <- strsplit(s, '[0-9]*?\\.')[[1]]
moves <- unlist(lapply(moves[-1], function(x) { a <- strsplit(trim(x), ' ')[[1]]; c(a[1], a[2]) }))
dim(moves) <- c(2, length(moves)/2)
moves <- t(moves)
colnames(moves) <- c("W", "B")
moves
}
is.free.square <- function(x) {
if (is.null(x)) return(1) else return(0)
}
is.free <- function(board, r=0, f=0, d=0) {
if (r == 0 && f == 0) return(unlist(lapply(board, is.free.square)))
if (r == 0) return(unlist(lapply(board[f,], is.free.square)))
if (f == 0) return(unlist(lapply(board[,r], is.free.square)))
if (d == 1) {
return(unlist(lapply(board[col(board) + row(board) == f+r], is.free.square)))
}
if (d == -1) {
return(unlist(lapply(board[col(board) - row(board) == f-r], is.free.square)))
}
return(is.free.square(board[[f,r]]))
}
mobility.line <- function(l, p) {
l[p] <- 2
pat <- '(^|[01]*0+)(1*21*)($|0+[01]*)'
l <- gsub(pat, '\\2', paste(l, collapse=''))
nchar(l)-1
}
mobility.ChessPiece <- function(x, board) {
if (x$piece == 'P') {
if (x$color == 'W')
return(is.free(board, x$r+1, x$f))
else
return(is.free(board, x$r-1, x$f))
} else if (x$piece == 'R') {
return(mobility.line(is.free(board, r=x$r), x$r) + mobility.line(is.free(board, f=x$f), x$f))
} else if (x$piece == 'N') {
m <- c(-2, 1, -2, -1, -1, 2, -1, -2, 1, 2, 1, -2, 2, 1, 2, -1)
dim(m) <- c(2, 8)
l <- apply(m, 2, function(y, r=x$r, f=x$f) {(y[[1]] + f - 1)*8 + y[[2]] + r})
l <- l[l>0]
l <- l[l<65]
if (x$r < 3)
l <- l[l %% 8 < 5]
if (x$r > 6)
l <- l[l %% 8 > 4]
return(sum(unlist(lapply(board[l], is.free.square))))
} else if (x$piece == 'B') {
return(mobility.line(is.free(board, r=x$r, f=x$f, d=1)) + mobility.line(is.free(board, r=x$r, f=x$f, d=-1)))
} else if (x$piece == 'Q') {
return(mobility.line(is.free(board, r=x$r), x$r) + mobility.line(is.free(board, f=x$f), x$f) + mobility.line(is.free(board, r=x$r, f=x$f, d=1)) + mobility.line(is.
free(board, r=x$r, f=x$f, d=-1)))
} else if (x$piece == 'K') {
m <- c(1, 1, 1, 0, 1, -1, 0, -1, -1, -1, -1, 0, -1, 1, 0, 1)
dim(m) <- c(2, 8)
l <- apply(m, 2, function(y, r=x$r, f=x$f) {(y[[1]] + f - 1)*8 + y[[2]] + r})
l <- l[l>0]
l <- l[l<65]
if (x$r < 2)
l <- l[l %% 8 < 3]
if (x$r > 7)
l <- l[l %% 8 > 6]
return(sum(unlist(lapply(board[l], is.free.square))))
}
} |
Photograph used with permission from mylittleshoebox.ca
To leave a comment for the author, please follow the link and comment on their blog: DataPunks.com » R.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.