From 6c7d9ded0082d154c5ec158c2d771702f8c24a16 Mon Sep 17 00:00:00 2001 From: Jonathan McPherson Date: Mon, 7 Oct 2013 11:11:59 -0700 Subject: [PATCH 1/4] simplify syntax for creating new debuggable expressions --- R/shinywrappers.R | 19 ++++++------------- R/utils.R | 34 ++++++++++++++++++++++++++++++---- 2 files changed, 36 insertions(+), 17 deletions(-) diff --git a/R/shinywrappers.R b/R/shinywrappers.R index 8dfa0a3d2..1b85ba1f6 100644 --- a/R/shinywrappers.R +++ b/R/shinywrappers.R @@ -42,11 +42,9 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ..., if (!is.null(func)) { shinyDeprecated(msg="renderPlot: argument 'func' is deprecated. Please use 'expr' instead.") } else { - func <- exprToFunction(expr, env, quoted) - registerDebugHook("func", environment(), "Render Plot") + installExprFunction(expr, "func", env, quoted) } - args <- list(...) if (is.function(width)) @@ -221,8 +219,7 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ..., #' } renderImage <- function(expr, env=parent.frame(), quoted=FALSE, deleteFile=TRUE) { - func <- exprToFunction(expr, env, quoted) - registerDebugHook("func", environment(), "Render Image") + installExprFunction(expr, "func", env, quoted) return(function(shinysession, name, ...) { imageinfo <- func() @@ -272,8 +269,7 @@ renderTable <- function(expr, ..., env=parent.frame(), quoted=FALSE, func=NULL) if (!is.null(func)) { shinyDeprecated(msg="renderTable: argument 'func' is deprecated. Please use 'expr' instead.") } else { - func <- exprToFunction(expr, env, quoted) - registerDebugHook("func", environment(), "Render Table") + installExprFunction(expr, "func", env, quoted) } function() { @@ -330,8 +326,7 @@ renderPrint <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) { if (!is.null(func)) { shinyDeprecated(msg="renderPrint: argument 'func' is deprecated. Please use 'expr' instead.") } else { - func <- exprToFunction(expr, env, quoted) - registerDebugHook("func", environment(), "Render Print") + installExprFunction(expr, "func", env, quoted) } function() { @@ -374,8 +369,7 @@ renderText <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) { if (!is.null(func)) { shinyDeprecated(msg="renderText: argument 'func' is deprecated. Please use 'expr' instead.") } else { - func <- exprToFunction(expr, env, quoted) - registerDebugHook("func", environment(), "Render Text") + installExprFunction(expr, "func", env, quoted) } function() { @@ -415,8 +409,7 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) { if (!is.null(func)) { shinyDeprecated(msg="renderUI: argument 'func' is deprecated. Please use 'expr' instead.") } else { - func <- exprToFunction(expr, env, quoted) - registerDebugHook("func", environment(), "Render UI") + installExprFunction(expr, "func", env, quoted) } function() { diff --git a/R/utils.R b/R/utils.R index a0e18a527..b5ef74073 100644 --- a/R/utils.R +++ b/R/utils.R @@ -130,6 +130,8 @@ makeFunction <- function(args = pairlist(), body, env = parent.frame()) { #' @param env The desired environment for the function. Defaults to the #' calling environment two steps back. #' @param quoted Is the expression quoted? +#' @param caller_offset If specified, the offset in the callstack of the +#' functiont to be treated as the caller. #' #' @examples #' # Example of a new renderer, similar to renderText @@ -165,9 +167,10 @@ makeFunction <- function(args = pairlist(), body, env = parent.frame()) { #' # "text, text, text" #' #' @export -exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE) { +exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE, + caller_offset=1) { # Get the quoted expr from two calls back - expr_sub <- eval(substitute(substitute(expr)), parent.frame()) + expr_sub <- eval(substitute(substitute(expr)), parent.frame(caller_offset)) # Check if expr is a function, making sure not to evaluate expr, in case it # is actually an unquoted expression. @@ -176,8 +179,8 @@ exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE) { # latter, it will be a language object. if (!is.name(expr_sub) && expr_sub[[1]] == as.name('function')) { # Get name of function that called this function - called_fun <- sys.call(-1)[[1]] - + called_fun <- sys.call(-1 * caller_offset)[[1]] + shinyDeprecated(msg = paste("Passing functions to '", called_fun, "' is deprecated. Please use expressions instead. See ?", called_fun, " for more information.", sep="")) @@ -193,6 +196,29 @@ exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE) { } } +#' Installs an expression in the given environment as a function, and registers +#' debug hooks so that breakpoints may be set in the function. +#' +#' @note Wraps \code{exprToFunction}; see that method's documentation for +#' more documentation and examples. +#' +#' @param expr A quoted or unquoted expression +#' @param name The name the function should be given +#' @param eval.env The desired environment for the function. Defaults to the +#' calling environment two steps back. +#' @param quoted Is the expression quoted? +#' @param assign.env The environment in which the function should be assigned. +#' @param label A label for the object to be shown in the debugger. Defaults +#' to the name of the calling function. +installExprFunction <- function(expr, name, eval.env = parent.frame(2), + quoted = FALSE, + assign.env = parent.frame(1), + label = as.character(sys.call(-1)[[1]])) { + func <- exprToFunction(expr, eval.env, quoted, 2) + assign(name, func, envir = assign.env) + registerDebugHook(name, assign.env, label) +} + #' Parse a GET query string from a URL #' #' Returns a named character vector of key-value pairs. From d10cbc9984a12e3c289882a37ba59cf07e74e3b2 Mon Sep 17 00:00:00 2001 From: Jonathan McPherson Date: Tue, 8 Oct 2013 10:36:31 -0700 Subject: [PATCH 2/4] export and add docs for installExprFunction --- NAMESPACE | 1 + R/utils.R | 10 +++++- man/exprToFunction.Rd | 11 +++++- man/installExprFunction.Rd | 70 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 90 insertions(+), 2 deletions(-) create mode 100644 man/installExprFunction.Rd diff --git a/NAMESPACE b/NAMESPACE index a33683cb8..e0c97466c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -57,6 +57,7 @@ export(includeHTML) export(includeMarkdown) export(includeScript) export(includeText) +export(installExprFunction) export(invalidateLater) export(is.reactive) export(is.reactivevalues) diff --git a/R/utils.R b/R/utils.R index b5ef74073..a29f5a5cf 100644 --- a/R/utils.R +++ b/R/utils.R @@ -199,7 +199,13 @@ exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE, #' Installs an expression in the given environment as a function, and registers #' debug hooks so that breakpoints may be set in the function. #' -#' @note Wraps \code{exprToFunction}; see that method's documentation for +#' Can replace \code{exprToFunction} as follows: +#' +#' Before: \code{func <- exprToFunction(expr)} +#' +#' After: \code{installExprFunction(expr, "func")} +#' +#' @seealso Wraps \code{exprToFunction}; see that method's documentation for #' more documentation and examples. #' #' @param expr A quoted or unquoted expression @@ -210,6 +216,8 @@ exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE, #' @param assign.env The environment in which the function should be assigned. #' @param label A label for the object to be shown in the debugger. Defaults #' to the name of the calling function. +#' +#' @export installExprFunction <- function(expr, name, eval.env = parent.frame(2), quoted = FALSE, assign.env = parent.frame(1), diff --git a/man/exprToFunction.Rd b/man/exprToFunction.Rd index 37f508155..932f9153e 100644 --- a/man/exprToFunction.Rd +++ b/man/exprToFunction.Rd @@ -3,7 +3,7 @@ \title{Convert an expression or quoted expression to a function} \usage{ exprToFunction(expr, env = parent.frame(2), - quoted = FALSE) + quoted = FALSE, caller_offset = 1) } \arguments{ \item{expr}{A quoted or unquoted expression, or a @@ -13,6 +13,9 @@ Defaults to the calling environment two steps back.} \item{quoted}{Is the expression quoted?} + + \item{caller_offset}{The offset in the callstack of the function to be + considered the caller. Defaults to the direct caller.} } \description{ This is to be called from another function, because it @@ -27,6 +30,12 @@ this will quote the original expression and convert it to a function. } +\note{ +exprToFunction does not set debug hooks in the function it creates, so it is +not possible to set breakpoints in the original expressions and hit them during +Shiny application runtime. Use \code{\link{installExprFunction}} instead if you +need debug support. +} \examples{ # Example of a new renderer, similar to renderText # This is something that toolkit authors will do diff --git a/man/installExprFunction.Rd b/man/installExprFunction.Rd new file mode 100644 index 000000000..2fcb129a2 --- /dev/null +++ b/man/installExprFunction.Rd @@ -0,0 +1,70 @@ +\name{installExprFunction} +\alias{installExprFunction} +\title{Convert an expression to a function and place it in an environment} +\description{This is to be called from another function, because it will attempt +to get an unquoted expression from two calls back.} +\usage{ + installExprFunction(expr, name, eval.env = parent.frame(2), + quoted = FALSE, assign.env = parent.frame(1), + label = as.character(sys.call(-1)[[1]])) +} +\arguments{ + \item{expr}{A quoted or unquoted expression.} + + \item{name}{The name of the function object to create.} + + \item{eval.env}{The desired environment for the function. Defaults to the + calling environment two steps back.} + + \item{quoted}{Is the expression quoted?} + + \item{assign.env}{The environment in which to place the function object. + Defaults to the calling environment.} + + \item{label}{A descriptive label for the function to be shown in the + debugger, if active. Defaults to the name of the calling function.} +} +\details{ + Converts expr to a function, using the semantics described in + \code{\link{exprToFunction}}. Installs the newly created function into an + environment (the environment of the caller unless otherwise specified), and + registers debug hooks on the function object if a debugger is active so that + breakpoints may be set in it. +} +\seealso{ +\code{link{exprToFunction}} +} +\examples{ +# Example of a new renderer, similar to renderText +# This is something that toolkit authors will do +renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) { + # Create a function named "func" from the expression + shiny::installExprFunction(expr, "func", env, quoted) + + function() { + # Call the function just created + value <- func() + paste(rep(value, 3), collapse=", ") + } +} + +# Example of using the renderer. +# This is something that app authors will do. +values <- reactiveValues(A="text") + +\dontrun{ +# Create an output object +output$tripleA <- renderTriple({ + values$A +}) +} + +# At the R console, you can experiment with the renderer using isolate() +tripleA <- renderTriple({ + values$A +}) + +isolate(tripleA()) +# "text, text, text" +} + From 347e44f04db7bccbc7835dd262bda9a0618c433f Mon Sep 17 00:00:00 2001 From: Jonathan McPherson Date: Tue, 8 Oct 2013 15:29:35 -0700 Subject: [PATCH 3/4] look up function by name (for R CMD check --as-cran) --- R/shinywrappers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/shinywrappers.R b/R/shinywrappers.R index 1b85ba1f6..23af39e10 100644 --- a/R/shinywrappers.R +++ b/R/shinywrappers.R @@ -222,7 +222,7 @@ renderImage <- function(expr, env=parent.frame(), quoted=FALSE, installExprFunction(expr, "func", env, quoted) return(function(shinysession, name, ...) { - imageinfo <- func() + imageinfo <- get("func")() # Should the file be deleted after being sent? If .deleteFile not set or if # TRUE, then delete; otherwise don't delete. if (deleteFile) { From 6452f62b884687f27926f4de057c2b4d3deac5dd Mon Sep 17 00:00:00 2001 From: Jonathan McPherson Date: Tue, 8 Oct 2013 23:24:27 -0700 Subject: [PATCH 4/4] use a check hint (globalVariables()) in favor of modifying code in renderImage --- R/shinywrappers.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/shinywrappers.R b/R/shinywrappers.R index 23af39e10..0a7e1cc5d 100644 --- a/R/shinywrappers.R +++ b/R/shinywrappers.R @@ -2,6 +2,7 @@ suppressPackageStartupMessages({ library(caTools) library(xtable) }) +globalVariables('func') #' Plot Output #' @@ -222,7 +223,7 @@ renderImage <- function(expr, env=parent.frame(), quoted=FALSE, installExprFunction(expr, "func", env, quoted) return(function(shinysession, name, ...) { - imageinfo <- get("func")() + imageinfo <- func() # Should the file be deleted after being sent? If .deleteFile not set or if # TRUE, then delete; otherwise don't delete. if (deleteFile) {