Reactive object bindings in a non-shiny context

Question

Actual question

How could you either approximate the reactive environment/behavior established by shiny functions or possibly even use these very functions in a

Answer 1

Thanks to Joe's pointers I was able to significantly simplify the design. I'd really like not needing to worry about if some variable is a reactive variable or not (the former implying that you'd have to execute the underlying reactive binding function via () as in x_2() in Joe's answer above). So that's why I tried combining Joe's code with makeActiveBinding().

Pros

• there's no need for the hash environment where$._HASH anymore and the actual reactivity details are left up to shiny - which is awesome because if someone knows how to master reactivity done in R it's probably the RStudio guys ;-) Also, that way the whole thing might be even compatible with shiny apps - well, at least theoretically ;-)
• as Joe pointed out, reactive() doesn't care how many observed variables you feed to it - as long as they are in the same environment (arg env in reactive(), arg where in my code).

Cons

• I think you loose the ability to definie "mutual dependency" this way - at least AFAICT so far. The roles are pretty clear now: there's a variable that can be overserved and might be set explicitly, and the other one really just observes.

• The return value of reactive() is quite tricky as it suggests a much simpler object than is actually returned (which is a Reference Class). This makes it hard to combine with substitute() "as is" as this would result in a somewhat static binding (works for the very first cycle, but then it's static).

  I needed to use the good old workaround of going all the way back to transforming the whole thing to a character string:

  reactive_expr <- gsub(") $", ", env = where)", capture.output(reactive(x_1 + 60*60*24))
  

  Probably a bit dangerous or unreliable, but it seems that the end of capture.output(reactive()) always has that trailing whitespace which is goot for us as it let's us identify the last ).

  Also, this comes with kind of a Pro as well: as where is added inside setReactive, the user does not need to specify where twice - as would otherwise be needed:

  where <- new.env()
  setReactive("x_1", reactive(x_2 + 60*60*24, env = where), where = where)
  

So, here's the draft

require("shiny")

setReactive <- function(
  id = id,
  value = NULL,
  where = .GlobalEnv,
  .tracelevel = 0,
  ...
) {
  ## Ensure shiny let's me do this //
  shiny_opt <- getOption("shiny.suppressMissingContextError")
  if (is.null(shiny_opt) || !shiny_opt) {
    options(shiny.suppressMissingContextError = TRUE)  
  }

  ## Check if regular value assignment or reactive function //
  if (!inherits(value, "reactive")) {
    is_reactive <- FALSE
    shiny::makeReactiveBinding(symbol = id, env = where)
    value_expr <- substitute(VALUE, list(VALUE = value))
  } else {
    is_reactive <- TRUE
    ## Put together the "line of lines" //
    value_expr <- substitute(value <<- VALUE(), list(VALUE = value))
    ## --> works initially but seems to be static
    ## --> seems like the call to 'local()' needs to contain the *actual*
    ## "literate" version of 'reactive(...)'. Evaluationg it  
    ## results in the reactive object "behind" 'reactive(()' to be assigned
    ## and that seems to make it static.

    ## Workaround based character strings and re-parsing //
    reactive_expr <- gsub(") $", ", env = where)", capture.output(value))
    value_expr <- substitute(value <<- eval(VALUE)(), 
                             list(VALUE = parse(text = reactive_expr)))
  }

  ## Call to 'makeActiveBinding' //
  expr <- substitute(
    makeActiveBinding(
      id,
      local({
        value <- VALUE
        function(v) {
          if (!missing(v)) {
              value <<- v
          } else {
              VALUE_EXPR
          }
          value
        }
      }),
      env = where
    ),
    list(
      VALUE = value,
      VALUE_EXPR = value_expr
     )
  )
  if (.tracelevel == 1) {
    print(expr)
  }
  eval(expr)

  ## Return value //
  if (is_reactive) {
    out <- get(id, envir = where, inherits = FALSE)
  } else {
    out <- value
  }
  return(out)
}

Testing in .GlobalEnv

## In .GlobalEnv //
## Make sure 'x_1' and 'x_2' are removed:
suppressWarnings(rm(x_1))
suppressWarnings(rm(x_2))
setReactive("x_1", value = Sys.time())
x_1
# [1] "2014-09-24 18:35:49 CEST"
x_1 <- Sys.time()
x_1
# [1] "2014-09-24 18:35:51 CEST"

setReactive("x_2", value = reactive(x_1 + 60*60*24))
x_2
# [1] "2014-09-25 18:35:51 CEST"
x_1 <- Sys.time()
x_1
# [1] "2014-09-24 18:36:47 CEST"
x_2
# [1] "2014-09-25 18:36:47 CEST"

setReactive("x_3", value = reactive({
  message(x_1)
  message(x_2)
  out <- x_2 + 60*60*24
  message(paste0("Difference: ", out - x_1))
  out
}))
x_3
# 2014-09-24 18:36:47
# 2014-09-25 18:36:47
# Difference: 2
# [1] "2014-09-26 18:36:47 CEST"
x_1 <- Sys.time()
x_1
# [1] "2014-09-24 18:38:50 CEST"
x_2
# [1] "2014-09-25 18:38:50 CEST"
x_3
# 2014-09-24 18:38:50
# 2014-09-25 18:38:50
# Difference: 2
# [1] "2014-09-26 18:38:50 CEST"

## Setting an observer has no effect
x_2 <- 100
x_2
# [1] "2014-09-25 18:38:50 CEST"

Testing in custom environment

Works analogous to using .GlobalEnv except that you need to state/use where:

where <- new.env()
suppressWarnings(rm(x_1, envir = where))
suppressWarnings(rm(x_2, envir = where))

setReactive("x_1", value = Sys.time(), where = where)
where$x_1
# [1] "2014-09-24 18:43:18 CEST"

setReactive("x_2", value = reactive(x_1 + 60*60*24, env = where), where = where)
where$x_2
# [1] "2014-09-25 18:43:18 CEST"
where$x_1 <- Sys.time()
where$x_1
# [1] "2014-09-25 18:43:52 CEST"
where$x_2 
# [1] "2014-09-25 18:43:52 CEST"

A couple of follow up questions (mostly directed to Joe if you're still "listening")

1. If not taking care of chipping env in via string manipulation as I do it, how would I be able to access/alter the environment of the actual function/closure that defines the reactivity (to prevent the need to state the environment twice)?

   func <- attributes(reactive(x_1 + 60*60*24))$observable$.func
   func
   # function () 
   # x_1 + 60 * 60 * 24
   # attr(,"_rs_shinyDebugPtr")
   # 
   # attr(,"_rs_shinyDebugId")
   # [1] 858
   # attr(,"_rs_shinyDebugLabel")
   # [1] "Reactive"  
   

   EDIT: Figured that out: environment(func)

2. Is there any way to realize "mutual dependencies" as the one realized with my code above with existing shiny functionality?

3. Just a "far-off" thought without a specific use case behind it: would it be possible to have the observed variables live in different environments as well and still have reactive() recognize them appropriately?

Thanks again, Joe!