Shiny app crashing when I expand data selection

Posit Professional & Hosted Products shinyapps.io
1

I have posted a variation of this script before with other issues that have now been solved, but I'm still dealing with a final issue relating to the apps ability to handle larger datasets.

If I run everything locally, it works fine. A little slow and laggy, but gets the job done. The issue arises when I push it to my Shiny Server.

While it successfully deploys, you will notice that if you do the following, you get an error message:

  1. Move the age range slider from 18-20 to 18-45
  2. Move the score threshold slider from 35 to 0.

If you do those things, it should give this error message:

enter image description here

How can I better optimize my script to handle this? I'm assuming it has to do with the size of the data set I'm working with (3M rows), but I've used other Shiny apps in the past with larger datasets that work fine.

First, here is the reproducible data in the global.R file:

library(dbplyr)
library(dplyr)
library(shiny)
library(DT)

df <- read.csv("https://raw.githubusercontent.com/datacfb123/testdata/main/canonical_df2.csv")

d <- df
n <- 12
df <- do.call("rbind", replicate(n, d, simplify = FALSE))

Then the server.R file:

  server <- function(input, output, session){
  
  observeEvent(input$data1, {
    if (input$data1 != "All") {
      updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county[df$state == input$data1])))
    } else {
      updateSelectizeInput(session, "data2", "Select County", server = TRUE, choices = c("All", unique(df$county)))
    }
  }, priority = 2)
  
  observeEvent(c(input$data1, input$data2), {
    if (input$data2 != "All") {
      updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city[df$county == input$data2])))
    } else {
      if (input$data1 != "All") {
        updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city[df$state == input$data1])))
      } else {
        updateSelectizeInput(session, "data3", "Select City", server = TRUE, choices = c("All", unique(df$city)))
      }
    }
  }, priority = 1)
  
  filtered_data <- reactive({
    temp_data <- df
    if (input$data1 != "All") {
      temp_data <- temp_data[temp_data$state == input$data1, ]
    }
    if (input$data2 != "All") {
      temp_data <- temp_data[temp_data$county == input$data2, ]
    }
    if (input$data3 != "All") {
      temp_data <- temp_data[temp_data$city == input$data3, ]
    }
    if (input$data4 != "All") {
      temp_data <- temp_data[temp_data$demo == input$data4, ]
    }
    if (input$data5 != "All") {
      temp_data <- temp_data[temp_data$registration_status == input$data5, ]
    }
    
    temp_data %>% filter(temp_data$age >= input$age[1] & temp_data$age <= input$age[2] & temp_data$turnout_score >= input$score)
    
  })
  
  output$table <- renderDT(
    filtered_data() %>% select(unique_id, first_name, last_name, phone)
  )
  
  output$download <- downloadHandler(
    filename = function() {
      paste("universe", "_", date(), ".csv", sep="")
    },
    content = function(file) {
      write.csv(filtered_data() %>% select(unique_id, first_name, last_name, phone) %>% distinct_all(), file, row.names = FALSE)
    }
  )
  
}

And finally, the ui.R file:

ui <- fluidPage(
  titlePanel("Sample"),
  sidebarLayout(
    sidebarPanel(
      selectInput("data1", "Select State", choices = c("All", unique(df$state))),
      selectInput("data2", "Select County", choices = NULL),
      selectInput("data3", "Select City", choices = NULL),
      selectInput("data4", "Select Demo", choices = c("All", unique(df$demo))),
      selectInput("data5", "Select Registration Status", choices = c("All", unique(df$registration_status))),
      sliderInput("age", label = h3("Select Age Range"), 18, 
                  45, value = c(18, 20), round = TRUE, step = 1),
      sliderInput("score", label = h3("Select Score Minimum"), min = 0,
                  max = 100, value = 35),
      downloadButton("download", "Download Data")
    ),
    mainPanel(
      DTOutput("table")
    )
  ))