I have an app with three select inputs, each dependent on the previous input. It appears sometimes the input function and the corresponding plot are rendered twice. I have created a simpler sample with the flights dataset. I'm printing a line to show when the code enters the function to render the UI and then the function to render the plot. Ideally the inputs are created in the first function call and the plot is created, with no subsequent calls to update the input again. I think I need to isolate part of the code but I'm struggling to figure out what that is, I haven't used isolate before. Having "All" as an option for each input also complicates the code, but I need this for my real dashboard.
First, onload it seems to call the input and plot function twice. Other scenarios happen when you select an airline with a certain destination, then switch the airline to an airline that doesn't have that destination and the code needs to default the destination selection to be "all". I'm assuming setting the destination to all is triggering the second round of rendering. I've tried throwing isoloate() around a few different chunks of code with no solution. I may also need to rearrange my code. To recreate the issue you can select Airline "AS", then Origin "EWR" then destination "SEA", the select airline "DL", you'll see "Generating inputs" and "Generating plot" printed twice.
Thoughts? Solutions? Thanks in advance.
I've added a different route I tried with updateSelectInput, see both solutions below. Still working through this.
library(shiny)
library(shinydashboard)
library(tidyverse)
library(plotly)
library(nycflights13)
library(shinyjs)
library(V8)
ui <- dashboardPage(skin = "black",
dashboardHeader(
title="Test App"
),
dashboardSidebar(sidebarMenu(id = "sidebar",
menuItem("Tab One", tabName = "tabOne", icon = icon("heartbeat")),
menuItem("Tab Two", tabName = "tabTwo", icon = icon("warning")),
uiOutput("out_airline_origin_dest")
)),
dashboardBody(
useShinyjs(),
extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-month_select', 'null'); }"),
#extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-month_select', 'null'); }"),
tabItems(
tabItem(tabName = "tabOne",
shiny::column(width = 6,
plotOutput("flight_delay_plot")
)
),
tabItem(tabName = "tabTwo",
tabsetPanel(id = "tab_two_tabs",
tabPanel(
title = "Month Data",
value = "month_data",
fluidPage(
shiny::column(width = 2,
selectInput("month","Month: ", unique(nycflights13::flights$month))
),
shiny::column(width = 5,
plotlyOutput("plot1")
),
shiny::column(width = 5,
plotlyOutput("plot2")
)
)
),
tabPanel(
title = "Airline Orign",
value = "airline_origin",
fluidPage(
shiny::column(width = 12,
"Don't show destination drop down")
)
)
)
)
)
)
)
server <- function(input, output, session) {
output$out_airline_origin_dest <- renderUI({
input_data <- nycflights13::flights
print(paste0("Generating inputs"))
input_data_origin <- input_data
if (!is.null(input$input_airline) && input$input_airline != "All") {
input_data_origin <- input_data %>% filter(carrier == input$input_airline)
}
input_data_dest <- input_data_origin
if (!is.null(input$input_origin) && input$input_origin != "All") {
input_data_dest <- input_data_dest %>% filter(origin == input$input_origin)
}
selected_airline <- if(is.null(input$input_airline)) { "All" } else { input$input_airline }
selected_origin <- if(is.null(input$input_origin)) { "All" } else { input$input_origin }
selected_dest <- if(is.null(input$input_dest)) { "All" } else { input$input_dest }
#isolate({
list(
selectInput("input_airline", "Airline:", c("All",sort(unique(input_data$carrier))),selected_airline),
selectInput("input_origin", "Origin:", c("All",sort(unique(input_data_origin$origin))),selected_origin),
#conditionalPanel(condition="((input.sidebar == 'tabTwo' & input.tab_two_tabs != 'airline_origin') || input.sidebar == 'tabOne')",
selectInput("input_dest", "Destination:", c("All",sort(unique(input_data_dest$dest))),selected_dest)#)
)
#})
})
output$flight_delay_plot <- renderPlot({
print(paste0("Generating plot"))
data <- nycflights13::flights
if(!is.null(input$input_airline) && input$input_airline != "All") {
data <- data %>% filter(carrier == input$input_airline)
}
if(!is.null(input$input_origin) && input$input_origin != "All") {
data <- data %>% filter(origin == input$input_origin)
}
if(!is.null(input$input_dest) && input$input_dest != "All") {
data <- data %>% filter(dest == input$input_dest)
}
data %>%
group_by(month) %>%
summarise(avg_delay = mean(dep_delay,na.rm = TRUE)) %>%
ggplot(aes(x = month, y = avg_delay)) +
geom_point(size = 1.5) +
geom_line(size=1)
})
output$plot1 <- renderPlotly({
result <- nycflights13::flights %>%
group_by(month) %>%
count()
plot <- result %>%
ggplot(aes(x = month, y = n)) +
geom_point(aes(text = paste0("Flight Count: ", n)), size = 1.5) +
geom_line(size = 1) +
labs(x="Month",y="")
plot %>%
ggplotly(tooltip = c("text"), source = "month_select")
})
output$plot2 <- renderPlotly({
# Get month based on click
event_data <- event_data("plotly_click", source = "month_select")
print(event_data)
selected_month <- input$month
if(!is.null(event_data)) {
selected_month <- event_data[[3]]
}
print(selected_month)
result <- nycflights13::flights %>%
filter(month == selected_month) %>%
group_by(carrier) %>%
count()
plot <- result %>%
ggplot(aes(x = carrier, y = n)) +
geom_bar(stat="identity") +
labs(x="Airline",y="Flight Count")
plot %>%
ggplotly()
})
observeEvent(event_data("plotly_click", source = "month_select"), {
event_data <- event_data("plotly_click", source = "month_select")
updateVarSelectInput(session, "month", selected = event_data[[3]])
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have also tried this way, using updateSelectInput, the app will load once on start up vs. twice, which is slightly better, but it still renders the graph twice because it will run the plot with the new airline selection and the old origin and destination, then it updates the origin and destination and runs again. I've tried adding isolates around and in the updateSelectInput calls, but it seems to render the plot before it has registered the update. I'm really hoping there's a way to do this with isolate, I'd prefer not to add a button that the user has to click.
library(shiny)
library(shinydashboard)
library(tidyverse)
library(plotly)
library(nycflights13)
library(shinyjs)
library(V8)
input_data <- nycflights13::flights
ui <- dashboardPage(skin = "black",
dashboardHeader(
title="Test App"
),
dashboardSidebar(sidebarMenu(id = "sidebar",
menuItem("Tab One", tabName = "tabOne", icon = icon("heartbeat")),
menuItem("Tab Two", tabName = "tabTwo", icon = icon("warning")),
selectInput("input_airline", "Airline:", c("All",sort(unique(input_data$carrier))),"All"),
selectInput("input_origin", "Origin:", c("All",sort(unique(input_data$origin))),"All"),
#conditionalPanel(condition="((input.sidebar == 'tabTwo' & input.tab_two_tabs != 'airline_origin') || input.sidebar == 'tabOne')",
selectInput("input_dest", "Destination:", c("All",sort(unique(input_data$dest))),"All")
)),
dashboardBody(
useShinyjs(),
extendShinyjs(text = "shinyjs.resetClick = function() { Shiny.onInputChange('.clientValue-plotly_click-month_select', 'null'); }"),
tabItems(
tabItem(tabName = "tabOne",
shiny::column(width = 6,
plotOutput("flight_delay_plot")
)
),
tabItem(tabName = "tabTwo",
tabsetPanel(id = "tab_two_tabs",
tabPanel(
title = "Month Data",
value = "month_data",
fluidPage(
shiny::column(width = 2,
selectInput("month","Month: ", unique(nycflights13::flights$month))
),
shiny::column(width = 5,
plotlyOutput("plot1")
),
shiny::column(width = 5,
plotlyOutput("plot2")
)
)
),
tabPanel(
title = "Airline Orign",
value = "airline_origin",
fluidPage(
shiny::column(width = 12,
"Don't show destination drop down")
)
)
)
)
)
)
)
server <- function(input, output, session) {
input_data <- nycflights13::flights
observeEvent(input$input_airline,{
print(paste0("Observing airline change inputs ", Sys.time()))
input_data_origin <- input_data
if (input$input_airline != "All") {
input_data_origin <- input_data %>% filter(carrier == input$input_airline)
}
updateSelectInput(session,"input_origin","Origin",c("All",sort(unique(input_data_origin$origin)),"All"))
input_data_dest <- input_data_origin
if (input$input_origin != "All") {
input_data_dest <- input_data_dest %>% filter(origin == input$input_origin)
}
updateSelectInput(session,"input_dest","Destination",c("All",sort(unique(input_data_dest$dest)),"All"))
print(paste0("Observing airline change inputs, input_dest: ", input$input_dest))
},ignoreInit = TRUE)
observeEvent(input$input_origin,{
print(paste0("Observing origin change inputs ", Sys.time()))
input_data_origin <- input_data
if (input$input_airline != "All") {
input_data_origin <- input_data %>% filter(carrier == input$input_airline)
}
input_data_dest <- input_data_origin
if (input$input_origin != "All") {
input_data_dest <- input_data_dest %>% filter(origin == input$input_origin)
}
updateSelectInput(session,"input_dest","Destnation",c("All",sort(unique(input_data_dest$dest)),"All"))
},ignoreInit = TRUE)
observeEvent(input$input_dest,{
print(paste0("Observing dest change inputs ", Sys.time()))
},ignoreInit = TRUE)
output$flight_delay_plot <- renderPlot({
print(paste0("Generating plot ", Sys.time(),
"\nAirline: ",input$input_airline,
"\nOrigin: ",input$input_origin,
"\ndest: ",input$input_dest))
data <- nycflights13::flights
if(!is.null(input$input_airline) && input$input_airline != "All") {
data <- data %>% filter(carrier == input$input_airline)
}
if(!is.null(input$input_origin) && input$input_origin != "All") {
data <- data %>% filter(origin == input$input_origin)
}
if(!is.null(input$input_dest) && input$input_dest != "All") {
data <- data %>% filter(dest == input$input_dest)
}
data %>%
group_by(month) %>%
summarise(avg_delay = mean(dep_delay,na.rm = TRUE)) %>%
ggplot(aes(x = month, y = avg_delay)) +
geom_point(size = 1.5) +
geom_line(size=1)
})
output$plot1 <- renderPlotly({
result <- nycflights13::flights %>%
group_by(month) %>%
count()
plot <- result %>%
ggplot(aes(x = month, y = n)) +
geom_point(aes(text = paste0("Flight Count: ", n)), size = 1.5) +
geom_line(size = 1) +
labs(x="Month",y="")
plot %>%
ggplotly(tooltip = c("text"), source = "month_select")
})
output$plot2 <- renderPlotly({
# Get month based on click
event_data <- event_data("plotly_click", source = "month_select")
print(event_data)
selected_month <- input$month
if(!is.null(event_data)) {
selected_month <- event_data[[3]]
}
print(selected_month)
result <- nycflights13::flights %>%
filter(month == selected_month) %>%
group_by(carrier) %>%
count()
plot <- result %>%
ggplot(aes(x = carrier, y = n)) +
geom_bar(stat="identity") +
labs(x="Airline",y="Flight Count")
plot %>%
ggplotly()
})
observeEvent(event_data("plotly_click", source = "month_select"), {
event_data <- event_data("plotly_click", source = "month_select")
updateVarSelectInput(session, "month", selected = event_data[[3]])
})
}
# Run the application
shinyApp(ui = ui, server = server)