Nothing
#' Play the Mine Sweeper game in R
#'
#' The controls should be familiar to you: Click the left mouse button to dig in
#' an area, and right button to mark or unmark the area with flags.
#' @param width number of grids in horizontal axis
#' @param height number of grids in vertical axis
#' @param mines number of mines
#' @param cheat logical. If \code{TRUE} a matrix indicating the mines will be
#' printed
#' @author Yixuan Qiu \email{yixuan.qiu@@cos.name}
#' @note Linux/Mac users have to use \code{X11(type = 'Xlib')} or the Cairo
#' graphics device \code{Cairo()} in the package \pkg{cairoDevice}.
#' @references \url{https://en.wikipedia.org/wiki/Minesweeper_(computer_game)}
#' @export
#' @examples
#' ## should use Xlib for the x11() device under *nix, e.g
#' if (interactive()) {
#' if (.Platform$OS.type == 'windows') x11() else x11(type = 'Xlib')
#' mine_sweeper()
#' }
mine_sweeper <- function(width = 10, height = 10, mines = 20, cheat = FALSE) {
# Deal with some exceptions
if (!interactive()) return()
if (mines >= width * height) {
stop("Are you a terrorist??? Too many mines!")
}
if (width <= 0 | height <= 0 | mines <= 0) {
stop("width, height and mines should be positive!")
}
width <- floor(width)
height <- floor(height)
mines <- floor(mines)
m <- rep(0, width * height)
# Status: 0 for untested areas, 1 for tested areas, 2 for flags
mat.status <- matrix(m, height, width)
mine.index <- sample(width * height, mines)
m[mine.index] <- -10
mine.mat <- matrix(m, height, width)
search.mine <- which(mine.mat < 0, arr.ind = TRUE)
mine.row <- search.mine[, 1]
mine.col <- search.mine[, 2]
# Calculate the number of mines in every 3x3 square
for (i in 1:mines) {
mrow <- intersect(1:height, (mine.row[i] - 1):(mine.row[i] + 1))
mcol <- intersect(1:width, (mine.col[i] - 1):(mine.col[i] + 1))
mine.mat[mrow, mcol] <- mine.mat[mrow, mcol] + 1
}
mine.mat <- ifelse(mine.mat < 0, -1, mine.mat)
# -1 for mines
if (cheat) print(mine.mat)
# Plot a grid
plot.grid <- function(x, y, w = 1, h = 1, col1 = "#D6E3F0", col2 = "#92B0CA", slices = 10) {
# Generate contiguous colors
f <- colorRampPalette(c(col1, col2))
cols <- f(slices)
xs <- rep(x, slices)
ys <- seq(y + 0.5 * h - 0.5 * h / slices, y - 0.5 * h + 0.5 * h / slices,
length.out = slices)
gwidth <- rep(w, slices)
gheight <- rep(h / slices, slices)
# Rectangles with contiguous colors
symbols(xs, ys, rectangles = cbind(gwidth, gheight), fg = cols, bg = cols,
inches = FALSE, add = TRUE)
# polygon(x + c(-0.5, -0.5, -0.45) * w,
# y + c(0.45, 0.5, 0.5) * h,
# border = NA, col = "#DDDDDD")
# polygon(x + c(0.45, 0.5, 0.5) * w,
# y + c(0.5, 0.5, 0.45) * h,
# border = NA, col = "#DDDDDD")
# polygon(x + c(-0.5, -0.5, -0.45) * w,
# y + c(-0.5, -0.45, -0.5) * h,
# border = NA, col = "#DDDDDD")
# polygon(x + c(0.45, 0.5, 0.5) * w,
# y + c(-0.5, -0.45, -0.5) * h,
# border = NA, col = "#DDDDDD")
# polygon(x + c(-0.5, -0.45, 0.45, 0.5, 0.5, 0.45, -0.45, -0.5) * w,
# y + c(0.45, 0.5, 0.5, 0.45, -0.45, -0.5, -0.5, -0.45) * h,
# border = "#777777", lwd = 1)
# Border
polygon(x + c(-0.5, -0.5, 0.5, 0.5) * w, y + c(-0.5, 0.5, 0.5, -0.5) * h,
border = "#777777")
}
# Plot the interface
par(mar = c(0, 0, 0, 0), bg = "#DDDDDD")
plot(1, type = "n", asp = 1, xlab = "", ylab = "",
xlim = c(0.5, width + 0.5), ylim = c(0.5, height + 0.5), axes = FALSE)
# Set font for X11 device
if(.Device == "X11") {
fixed <- X11Font("-*-fixed-*-*-*-*-*-*-*-*-*-*-*-*")
X11Fonts(fixed = fixed)
par(family = "fixed")
}
x.grid <- (width + 1) / 2
y.grid <- 1:height
for (i in 1:height) plot.grid(x.grid, y.grid[i], w = width, h = 1)
x0 <- x1 <- seq(1.5, by = 1, length.out = width - 1)
y0 <- rep(0.5, width - 1)
y1 <- y0 + height
segments(x0, y0, x1, y1, col = "#777777")
# Colors to draw numbers
col.palette <- c("DarkBlue", "ForestGreen", "brown", "green",
"blue", "yellow", "orange", "red")
# Function to determine the font size of numbers
text.cex <- function() {
ps <- par("ps")
0.6 * min(dev.size(units = "px") / c(width, height)) / ps
}
# Plot numbers -- vectorized
plot.num <- function(x, y, num) {
for(i in 1:length(x)) plot.grid(x[i], y[i], col1 = "#FFFFFF", col2 = "#C8C8C8")
pnum = num[num > 0]
px = x[num > 0]
py = y[num > 0]
text(px, py, pnum, col = col.palette[pnum], cex = text.cex())
}
# Draw unexploded mines -- vectorized
plot.mine <- function(x, y) {
for(i in 1:length(x)) plot.grid(x[i], y[i], col1 = "#FFFFFF", col2 = "#C8C8C8")
symbols(x, y, circles = rep(0.35, length(x)),
inches = FALSE, fg = NULL, bg = "black", add = TRUE)
op = par(lend = 2)
segments(x - 0.4, y, x + 0.4, y, col = "black", lwd = 5)
segments(x, y - 0.4, x, y + 0.4, col = "black", lwd = 5)
d = 0.4 / sqrt(2)
segments(x - d, y - d, x + d, y + d, col = "black", lwd = 5)
segments(x - d, y + d, x + d, y - d, col = "black", lwd = 5)
}
# Draw the exploded mine
plot.mine.explode <- function(x, y) {
plot.grid(x, y, col1 = "#FFFFFF", col2 = "#C8C8C8")
star <- t(matrix(c(0.3, 0.4), 20, length(x)))
symbols(x, y, stars = star, inches = FALSE, bg = "red", fg = NA, add = TRUE)
symbols(x, y, stars = 0.7 * star, inches = FALSE, bg = "yellow", fg = NA, add = TRUE)
}
# Draw flags -- vectorized
plot.flag <- function(x, y) {
symbols(x + 0.075, y + 0.2,
rectangles = matrix(rep(c(0.35, 0.2), rep(length(x), 2)), ncol = 2),
inches = FALSE, fg = "red", bg = "red", add = TRUE)
symbols(x, y - 0.25,
rectangles = matrix(rep(c(0.6, 0.1), rep(length(x), 2)), ncol = 2),
inches = FALSE, fg = "black", bg = "black", add = TRUE)
segments(x - 0.1, y + 0.3, x - 0.1, y - 0.2)
}
search.zeroes <- function(pos, mat) {
nr <- nrow(mat)
nc <- ncol(mat)
x <- ifelse(pos %% nr == 0, nr, pos %% nr)
y <- ceiling(pos / nr)
areas <- c(pos, (x > 1 & y > 1) * (pos - nr - 1), (y > 1) * (pos - nr),
(x < nr & y > 1) * (pos - nr + 1), (x > 1) * (pos - 1),
(x < nr) * (pos + 1), (x > 1 & y < nc) * (pos + nr - 1),
(y < nc) * (pos + nr), (x < nr & y < nc) * (pos + nr + 1))
areas <- unique(areas[areas != 0])
zeroes <- intersect(areas, which(mat == 0))
return(list(zeroes = zeroes, areas = areas))
}
mousedown <- function(buttons, x, y) {
## At least under Ubuntu, right click leads to buttons = c(0, 1)
if (length(buttons) == 2) buttons <- 2
plx <- round(grconvertX(x, "ndc", "user"))
ply <- round(grconvertY(y, "ndc", "user"))
ms <- mat.status
if (plx < 1 || plx > width || ply < 1 || ply > height || buttons == 1) {
return(ms)
}
current.status <- ms[height + 1 - ply, plx]
current.mat <- mine.mat[height + 1 - ply, plx]
## Left button
if (buttons == 0) {
## Untested area
if (current.status == 0) {
## Is a mine
if (current.mat == -1) {
plot.mine(mine.col, height + 1 - mine.row)
plot.mine.explode(plx, ply)
cat("Game Over!\n")
return(-1)
## Blank area
} else if (current.mat == 0) {
pos <- height * plx + 1 - ply
while (TRUE) {
temp <- pos
lst <- search.zeroes(pos, mine.mat)
pos <- lst$zeroes
if (length(pos) == length(temp)) {
areas <- lst$areas
areas.row <- ifelse(areas %% height == 0, height, areas %% height)
areas.col <- ceiling(areas / height)
plot.num(areas.col, height + 1 - areas.row, mine.mat[areas])
ms[areas] <- 1
break
}
}
if (sum(ms == 1) == width * height - mines) {
plot.flag(mine.col, height + 1 - mine.row)
cat("You win!\n")
return(1)
}
return(ms)
## Numbered area
} else {
plot.num(plx, ply, current.mat)
if (sum(ms == 1) == width * height - mines -1) {
plot.flag(mine.col, height + 1 - mine.row)
cat("You win!\n")
return(1)
}
ms[height + 1 - ply, plx] <- 1
return(ms)
}
## Tested area or flag -- no action
} else {
return(ms)
}
}
## Right button
if (buttons == 2) {
## Blank area
if (current.status == 0) {
ms[height + 1 - ply, plx] <- 2
plot.flag(plx, ply)
return(ms)
## Flag
} else if (current.status == 2) {
ms[height + 1 - ply, plx] <- 0
plot.grid(plx, ply)
return(ms)
## Numbered area -- no action
} else {
return(ms)
}
}
return(ms)
}
while (TRUE) {
if (length(mat.status) == 1) break
mat.status <- getGraphicsEvent(prompt = "", onMouseDown = mousedown)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.