Reputation: 51
I am developing a data selection component for my shiny App. The input is a data.frame. Then there is a dynamic data selection UI (implemented by renderUI() ) for users to choose data by different columns. By default, I would expect the data are completely selected thus I set the selected parameters of checkboxGroupInput() as all values.
However, since the reactive expression is lazy evaluated , the data table will be really completed only after every UI component are rendered by renderUI(). That means even though I know by default all rows are selected, I still need to click through the selectInput() choices for initializing the values which will be provided by renderUI.
I am wondering that is what is the way to implement such data selection component UI in shiny ?
The run example code is here:
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)
Upvotes: 4
Views: 1116
Reputation: 25385
The problem is that the checkboxGroupInput returns both NULL
when initialized, and when no selections have been made. This makes it difficult to distinguish based on that value alone. Below is a way to fix that, with a reactiveValues
that is NULL when not initialized, and '' when all options are deselected.
Note that there is one more issue (or is it on purpose? with your script, and that is that every time you go from input A
to B
, you are recreating the entire cellsCheckBox
, and thus every checkboxGroupInput
is initialized again too! So when you go from A
, deselec options there, to B
and back to A
, the checkboxGroupInput
A again has all values selected. Maybe a tabSetPanel is better suited for your case?
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)
Upvotes: 1