Actual question
How could you either approximate the reactive environment/behavior established by shiny functions or possibly even use these very functions in a non-shiny context in order to create "reactive" variables?
Background
I'm absolutely fascinated by the shiny framework and its underlying paradigms. In particular with respect to the established overall reactive environment. Just for the pure fun of it, I wondered if one could transfer this reactive programming paradigm to a non-shiny context - i.e. a regular R application/project/package or however you want to call it.
Maybe think options: you might want option_2 to depend on the value of option_1 to ensure
consistent data states. If option_1 changes, option_2 should change as well.
I guess I'm idealy looking for something as efficient as possible, i.e. option_2 should only be updated when necessary, i.e. when option_1 actually changes (as opposed to computing the current state of option_2 each time I query the option).
Due dilligence
I played around a bit with the following functions:
shiny::reactiveValuesshiny::reactiveshiny::observeshiny::isolate
But AFAIU, they are closely tailord to the shiny context, of course.
Own prototype
This is a very simple solution based on environments. It works, but
- I'd be interested in different/better approaches and
- I thought maybe one could actually reuse shiny code somehow.
Definition of set function:
setValue <- function(
id,
value,
envir,
observe = NULL,
binding = NULL,
...
) {
## Auxiliary environments //
if (!exists(".bindings", envir, inherits = FALSE)) {
assign(".bindings", new.env(), envir)
}
if (!exists(".hash", envir, inherits = FALSE)) {
assign(".hash", new.env(), envir)
}
if (!exists(".observe", envir, inherits = FALSE)) {
assign(".observe", new.env(), envir)
}
if (!exists(id, envir$.hash, inherits = FALSE)) {
assign(id, new.env(), envir$.hash)
}
## Decide what type of variable we have //
if (!is.null(observe) && !is.null(binding)) {
has_binding <- TRUE
} else {
has_binding <- FALSE
}
## Set //
if (has_binding) {
## Value with binding //
## Get and transfer hash value of observed variable:
assign(id, get(observe, envir$.hash[[observe]]), envir$.hash[[observe]])
## Compute actual value based on the binding contract/function:
out <- binding(x = get(observe, envir))
## Store actual value:
assign(id, out, envir)
## Store hash value:
assign(id, digest::digest(out), envir$.hash[[id]])
## Store binding:
assign(id, binding, envir$.bindings)
## Store name of observed variable:
assign(id, observe, envir$.observe)
} else {
## Regular variable without binding //
## Store actual value:
out <- assign(id, value, envir)
## Store hash value:
assign(id, digest::digest(value), envir$.hash[[id]])
}
return(out)
}
Definition of get function:
getValue <- function(
id,
envir,
...
) {
## Check if variable observes another variable //
observe <- envir$.observe[[id]]
## Get //
if (!is.null(observe)) {
## Check if any of observed variables have changed //
## Note: currently only tested with bindings that only
## take one observed variable
idx <- sapply(observe, function(ii) {
hash_0 <- get(ii, envir$.hash[[ii]], inherits = FALSE)
hash_1 <- get(id, envir$.hash[[ii]], inherits = FALSE)
hash_0 != hash_1
})
## Update required //
if (any(idx)) {
out <- setValue(
id = id,
envir = envir,
binding = get(id, envir$.bindings, inherits = FALSE),
observe = observe
)
} else {
out <- get(id, envir, inherits = FALSE)
}
} else {
out <- get(id, envir, inherits = FALSE)
}
return(out)
}
Apply:
##------------------------------------------------------------------------------
## Apply //
##------------------------------------------------------------------------------
require("digest")
envir <- new.env()
## Set regular variable value //
setValue(id = "x_1", value = Sys.time(), envir = envir)
[1] "2014-09-17 23:15:38 CEST"
getValue(id = "x_1", envir = envir)
# [1] "2014-09-17 23:15:38 CEST"
## Set variable with binding to observed variable 'x_1' //
setValue(
id = "x_2",
envir = envir,
binding = function(x) {
x + 60*60*24
},
observe = "x_1"
)
# [1] "2014-09-18 23:15:38 CEST"
## As long as observed variable does not change,
## value of 'x_2' will also not change
getValue(id = "x_2", envir = envir)
# [1] "2014-09-18 23:15:38 CEST"
## Change value of observed variable 'x_1' //
setValue(id = "x_1", value = Sys.time(), envir = envir)
# [1] "2014-09-17 23:16:52 CEST"
## Value of 'x_2' will change according to binding contract/function:
getValue(id = "x_2", envir = envir)
# [1] "2014-09-18 23:16:52 CEST"
Profiling:
##------------------------------------------------------------------------------
## Profiling //
##------------------------------------------------------------------------------
require(microbenchmark)
envir <- new.env()
binding <- function(x) {
x + 60*60*24
}
microbenchmark(
"1" = setValue(id = "x_1", value = Sys.time(), envir = envir),
"2" = getValue(id = "x_1", envir = envir),
"3" = setValue(id = "x_2", envir = envir,
binding = binding, observe = "x_1"),
"4" = getValue(id = "x_2", envir = envir),
"5" = setValue(id = "x_1", value = Sys.time(), envir = envir),
"6" = getValue(id = "x_2", envir = envir)
)
# Unit: microseconds
# expr min lq median uq max neval
# 1 108.620 111.8275 115.4620 130.2155 1294.881 100
# 2 4.704 6.4150 6.8425 7.2710 17.106 100
# 3 178.324 183.6705 188.5880 247.1735 385.300 100
# 4 43.620 49.3925 54.0965 92.7975 448.591 100
# 5 109.047 112.0415 114.1800 159.2945 223.654 100
# 6 43.620 47.6815 50.8895 100.9225 445.169 100
makeActiveBindingis probably something worth examining. - Thomasevalwith expressions, calls, and quotes to avoid extra copying operations. - shadowtalker