初始化将由renderUI生成的值

时间:2018-01-29 12:45:18

标签: r shiny

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

但是,由于反应式表达式是惰性计算的,因此只有在每个UI组件由renderUI()呈现之后,数据表才会真正完成。这意味着即使我知道默认选择了所有行,我仍然需要点击selectInput()选项来初始化由renderUI提供的值。

我想知道在光泽中实现这样的数据选择组件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
  })
}

shinyApp(ui,server)

1 个答案:

答案 0 :(得分:1)

问题是checkboxGroupInput在初始化时返回NULL,并且没有做出选择。这使得难以仅基于该值进行区分。下面是一种解决方法,reactiveValues在未初始化时为NULL,并且&#39;&#39;&#39;取消选择所有选项时。

请注意,还有一个问题(或者是故意的?使用您的脚本,也就是每次从输入A转到B时,您正在重新创建整个cellsCheckBox 1}},因此每个checkboxGroupInput也会被重新初始化!所以当你从A,deselec选项到B再回到A时,{checkboxGroupInput 1}} 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)