##' Makes a move for black
##' @description Makes a move for black based on PGN format and a starting chess board.
##' @param move the move notation in PGN format
##' @param startingboard the layout of the board before the move
##' @export
black_move <- function(move,startingboard) {
#black to move
#This removes the "check" plus signs
if (substr(move,nchar(move),nchar(move)) == "+") {
move <- substr(move,1,(nchar(move)-1))
}
# is it a promotion?
if (sum(grep("=",move)) > 0) { # if a promotion
if (nchar(move) == 4) { # just a move, for example c1=Q
column <- substr(move,1,1)
row <- 1
newpiece <- substr(move,nchar(move),nchar(move))
startingboard[row,column] <- paste0(newpiece,"new_b")
if (substr(startingboard[(row+1),column],1,1) == "p") {
startingboard[(row+1),column] <- "none"
}
else {
stop("Can't find the piece being promoted.")
}
return(startingboard)
}
if (nchar(move) == 6) { # a capture, for example dxe8=Q
capcolumn <- substr(move,1,1)
column <- substr(move,3,3)
row <- 1
newpiece <- substr(move,nchar(move),nchar(move))
startingboard[row,capcolumn] <- paste0(newpiece,"new_b")
startingboard[(row+1),column] <- "none"
return(startingboard)
}
else {
stop("promotion problem.")
}
}
#This changes the format of capturing by major pieces to just look like a move
if (nchar(move) == 4 | nchar(move) == 5) {
#Capture
if ("x" %in% unlist(strsplit(move,NULL))) {
if (substr(move,1,1) %in% c("R","N","B","K","Q")) { # This removes the "x"
move <- paste0(unlist(strsplit(move,NULL))[!(unlist(strsplit(move,NULL)) == "x")],collapse = "")
}
}
}
if (nchar(move) == 2) {
if (startingboard[as.numeric(substr(move,2,2))+1,substr(move,1,1)] != "none" && substr(startingboard[as.numeric(substr(move,2,2))+1,substr(move,1,1)],1,1) == "p") {
movingpiece <- startingboard[as.numeric(substr(move,2,2))+1,substr(move,1,1)]
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,2,2),substr(move,1,1)] <- movingpiece
}
else if (as.numeric(substr(move,2,2))+2 == 7 && substr(startingboard[as.numeric(substr(move,2,2))+2,substr(move,1,1)],1,1) == "p") {
movingpiece <- startingboard[as.numeric(substr(move,2,2))+2,substr(move,1,1)]
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,2,2),substr(move,1,1)] <- movingpiece
}
else {
stop("Something is up with a pawn move.")
}
}
if (nchar(move) == 3) {
#Rook
if (substr(move,1,1) == "R") {
colnumber <- match(substr(move,2,2),colnames(startingboard))
rownumber <- match(substr(move,3,3),rownames(startingboard))
possible.coords <- list()
# rows increasing
orig.coords <- c(rownumber+1,colnumber)
i <- 1
while (sum(orig.coords <= 8) == 2 && sum(orig.coords >= 1) == 2 && (startingboard[orig.coords[1],orig.coords[2]] %in%
c("none","R1_b","R2_b"))) {
possible.coords[[i]] <- orig.coords
orig.coords <- c((orig.coords[1] + 1), (orig.coords[2]))
i <- i + 1
}
# rows decreasing
orig.coords <- c(rownumber-1,colnumber)
i <- length(possible.coords) + 1
while (sum(orig.coords <= 8) == 2 && sum(orig.coords >= 1) == 2 && (startingboard[orig.coords[1],orig.coords[2]] %in%
c("none","R1_b","R2_b"))) {
possible.coords[[i]] <- orig.coords
orig.coords <- c((orig.coords[1] - 1), (orig.coords[2]))
i <- i + 1
}
# columns increasing
orig.coords <- c(rownumber,colnumber+1)
i <- length(possible.coords) + 1
while (sum(orig.coords <= 8) == 2 && sum(orig.coords >= 1) == 2 && (startingboard[orig.coords[1],orig.coords[2]] %in%
c("none","R1_b","R2_b"))) {
possible.coords[[i]] <- orig.coords
orig.coords <- c((orig.coords[1]),(orig.coords[2] + 1))
i <- i + 1
}
# columns decreasing
orig.coords <- c(rownumber,colnumber-1)
i <- length(possible.coords) + 1
while (sum(orig.coords <= 8) == 2 && sum(orig.coords >= 1) == 2 && (startingboard[orig.coords[1],orig.coords[2]] %in%
c("none","R1_b","R2_b"))) {
possible.coords[[i]] <- orig.coords
orig.coords <- c((orig.coords[1]),(orig.coords[2] - 1))
i <- i + 1
}
#Return moving piece name
movingpiece <- integer(0)
for (i in 1:length(possible.coords)) {
if (startingboard[possible.coords[[i]][1],possible.coords[[i]][2]] == "R1_b") {
movingpiece <- c(movingpiece,"R1_b")
}
if (startingboard[possible.coords[[i]][1],possible.coords[[i]][2]] == "R2_b") {
movingpiece <- c(movingpiece,"R2_b")
}
}
if (length(movingpiece) == 1) {
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,3,3),substr(move,2,2)] <- movingpiece
}
else { # in case there are two rooks on same row!
indices <- integer(0)
for (i in 1:length(possible.coords)) {
if (startingboard[possible.coords[[i]][1],possible.coords[[i]][2]] %in% c("R1_b","R2_b")) {
indices <- c(indices,i)
}
}
two.coords <- possible.coords[indices]
moving.to.coords <- c(rownumber,colnumber)
if (two.coords[[1]][1] == two.coords[[2]][1]) {
if (abs(moving.to.coords[2]-two.coords[[1]][2]) > abs(moving.to.coords[2]-two.coords[[2]][2])) {
movingpiece <- startingboard[two.coords[[2]][1],two.coords[[2]][2]]
}
else {
movingpiece <- startingboard[two.coords[[1]][1],two.coords[[1]][2]]
}
}
if (two.coords[[1]][2] == two.coords[[2]][2]) {
if (abs(moving.to.coords[1]-two.coords[[1]][1]) > abs(moving.to.coords[1]-two.coords[[2]][1])) {
movingpiece <- startingboard[two.coords[[2]][1],two.coords[[2]][2]]
}
else {
movingpiece <- startingboard[two.coords[[1]][1],two.coords[[1]][2]]
}
}
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,3,3),substr(move,2,2)] <- movingpiece
}
}
#Bishop
if (substr(move,1,1) == "B") {
colnumber <- match(substr(move,2,2),colnames(startingboard))
rownumber <- match(substr(move,3,3),rownames(startingboard))
possible.coords <- list()
# +1 for both
orig.coords <- c(rownumber+1,colnumber+1)
i <- 1
while (sum(orig.coords <= 8) == 2 && sum(orig.coords >= 1) == 2 && (startingboard[orig.coords[1],orig.coords[2]] %in%
c("none","B1_b","B2_b"))) {
possible.coords[[i]] <- orig.coords
orig.coords <- orig.coords + 1
i <- i + 1
}
# -1 for both
orig.coords <- c(rownumber-1,colnumber-1)
i <- length(possible.coords) + 1
while (sum(orig.coords <= 8) == 2 && sum(orig.coords >= 1) == 2 && (startingboard[orig.coords[1],orig.coords[2]] %in%
c("none","B1_b","B2_b"))) {
possible.coords[[i]] <- orig.coords
orig.coords <- orig.coords - 1
i <- i + 1
}
#+1 -1
orig.coords <- c(rownumber+1,colnumber-1)
i <- length(possible.coords) + 1
while (sum(orig.coords <= 8) == 2 && sum(orig.coords >= 1) == 2 && (startingboard[orig.coords[1],orig.coords[2]] %in%
c("none","B1_b","B2_b"))) {
possible.coords[[i]] <- orig.coords
orig.coords <- c((orig.coords[1] + 1),(orig.coords[2] - 1))
i <- i + 1
}
#-1 +1
orig.coords <- c(rownumber-1,colnumber+1)
i <- length(possible.coords) + 1
while (sum(orig.coords <= 8) == 2 && sum(orig.coords >= 1) == 2 && (startingboard[orig.coords[1],orig.coords[2]] %in%
c("none","B1_b","B2_b"))) {
possible.coords[[i]] <- orig.coords
orig.coords <- c((orig.coords[1] - 1),(orig.coords[2] + 1))
i <- i + 1
}
#name moving piece
movingpiece <- integer(0)
for (i in 1:length(possible.coords)) {
if (startingboard[possible.coords[[i]][1],possible.coords[[i]][2]] == "B1_b") {
movingpiece <- c(movingpiece,"B1_b")
}
if (startingboard[possible.coords[[i]][1],possible.coords[[i]][2]] == "B2_b") {
movingpiece <- c(movingpiece,"B2_b")
}
}
if (length(movingpiece) == 1) {
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,3,3),substr(move,2,2)] <- movingpiece
}
else {
stop("You have two separate bishops in the same line that can do this.")
}
}
#Knight
#all possible night moves
if (substr(move,1,1) == "N") {
colnumber <- match(substr(move,2,2),colnames(startingboard))
rownumber <- match(substr(move,3,3),rownames(startingboard))
possible.coords <- list()
possible.coords[[1]] <- c(rownumber + 1, colnumber + 2)
possible.coords[[2]] <- c(rownumber + 1, colnumber - 2)
possible.coords[[3]] <- c(rownumber - 1, colnumber + 2)
possible.coords[[4]] <- c(rownumber - 1, colnumber - 2)
possible.coords[[5]] <- c(rownumber + 2, colnumber + 1)
possible.coords[[6]] <- c(rownumber + 2, colnumber - 1)
possible.coords[[7]] <- c(rownumber - 2, colnumber + 1)
possible.coords[[8]] <- c(rownumber - 2, colnumber - 1)
#Now remove any that have values outside of our 1:8 bounds
possible.coords <- possible.coords[as.logical(unlist(lapply(possible.coords,function(x) if (any(x<1 | x > 8)) {0} else {1})))]
for (i in 1:length(possible.coords)) {
if (startingboard[possible.coords[[i]][1],possible.coords[[i]][2]] == "N1_b") {
movingpiece <- "N1_b"
}
if (startingboard[possible.coords[[i]][1],possible.coords[[i]][2]] == "N2_b") {
movingpiece <- "N2_b"
}
}
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,3,3),substr(move,2,2)] <- movingpiece
}
#Queen
if (substr(move,1,1) == "Q") {
movingpiece <- "Q_b"
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,3,3),substr(move,2,2)] <- movingpiece
}
#King
if (substr(move,1,1) == "K") {
movingpiece <- "K_b"
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,3,3),substr(move,2,2)] <- movingpiece
}
#Kingside castle
if (substr(move,1,3) == "O-O") {
movingpiece1 <- "K_b"
movingpiece2 <- "R2_b"
startingboard[grep(movingpiece1,startingboard)] <- "none"
startingboard[grep(movingpiece2,startingboard)] <- "none"
startingboard["8","f"] <- movingpiece2
startingboard["8","g"] <- movingpiece1
}
}
if (nchar(move) == 4) {
#Capture
if (substr(move,2,2) == "x") {
if (startingboard[(as.numeric(substr(move,4,4))),substr(move,3,3)] != "none") {
movingpiece <- startingboard[(as.numeric(substr(move,4,4))+1),substr(move,1,1)] #+1 if black (not -1)
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,4,4),substr(move,3,3)] <- movingpiece
}
#en passant
else if ((startingboard[(as.numeric(substr(move,4,4))),substr(move,3,3)] == "none") && as.numeric(substr(move,4,4)) == 3) {
movingpiece <- startingboard[(as.numeric(substr(move,4,4))+1),substr(move,1,1)]
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[(as.numeric(substr(move,4,4))+1),substr(move,3,3)] <- "none"
startingboard[substr(move,4,4),substr(move,3,3)] <- movingpiece
}
}
else if (substr(move,2,2) %in% letters[1:8]) { #specifying which column -- e.g. Nexc4
column <- as.vector(startingboard[,substr(move,2,2)])
movingpiece <- column[grepl(substr(move,1,1),column)+grepl("b",column) == 2]
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,4,4),substr(move,3,3)] <- movingpiece
}
else if (substr(move,2,2) %in% 1:8) { # specifying row -- e.g. N2xc5
row <- as.vector(startingboard[substr(move,2,2),])
movingpiece <- row[grepl(substr(move,1,1),row)+grepl("b",row) == 2]
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,4,4),substr(move,3,3)] <- movingpiece
}
}
if (nchar(move) == 5) {
if (substr(move,3,3) == "x") { # if a capture
if (substr(move,2,2) %in% letters[1:8]) { #the moving piece is in a particular column
column <- as.vector(startingboard[,substr(move,2,2)])
movingpiece <- column[grepl(substr(move,1,1),column)+grepl("b",column) == 2]
startingboard[grep(movingpiece,startingboard)] <- "none"
startingboard[substr(move,5,5),substr(move,4,4)] <- movingpiece
}
}
if (move == "O-O-O") { #Queenside Castle
movingpiece1 <- "K_b"
movingpiece2 <- "R1_b"
startingboard[grep(movingpiece1,startingboard)] <- "none"
startingboard[grep(movingpiece2,startingboard)] <- "none"
startingboard["1","d"] <- movingpiece2
startingboard["1","c"] <- movingpiece1
}
}
startingboard
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.