根据 Shiny 中的用户输入动态更改绘图

Question

我正在尝试创建一个闪亮的应用程序，该应用程序根据用户选择的已加载数据帧的子集生成绘图。例如，我有以下数据集：

library(shiny)
library(data.table)

df <- rbind(
  data.table( cat = rep('X', 40), grp = rep(LETTERS[1:4], each=10), x = rep(1:10, times=4), y = rnorm(40) ),
  data.table( cat = rep('Y', 30), grp = rep(LETTERS[1:3], each=10), x = rep(1:10, times=3), y = rnorm(30) ),  
  data.table( cat = rep('Z', 20), grp = rep(LETTERS[4:6], each=10), x = rep(1:10, times=2), y = rnorm(20) )
)

根据用户在 UI 中选择的cat 的值，我希望闪亮为grp 的每个值生成图表。因此，如果用户选择“X”，则将生成 4 个图；如果他们选择 'Y' 就会有 3 个，如果他们选择 'Z' 就会有 3 个。

我还想指定如何根据grp 的值生成每个图表。因此，如果 grp 是 A、D 或 E，我希望它生成一个线图，否则它应该生成一个散点图（当然，只有当 grp 具有该值时）。

以下是我的（损坏的）闪亮应用的代码：

server <- function(input, output) {

  rv <- reactiveValues(
    i  = NULL,
    df = NULL
  )

  observe({ rv$i <- input$i })

  observe({ rv$df <- df[cat == rv$i] })

  output$test <- renderUI({
    plotList <- lapply( LETTERS[1:6], function(x) plotOutput(x) )

    do.call( tagList, unlist(plotList, recursive=FALSE))
  })

  for(i in LETTERS[1:6]){
    local({
      my_i <- i

      output[[my_i]] <- renderPlot({
        if( my_i %in% c('A','D','E')) {
          with(rv$df[grp == my_i], plot(x,y, type='l'))
        } else {
          with(rv$df[grp == my_i], plot(x,y))
        }
      })
    })
  }

}

ui <- fluidPage(
  titlePanel('Title'),

  sidebarLayout(
    sidebarPanel(
      helpText('Select the Category you would like to view.'),

      selectInput('i', 'Category', c('X','Y','Z'), selectize=TRUE)
    ),

    mainPanel(
      uiOutput('test')
    )
  )
)

shinyApp(ui, server)

Answer 1

可在底部找到可重现的示例。

一些提示：

1) 使用反应式上下文：

在服务器代码底部的 for 循环中，您使用的是反应变量 rv，因此您必须在反应内容中运行代码。所以把它包装在observe()中。

2) 创建输出列表：

如果我没记错的话，你在这个答案中使用了一些代码：dynamically add plots to web page using shiny。

这是一个很好的起点。对于 taglist 的部分，它可能更容易简化为：

output$test <- renderUI({
    lapply(unique(rv$df$grp), plotOutput)
})

你也可以加tagList()，不过这里没必要，...

3) 修正样本数据：

您可能想要更新 df 变量：

  data.table(cat = rep('Z', 20), grp = rep(LETTERS[4:6], each=10), 
             x = rep(1:10, times=2), y = rnorm(20) )

这里有三个字母，因此您可以将其更改为 LETTERS[5:6] 或更新其他数字。

完整的可重现示例：

library(shiny)
library(data.table)

df <- rbind(
  data.table( cat = rep('X', 40), grp = rep(LETTERS[1:4], each=10), x = rep(1:10, times=4), y = rnorm(40) ),
  data.table( cat = rep('Y', 30), grp = rep(LETTERS[1:3], each=10), x = rep(1:10, times=3), y = rnorm(30) ),  
  data.table( cat = rep('Z', 30), grp = rep(LETTERS[4:6], each=10), x = rep(1:10, times=3), y = rnorm(30) )
)
server <- function(input, output) {

  rv <- reactiveValues(
    i  = NULL,
    df = NULL
  )

  observe({ rv$i <- input$i })

  observe({ rv$df <- df[cat == rv$i] })

  observe({
    for(letter in unique(rv$df$grp)){
      local({
        let <- letter
        output[[let]] <- renderPlot({
          if( let %in% c('A','D','E')) {
            with(rv$df[grp == let], plot(x, y, type='l'))
          } else {
            with(rv$df[grp == let], plot(x,y))
          }
        })
      })
    }
  })

  output$test <- renderUI({
    lapply(unique(rv$df$grp), plotOutput)
  })

}

ui <- fluidPage(
  titlePanel('Title'),
  sidebarLayout(
    sidebarPanel(
      helpText('Select the Category you would like to view.'),
      selectInput('i', 'Category', c('X','Y','Z'), selectize=TRUE)
    ),

    mainPanel(
      uiOutput('test')
    )
  )
)

shinyApp(ui, server)