/
animate.r
129 lines (117 loc) · 3.84 KB
/
animate.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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
#' Animate a tour path.
#'
#' This is the function that powers all of the tour animations. If you want
#' to write your own tour animation method, the best place to
#' start is by looking at the code for animation methods that have already
#' implemented in the package.
#'
#' See \code{\link{render}} to render animations to disk.
#'
#' @param data matrix, or data frame containing numeric columns
#' @param tour_path tour path generator, defaults to 2d grand tour
#' @param start projection to start at, if not specified, uses default
#' associated with tour path
#' @param display takes the display that is suppose to be used, defaults to
#' the xy display
#' @param aps target angular velocity (in radians per second)
#' @param fps target frames per second (defaults to 15, to accommodate RStudio graphics device)
#' @param max_frames the maximum number of bases to generate. Defaults to
#' Inf for interactive use (must use Ctrl + C to terminate), and 1 for
#' non-interactive use.
#' @param rescale Default FALSE. If TRUE, rescale all variables to range [0,1]?
#' @param sphere if true, sphere all variables
#' @param ... ignored
#' @return an (invisible) list of bases visited during this tour
#' @export
#' @examples
#' f <- flea[, 1:6]
#' animate(f, grand_tour(), display_xy())
#' # or in short
#' animate(f)
#' animate(f, max_frames = 30)
#' \donttest{
#' animate(f, max_frames = 10, fps = 1, aps = 0.1)
#' }
animate <- function(data, tour_path = grand_tour(), display = display_xy(),
start = NULL, aps = 1, fps = 10, max_frames = Inf,
rescale = FALSE, sphere = FALSE, ...) {
record <-
tibble::tibble(
basis = list(),
index_val = numeric(),
info = character(),
method = character(),
alpha = numeric(),
tries = numeric(),
loop = numeric()
)
if (!is.matrix(data)) {
message("Converting input data to the required matrix format.")
data <- as.matrix(data)
}
if (rescale) data <- rescale(data)
if (sphere) data <- sphere_data(data)
# By default, only take single step if not interactive
# This is useful for the automated tests run by R CMD check
if (!interactive() && missing(max_frames)) {
max_frames <- 1
}
if (max_frames == Inf) {
to_stop()
}
plat <- find_platform()
if (rstudio_gd() && fps > 19) {
warning("Rstudio graphics device supports maximum fps of 19", call. = FALSE)
fps <- 19
}
tour <- new_tour(data, tour_path, start, ...)
start <- tour(0, ...)
bs <- 1
bases <- array(NA, c(ncol(data), ncol(start$target), bs))
# Initialise display
display$init(data)
display$render_frame()
display$render_data(data, start$proj)
b <- 0
i <- 0
tryCatch(
{
while (i < max_frames) {
i <- i + 1
step <- tour(aps / fps, ...)
if (step$step == 1) {
b <- b + 1
if (b > bs) {
bases <- c(bases, rep(NA, bs * dim(bases)[1] * dim(bases)[2]))
dim(bases) <- c(ncol(data), ncol(start$target), 2 * bs)
bs <- 2 * bs
}
bases[, , b] <- step$target
}
dev.hold()
on.exit(dev.flush())
if (plat$os == "win" || plat$iface == "rstudio") {
display$render_frame()
} else {
display$render_transition()
}
display$render_data(data, step$proj, step$target)
dev.flush()
if (step$step < 0) break # break after rendering final projection
Sys.sleep(1 / fps)
}
},
interrupt = function(cond) {
dev.flush()
return()
}
)
if (b != 0) {
invisible(bases[, , seq_len(b)])
}
invisible(record)
# Need a better way to clean up global variables than this
# suppressWarnings(rm(tries, cur_index, current, t0, record, envir = globalenv()))
}
rstudio_gd <- function() identical(names(dev.cur()), "RStudioGD")
# globalVariables("record")