Here's a small example to illustrate my issue. My real situation involves a dataframe with 14 columns and over 22 million rows...
library(shiny)
library(DT)
library(magrittr)
model <- c("Prius", "Prius", "Prius", "Prius", "Civic", "Civic", "Civic", "Civic",
"Civic Hybrid", "Civic Hybrid", "Civic Hybrid", "Escort", "Escort",
"Escort", "Escort")
assembly <- c("Battery", "Battery", "CVT", "Brakes", "Engine", "Brakes", "Exhaust",
"Transmission", "Battery", "Battery", "Brakes", "Engine", "Exhaust",
"Brakes", "Lights")
part <- c("Cable", "Enclosure", "Paddle", "Paddle", "Cylinder", "Rotor", "Muffler",
"Sensor", "Cable", "Emclosure", "Drum", "Piston", "Muffler", "Disc",
"Bulb")
partNumber <- c(2290, 4755, 3152, 4111, 1754, 2827, 1602, 2622, 1305,
4025, 4034, 1697, 3583, 4608, 1789)
CarDF <- data.frame(model, assembly, part, partNumber)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Minimal Example"),
# Sidebar
sidebarLayout(
sidebarPanel(
tabPanel("Columns",
checkboxGroupInput(inputId = "ColumnsToShow", label = "Output Columns",
choices = names(CarDF),
selected = c("model", "assembly", "part", "partNumber")
)
),
selectInput(inputId = "model",
label = "Model",
choices = unique(CarDF$model)
),
selectInput(inputId = "assembly",
label = "Sub-assembly",
choices = unique(CarDF$assembly))
),
# Show a table
mainPanel(
DT::dataTableOutput("FilteredDataFrame")
)
)
)
server <- function(input, output) {
selectedModel <- reactive({
return(input$model)
})
# Chose a new model, update the list of available assemblies
observeEvent(input$model, {
assembly_choices <- CarDF %>% filter(model == selectedModel()) %>% select(assembly) %>% unique()
updateSelectInput(inputId = "assembly", choices = assembly_choices)
})
#the dataframe to be displayed
filtered_df <- reactive({
tempFrame <- CarDF %>% filter(model == selectedModel()) %>%
filter(assembly == input$assembly) %>% select(all_of(input$ColumnsToShow))
return(tempFrame)}
)
########################################### the main data table
output$FilteredDataFrame <- DT::renderDT(server=TRUE, {datatable(filtered_df(), extensions = 'Buttons',
options = list(scrollx=TRUE,
lengthMenu = c(10,20,30),
paging = TRUE,
searching = TRUE,
fixedColumns = TRUE,
autoWidth = TRUE,
ordering = TRUE,
#dom = 'Bfrtip',
dom = 'tlip',
buttons = c('copy',
'csv',
'excel')
)
)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
This runs and does everything I want for this small example. But when I use this approach on my actual data, I get a warning from R
Warning: The select input (the equivalent of Assembly in the above example) contains a large number of options; consider using server-side selectize for massively improved performance. See the Details section of the ?selectizeInput help topic.
And so I modified the code
library(shiny)
library(DT)
library(magrittr)
model <- c("Prius", "Prius", "Prius", "Prius", "Civic", "Civic", "Civic", "Civic",
"Civic Hybrid", "Civic Hybrid", "Civic Hybrid", "Escort", "Escort",
"Escort", "Escort")
assembly <- c("Battery", "Battery", "CVT", "Brakes", "Engine", "Brakes", "Exhaust",
"Transmission", "Battery", "Battery", "Brakes", "Engine", "Exhaust",
"Brakes", "Lights")
part <- c("Cable", "Enclosure", "Paddle", "Paddle", "Cylinder", "Rotor", "Muffler",
"Sensor", "Cable", "Emclosure", "Drum", "Piston", "Muffler", "Disc",
"Bulb")
partNumber <- c(2290, 4755, 3152, 4111, 1754, 2827, 1602, 2622, 1305,
4025, 4034, 1697, 3583, 4608, 1789)
CarDF <- data.frame(model, assembly, part, partNumber)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Minimal Example"),
# Sidebar
sidebarLayout(
sidebarPanel(
tabPanel("Columns",
checkboxGroupInput(inputId = "ColumnsToShow", label = "Output Columns",
choices = names(CarDF),
selected = c("model", "assembly", "part", "partNumber")
)
),
selectInput(inputId = "model",
label = "Model",
choices = unique(CarDF$model)
),
#selectInput(inputId = "assembly",
# label = "Sub-assembly",
# choices = unique(CarDF$assembly))
selectizeInput(inputId = "assembly",
label = "Sub-assembly",
choices = NULL),
),
# Show a table
mainPanel(
DT::dataTableOutput("FilteredDataFrame")
)
)
)
server <- function(input, output) {
selectedModel <- reactive({
return(input$model)
})
# Chose a new model, update the list of available assemblies
observeEvent(input$model, {
assembly_choices <- CarDF %>% filter(model == selectedModel()) %>% select(assembly) %>% unique()
#updateSelectInput(inputId = "assembly", choices = assembly_choices)
updateSelectizeInput(inputId = "assembly", choices = assembly_choices, server = TRUE)
})
#the dataframe to be displayed
filtered_df <- reactive({
tempFrame <- CarDF %>% filter(model == selectedModel()) %>%
filter(assembly == input$assembly) %>% select(all_of(input$ColumnsToShow))
return(tempFrame)}
)
########################################### the main data table
output$FilteredDataFrame <- DT::renderDT(server=TRUE, {datatable(filtered_df(), extensions = 'Buttons',
options = list(scrollx=TRUE,
lengthMenu = c(10,20,30),
paging = TRUE,
searching = TRUE,
fixedColumns = TRUE,
autoWidth = TRUE,
ordering = TRUE,
#dom = 'Bfrtip',
dom = 'tlip',
buttons = c('copy',
'csv',
'excel')
)
)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
Basically just making these two changes: In the UI
#selectInput(inputId = "assembly",
# label = "Sub-assembly",
# choices = unique(CarDF$assembly))
selectizeInput(inputId = "assembly",
label = "Sub-assembly",
choices = NULL),
And in the server
observeEvent(input$model, {
assembly_choices <- CarDF %>% filter(model == selectedModel()) %>% select(assembly) %>% unique()
#updateSelectInput(inputId = "assembly", choices = assembly_choices)
updateSelectizeInput(inputId = "assembly", choices = assembly_choices, server = TRUE)
})
And this is where I get really confused. In this example, the app runs but the selectizeInput for assembly is always blank. In my larger app with the equivalent changes, it crashes at the equivalent of this line
tempFrame <- CarDF %>% filter(model == selectedModel()) %>%
filter(assembly == input$assembly) %>% select(all_of(input$ColumnsToShow))
With an error message that equates to
Warning: Error in filter: ℹ In argument:
assembly == input$assembly. Caused by error: !..1must be of size 187999 or 1, not size 0.
I changed the names to match the example, the size numbers relate to my larger dataset. The size 0 leads me to think there isn't a value yet for input$assembly?
I tried using the selected parameter in the updateSelectizeInput to just select the first option, but that didn't make a difference.
I'm not sure how to proceed at this point. I feel like there's probably something very simple I'm missing.
A couple of things:
You need to update the selectize immediately. Per the docs, you can do this by itself (not in observe/reactive, dependent on nothing, fires once only). (This may not be strictly required in this one case, tbh, since you update it fairly quickly. I'm including this here in case there are server-size selectize questions where the choices are not instantly dynamically updated via another block.)
Your observeEvent(input$model, ..) is creating assembly_choices but it is a data.frame whereas choices= needs a vector. You can see this for yourself by adding browser() in that block and run your app. This is simple, just use assembly_choices$assembly or you can pull() it.
Add the first line and replace the appropriate observeEvent code with this:
updateSelectizeInput(inputId = "assembly", choices = unique(CarDF$assembly), server = TRUE)
# Chose a new model, update the list of available assemblies
observeEvent(input$model, {
assembly_choices <- CarDF %>% filter(model == selectedModel()) %>% select(assembly) %>% unique() %>% pull(assembly)
updateSelectizeInput(inputId = "assembly", choices = assembly_choices, server = TRUE)
})