R Shiny将被动值分配给粘贴的对象

时间:2017-06-08 11:17:05

标签: r shiny lapply reactive

我正在构建一个由多个重复输入和输出填充的Shiny应用程序。我不是一遍又一遍地复制和粘贴代码,而是跟随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
)

1 个答案:

答案 0 :(得分:0)

以下是使用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)