Merge remote-tracking branch 'origin/feature/event-reactives'

Conflicts:
	inst/tests/test-reactivity.r

NAMESPACE

@@ -49,6 +49,7 @@ export(downloadButton)
 export(downloadHandler)
 export(downloadLink)
 export(em)
+export(eventReactive)
 export(exprToFunction)
 export(fileInput)
 export(fixedPage)

NEWS

@@ -4,8 +4,9 @@ shiny 0.10.2.9xxx
 * `actionButton` and `actionLink` now pass their `...` arguments to the
   underlying tag function. (#607)
 
-* Added `observeEvent` function for clearer, terser handling of `actionButton`,
-  plot clicks, and other naturally-imperative inputs.
+* Added `observeEvent` and `eventReactive` functions for clearer, more concise
+  handling of `actionButton`, plot clicks, and other naturally-imperative
+  inputs.
 
 * Errors that happen in reactives no longer prevent any remaining pending
   observers from executing. It is also now possible for users to control how

R/bootstrap.R

@@ -948,7 +948,7 @@ submitButton <- function(text = "Apply Changes", icon = NULL) {
 #' actionButton("goButton", "Go!")
 #' }
 #'
-#' @seealso \code{\link{observeEvent}} and \code{\link{eventFilter}}
+#' @seealso \code{\link{observeEvent}} and \code{\link{eventReactive}}
 #'
 #' @export
 actionButton <- function(inputId, label, icon = NULL, ...) {

R/reactives.R

@@ -493,7 +493,15 @@ Observer <- R6Class(
         stop("Can't make an observer from a function that takes parameters; ",
              "only functions without parameters can be reactive.")
 
-      .func <<- func
+      .func <<- function() {
+        tryCatch(
+          func(),
+          validation = function(e) {
+            # It's OK for a validation error to cause an observer to stop
+            # running
+          }
+        )
+      }
       .label <<- label
       .domain <<- domain
       .autoDestroy <<- autoDestroy
@@ -1211,33 +1219,174 @@ maskReactiveContext <- function(expr) {
 
 #' Event handler
 #'
+#' Respond to "event-like" reactive inputs, values, and expressions.
+#'
+#' Shiny's reactive programming framework is primarily designed for calculated
+#' values (reactive expressions) and side-effect-causing actions (observers)
+#' that respond to \emph{any} of their inputs changing. That's often what is
+#' desired in Shiny apps, but not always: sometimes you want to wait for a
+#' specific action to be taken from the user, like clicking an
+#' \code{\link{actionButton}}, before calculating an expression or taking an
+#' action. A reactive value or expression that is used to trigger other
+#' calculations in this way is called an \emph{event}.
+#'
+#' These situations demand a more imperative, "event handling" style of
+#' programming that is possible--but not particularly intuitive--using the
+#' reactive programming primitives \code{\link{observe}} and
+#' \code{\link{isolate}}. \code{observeEvent} and \code{eventReactive} provide
+#' straightforward APIs for event handling that wrap \code{observe} and
+#' \code{isolate}.
+#'
+#' Use \code{observeEvent} whenever you want to \emph{perform an action} in
+#' response to an event. (Note that "recalculate a value" does not generally
+#' count as performing an action--see \code{eventReactive} for that.) The first
+#' argument is the event you want to respond to, and the second argument is a
+#' function that should be called whenever the event occurs.
+#'
+#' Use \code{eventReactive} to create a \emph{calculated value} that only
+#' updates in response to an event. This is just like a normal
+#' \link[=reactive]{reactive expression} except it ignores all the usual
+#' invalidations that come from its reactive dependencies; it only invalidates
+#' in response to the given event.
+#'
+#' Both \code{observeEvent} and \code{eventReactive} take an \code{ignoreNULL}
+#' parameter that affects behavior when the \code{eventExpr} evaluates to
+#' \code{NULL} (or in the special case of an \code{\link{actionButton}},
+#' \code{0}). In these cases, if \code{ignoreNULL} is \code{TRUE}, then an
+#' \code{observeEvent} will not execute and an \code{eventReactive} will raise a
+#' silent \link[=validate]{validation} error. This is useful behavior if you
+#' don't want to do the action or calculation when your app first starts, but
+#' wait for the user to initiate the action first (like a "Submit" button);
+#' whereas \code{ignoreNULL=FALSE} is desirable if you want to initially perform
+#' the action/calculation and just let the user re-initiate it (like a
+#' "Recalculate" button).
+#'
+#' @param eventExpr A (quoted or unquoted) expression that represents the event;
+#'   this can be a simple reactive value like `input$click`, a call to a
+#'   reactive expression like `dataset()`, or even a complex expression inside
+#'   curly braces
+#' @param handlerExpr The expression to call whenever \code{eventExpr} is
+#'   invalidated. This should be a side-effect-producing action (the return
+#'   value will be ignored). It will be executed within an \code{\link{isolate}}
+#'   scope.
+#' @param valueExpr The expression that produces the return value of the
+#'   \code{eventReactive}. It will be executed within an \code{\link{isolate}}
+#'   scope.
+#' @param event.env The parent environment for \code{eventExpr}. By default,
+#'   this is the calling environment.
+#' @param event.quoted Is the \code{eventExpr} expression quoted? By default,
+#'   this is \code{FALSE}. This is useful when you want to use an expression
+#'   that is stored in a variable; to do so, it must be quoted with `quote()`.
+#' @param handler.env The parent environment for \code{handlerExpr}. By default,
+#'   this is the calling environment.
+#' @param handler.quoted Is the \code{handlerExpr} expression quoted? By
+#'   default, this is \code{FALSE}. This is useful when you want to use an
+#'   expression that is stored in a variable; to do so, it must be quoted with
+#'   `quote()`.
+#' @param value.env The parent environment for \code{valueExpr}. By default,
+#'   this is the calling environment.
+#' @param value.quoted Is the \code{valueExpr} expression quoted? By
+#'   default, this is \code{FALSE}. This is useful when you want to use an
+#'   expression that is stored in a variable; to do so, it must be quoted with
+#'   `quote()`.
+#' @param label A label for the observer or reactive, useful for debugging.
+#' @param suspended If \code{TRUE}, start the observer in a suspended state. If
+#'   \code{FALSE} (the default), start in a non-suspended state.
+#' @param priority An integer or numeric that controls the priority with which
+#'   this observer should be executed. An observer with a given priority level
+#'   will always execute sooner than all observers with a lower priority level.
+#'   Positive, negative, and zero values are allowed.
+#' @param domain See \link{domains}.
+#' @param autoDestroy If \code{TRUE} (the default), the observer will be
+#'   automatically destroyed when its domain (if any) ends.
+#' @param ignoreNULL Whether the action should be triggered (or value
+#'   calculated, in the case of \code{eventReactive}) when the input is
+#'   \code{NULL}. See Details.
+#' @return \code{observeEvent} returns an observer reference class object (see
+#'   \code{\link{observe}}). \code{eventReactive} returns a reactive expression
+#'   object (see \code{\link{reactive}}).
+#'
 #' @seealso \code{\link{actionButton}}
 #'
 #' @examples
-#' \dontrun{
-#' # In ui.R:
-#' shinyUI(basicPage(
-#'   numericInput("n", "Number of observations", 5),
-#'   actionButton("saveButton", "Save")
-#' ))
-#' # In server.R:
-#' shinyServer(function(input, output) {
-#'   observeEvent(input$saveButton, function() {
-#'     write.csv(runif(input$n), file = "data.csv")
+#' \donttest{
+#' ui <- fluidPage(
+#'   column(4,
+#'     numericInput("x", "Value", 5),
+#'     br(),
+#'     actionButton("button", "Show")
+#'   ),
+#'   column(8, tableOutput("table"))
+#' )
+#' server <- function(input, output) {
+#'   # Take an action every time button is pressed;
+#'   # here, we just print a message to the console
+#'   observeEvent(input$button, function() {
+#'     cat("Showing", input$x, "rows\n")
+#'   })
+#'   # Take a reactive dependency on input$button, but
+#'   # not on any of the stuff inside the function
+#'   df <- eventReactive(input$button, function() {
+#'     head(cars, input$x)
+#'   })
+#'   output$table <- renderTable({
+#'     df()
 #'   })
-#' })
+#' }
+#' shinyApp(ui=ui, server=server)
 #' }
 #'
 #' @export
-observeEvent <- function(eventExpr, callback, env=parent.frame(), quoted=FALSE) {
-  eventFunc <- exprToFunction(eventExpr, env, quoted)
+observeEvent <- function(eventExpr, handlerExpr,
+  event.env = parent.frame(), event.quoted = FALSE,
+  handler.env = parent.frame(), handler.quoted = FALSE,
+  label=NULL, suspended=FALSE, priority=0, domain=getDefaultReactiveDomain(),
+  autoDestroy = TRUE, ignoreNULL = TRUE) {
+
+  eventFunc <- exprToFunction(eventExpr, event.env, event.quoted)
+  if (is.null(label))
+    label <- sprintf('observeEvent(%s)', paste(deparse(body(eventFunc)), collapse='\n'))
+
+  handlerFunc <- exprToFunction(handlerExpr, handler.env, handler.quoted)
 
-  initialized <- FALSE
   invisible(observe({
-    eventVal <- eventFunc()
-    if (!initialized)
-      initialized <<- TRUE
-    else
-      isolate(callback())
-  }))
+    e <- eventFunc()
+
+    if (ignoreNULL && isNullEvent(e)) {
+      return()
+    }
+
+    isolate(handlerFunc())
+  }, label = label, suspended = suspended, priority = priority, domain = domain,
+    autoDestroy = TRUE))
+}
+
+#' @rdname observeEvent
+#' @export
+eventReactive <- function(eventExpr, valueExpr,
+  event.env = parent.frame(), event.quoted = FALSE,
+  value.env = parent.frame(), value.quoted = FALSE,
+  label=NULL, domain=getDefaultReactiveDomain(),
+  ignoreNULL = TRUE) {
+
+  eventFunc <- exprToFunction(eventExpr, event.env, event.quoted)
+  if (is.null(label))
+    label <- sprintf('eventReactive(%s)', paste(deparse(body(eventFunc)), collapse='\n'))
+
+  handlerFunc <- exprToFunction(valueExpr, value.env, value.quoted)
+
+  invisible(reactive({
+    e <- eventFunc()
+
+    validate(need(
+      !ignoreNULL || !isNullEvent(e),
+      message = FALSE
+    ))
+
+    isolate(handlerFunc())
+  }, label = label, domain = domain))
+}
+
+isNullEvent <- function(value) {
+  is.null(value) || (inherits(value, 'shinyActionButtonValue') && value == 0)
 }

inst/tests/test-reactivity.r

@@ -822,7 +822,6 @@ test_that("maskReactiveContext blocks use of reactives", {
   expect_identical(isolate(maskReactiveContext(isolate(vals$x))), 123)
 })
 
-
 test_that("Flush completes even when errors occur", {
   vals <- reactiveValues(x = 1)
 
@@ -885,3 +884,52 @@ test_that("Alternate error handler function", {
   flushReact()
   expect_identical(ec, 2)
 })
+
+test_that("event handling helpers take correct dependencies", {
+  vals <- reactiveValues(action = NULL, x = 1)
+
+  o1_count <- 0
+  o1 <- observeEvent(vals$action, {
+    vals$x
+    o1_count <<- o1_count + 1
+  })
+  o2_count <- 0
+  o2 <- observeEvent(ignoreNULL = FALSE, vals$action, {
+    vals$x
+    o2_count <<- o2_count + 1
+  })
+  r1 <- eventReactive(vals$action, {
+    vals$x
+  })
+  r2 <- eventReactive(ignoreNULL = FALSE, vals$action, {
+    vals$x
+  })
+
+  flushReact()
+
+  expect_error(isolate(r1()))
+  expect_identical(isolate(r2()), 1)
+  expect_equal(o1_count, 0)
+  expect_equal(o2_count, 1)
+  expect_equal(execCount(o1), 1)
+  expect_equal(execCount(o2), 1)
+
+  vals$x <- 2
+  flushReact()
+
+  expect_error(isolate(r1()))
+  expect_identical(isolate(r2()), 1)
+  expect_equal(o1_count, 0)
+  expect_equal(o2_count, 1)
+  expect_equal(execCount(o1), 1)
+  expect_equal(execCount(o2), 1)
+
+  vals$action <- 1
+  flushReact()
+  expect_identical(isolate(r1()), 2)
+  expect_identical(isolate(r2()), 2)
+  expect_equal(o1_count, 1)
+  expect_equal(o2_count, 2)
+  expect_equal(execCount(o1), 2)
+  expect_equal(execCount(o2), 2)
+})

man/actionButton.Rd

@@ -40,7 +40,7 @@ actionButton("goButton", "Go!")
 }
 }
 \seealso{
-\code{\link{observeEvent}} and \code{\link{eventFilter}}
+\code{\link{observeEvent}} and \code{\link{eventReactive}}
 
 Other input.elements: \code{\link{animationOptions}},
   \code{\link{sliderInput}};