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
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)
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments