Bugs with large dataframe filters & view in R shiny

I'm trying do make a shiny application with interdependant selectInput() , it seems to work fine with a "little" dataframe but crash with a "large" dataframe. Here is my example, with two dataframes : First, you can launch the application with the two dataframe, just comment the one you dont want to show in output. Is it a problem with performance, I have to use data.table ? or it's updateSelectInput() functions problem ?

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

# df <- tibble(LETTERS = rep(LETTERS, 2), Numbers = as.character(1:52),
#              letters = paste(LETTERS, Numbers, sep = ""))

df <- tibble(LETTERS = rep(LETTERS, 1000), Numbers = as.character(1:(26*1000)),
             letters = paste(LETTERS, Numbers, sep = ""))

ui <- fluidPage(

  titlePanel("Title"),

  sidebarLayout(
    sidebarPanel(width=3,
                 selectInput("filter1", "Filter 1", multiple = TRUE, choices = c(unique(df$LETTERS))),
                 selectInput("filter2", "Filter 2", multiple = TRUE, choices = c(unique(df$Numbers))),
                 selectInput("filter3", "Filter 3", multiple = TRUE, choices = c(unique(df$letters)))),

    mainPanel(
      DT::dataTableOutput("tableprint")
    )
  )
)

server <- function(input, output, session) {


  goButton <- reactive({
    # Data

    df1 <- df

    if (length(input$filter1)){
      df1 <- df1[which(df1$LETTERS %in% input$filter1),]
    }

    # Update selectInput choices based on the filtered data. Update 'selected' to reflect the user input.
    updateSelectInput(session, "filter1", choices = c("All", df$LETTERS), selected = input$filter1)
    updateSelectInput(session, "filter2", choices = c("All", df1$Numbers), selected = input$filter2)



    if (length(input$filter2)){
      df1 <- df1[which(df1$Numbers %in% input$filter2),]
    }
    updateSelectInput(session, "filter3", choices = c("All", df1$letters), selected = input$filter3)
    updateSelectInput(session, "filter1", choices = c("All", df1$LETTERS), selected = input$filter1)

    if (length(input$filter3)){
      df1 <- df1[which(df1$letters %in% input$filter3),]
    }
    updateSelectInput(session, "filter1", choices = c("All", df1$LETTERS), selected = input$filter1)
    updateSelectInput(session, "filter2", choices = c("All", df1$Numbers), selected = input$filter2)


    datatable(df1)
  })

  output$tableprint <- DT::renderDataTable({
    goButton()

  })
}

shinyApp(ui, server)

I tried the same example with a textOutput() function to show dimension of the output dataframe and get some issues, I think it's a bug with the updateSelectInput function

26K rows is not large enough to cause a slow down in tibble.
its that there's too many choices in the select inputs.
you're asking the web browser to render 26K options in the dropdown menu.
maybe shiny is adding to that overhead but i would bet that's the root of the problem.

also, look at your updateSelectInput( .... choices=c("All", df$LETTERS ... and similar lines.
make sure that's what you really want and not unique(df$LETTERS).

1 Like

Thanks @lexy009, 26k option is too large for a browser ? But a select input doesnt show all the modalities only some of them isnt it ?
I compared this solution with below solution and I noticed that the updateselectinput() function is not adapted in my case :slight_smile:

I tried this with a different exemple seems to work but not really beautiful .. do you think I can improve this ?

df <- structure(list(Continent = c("Africa", "Africa", "Asia", "Asia",
"Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Asia",
"Asia", "Asia", "Asia", "Asia", "Asia", "Asia", "Europe", "Europe",
"Europe", "Europe", "Europe", "Europe", "Europe", "Europe", "Europe",
"Europe", "Europe", "Europe", "Europe", "Europe", "Europe", "Europe",
"Europe", "Europe", "Europe", "Europe", "Europe", "Europe", "Europe",
"Europe", "Europe", "North America", "North America", "North America",
"North America", "North America", "North America", "North America",
"North America", "North America", "North America", "North America",
"North America", "North America", "North America", "North America",
"North America", "North America", "North America", "North America",
"Oceania", "Oceania", "Oceania", "Oceania", "Oceania", "Oceania",
"Oceania", "Oceania", "Oceania", "Oceania", "Oceania", "Oceania",
"Oceania", "Oceania", "South America", "South America", "South America",
"South America", "South America", "South America", "South America",
"South America", "South America", "South America", "South America",
"South America"), Country = c("Algeria", "Angola", "India", "India",
"India", "India", "India", "India", "India", "India", "Cambodia",
"Iraq", "Israel", "Japan", "Jordan", "Pakistan", "Philippines",
"Qatar", "Belgium", "Bosnia and Herzegovina", "Bulgaria", "Croatia",
"Cyprus", "Czech Republic", "Denmark", "Estonia", "Finland",
"France", "Georgia", "Monaco", "Montenegro", "Netherlands", "Norway",
"Poland", "Portugal", "Romania", "San Marino", "Serbia", "Slovakia",
"Slovenia", "Spain", "Sweden", "Switzerland", "United States",
"United States", "United States", "United States", "United States",
"United States", "United States", "United States", "United States",
"United States", "United States", "United States", "United States",
"United States", "Panama", "Saint Kitts and Nevis", "Saint Lucia",
"Saint Vincent and the Grenadines", "Trinidad and Tobago", "Australia",
"Fiji", "Kiribati", "Marshall Islands", "Micronesia", "Nauru",
"New Zealand", "Palau", "Papua New Guinea", "Samoa", "Solomon Islands",
"Tonga", "Tuvalu", "Vanuatu", "Argentina", "Bolivia", "Brazil",
"Chile", "Colombia", "Ecuador", "Guyana", "Paraguay", "Peru",
"Suriname", "Uruguay", "Venezuela"), State = c("State_Algeria",
"State_Angola", "Andhra Pradesh", "Arunachal Pradesh", "Assam",
"Bihar", "Chhattisgarh", "Goa", "Gujarat", "Haryana", "State_Cambodia",
"State_Iraq", "State_Israel", "State_Japan", "State_Jordan",
"State_Pakistan", "State_Philippines", "State_Qatar", "State_Belgium",
"State_Bosnia and Herzegovina", "State_Bulgaria", "State_Croatia",
"State_Cyprus", "State_Czech Republic", "State_Denmark", "State_Estonia",
"State_Finland", "State_France", "State_Georgia", "State_Monaco",
"State_Montenegro", "State_Netherlands", "State_Norway", "State_Poland",
"State_Portugal", "State_Romania", "State_San Marino", "State_Serbia",
"State_Slovakia", "State_Slovenia", "State_Spain", "State_Sweden",
"State_Switzerland", "Alabama", "Alaska", "Arizona", "Arkansas",
"California", "Colorado", "Connecticut", "Delaware", "District of Columbia",
"Florida", "Georgia", "Hawaii", "Idaho", "Iowa", "State_Panama",
"State_Saint Kitts and Nevis", "State_Saint Lucia", "State_Saint Vincent and the Grenadines",
"State_Trinidad and Tobago", "State_Australia", "State_Fiji",
"State_Kiribati", "State_Marshall Islands", "State_Micronesia",
"State_Nauru", "State_New Zealand", "State_Palau", "State_Papua New Guinea",
"State_Samoa", "State_Solomon Islands", "State_Tonga", "State_Tuvalu",
"State_Vanuatu", "State_Argentina", "State_Bolivia", "State_Brazil",
"State_Chile", "State_Colombia", "State_Ecuador", "State_Guyana",
"State_Paraguay", "State_Peru", "State_Suriname", "State_Uruguay",
"State_Venezuela"), Population = c(436315, 322788, 84665533,
1382611, 31169272, 103804637, 25540196, 1457723, 60383628, 25353081,
943256, 91267, 536097, 420799, 287888, 980889, 792094, 702230,
334450, 118410, 515967, 398281, 659918, 216675, 133583, 176648,
131878, 941740, 860759, 783373, 188232, 835066, 59606, 992782,
377751, 720217, 982980, 56697, 644305, 391579, 352490, 143215,
90170, 817644, 743157, 572583, 595467, 749073, 527312, 914680,
843229, 978792, 589096, 705171, 750524, 579311, 566931, 800722,
427156, 753354, 153684, 557458, 987445, 675226, 115191, 664896,
619308, 274021, 363655, 85848, 66679, 513121, 427450, 985883,
250922, 406122, 379940, 790470, 300293, 106926, 383729, 851993,
860519, 607444, 776975, 961911, 769912, 979218)), row.names = c(NA, -88L), class = c("tbl_df", "tbl", "data.frame"))

library(shiny)
library(readxl)
library(shinydashboard)
library(dplyr)
library(DT)

is.not.null <- function(x) !is.null(x)

header <- dashboardHeader(
title = "Test",
dropdownMenu(type = "notifications",
notificationItem(
text = "RAS",
icon("cog", lib = "glyphicon")
)
)
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Data", tabName = "ShowData", icon = icon("dashboard")),
menuItem("Summary", tabName = "ShowSummary", icon = icon("bar-chart-o"))
)
)

body <- dashboardBody(
tabItems(
tabItem(tabName = "ShowData",
DT::dataTableOutput("table")
),
tabItem(tabName = "ShowSummary",
box(width =3,
h3("Test"),
helpText("Please Continent, Country and State Combition"),
uiOutput("continent"),
uiOutput("country"),
uiOutput("state")
),

        box(width =9,
            DT::dataTableOutput("table_subset")
        )
)

)
)

ui = dashboardPage(
header,
sidebar,
body
)

################################################
################################################

server = shinyServer(function(input,output){

data <- bind_rows(replicate(5500, df, simplify = FALSE))

output$table <- DT::renderDataTable({
if(is.null(data)){return()}
DT::datatable(data, options = list(scrollX = T))
})

output$continent <- renderUI({
selectInput(inputId = "Continent", "Select Continent",choices = c("all", var_continent()), multiple = T)
})
output$country <- renderUI({
selectInput(inputId = "Country", "Select Country",choices = c("all", var_country()), multiple = T)
})
output$state <- renderUI({
selectInput(inputId = "State", "Select State",choices = c("all", var_state()), multiple = T)
})

var_continent <- reactive({
file1 <- data
if(is.null(data)){return()}
as.list(c("all", unique(file1$Continent)))
})

continent_function <- reactive({
file1 <- data
continent <- input$Continent
continent <<- input$Continent
if (is.null(continent)){
return(file1)
} else {
file2 <- file1 %>%
filter(Continent %in% continent)
return (file2)
}

})

var_country <- reactive({
file1 <- continent_function()
continent <- input$Continent
file2 <- data

if(is.null(continent)){
  as.list(unique(file2$Country))
} else {
  as.list(unique(file1$Country))
}

})

country_function <- reactive({
file1 <- data
country <- input$Country
country <<- input$Country
if (is.null(country)){
return(file1)
} else {
file2 <- file1 %>%
filter(Country %in% country)
return (file2)
}

})

var_state <- reactive({
file1 <- country_function()
country <- input$Country
file2 <- data

if(is.null(country)){
  as.list(unique(file2$State))
} else {
  as.list(unique(file1$State))
}

})

state_function <- reactive({
file1 <- data
state <- input$State
state <<- input$State
if (is.null(state)){
return(file1)
} else {
file2 <- file1 %>%
filter(State %in% state)
return (file2)
}

})

df <- reactive({

file1 <- data
continent <- input$Continent
country <- input$Country
state <- input$State

if (is.null(continent) & is.not.null(country) & is.not.null(state)){
  file2 <- file1 %>%
    filter(Country %in% country, State %in% state)
} else if (is.null(country) & is.not.null(continent) & is.not.null(state)){
  file2 <- file1 %>%
    filter(State %in% state, Continent %in% continent)
} else if (is.null(state) & is.not.null(country) & is.not.null(continent)){
  file2 <- file1 %>%
    filter(Country %in% country, Continent %in% continent)
} else if (is.null(continent) & is.null(country) & is.not.null(state)){
  file2 <- file1 %>%
    filter(State %in% state)
} else if (is.null(continent) & is.null(state) & is.not.null(country)){
  file2 <- file1 %>%
    filter(Country %in% country)
} else if (is.null(country) & is.null(state) & is.not.null(continent)){
  file2 <- file1 %>%
    filter(Continent %in% continent)
} else {
  file2 <- file1 %>%
    filter(Country %in% country, State %in% state, Continent %in% continent)
}
file2

})

output$table_subset <- DT::renderDataTable({
# validate(
# need(input$Continent, 'Check that'),
# need(input$Country, 'Please choose :)')
# need(input$State, 'Please choose :D')
# )
DT::datatable(df(), options = list(scrollX = T))

})

})

shinyApp(ui, server)