非闪亮上下文中的反应对象绑定

Question

实际问题

你怎么能接近reactive environment/behavior函数建立的shiny，或者甚至可以在 non-shiny 上下文中使用这些函数来创建＆＃34;反应性＆＃34;变量

背景

我对shiny framework及其基本范例非常着迷。特别是关于已建立的整体反应环境。只是为了它的纯粹乐趣，我想知道是否可以将这种反应式编程范式转换为非闪亮的上下文 - 即常规的R应用程序/项目/包或者你想要调用它。

也许会想到选项：您可能希望option_2依赖option_1的值来确保 一致的数据状态。如果option_1发生变化，option_2也会发生变化。

我想我想找到尽可能高效的内容，例如option_2 只应在必要时更新，即当option_1实际发生变化时（如反对计算当前状态option_2 每次我查询选项。）

尽职调查

我使用以下功能玩了一下：

• shiny::reactiveValues
• shiny::reactive
• shiny::observe
• shiny::isolate

但是AFAIU，当然，它们与闪亮的环境紧密相关。

拥有原型

这是一个基于environment的非常简单的解决方案。它有效，但

1. 我对不同/更好的方法和
感兴趣
2. 我想也许有人可能会以某种方式重复使用闪亮的代码。

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

Answer 1

对于那些感兴趣的人：这周末一直困扰着我，所以我把一个名为reactr的小包装在一起，这个包基于可以通过makeActiveBinding定义绑定的方式。您可以找到基本构思here。

主要功能

• 支持的监控方案：该软件包允许定义简单监控方案以及更复杂的方案，例如任意功能关系，相互绑定和＃34;来源＆＃34;和＆＃34;目标＆＃34;变量（参见参数where和where_watch）。
• 缓存：这种创建绑定的方法尽可能使用缓存值以提高效率（如果监视变量未更改，则可以使用缓存值而不是每次重新运行绑定函数）。
• 作为参考，我仍然根据上述问题中的概念保留了解决方案。它可以通过binding_type = 2获得。但是，它不支持使用assign()和get()（<-和<obj-name>或$<obj-name>）的语法糖来保持哈希值值同步 - 所以我猜不会使用它。

缺点

我真正喜欢的是我需要一个辅助环境来存储被比较的哈希值，以便做出决定＆＃34;更新缓存或返回缓存＆＃34;。它在where中浮动，默认情况下位于where$._HASH（请参阅ensureHashRegistryState()，但至少可以将名称/ ID更改为您更喜欢或需要的名称/ ID（请参阅参数{{1 }}）。

如果有人知道如何摆脱这种情况，那就非常感激！ ： - ）

---

实施例

请参阅README.md

负载：

.hash_id

使用示例环境，这样我们就不会搞砸我们的require("devtools") devtools::install_github("Rappster/classr") devtools::install_github("Rappster/reactr") require("reactr") ：

.GlobalEnv

绑定方案1：简单监控（相同值）

设置可监控的变量：

where <- new.env()

设置一个监视setReactive(id = "x_1", value = 10, where = where) 并且具有反应绑定的变量：

x_1

每当setReactiveid = "x_2", watch = "x_1", where = where) 发生变化时，x_1会相应更改：

x_2

请注意，尝试更改where$x_1 # [1] 10 where$x_2 # [1] 10 where$x_1 <- 100 where$x_2 # [1] 100 时会被忽略，因为它只能监控x_2：

x_1

绑定方案2：简单监控（任意功能关系）

where$x_2 <- 1000
where$x_2
# [1] 100

每当setReactiveid = "x_3", watch = "x_1", where = where, binding = function(x) {x * 2}) 发生变化时，x_1会相应更改：

x_3

绑定方案3：相互绑定（相同的值）

设置两个具有相互绑定的变量。 与绑定方案1 的主要区别在于，您可以设置 where$x_1 # [1] 100 where$x_2 # [1] 100 where$x_3 # [1] 200 where$x_1 <- 500 where$x_2 # [1] 500 where$x_3 # [1] 1000 和 x_1，并反映更改。

为了做到这一点，还需要重置x_4的绑定 与x_1：

mutual = TRUE

每当setReactive(id = "x_1", watch = "x_4", where = where, mutual = TRUE) setReactive(id = "x_4", watch = "x_1", where = where, mutual = TRUE) 更改时，x_1会相应更改，反之亦然。

请注意，具有相互绑定的变量仅由x_4初始化，默认值为setThis。您必须实际为一个值分配值 在建立绑定之后通过NULL 进行的操作：

<-

绑定方案4：相互绑定（有效的双向关系）

where$x_1
# NULL
where$x_4
# NULL

where$x_1 <- 100
where$x_1
# [1] 100
where$x_4
# [1] 100
where$x_2
# [1] 100
where$x_3
# [1] 200

where$x_4 <- 1000
where$x_4
# [1] 1000
where$x_1
# [1] 1000
where$x_2
# [1] 1000
where$x_3
# [1] 2000

进一步的例子

请参阅setReactive(id = "x_5", watch = "x_6", where = where, binding = function(x) {x * 2}, mutual = TRUE) setReactive(id = "x_6", watch = "x_5", where = where, binding = function(x) {x / 2}, mutual = TRUE) where$x_5 <- 100 where$x_5 # [1] 100 where$x_6 # [1] 50 where$x_6 <- 500 where$x_6 # [1] 500 where$x_5 # [1] 1000 和?setReactive。

---

仿形

我在/inst/prof/prof_1.r中添加了一个分析脚本。有一个＆＃34;裸＆＃34; S3方法?setReactive_bare大约快10％。

使用S4方法setThis_bare

setValue()

使用S3函数where <- new.env() res_1 <- microbenchmark( "1" = setReactive(id = "x_1", value = 10, where = where), "2" = getReactive(id = "x_1", where = where), "3" = setReactive(id = "x_2", where = where, watch = "x_1", binding = function(x) {x + 100}), "4" = getReactive(id = "x_2", where = where), "5" = setReactive(id = "x_1", value = 100, where = where), "6" = getReactive(id = "x_2", where = where), control = list(order = "inorder") ) Unit: microseconds expr min lq median uq max neval 1 476.387 487.9330 494.7750 545.6640 7759.026 100 2 25.658 26.9420 27.5835 30.5770 55.166 100 3 644.875 657.7045 668.1820 743.6595 7343.364 100 4 34.211 35.4950 36.3495 38.4870 86.384 100 5 482.802 494.7750 505.4665 543.9535 2665.027 100 6 51.744 53.0280 54.3100 58.1595 99.640 100

setThis_bare()

---

对于那些对细节感兴趣的人

这是样板代码在where <- new.env() res_3 <- microbenchmark( "1" = setReactive_bare(id = "x_1", value = 10, where = where), "2" = getReactive(id = "x_1", where = where), "3" = setReactive_bare(id = "x_2", where = where, watch = "x_1", binding = function(x) {x + 100}), "4" = getReactive(id = "x_2", where = where), "5" = setReactive_bare(id = "x_1", value = 100, where = where), "6" = getReactive(id = "x_2", where = where), control = list(order = "inorder") ) Unit: microseconds expr min lq median uq max neval 1 428.492 441.9625 453.936 567.4735 6013.844 100 2 25.659 26.9420 27.797 33.9980 84.672 100 3 599.546 613.0165 622.852 703.0340 2369.103 100 4 34.211 35.9220 36.777 45.5445 71.844 100 5 436.189 448.1630 457.571 518.5095 2309.662 100 6 51.745 53.4550 54.952 60.5115 1131.952 100 内传递给makeActiveBinding()的样子（省略setThis()内容;请参阅/R/getBoilerplateCode.r）。

可以监控的变量：

message()

准备评估：

out <- substitute(
  local({
    VALUE <- NULL
    function(v) {
      if (!missing(v)) {
        VALUE <<- v
        ## Ensure hash value //
        assign(id, digest::digest(VALUE), where[[HASH]][[id]])
      }
      VALUE
    }
  }),
  list(
    VALUE = as.name("value"),
    HASH = as.name(".hash_id")
  )
)

监控的变量：

getBoilerplateCode(
  ns = classr::createInstance(cl = "Reactr.BindingContractMonitored.S3")
)

准备评估：

out <- substitute(
  local({
    if (  exists(watch, envir = where_watch, inherits = FALSE) &&
          !is.null(get(watch, envir = where_watch, inherits = FALSE))
    ) {
      VALUE <- BINDING_CONTRACT
    } else {
      VALUE <- NULL
    }
    function(v) { 
      if (exists(watch, envir = where_watch, inherits = FALSE)) {  
        if (missing(v)) {
          hash_0 <- where_watch[[HASH]][[watch]][[watch]]
          hash_1 <- where_watch[[HASH]][[watch]][[id]]
          if (hash_0 != hash_1) {
            VALUE <<- BINDING_CONTRACT
            where_watch[[HASH]][[watch]][[id]] <- hash_0
            where[[HASH]][[id]][[id]] <- hash_0
            where[[HASH]][[id]][[watch]] <- hash_0
          } 
        }
      }
      VALUE
    }
  }),
  list(
    VALUE = as.name("value"), 
    BINDING_CONTRACT = substitute(.binding(x = where_watch[[watch]])),
    HASH = as.name(".hash_id")
  )
)    

具有相互绑定的变量：

getBoilerplateCode(
  ns = classr::createInstance(cl = "Reactr.BindingContractMonitoring.S3")
)

准备评估：

out <- substitute(
  local({
    if (  exists(watch, envir = where, inherits = FALSE) &&
          !is.null(get(watch, envir = where, inherits = FALSE))
    ) {
      VALUE <- BINDING_CONTRACT
    } else {
      VALUE <- NULL
    }
    function(v) {
      if (!missing(v)) {
        VALUE <<- v
        ## Update hash value //
        assign(id, digest::digest(VALUE), where[[HASH]][[id]])
      }
      if (exists(watch, envir = where, inherits = FALSE)) {
        if (missing(v)) {
          hash_0 <- where[[HASH]][[watch]][[watch]]
          hash_1 <- where[[HASH]][[watch]][[id]]
          if (hash_0 != hash_1) {
            VALUE <<- BINDING_CONTRACT
            where[[HASH]][[watch]][[id]] <- hash_0
            where[[HASH]][[id]][[id]] <- hash_0
            where[[HASH]][[id]][[watch]] <- hash_0
          }
        }
      }
      VALUE
    }
  }),
  list(
    VALUE = as.name("value"), 
    BINDING_CONTRACT = substitute(.binding(x = where[[watch]])),
    HASH = as.name(".hash_id")
  )
)    

Answer 2

（试图将此作为评论，但S.O.说它太长了。）

赞赏更加密切关注反应性。您可能会发现这两个链接很有用：

• https://jcheng.shinyapps.io/reactivity-dsc2014
• How does Meteor's reactivity work behind the scenes?（Shiny的反应核心主要受到Meteor的启发）

所以实际上Shiny的反应性可以在Shiny应用程序之外使用 - 有两个技巧。

1. 如果您尝试从控制台读取反应式表达式或反应值，则会出现错误。我故意这样做是因为在像Shiny这样的基本反应系统中，从非反应性上下文中读取反应值或表达式几乎总是一个错误（如果你已经阅读了上面的两个链接，希望这句话是有意义的）。然而，当你在控制台驾驶时，想要绕过这个检查是非常合理的。因此，您可以设置options(shiny.suppressMissingContextError=TRUE)以使其消失。
2. 当您执行触发反应的事物时，在您致电shiny:::flushReact()之前，观察员实际上并未执行。这样您就可以执行多个更新，然后让所有响应代码响应一次，而不是每次更新时重新计算。对于控制台使用，您可以要求Shiny使用flushReact在每个控制台提示符上自动调用shiny:::setAutoflush(TRUE)。同样，只有观察者才需要这样做。

今天有效的示例（在控制台上逐行执行）：

library(shiny)
options(shiny.suppressMissingContextError=TRUE)

makeReactiveBinding("x_1")
x_1 <- Sys.time()
x_2 <- reactive(x_1 + 60*60*24)
x_1
x_2()
x_1 <- Sys.time()
x_1
x_2()

# Now let's try an observer
shiny:::setAutoflush(TRUE)
observe(print(paste("The time changed:", x_1)))
x_1 <- Sys.time()

我建议再考虑更直接地利用Shiny的反应抽象。我认为你可以用makeActiveBinding非常直接地实现这样的语法（假设你认为这比Shiny今天给你的更好）：

where <- new.reactr()
where$x_1 <- Sys.time()
where$x_2 <- reactive(x_1 + 60*60*24)
where$x_1  # Read x_1
where$x_2  # Read x_2

使用reactive()而不是setThis声明反应式表达式的一个关键优势是，前者可以轻松自然地模拟依赖于多个反应值/表达式的表达式。请注意，反应式表达式都是缓存的和惰性的：如果您修改x_1，则在尝试阅读x_2之前，它实际上不会重新计算x_2，如果您再次阅读x_2 x_1已更改，然后只返回上一个值而不重新计算。

关于Shiny反应性的更多功能性转变，请参阅受https://github.com/hadley/shinySignals启发的Hadley Wickham的新包Elm。

希望有所帮助。

Answer 3

位置test_that中有一组/usr/local/lib/R/site-library/shiny/tests/单元测试。它们让你很好地了解函数/包装器：

• reactiveValues
• reactive
• observe
• isolate

可以在shinyServer来电之外使用。

关键是使用flushReact来消除反应性。例如，这是文件test-reactivity.r中的一个测试，我认为它已经让您很好地了解了您需要做什么：

test_that("overreactivity2", {
  # ----------------------------------------------
  # Test 1
  # B depends on A, and observer depends on A and B. The observer uses A and
  # B, in that order.

  # This is to store the value from observe()
  observed_value1 <- NA
  observed_value2 <- NA

  values <- reactiveValues(A=1)
  funcB  <- reactive({
    values$A + 5 
  })  
  obsC <- observe({
    observed_value1 <<-  funcB() * values$A
  })  
  obsD <- observe({
    observed_value2 <<-  funcB() * values$A
  })  

  flushReact()
  expect_equal(observed_value1, 6)   # Should be 1 * (1 + 5) = 6
  expect_equal(observed_value2, 6)   # Should be 1 * (1 + 5) = 6
  expect_equal(execCount(funcB), 1)
  expect_equal(execCount(obsC), 1)
  expect_equal(execCount(obsD), 1)

  values$A <- 2
  flushReact()
  expect_equal(observed_value1, 14)  # Should be 2 * (2 + 5) = 14
  expect_equal(observed_value2, 14)  # Should be 2 * (2 + 5) = 14
  expect_equal(execCount(funcB), 2)
  expect_equal(execCount(obsC), 2)
  expect_equal(execCount(obsD), 2)
})

Answer 4

感谢Rappster，Joe和Robert，你的谈话确实让我受益匪浅。

我刚刚编写了一个小工具，使用以下想法构建可缓存的函数：

library(shiny)
gen.f <- function () {
    reactv <- reactiveValues()

    a <- reactive({ print('getting a()'); reactv$x + 1 })
    b <- reactive({ print('getting b()'); reactv$y + 1 })
    c <- reactive({ print('getting c()'); a() + b() })

    function (x.value, y.value) {
        reactv$x <<- x.value
        reactv$y <<- y.value
        isolate(c())
    }
}
f <- gen.f()

在上面的例子中，返回函数的父环境 用于存储反应值和反应表达式。

通过这样做，返回的函数将具有缓存它的能力 中间结果，如果函数不需要重新计算它们 进一步调用相同的参数。底层的反应式表达式包含在内部，函数可以 用作普通的R函数。

> f(6,9)
[1] "getting c()"
[1] "getting a()"
[1] "getting b()"
[1] 17
> f(6,9)
[1] 17
> f(6,7)
[1] "getting c()"
[1] "getting b()"
[1] 15

基于这个想法，我写了一个工具来帮助生成这种可缓存的 具有以下语法的函数。你可以在https://github.com/marlin-na/reactFunc

看到我的回购

myfunc <- reactFunc(
    # ARGV is the formal arguments of the returned function
    ARGV = alist(x = , y = ),

    # These are reactive expressions in the function argument form
    a = { print('getting a()'); x + 1 },
    b = { print('getting b()'); y + 1 },
    ans = { print('getting ans()'); a() + b() }
)
> myfunc(6, 9)
[1] "getting ans()"
[1] "getting a()"
[1] "getting b()"
[1] 17
> myfunc(6, 9)
[1] 17
> myfunc(6, 7)
[1] "getting ans()"
[1] "getting b()"
[1] 15

此致

米;

Answer 5

感谢Joe的指示，我能够显着简化设计。我真的很喜欢不需要担心一些变量是否是一个反应变量（前者暗示你必须通过{{1}执行底层反应绑定函数在Joe的回答中()中就像在{}}中那样。这就是为什么我尝试将Joe的代码与x_2()结合起来。

赞成

• 不再需要哈希环境makeActiveBinding()，实际的反应性细节留给where$._HASH - 这真是太棒了，因为如果有人知道如何掌握R中的反应性＆ ＃39;可能是RStudio的人;-)而且，这样整个事情甚至可能与shiny应用兼容 - 好吧，至少在理论上; - ）
• 正如Joe指出的那样，shiny并不关心您向其提供的观察变量的数量 - 只要它们处于相同的环境中（reactive()中的env {ar} reactive() ，arg where在我的代码中）。

缺点

• 我认为你失去了定义和相互依赖的能力。这样 - 到目前为止至少是AFAICT。这些角色现在非常清楚：有一个变量可以过度使用并且可以明确设置，而另一个真正只是观察。

• reactive()的返回值非常棘手，因为它建议的对象比实际返回的更简单（参考类）。这使得很难与substitute()＆＃34;以及＃34;因为这会导致一些静态绑定（适用于第一个周期，但它是静态的）。

  我需要使用旧的解决方法，一直回到将整个事物转换为character字符串：

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

  可能有点危险或不可靠，但似乎capture.output(reactive())的结尾总是有尾随的空白，这对我们来说是个好消息，因为它让我们识别出最后的)。 / p>

  另外，这也带有一种 Pro ：当where添加 setReactive时，用户不需要指定where两次 - 否则将需要：

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

所以，这是草案

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)
}

在.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"

在自定义环境中进行测试

类似于使用.GlobalEnv，除了您需要声明/使用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"

一些跟进问题（如果你还是＃34，那么主要针对Joe＆＃34;正在倾听＆＃34;）

1. 如果不像我那样处理通过字符串操作中的env切片，我将如何能够访问/更改定义反应性的实际函数/闭包的环境（以防止需要两次声明环境）？

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

   修改 想出来：environment(func)

2. 有没有办法实现＆＃34;相互依赖＆＃34;我用上面的代码实现了现有的闪亮功能吗？

3. 只是一个＆＃34;遥远的＆＃34;没有特定用例的想法：是否有可能让观察到的变量同时存在于不同的环境中，并且reactive()仍能正确识别它们？

再次感谢，乔！