阿弥陀佛,响应一下Ihavenothing朋友,再一次唆使R不务正业。
<br />
playNums(size = c(4,4), bg = "lightblue",z = NULL, ...)<br />
参数说明:
size,数字拼图的大小,默认4*4;
bg,数字框的背景颜色
z,数字阵,置空,可以自动生成
效果参见:
http://weitaiyun.blogspot.com/2009/03/play-sliding-puzzles-on-r.html
代码如下,欢迎大家找bug:
<br />
playNums <- function(size = c(4,4), bg = "lightblue",z = NULL, ...) {<br />
n <- size[1]<br />
m <- size[2]<br />
z.right <- matrix(1:(n*m), n, byrow = TRUE)<br />
z.right[n,m]<- 0<br />
<br />
##逆序数函数<br />
neg_seq.length <- function(x){<br />
len <- 0<br />
for(i in 1:(length(x) - 1)){<br />
tmp <- x[(i+1):length(x)] - x[i]<br />
len <- len + sum(tmp < 0)<br />
}<br />
}<br />
<br />
len.right <- neg_seq.length(as.vector(z.right)) +n+m<br />
<br />
<br />
if (is.null(z)) <br />
z <- matrix(sample(0:(n*m - 1)), n)<br />
len.z <- neg_seq.length(as.vector(z)) + sum(which(z==0, arr.ind = TRUE)) <br />
<br />
<br />
##保证有解<br />
while((len.right%%2)!=(len.z%%2)){<br />
z <- matrix(sample(0:(n*m - 1)), n)<br />
len.z <- neg_seq.length(as.vector(z)) + sum(which(z==0, arr.ind = TRUE)) <br />
}<br />
z[!z]<-NA<br />
<br />
<br />
##画图<br />
replot <- function(z) {<br />
bg <- ifelse(z, bg, "white")<br />
fg <- ifelse(z, bg, "white")<br />
par(mar = c(0, 0, 0, 0), bg = "white")<br />
plot(c(0, m), c(0, n), type = "n",axes = FALSE, asp = 1, xlab = "", <br />
ylab = "")<br />
segments(0:m, rep(0, m + 1), 0:m, rep(n, m + 1), col = "grey", <br />
lwd = 2)<br />
segments(rep(0, n + 1), 0:n, rep(m, n + 1), 0:n, col = "grey", <br />
lwd = 2)<br />
symbols(0.5 + rep(0:(m - 1), each = n), 0.5 + rep((n - <br />
1):0, m), squares = rep(0.9, n*m), add = TRUE, inches = FALSE, <br />
fg = as.vector(fg), bg = as.vector(bg))<br />
text(0.5 + rep(0:(m - 1), each = n), 0.5 + rep((n - <br />
1):0, m), as.vector(z), cex = 3)<br />
}<br />
<br />
##推数字<br />
push <- function(x, begin, space) {<br />
tmp <- x[space]<br />
if (begin < space) {<br />
x[(begin + 1):space] <- x[begin:(space - 1)]<br />
x[begin] <- tmp<br />
}<br />
if (begin > space) {<br />
x[(begin - 1):space] <- x[begin:(space + 1)]<br />
x[begin] <- tmp<br />
}<br />
x<br />
}<br />
<br />
count <- 0<br />
mousedown <- function(buttons, x, y) {<br />
plx <- grconvertX(x, "ndc", "user")<br />
ply <- grconvertY(y, "ndc", "user")<br />
m.col <- ceiling(plx)<br />
m.row <- n - floor(ply)<br />
ind.NA <- which(is.na(z), arr.ind = TRUE)<br />
if (!xor(m.row == ind.NA[1], m.col == ind.NA[2])) <br />
cat("Warning: Cannot push any case!\n")<br />
<br />
##row push<br />
ind.NA <- which(is.na(z), arr.ind = TRUE)<br />
if (ind.NA[1] == m.row & ind.NA[2] != m.col) {<br />
z[m.row, ] <<- push(z[m.row, ], m.col, ind.NA[2])<br />
cat("step = ", count <<- count + 1, "\n")<br />
}<br />
##col push<br />
if (ind.NA[1] != m.row & ind.NA[2] == m.col) {<br />
z[, m.col] <<- push(z[, m.col], m.row, ind.NA[1])<br />
cat("step = ", count <<- count + 1, "\n")<br />
}<br />
replot(z)<br />
flag <- z == z.right<br />
if (all(flag[!is.na(flag)])){<br />
"You win!"<br />
}<br />
}<br />
<br />
replot(z)<br />
getGraphicsEvent("Game begin!", onMouseDown = mousedown)<br />
<br />
}<br />