【发布时间】：2014-11-12 02:00:00
【问题描述】：
实际问题
您如何近似由shiny 函数建立的reactive environment/behavior，或者甚至可能在非闪亮上下文中使用这些函数来创建“反应性”变量？
背景
我对@987654323@ 及其基本范式非常着迷。特别是关于已建立的整体反应环境。只是为了纯粹的乐趣，我想知道是否可以将这种反应式编程范式转移到非闪亮的上下文中 - 即常规的 R 应用程序/项目/包，或者您想调用它。
也许认为选项：您可能希望option_2 依赖于option_1 的值以确保
一致的数据状态。如果option_1 改变，option_2 也应该改变。
我想我想寻找尽可能高效的东西，即option_2 应该仅在必要时更新，即当option_1 实际发生变化时（而不是计算当前状态） option_2 每次我都会查询该选项）。
尽职调查
我玩了一下以下函数：
shiny::reactiveValues-
shiny::reactive shiny::observeshiny::isolate
但是 AFAIU，当然，它们是为闪亮的环境量身定制的。
自己的原型
这是一个基于environments 的非常简单的解决方案。它有效，但是
- 我会对不同/更好的方法感兴趣，并且
- 我想也许真的可以以某种方式重用闪亮的代码。
set函数的定义：
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)
}
get函数的定义：
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 //
##------------------------------------------------------------------------------
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 //
##------------------------------------------------------------------------------
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
【问题讨论】：
-
如果您使用图形界面语言（例如 tcl/tk），这几乎已经存在。例如，看一下playwith 绘图 GUI。在 GUI 方法之外，
makeActiveBinding可能值得研究。 -
@Thomas：谢谢，我去看看！
-
我不确定它是否可以用来真正模仿响应式功能，但我有时会使用（滥用？）
eval与表达式、调用和引号来避免额外的复制操作。
标签： r shiny reactive-programming