r - 初始化将由 renderUI 生成的值

Question

我正在为我 Shiny 的应用程序开发数据选择组件。
输入是一个 data.frame。
然后有一个动态数据选择 UI(由 renderUI() 实现)供用户按不同的列选择数据。
默认情况下，我希望数据被完全选中，因此我将 checkboxGroupInput() 的选定参数设置为所有值。

但是，由于响应式表达式是惰性求值的，数据表只有在每个 UI 组件都被 renderUI() 渲染后才会真正完成。这意味着即使我知道默认情况下所有行都被选中，我仍然需要单击 selectInput() 选项来初始化将由 renderUI 提供的值。

我想知道在 Shiny 中实现此类数据选择组件 UI 的方法是什么？

运行示例代码在这里:

library(dplyr)
library(shiny)
set.seed(319)
df <- data.frame(A = sample(c("aa", "ab", "ac"), 100, T), 
             B = sample(c("ba", "bb", "bc"), 100, T), 
             C = sample(c("ca", "cb", "cc"), 100, T))

ui <-  fluidPage(
  titlePanel("Dynamically generated user interface components"),
  fluidRow(column(12,
          selectInput("cellsVars",
                      label = "Cell Attributes",
                      choices = c("A", "B", "C")),
          uiOutput("cellsCheckBox")
  ),
 fluidRow(column(12,
          dataTableOutput("table"))
       )
 )
)

server <- function(input, output) {
 output$cellsCheckBox <- renderUI({
 if(is.null(input$cellsVars) ) return()

switch(input$cellsVars,
       "A"      = wellPanel(
         checkboxGroupInput("A", label = "Donors",
                            choices = c("aa", "ab", "ac"),
                            selected = c("aa", "ab", "ac") )
       ),
       "B"   = wellPanel(
         checkboxGroupInput("B", label = "Tissue",
                            choices = c("ba", "bb", "bc"),
                            selected = c("ba", "bb", "bc"))
       ),
       "C"  = wellPanel(
         checkboxGroupInput("C", label = "Annotated Cell Type",
                            choices = c("ca", "cb", "cc"),
                            selected = c("ca", "cb", "cc"))
       )
  )
  })

  output$table <- renderDataTable({
    filtered <- df %>%  filter( (A %in% input$donors) & (B %in%    input$tissueType) & (C %in% input$cellType))
filtered
  })
}

Shiny 应用程序(用户界面，服务器)

Answer 1

问题是 checkboxGroupInput 在初始化和没有选择时都返回 NULL 。这使得仅根据该值难以区分。下面是一种解决此问题的方法，reactiveValues 在未初始化时为 NULL，在取消选择所有选项时为 ''。

请注意，还有一个问题(或者是故意的？与您的脚本有关，那就是每次从输入 A 到 B 时，您都在重新创建整个 cellsCheckBox ，因此每个 checkboxGroupInput 再次初始化时!你从 A ，那里的 deselec 选项到 B 再回到 A ， checkboxGroupInput A 再次选择了所有值。也许 tabSetPanel 更适合你的情况？

library(dplyr)
library(shiny)
set.seed(319)
df <- data.frame(A = sample(c("aa", "ab", "ac"), 100, T), 
                 B = sample(c("ba", "bb", "bc"), 100, T), 
                 C = sample(c("ca", "cb", "cc"), 100, T))

ui <-  fluidPage(
  titlePanel("Dynamically generated user interface components"),
  fluidRow(column(12,
                  selectInput("cellsVars",
                              label = "Cell Attributes",
                              choices = c("A", "B", "C")),
                  uiOutput("cellsCheckBox")
  ),
  fluidRow(column(12,
                  dataTableOutput("table"))
  )
  )
)

server <- function(input, output) {
  output$cellsCheckBox <- renderUI({
    if(is.null(input$cellsVars) ) return()

    switch(input$cellsVars,
           "A"      = wellPanel(
             checkboxGroupInput("A", label = "Donors",
                                choices = c("aa", "ab", "ac"),
                                selected = c("aa", "ab", "ac") )
           ),
           "B"   = wellPanel(
             checkboxGroupInput("B", label = "Tissue",
                                choices = c("ba", "bb", "bc"),
                                selected = c("ba", "bb", "bc"))
           ),
           "C"  = wellPanel(
             checkboxGroupInput("C", label = "Annotated Cell Type",
                                choices = c("ca", "cb", "cc"),
                                selected = c("ca", "cb", "cc"))
           )
    )
  })

  selections = reactiveValues(A=NULL,B=NULL,C=NULL)
  lapply(c('A','B','C'), function(x) {
    observeEvent(input[[x]],ignoreInit = T,{
      selections[[x]] <- ifelse(is.null(input[[x]]),'',input[[x]])}
    )
  })

  output$table <- renderDataTable({
    if(!is.null(selections$A))
      df <- df %>% filter(A %in% input$A)
    if(!is.null(selections$B))
      df <- df %>% filter(B %in% input$B)
    if(!is.null(selections$C))
      df <- df %>% filter(C %in% input$C)
    df
  })
}
shinyApp(ui, server)