继续不务正业一下,权当练手。
提示:运行起来用鼠标拖动或光标移动键试试。
<br />
# Usage examples:<br />
# Rotate3D(matrix(sample(100), c(10, 10)), col = "lightblue");<br />
# Rotate3D(outer(-10:10, -10:10, function(x, y) { r <- sqrt(x * x + y * y); 10 * sin(r) / r}), col = "lightblue");<br />
<br />
Rotate3D <- function(x, ...) {<br />
<br />
run.Rotate3D <- function(<br />
x = seq(0, 1, length.out = nrow(z)),<br />
y = seq(0, 1, length.out = ncol(z)),<br />
z, theta = 0, phi = 15, verbose = FALSE, step = 5, speed = 20, ...) {<br />
<br />
currentTheta <- theta;<br />
currentPhi <- phi;<br />
startX <- NA;<br />
startY <- NA;<br />
currentX <- NA;<br />
currentY <- NA;<br />
<br />
refresh.screen <- function() {<br />
dTheta <- 0;<br />
dPhi <- 0;<br />
if ( ! is.na(startX) && ! is.na(startY) && ! is.na(currentX) && ! is.na(currentY)) {<br />
dTheta <- -step * (currentX - startX) / (diff(range(x)) / speed);<br />
dPhi <- -step * (currentY - startY) / (diff(range(y)) / speed);<br />
if (is.infinite(dTheta)) dTheta <- 0;<br />
if (is.infinite(dPhi)) dPhi <- 0;<br />
}<br />
if (verbose) cat("persp( theta = ", currentTheta + dTheta, ", phi = ", currentPhi + dPhi, ")\n");<br />
persp(x, y, z, theta = currentTheta + dTheta, phi = currentPhi + dPhi, ...);<br />
}<br />
<br />
eventMouseDown <- function(buttons, eventX, eventY) {<br />
pointX <- grconvertX(eventX, "ndc", "user")<br />
pointY <- grconvertY(eventY, "ndc", "user")<br />
if (verbose) cat("eventMouseDown( buttons = ", buttons, ", pointX = ", pointX, ", piontY = ", pointY, ")\n");<br />
startX <<- pointX;<br />
startY <<- pointY;<br />
NULL;<br />
}<br />
<br />
eventMouseMove <- function (buttons, eventX, eventY) {<br />
pointX <- grconvertX(eventX, "ndc", "user")<br />
pointY <- grconvertY(eventY, "ndc", "user")<br />
if (verbose) cat("eventMouseMove( buttons = ", buttons, ", pointX = ", pointX, ", pointY = ", pointY, ")\n");<br />
currentX <<- pointX;<br />
currentY <<- pointY;<br />
refresh.screen();<br />
NULL;<br />
}<br />
<br />
eventMouseUp <- function(buttons, eventX, eventY) {<br />
pointX <- grconvertX(eventX, "ndc", "user")<br />
pointY <- grconvertY(eventY, "ndc", "user")<br />
if (verbose) cat("eventMouseUp( buttons = ", buttons, ", pointX = ", pointX, ", pointY = ", pointY, ")\n");<br />
if ( ! is.na(startX) && ! is.na(startY)) {<br />
dTheta <- step * (pointX - startX) / (diff(range(x)) / speed);<br />
dPhi <- step * (pointY - startY) / (diff(range(y)) / speed);<br />
if (is.finite(dTheta)) currentTheta <<- currentTheta - dTheta;<br />
if (is.finite(dPhi)) currentPhi <<- currentPhi - dPhi;<br />
}<br />
startX <<- NA;<br />
startY <<- NA;<br />
currentX <<- NA;<br />
currentY <<- NA;<br />
NULL;<br />
}<br />
<br />
eventKeybd <- function (key) {<br />
if (verbose) cat("eventKeybd( key = ", key, ")\n");<br />
if (key == "Up") {<br />
currentPhi <<- currentPhi - step;<br />
refresh.screen();<br />
} else if (key == "Down") {<br />
currentPhi <<- currentPhi + step;<br />
refresh.screen();<br />
} else if (key == "Left") {<br />
currentTheta <<- currentTheta - step;<br />
refresh.screen();<br />
} else if (key == "Right") {<br />
currentTheta <<- currentTheta + step;<br />
refresh.screen();<br />
};<br />
NULL;<br />
}<br />
<br />
refresh.screen();<br />
getGraphicsEvent("",<br />
onMouseDown = eventMouseDown,<br />
onMouseMove = eventMouseMove,<br />
onMouseUp = eventMouseUp,<br />
onKeybd = eventKeybd)<br />
}<br />
<br />
if (length(dim(x)) > 1) {<br />
run.Rotate3D(z = x, ...);<br />
} else {<br />
run.Rotate3D(x, ...);<br />
}<br />
}<br />
<br />
Rotate3D(outer(-10:10, -10:10, function(x, y) { r <- sqrt(x * x + y * y); 10 * sin(r) / r}), col = "lightblue");<br />