Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
a new function qtour() is done and documented; close #88
- Loading branch information
Showing
4 changed files
with
177 additions
and
96 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,85 +1,92 @@ | ||
| #' This is not a display method, but a method for adding | ||
| #' @noRd | ||
| tourr <- function() { | ||
| ##' Create a tour associated with a mutaframe | ||
| ##' | ||
| ##' The \pkg{tourr} package is used to create the tour projections. | ||
| ##' This function creates an \R object to manipulate the tour, and all | ||
| ##' the changes in the tour can be reflected immediately in plots | ||
| ##' created in \pkg{cranvas}. | ||
| ##' | ||
| ##' Because the data provided to the tour is a mutaframe, it can | ||
| ##' listen to changes through listeners on it. Usually these listeners | ||
| ##' can update the plots which are created from this mutaframe | ||
| ##' (further, those linked to this mutaframe) on the fly. | ||
| ##' | ||
| ##' Four basic methods can be applied to the object returned by this | ||
| ##' function (say, \code{tour}): \code{tour$start()} will start the | ||
| ##' tour (tour projections change successively and are attached to the | ||
| ##' mutaframe; column names are \code{tour_1}, \code{tour_2}, ...); | ||
| ##' \code{tour$stop()} pauses the tour; \code{tour$slower()} makes the | ||
| ##' tour slower and \code{tour$faster()} makes it faster. | ||
| ##' @param vars variable names to be used in the tour (parsed by | ||
| ##' \code{\link{var_names}}) | ||
| ##' @inheritParams qbar | ||
| ##' @inheritParams tourr::animate | ||
| ##' @return An object generated by reference classes with signals. | ||
| ##' @author Yihui Xie <\url{http://yihui.name}> | ||
| ##' @export | ||
| ##' @example inst/examples/qtourr-ex.R | ||
| qtour = | ||
| function(vars = ~., data = last_data(), tour_path = grand_tour(), aps = 1, fps = 30, | ||
| rescale = TRUE, sphere = FALSE, ...) { | ||
| data = check_data(data) | ||
| meta = | ||
| Tour.meta$new(vars = var_names(vars, data), aps = aps, fps = fps, | ||
| rescale = rescale, sphere = sphere) | ||
| src = last_time = tour = timer = NULL | ||
|
|
||
| tour_init = function() { | ||
| src <<- vapply(as.data.frame(data[, meta$vars]), as.numeric, | ||
| numeric(nrow(data))) | ||
| if (meta$rescale) | ||
| src <<- tourr::rescale(src) | ||
| if (meta$sphere) | ||
| src <<- tourr::sphere(src) | ||
| timer <<- qtimer(1000 / meta$fps, tour_step) | ||
| tour <<- new_tour(src, tour_path, NULL) | ||
| } | ||
| tour_step = function() { | ||
| if (is.null(last_time)) { | ||
| last_time <<- proc.time()[3] | ||
| delta = 0 | ||
| } else { | ||
| cur_time = proc.time()[3] | ||
| delta = (cur_time - last_time) | ||
| last_time <<- cur_time | ||
| } | ||
| step = tour(meta$aps * delta) | ||
| if (is.null(step$proj)) { | ||
| meta$pause() | ||
| return() | ||
| } | ||
| data_proj = src %*% step$proj | ||
| data_proj = scale(data_proj, center = TRUE, scale = FALSE) | ||
| colnames(data_proj) = paste("tour", 1:ncol(data_proj), sep = "_") | ||
| for(col in colnames(data_proj)) { | ||
| data[[col]] = data_proj[, col] | ||
| } | ||
| invisible(step) | ||
| } | ||
| tour_init() | ||
| meta$pause = function() { | ||
| timer$stop() | ||
| } | ||
| meta$start = function() { | ||
| timer$start() | ||
| } | ||
| meta$slower = function() { | ||
| meta$aps = meta$aps * 0.9 | ||
| } | ||
| meta$faster = function() { | ||
| meta$aps = meta$aps * 1.1 | ||
| } | ||
| meta | ||
| } | ||
|
|
||
| Tour.meta = | ||
| setRefClass("Tourr_meta", fields = | ||
| signalingFields(list(vars = 'character', | ||
| ## tour_path = 'function', | ||
| aps = 'numeric', fps = 'numeric', | ||
| rescale = 'logical', sphere = 'logical', | ||
| start = 'function', stop = 'function', | ||
| slower = 'function', faster = 'function'))) | ||
|
|
||
|
|
||
| } | ||
|
|
||
| # TODO: | ||
| # Respond to changes in underlying data, fps, vars, etc | ||
| # | ||
|
|
||
| #' @examples | ||
| #' flea <- rescaler(flea) | ||
| #' qflea <- qdata(flea) | ||
| #' flea_tour <- Tourr$new(qflea, grand_tour(3), 1:6) | ||
| #' flea_tour$step() | ||
| #' qparallel(c("tour_1", "tour_2", "tour_3"), qflea) | ||
| #' qscatter(qflea, tour_1, tour_2) | ||
| #' # qhist(qflea, "tour_1") | ||
| #' flea_tour$start() | ||
| #' flea_tour$pause() | ||
| #' @noRd | ||
| #' @export | ||
| Tourr <- setRefClass("Tourr", | ||
| c("dest", "src", "tour_path", "tour", "aps", "paused", "timer", "last_time") | ||
| ) | ||
|
|
||
| Tourr$methods(initialize = function(data, tour_path, vars, aps = 1, fps = 30) { | ||
| stopifnot(is.mutaframe(data)) | ||
|
|
||
| src <<- as.matrix(as.data.frame(data[, vars])) | ||
| dest <<- data | ||
|
|
||
| tour_path <<- tour_path | ||
| paused <<- TRUE | ||
| aps <<- aps | ||
| last_time <<- NULL | ||
|
|
||
| timer <<- qtimer(1000 / fps, .self$step) | ||
| tour <<- new_tour(src, tour_path, NULL) | ||
|
|
||
| .self | ||
| }) | ||
|
|
||
| Tourr$methods(step = function() { | ||
|
|
||
| if (is.null(last_time)) { | ||
| last_time <<- proc.time()[3] | ||
| delta <- 0 | ||
| } else { | ||
| cur_time <- proc.time()[3] | ||
| delta <- (cur_time - last_time) | ||
| last_time <<- cur_time | ||
| } | ||
|
|
||
| tour_step <- tour(aps * delta) | ||
| if (is.null(tour_step$proj)) { | ||
| pause() | ||
| return() | ||
| } | ||
|
|
||
| data_proj <- src %*% tour_step$proj | ||
| data_proj <- scale(data_proj, center = TRUE, scale = FALSE) | ||
| colnames(data_proj) <- paste("tour", 1:ncol(data_proj), sep = "_") | ||
|
|
||
| for(col in colnames(data_proj)) { | ||
| dest[[col]] <<- data_proj[, col] | ||
| } | ||
|
|
||
| invisible(tour_step) | ||
| }) | ||
|
|
||
|
|
||
| Tourr$methods(pause = function() { | ||
| timer$stop() | ||
| }) | ||
| Tourr$methods(start = function() { | ||
| timer$start() | ||
| }) | ||
| Tourr$methods(slower = function() { | ||
| aps <<- aps*0.9 | ||
| }) | ||
| Tourr$methods(faster = function() { | ||
| aps <<- aps*1.1 | ||
| }) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,19 +1,16 @@ | ||
| ## examples of tourrs in cranvas | ||
| library(cranvas) | ||
|
|
||
| data(flea, package = 'tourr') | ||
| flea.s <- flea | ||
| flea.s[, -7] <- tourr::rescale(flea.s[, -7]) | ||
| qflea <- qdata(flea.s) | ||
| flea_tour <- Tourr$new(qflea, grand_tour(3), 1:6) | ||
| flea_tour$step() | ||
|
|
||
| qparallel(c("tour_1", "tour_2", "tour_3"), qflea) | ||
| qscatter(tour_1, tour_2, qflea, labeled=TRUE, xlim=c(-4,4), ylim=c(-4,4)) | ||
| qhist(tour_1, qflea, binwidth = 0.1, xlim = c(-1, 1)) | ||
| qdensity(tour_1, qflea, xlim=c(-4,4)) | ||
|
|
||
| qflea = qdata(flea, color = species) | ||
| flea_tour = qtour(1:6, data = qflea, tour_path = grand_tour(3)) | ||
| flea_tour$start() | ||
|
|
||
| qparallel(~tour_1+tour_2+tour_3) | ||
| qhist(tour_1, binwidth = 0.05, xlim = c(-1, 1), ylim = c(0, 16)) | ||
|
|
||
| flea_tour$pause() | ||
|
|
||
| flea_tour$slower() | ||
|
|
||
| flea_tour$faster() |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,77 @@ | ||
| \name{qtour} | ||
| \alias{qtour} | ||
| \title{Create a tour associated with a mutaframe} | ||
| \usage{ | ||
| qtour(vars = ~., data = last_data(), tour_path = grand_tour(), | ||
| aps = 1, fps = 30, rescale = TRUE, sphere = FALSE, ...) | ||
| } | ||
| \arguments{ | ||
| \item{vars}{variable names to be used in the tour (parsed | ||
| by \code{\link{var_names}})} | ||
|
|
||
| \item{data}{a mutaframe created by \code{\link{qdata}} | ||
| (default to be \code{\link{last_data}()}, i.e. the lastly | ||
| used data)} | ||
|
|
||
| \item{tour_path}{tour path generator, defaults to 2d | ||
| grand tour} | ||
|
|
||
| \item{aps}{target angular velocity (in radians per | ||
| second)} | ||
|
|
||
| \item{fps}{target frames per second (defaults to 30)} | ||
|
|
||
| \item{rescale}{if true, rescale all variables to range | ||
| [0,1]?} | ||
|
|
||
| \item{sphere}{if true, sphere all variables} | ||
|
|
||
| \item{...}{ignored} | ||
| } | ||
| \value{ | ||
| An object generated by reference classes with signals. | ||
| } | ||
| \description{ | ||
| The \pkg{tourr} package is used to create the tour | ||
| projections. This function creates an \R object to | ||
| manipulate the tour, and all the changes in the tour can | ||
| be reflected immediately in plots created in | ||
| \pkg{cranvas}. | ||
| } | ||
| \details{ | ||
| Because the data provided to the tour is a mutaframe, it | ||
| can listen to changes through listeners on it. Usually | ||
| these listeners can update the plots which are created | ||
| from this mutaframe (further, those linked to this | ||
| mutaframe) on the fly. | ||
|
|
||
| Four basic methods can be applied to the object returned | ||
| by this function (say, \code{tour}): \code{tour$start()} | ||
| will start the tour (tour projections change successively | ||
| and are attached to the mutaframe; column names are | ||
| \code{tour_1}, \code{tour_2}, ...); \code{tour$stop()} | ||
| pauses the tour; \code{tour$slower()} makes the tour | ||
| slower and \code{tour$faster()} makes it faster. | ||
| } | ||
| \examples{ | ||
| ## examples of tourrs in cranvas | ||
| library(cranvas) | ||
| data(flea, package = "tourr") | ||
|
|
||
| qflea <- qdata(flea, color = species) | ||
| flea_tour <- qtour(1:6, data = qflea, tour_path = grand_tour(3)) | ||
| flea_tour$start() | ||
|
|
||
| qparallel(~tour_1 + tour_2 + tour_3) | ||
| qhist(tour_1, binwidth = 0.05, xlim = c(-1, 1), ylim = c(0, | ||
| 16)) | ||
|
|
||
| flea_tour$pause() | ||
|
|
||
| flea_tour$slower() | ||
|
|
||
| flea_tour$faster() | ||
| } | ||
| \author{ | ||
| Yihui Xie <\url{http://yihui.name}> | ||
| } |