# First attempt at Chess Data Mining

November 15, 2011
By

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) meta <- 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

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.