发帖
雷达卡
R9<-function (z = NULL, hist.len = 100, solve = TRUE, display = c("guess",
"windows", "tk"), hscale = 1.25, vscale = 1.25, ...)
{
dsp <- substring(match.arg(display), 1, 1)
if (dsp == "g")
dsp <- switch(getOption("device"), windows = "w", "t")
if (dsp == "t" && !require(tkrplot))
stop("'tkrplot' package needed\n")
if (identical(z, 0)) {
z <- matrix(0, 3, 3)
solve <- FALSE
}
if (is.null(z))
z <- generateSudoku(...)
if (length(z) == 1)
z <- readSudoku(z)
if (solve) {
cat("Solving...")
zz <- solveSudoku(z, p = FALSE)
cat("done!\n")
}
cols <- ifelse(z, "blue", "black")
hst <- list(z)
ah <- function(newz) {
hst <<- c(hst, list(newz))
if (length(hst) > hist.len)
hst <<- hst[-1]
}
cusr <- cplt <- rep(0 + NA, 4)
replot <- function() {
par(mar = c(0, 0, 0, 0), bg = "white")
plot(0.5:3.5, 0.5:3.5, type = "n", axes = FALSE, xlab = "", ylab = "")
cusr <<- par("usr")
cplt <<- par("plt")
segments(0.5:3.5, rep(0.5, 10), 0.5:3.5, rep(3.5, 10), col = "green2")
segments(rep(0.5, 10), 0.5:3.5, rep(3.5, 10), 0.5:3.5, col = "grey")
segments(c(0,1,2,3) + 0.5, rep(0.5, 4), c(0,1,2,3) + 0.5, rep(3.5, 4), lwd = 3)
segments(rep(0.5, 4), c(0,1,2,3) + 0.5, rep(3.5, 4), c(0,1,2,3) + 0.5, lwd = 3)
for (i in 1:3) for (j in 1:3) if (z[i, j]) {
if (cols[i, j] == "red")
text(j, 10 - i, "X", col = "pink", cex = 3)
text(j, 10 - i, z[i, j], col = cols[i, j], font = ifelse(cols[i,
j] == "blue", 2, 1), cex = ifelse(cols[i, j] ==
"blue", 2, 1.8))
}
}
if (dsp == "t") {
tt <- tktoplevel()
tkwm.title(tt, "Sudoku")
img <- tkrplot(tt, replot, hscale = hscale, vscale = vscale)
txt <- tktext(tt, bg = "white", font = "courier")
scr <- tkscrollbar(tt, repeatinterval = 5, command = function(...) tkyview(txt,
...))
tkconfigure(txt, yscrollcommand = function(...) tkset(scr,
...))
tkpack(img, side = "top")
tkpack(txt, side = "left", fill = "both", expand = TRUE)
tkpack(scr, side = "right", fill = "y")
iw <- as.numeric(tcl("image", "width", tkcget(img, "-image")))
ih <- as.numeric(tcl("image", "height", tkcget(img, "-image")))
}
showz <- function() switch(dsp, w = replot(), t = tkrreplot(img))
showz()
cc <- function(x, y) {
if (dsp == "t") {
x <- (as.real(x) - 1)/iw
y <- 1 - (as.real(y) - 1)/ih
}
px <- (x - cplt[1])/(cplt[2] - cplt[1])
py <- (y - cplt[3])/(cplt[4] - cplt[3])
ux <- px * (cusr[2] - cusr[1]) + cusr[1]
uy <- py * (cusr[4] - cusr[3]) + cusr[3]
c(10 - round(uy), round(ux))
}
help.txt <- paste(" ? -- 幫助", "1-3 -- 數字輸入",
"0,'空白鍵' -- 清除錯誤", "r -- replot the puzzle",
"q -- 退出遊戲", "h -- 提示", "c -- 是否有錯誤 (用紅色表示)",
"u -- 上一步", "s -- 顯示一個數字(點選想知道的再按s)",
"a -- 觀看所有答案!!", "\n", sep = "\n")
type <- function(s) switch(dsp, w = cat(s), t = {
tkinsert(txt, "end", s)
tksee(txt, "end")
})
ij <- c(5, 5)
mm.w <- function(buttons, x, y) {
ij <<- cc(x, y)
return()
}
mm.t <- function(x, y) {
ij <<- cc(x, y)
return()
}
kb <- function(A) {
i <- ij[1]
j <- ij[2]
z[cols == "red"] <<- 0
cols[cols == "red"] <<- "black"
key <- switch(A, " " = "0", "/" = "?", tolower(A))
if (key == "q")
switch(dsp, t = tkdestroy(tt), w = return(1))
if (key %in% c(0:3, "h", "s") && (i < 1 || i > 3 || j < 1 || j > 3)){
type("Must be over puzzle cell\n")
return()
}
if (key %in% c("c", "s", "a") && !solve) {
type("Solution not available\n")
return()
}
if (key %in% c(0:3, "c", "s", "a"))
ah(z)
if (key %in% 0:3) {
z[i, j] <<- as.real(key)
cols[i, j] <<- "black"
}
if (key == "?")
type(help.txt)
if (key == "h")
type(hintSudoku(z, i, j))
if (key == "c") {
cols[z != 0 & z != zz] <<- "red"
if (!any(cols == "red")) {
type("正確!!\n")
return()
}
}
if (key == "u") {
h <- length(hst)
z <<- hst[[h]]
if (h > 1)
hst <<- hst[-h]
}
if (key == "s") {
z[i, j] <<- zz[i, j]
cols[i, j] <<- "green4"
}
if (key == "a") {
cols[z != zz] <<- "violetred2"
z <<- zz
}
if (key %in% c(0:9, "r", "c", "u", "s", "a"))
showz()
if (solve && all(z == zz))
type("恭喜您過關了!!厲害唷!!\n")
return()
}
kb("?")
if (solve && is.null(zz)) {
type("Puzzle not solvable.\n")
solve <- F
}
switch(dsp, w = getGraphicsEvent("遊戲開始!", onMouseMove = mm.w,
onKeybd = kb), t = {
tkbind(img, "<Motion>", mm.t)
tkbind(tt, "<Key>", kb)
tkwait.window(tt)
})
return(invisible(z))
}
generateSudoku<-
function (Nblank = 6, print.it = FALSE)
{
z <- c(1:3,3,1:2,1,2:3)
z <- matrix(sample(3)[z], 3, 3)
for (i in 1:2) z <- z[replicate(3, sample(3)) + 3 * rep(sample(0:2), each = 3),
replicate(3, sample(3)) + 3 * rep(sample(0:2), each = 3)]
for (bi in seq(0, 6, 3)) for (bj in seq(0, 6, 3)) {
idx <- data.matrix(expand.grid(bi + 1:3, bj + 1:3))
z[idx[sample(1:3, Nblank%/%3), ]] <- 0
}
while (sum(!z) < Nblank) z[matrix(sample(3, 1), 1)] <- 0
if (print.it)
printSudoku(z)
z
}
solveSudoku<-
function (z, verbose = FALSE, map = c(1:3, letters), level = 0,
print.it = TRUE)
{
if (length(z) == 1)
z <- readSudoku(z, map)
N <- nrow(z)
Ns <- sqrt(N)
oldngot <- sum(z > 0)
if (verbose)
cat("Known:", oldngot, ", level:", level, "\n")
isok <- TRUE
a <- array(NA, c(N, N, N))
fill <- function(i, j, k, txt = "") {
if (length(i) != 1 || length(j) != 1 || length(k) !=
1) {
isok <<- FALSE
return()
}
if (verbose && txt != "")
cat(i, j, "=", k, txt, "\n")
z[i, j] <<- k
ain <- a
a[i, j, ] <<- seq(1:N) == k
a[i, -j, k] <<- FALSE
a[-i, j, k] <<- FALSE
for (ii in Ns * ((i - 1)%/%Ns) + 1:Ns) for (jj in Ns *
((j - 1)%/%Ns) + 1:Ns) if (!(ii == i && jj == j))
a[ii, jj, k] <- FALSE
if (any(a != ain, na.rm = TRUE))
isok <<- FALSE
}
for (i in 1:N) for (j in 1:N) if (k <- z[i, j])
fill(i, j, k)
repeat {
for (i in 1:N) for (j in 1:N) if (sum(!a[i, j, ], na.rm = TRUE) ==
N - 1 & sum(a[i, j, ], na.rm = TRUE) == 0)
fill(i, j, which(is.na(a[i, j, ])), "by elimination")
for (k in 1:N) {
for (i in which(rowSums(!a[, , k], TRUE) == N - 1 &
!rowSums(a[, , k], TRUE))) fill(i, which(is.na(a[i,
, k])), k, "each row has a k")
for (j in which(colSums(!a[, , k], TRUE) == N - 1 &
!colSums(a[, , k], TRUE))) fill(which(is.na(a[,
j, k])), j, k, "each col has a k")
for (bi in seq(0, N - Ns, Ns)) for (bj in seq(0,
N - Ns, Ns)) {
idx <- cbind(data.matrix(expand.grid(bi + 1:Ns,
bj + 1:Ns)), k)
if (sum(!a[idx], na.rm = TRUE) == N - 1 && sum(a[idx],
na.rm = TRUE) == 0) {
m <- which(is.na(a[idx]))
fill(idx[m, 1], idx[m, 2], idx[m, 3], "each box has a k")
}
}
}
if (!isok) {
if (verbose)
cat("Inconsistent level", level, "\n")
return()
}
ngot <- sum(z > 0)
if (verbose)
cat("Known:", ngot, ", level:", level, "\n\n")
if (ngot == N^2) {
if (print.it)
print(matrix(map[z], N), quote = FALSE, right = TRUE)
return(invisible(z))
}
if (ngot == oldngot) {
poss <- rowSums(is.na(a), , 2)
if (!any(poss)) {
if (verbose)
cat("No possibilities left\n")
return()
}
ij <- which(poss == min(setdiff(poss, 0)), TRUE)[1,
]
k <- which(is.na(a[ij[1], ij[2], ]))[1]
if (verbose)
cat("Guessing:", ij[1], ij[2], "=", k, "\n")
zg <- z
zg[ij[1], ij[2]] <- k
res <- Recall(zg, verbose, map, level + 1, print.it)
if (is.null(res))
a[ij[1], ij[2], k] <- FALSE
else return(invisible(res))
}
oldngot <- ngot
}
}
请问各位大大 以上函数如要作成3*3的数独 还有哪边是需要修改的 小弟一直试不出来 快发疯了>”< 或者大大们有更简便的指令吗0 0? 求大大们帮忙解答 感恩~
请问各位大大
以上函数如要作成3*3的数独
还有哪边是需要修改的
小弟一直试不出来
快发疯了>”<
或者大大们有更简便的指令吗0 0?
求大大们帮忙解答
感恩~
京公网安备 11010802022788号
