CODEWITHSUNDEEP
rshinyselectize.js
jerH
jerH

Reputation: 1299

Default values for R Shiny selectizeInput

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: ! ..1 must 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.

Upvotes: 1

Views: 124

Answers (1)

r2evans
r2evans

Reputation: 160607

A couple of things:

  1. 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.)

  2. 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)
  })

Upvotes: 1

Related Questions