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

R Shiny assign reactive values to a pasted object

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

我在下面使用 mtcars 编写了一个简单的工作示例来解决我的问题。这段代码工作正常,但我想放弃 pred1pred2 的显式分配并替换为 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() 的解决方案:

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)