Bugs with large dataframe filters & view in R shiny

Question

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 ?

Thanks

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, "filter3", choices = c("All", df1$letters), selected = input$filter3)
    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

Answer 1

I replaced your selectInputs with pickerInputs from the shinyWidgets package and it runs much quicker - it's not fast but it works. I made a few other changes like not updating on startup:

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

# 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,
                     pickerInput("filter1", "Filter 1", multiple = TRUE, choices = unique(df$LETTERS), options = list(`actions-box` = TRUE)),
                     pickerInput("filter2", "Filter 2", multiple = TRUE, choices = unique(df$Numbers), options = list(`actions-box` = TRUE)),
                     pickerInput("filter3", "Filter 3", multiple = TRUE, choices = unique(df$letters), options = list(`actions-box` = TRUE))),

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

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


    goButton <- reactive({
        # Data

        df1 <- df

        if(length(input$filter1)+length(input$filter2)+length(input$filter3) == 0) {
            if(!is.null(isolate(input$tableprint_rows_current))){
                updatePickerInput(session, "filter1", choices = unique(df1$LETTERS), selected = input$filter1)
                updatePickerInput(session, "filter2", choices = unique(df1$Numbers), selected = input$filter2)
                updatePickerInput(session, "filter3", choices = unique(df1$letters), selected = input$filter3)
            }
            return(df1)
        }

        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.
            updatePickerInput(session, "filter2", choices = unique(df1$Numbers), selected = input$filter2)
            updatePickerInput(session, "filter3", choices = unique(df1$letters), selected = input$filter3)
        }


        if (length(input$filter2)){
            df1 <- df1[which(df1$Numbers %in% input$filter2),]

            updatePickerInput(session, "filter1", choices = unique(df1$LETTERS), selected = input$filter1)
            updatePickerInput(session, "filter3", choices = unique(df1$letters), selected = input$filter3)
        }


        if (length(input$filter3)){
            df1 <- df1[which(df1$letters %in% input$filter3),]

            updatePickerInput(session, "filter1", choices = unique(df1$LETTERS), selected = input$filter1)
            updatePickerInput(session, "filter2", choices = unique(df1$Numbers), selected = input$filter2)
        }


        return(df1)
    })

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

    })
}

shinyApp(ui, server)