-
Notifications
You must be signed in to change notification settings - Fork 1
/
rp.wire.R
78 lines (78 loc) · 2.61 KB
/
rp.wire.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
#' @name rp.wire
#' @export
#' @author Walmes Zeviani, \email{walmes@ufpr.br}.
#' @title A panel to rotate and choose the better view angle of a
#' wireframe
#' @description A panel (gui) rotate a wireframe plot and choose the
#' best view angle.
#'
#' \if{html}{\figure{rp-wire.png}{options: width="700px"}}
#' \if{latex}{\figure{rp-wire.pdf}{options: width=5.4in}}
#' @param wire a wireframe object.
#' @return Open a window with sliders for \code{x}, \code{y} and
#' \code{z}. Print the \code{dput} of the last view angle using the
#' button.
#' @seealso \code{\link[lattice]{wireframe}()},
#' \code{\link[wzRfun]{panel.3d.contour}()}.
#' @keywords GUI
#' @examples
#'
#' \dontrun{
#'
#' # A simple example.
#'
#' library(rpanel)
#' library(lattice)
#' library(latticeExtra)
#' library(RColorBrewer)
#'
#' colr <- brewer.pal(11, "Spectral")
#' colr <- colorRampPalette(colr, space = "rgb")
#'
#' grid <- expand.grid(x = seq(-1, 1, by = 0.1),
#' y = seq(-1, 1, by = 0.1))
#' grid$z <- with(grid, 1 + 0.01 * x + 0.05 * y -
#' 0.5 * x * y - 0.5 * x^2 - 0.2 * y^2)
#'
#' p1 <- wireframe(z ~ x + y, data = grid,
#' scales = list(arrows = FALSE),
#' col.regions = colr(101), drape = TRUE)
#' p1
#'
#' # Choose the better angle.
#' rp.wire(p1)
#'
#' }
#'
rp.wire <- function(wire) {
if (!requireNamespace("rpanel", quietly = TRUE)) {
stop(paste0("`rpanel` needed for this function to work.",
" Please install it."),
call. = FALSE)
}
draw.wire <- function(panel) {
sc <- list(x = panel$x, z = panel$z, y = panel$y)
print(stats::update(panel$wire, screen = sc))
panel
}
print.deput <- function(panel) {
sc <- list(x = panel$x, z = panel$z, y = panel$y)
dput(sc)
panel
}
panel <- rpanel::rp.control(wire = wire)
rpanel::rp.slider(panel, variable = "x",
from = -180, to = 180, initval = -60,
action = draw.wire, title = "x",
showvalue = TRUE, resolution = 5)
rpanel::rp.slider(panel, variable = "y",
from = -180, to = 180, initval = -20,
action = draw.wire, title = "y",
showvalue = TRUE, resolution = 5)
rpanel::rp.slider(panel, variable = "z",
from = -180, to = 180, initval = -10,
action = draw.wire, title = "z",
showvalue = TRUE, resolution = 5)
rpanel::rp.button(panel, action = print.deput,
title = "dput screen values")
}