From 70c162beccf928ab6c6d121a9a3fa27493c13aeb Mon Sep 17 00:00:00 2001
From: Yihui Xie <xie@yihui.name>
Date: Wed, 31 Aug 2011 01:42:52 -0500
Subject: [PATCH] a new function qtour() is done and documented; close #88

---
 NAMESPACE                 |   2 +-
 R/qtourr.R                | 175 ++++++++++++++++++++------------------
 inst/examples/qtourr-ex.R |  19 ++---
 man/qtour.Rd              |  77 +++++++++++++++++
 4 files changed, 177 insertions(+), 96 deletions(-)
 create mode 100644 man/qtour.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 07b30da..dee0b20 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -61,6 +61,7 @@ export(qparallel)
 export(qscatter)
 export(qspine)
 export(qtime)
+export(qtour)
 export(record_selector)
 export(remove_link)
 export(save_brush_history)
@@ -74,7 +75,6 @@ export("size_var<-")
 export(summary_one)
 export(switch_value)
 export(sync_limits)
-export(Tourr)
 export(update_brush_size)
 export("visible<-")
 export(visible)
diff --git a/R/qtourr.R b/R/qtourr.R
index 103b650..dfb1b54 100644
--- a/R/qtourr.R
+++ b/R/qtourr.R
@@ -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
-})
diff --git a/inst/examples/qtourr-ex.R b/inst/examples/qtourr-ex.R
index d66e9dd..fa6b47e 100644
--- a/inst/examples/qtourr-ex.R
+++ b/inst/examples/qtourr-ex.R
@@ -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()
diff --git a/man/qtour.Rd b/man/qtour.Rd
new file mode 100644
index 0000000..23e51b6
--- /dev/null
+++ b/man/qtour.Rd
@@ -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}>
+}