R/solitaire.R

In 2pie/Peg-Solitaire:

#' Peg-Solitaire Game
#' 
#' Function to play Peg Solitaire: A valid move is to jump a peg orthogonally
#' over an adjacent peg into a hole two positions away and then to remove the
#' jumped peg.
#' The game is over when no moves are possible.
#' 
#' The goal is to have the lower number peg at the end.
#' 
#' @export solitaire
#' 
#' @examples
#' solitaire()
solitaire <- function(){

    # build the board
    r1 <- c(-1, -1, 1, 1, 1, -1, -1)
    r2 <- rep(1, 7)
    r3 <- r2 - c(0, 0, 0, 1, 0, 0, 0)
    board <- cbind(r1, r1, r2, r3, r2, r1, r1)
    m <- board

    trans <- function(m, x1, y1, x2, y2){
        if(m[x1, y1] == -1 | 
           m[x1, y1] == 0  |
           m[x2, y2] == -1 |
           m[x2, y2] == 1) return(m)

        dx = abs(x2 - x1)
        dy = abs(y2 - y1)
        if(dx != 0 & dy != 0 |
           dx == 0 & dy == 0 |
           dx != 2 & dy == 0 |
           dx == 0 & dy != 2) return(m)
        
        # middle spot :
        if(dy > 0){
            xm <- x1
            if(y2 - y1 > 0) ym <- y1 + 1
            if(y2 - y1 < 0) ym <- y1 - 1
        }
        if(dx > 0){
            ym <- y1
            if(x2 - x1 > 0) xm <- x1 + 1
            if(x2 - x1 < 0) xm <- x1 - 1
        }
        if(m[xm, ym] == 0) return(m)

        m[xm, ym] <- 0
        m[x1, y1] <- 0
        m[x2, y2] <- 1
        return(m)
    }
    
    # True if any pawn has a neighbor (check for all pawn at the right (+7) and at         # the bottom (+1))
    end <- function(m){
        ones = which(m == 1)
        check = !any(c(any(m[ones] == m[ones + 1]), 
                       any(m[ones] == m[ones + 7])))
        return(check)
    }
    
    # setting GUI
    replot <- function(m){
        pos = which(m == 1, arr.ind = T)
        symbols(pos, circles = rep(1, nrow(pos)), inches = 0.25, bg = "black",
                xlim = c(0, nrow(board)+1), ylim = c(0, nrow(board)+1))
    }
    
    par(mar = c(0, 0, 0, 0))
    plot(1, type = "n", xlab = "", ylab = "",
         xlim = c(0, nrow(board)), ylim = c(0, nrow(board)), axes = FALSE)
    replot(board)
    
    while(!end(m)){
        l <- locator(2)
        lx <- round(l$x)
        ly <- round(l$y)
        m <- trans(m, x1 = lx[1], y1 = ly[1], x2 = lx[2], y2 = ly[2])
        replot(m)
        if(end(m)) stop("end !")
    }
}