R Shiny 将反应值分配给粘贴的对象答案

【问题标题】：R Shiny assign reactive values to a pasted objectR Shiny 将反应值分配给粘贴的对象
【发布时间】：2017-06-08 11:17:04
【问题描述】：

我正在构建一个由多个重复输入和输出填充的 Shiny 应用程序。我没有一遍又一遍地复制和粘贴代码，而是按照this example on the Shiny website 使用lapply() 生成输入和输出。这在一定程度上效果很好，但我想根据用户输入进行预测，然后将这些预测存储为反应性对象，以供众多输出调用（例如，绘图、打印和组合预测）。在这里，lapply() 函数中反应对象的分配似乎有问题。我感觉assign()函数不喜欢reactive()对象！

我在下面使用mtcars 编写了一个简单的工作示例来解决我的问题。这段代码工作正常，但我想放弃 pred1 和 pred2 的显式分配并替换为 lapply() 函数。我知道，在这个简单的示例中，在output$out 对象内进行预测会更容易，但在我的实际应用程序中，我需要将预测的对象调用到多个输出中。任何帮助将不胜感激。

library(shiny)
ui = fluidPage(
      # slider input for horse power to predict with...
      column(3,lapply(1:2, function(i) {
        sliderInput(paste0('hp', i), paste0('Select HP', i), min = 0, max = 300, value = 50)
      })
    ),

      # output display
      column(3,lapply(1:2, function(i) {
        uiOutput(paste0('out', i))
      })
    )

)

server = function(input, output, session) {

 # # I can work pred out separately like this...
 # pred1 <- reactive({
 #     predict(lm(mpg ~ hp, data = mtcars),
 #             newdata = data.frame(hp = input$hp1), se.fit = TRUE)
 #
 # })
 #
 # pred2 <- reactive({
 #   predict(lm(mpg ~ hp, data = mtcars),
 #           newdata = data.frame(hp = input$hp2), se.fit = TRUE)
 #
 #})

  # but I want to create pred1 and pred2 in one go...something like this:
  lapply(1:2, function(i){
     assign(paste0("pred",i), reactive({
       predict(lm(mpg ~ hp, data = mtcars),
               newdata = data.frame(hp = input[[paste0("hp",i)]]), se.fit = TRUE)
       }))
   })

  # output
  lapply(1:2, function(i){
    output[[paste0("out",i)]] <- renderText({
      paste0("MPG with HP",i," = ", round(get(paste0("pred",i))()$fit,0), " (", 
                   round(get(paste0("pred",i))()$fit - 1.96 * get(paste0("pred",i))()$se.fit,0), ", ",
                   round(get(paste0("pred",i))()$fit + 1.96 * get(paste0("pred",i))()$se.fit,0), ")")

      })
      })

}


# Compile
shinyApp(
  ui = ui,
  server = server
)

【问题讨论】：

我认为最好的方法是在reactiveValues() 中创建一个list() 并将它们分配到列表中，就像你在闪亮的外面做的那样，...
你没有提到任何错误或不想要的结果。
谢谢，我已经编辑产生一个错误，工作代码被注释掉了。这篇文章是关于效率而不是错误修复，很抱歉造成混乱。

标签： r shiny lapply reactive

【解决方案1】：

这是使用 reactiveValues() 的解决方案：

library(shiny)
ui = fluidPage(
  # slider input for horse power to predict with...
  column(3,lapply(1:2, function(i) {
    sliderInput(paste0('hp', i), paste0('Select HP', i), min = 0, max = 300, value = 50)
  })
  ),

   #output display
   column(3,lapply(1:2, function(i) {
     uiOutput(paste0('out', i))
   })
   )
)

server = function(input, output, session) {
   predReactive <- reactiveValues()

   outOjbects <- paste("pred", paste(1:2), sep = "")

   lapply(1:2, function(i){
     predReactive[[outOjbects[i]]] <- reactive({
       predict(lm(mpg ~ hp, data = mtcars),
               newdata = data.frame(hp = input[[paste0("hp",i)]]), se.fit = TRUE) 
     })
   })

  # output
   lapply(1:2, function(i){
     output[[paste0("out",i)]] <- renderText({
       paste0("MPG with HP",i," = ", round(predReactive[[outOjbects[i]]]()$fit,0), " (", 
              round(predReactive[[outOjbects[i]]]()$fit - 1.96 * predReactive[[outOjbects[i]]]()$se.fit,0), ", ",
              round(predReactive[[outOjbects[i]]]()$fit + 1.96 * predReactive[[outOjbects[i]]]()$se.fit,0), ")")

     })
   })

}


shinyApp(ui = ui, server = server)

【讨论】：