shiny code optimization avoid repeating renderPlotly... maybe with a loop

Question

I have a shiny app pulling data from a gsheet and displaying it in graphs inside individual tabs. The app works but:

the code inside the server section repeats itself too much => i was looking for suggestions to optimize it: could i use a loop to avoid all the renderPlotly repetitions? Perhaps the ui section could use some optimization too to organize the different tabs
it takes too long to load (about 50 secs), maybe because of the above or maybe because it retrieves too much information from the gsheet (11k rows) => any idea why? how could i improve this?

Here is the code, any help is appreciated:


# EIA

#library(httr)
#library(jsonlite)
library(dplyr)
#library(data.table)
library(googlesheets4)
#library(zoo)
library(shiny)
library(ggplot2)
library(shinyWidgets)
library(shinydashboard) # colours info here: https://www.w3schools.com/colors/colors_hex.asp
library(lubridate)
library(hrbrthemes)
library(ggthemes)
library(plotly)
#library(ggrepel)
library(tidyverse)
library(gargle)

gs4_auth(cache = ".secrets", email = "xxxxxxxxxxxx@gmail.com")

df_petroleum_lease <- read_sheet("https://docs.google.com/spreadsheets/d/1PUdqrOx__J34-sRYoHKcqI3H8iEjdMCFcVTOX0fqgPQ/edit#gid=0",
                                 sheet = 'crude_condensate') |>
  select(response.data.period, response.data.countryRegionId,response.data.countryRegionName, response.data.value, movmean)

colnames(df_petroleum_lease) <- c('month', 'countryId', 'countryName', 'volume', 'movmean')

df_petroleum_lease <- df_petroleum_lease |>
  mutate(month = as.Date(as.yearmon(month)))

shale_oil_us <- read_sheet("https://docs.google.com/spreadsheets/d/1PUdqrOx__J34-sRYoHKcqI3H8iEjdMCFcVTOX0fqgPQ/edit#gid=0",
                           sheet = 'us_shale_oil_plays') |>
  pivot_longer(-Date, names_to = "Region", values_to = "production_kbpd") |>
  mutate(production_kbpd = round(production_kbpd, 0),
         Date = as.Date(as.yearmon(Date)))

# Define UI
ui <- fluidPage(
  
  # Application title & background colors
  titlePanel("EIA crude oil + condensate stats top 20 producers - kb/d"),
  setBackgroundColor("Whitesmoke"),
  
  # Sidebar with a date range 
  sidebarLayout(
    sidebarPanel(
      dateRangeInput("dates",
                     label = h4("Date range",br(),"(pick 1st day of month)"),
                     format = "yyyy-mm",
                     start = '1973-01-01',
                     end = Sys.Date() %m-% months(4)),
      HTML(paste(tags$div(tags$a(href = "https://www.eia.gov/opendata/", 'Source country data')),"<br/>")),
      HTML(paste(tags$div(tags$a(href = "https://www.eia.gov/energyexplained/oil-and-petroleum-products/data/US-tight-oil-production.xlsx",'Source US Shale')),"<br/>")),
      fluidRow(column(6,downloadButton('downloadData', 'Download crude oil data')),column(6,downloadButton('downloadData2', 'Download US Shale data')))
    ),
    
    # Show plots in different tabs
    mainPanel(
      tabsetPanel(type = "tabs",
                  tabPanel(p(code("WORLD")),plotlyOutput("WorldOil", height = 575)),
                  tabPanel("USA",
                           br(), 
                           tabsetPanel(type = "tabs",
                                       tabPanel("USA total",plotlyOutput("USAOil", height = 575)),
                                       tabPanel(p(code("Focus on US Shale")), plotlyOutput("USAOilShale", height = 575)))),
                  tabPanel("Saudi Arabia", plotlyOutput("SAOil", height = 575)),
                  tabPanel("Russia", plotlyOutput("RussiaOil", height = 575)),
                  tabPanel("Irak", plotlyOutput("IrakOil", height = 575)),
                  tabPanel("Iran", plotlyOutput("IranOil", height = 575)),
                  tabPanel("China", plotlyOutput("ChinaOil", height = 575)),
                  tabPanel("Canada", plotlyOutput("CanadaOil", height = 575)),
                  tabPanel("UAE", plotlyOutput("UAEOil", height = 575)),
                  tabPanel("Kuwait", plotlyOutput("KuwaitOil", height = 575)),
                  tabPanel("Brazil", plotlyOutput("BrazilOil", height = 575)),
                  tabPanel("Colombia", plotlyOutput("ColombiaOil", height = 575)),
                  tabPanel("Mexico", plotlyOutput("MexicoOil", height = 575)),
                  tabPanel("Nigeria", plotlyOutput("NigeriaOil", height = 575)),
                  tabPanel("Angola", plotlyOutput("AngolaOil", height = 575)),
                  tabPanel("Norway", plotlyOutput("NorwayOil", height = 575)),
                  tabPanel("Kazakhstan", plotlyOutput("KazakhstanOil", height = 575)),
                  tabPanel("Qatar", plotlyOutput("QatarOil", height = 575)),
                  tabPanel("Algeria", plotlyOutput("AlgeriaOil", height = 575)),
                  tabPanel("Oman", plotlyOutput("OmanOil", height = 575)),
                  tabPanel("Libya", plotlyOutput("LibyaOil", height = 575)),
                  tabPanel(p(code("FACETS")), plotOutput("FACETSOil", height = 575))
                  
      )
    )
  )
)

# Define server
server <- function(input, output) {
  
  output$downloadData <- downloadHandler(
      filename = function() {
        'crude_oil.csv'
      },
      content = function(file) {
        write.csv(df_petroleum_lease, file)
      }
    )
    
  output$downloadData2 <- downloadHandler(
    filename = function() {
      'us_shale.csv'
    },
    content = function(file) {
      write.csv(shale_oil_us, file)
    }
  )
  
  data_crude_cond <- reactive({
    df_petroleum_lease |> filter(countryId == 'WORL' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$WorldOil <- renderPlotly({
    
    viz <- ggplot(data_crude_cond(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.7, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "World oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz)
    
  })
  
  data_crude_cond_USA <- reactive({
    df_petroleum_lease |> filter(countryId == 'USA' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$USAOil <- renderPlotly({
    
    viz2 <- ggplot(data_crude_cond_USA(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "USA oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz2)
    
  })
  
  data_crude_cond_USAShale <- reactive({
    shale_oil_us |> filter(Date >= input$dates[[1]] & Date <= input$dates[[2]])
  })
  
  output$USAOilShale <- renderPlotly({
    
    viz23 <- ggplot(data_crude_cond_USAShale(), aes(x = Date, y = production_kbpd)) +
      geom_line(aes(colour = Region), linewidth = 0.5) + # geom_point(size = 0.3) +
      theme_ft_rc(strip_text_size = 10, axis_text_size = 10) +
      labs(title = "US Shale oil production by region - kbpd", x = "year", y = "production volume - kbpd")
    ggplotly(viz23)
    
  })
  
  data_crude_cond_SA <- reactive({
    df_petroleum_lease |> filter(countryId == 'SAU' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$SAOil <- renderPlotly({
    
    viz3 <- ggplot(data_crude_cond_SA(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Saudi Arabia oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz3)
  })
  
  data_crude_cond_Russia <- reactive({
    df_petroleum_lease |> filter(countryId == 'RUS' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$RussiaOil <- renderPlotly({
    
    viz4 <- ggplot(data_crude_cond_Russia(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Russia oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz4)
  })
  
  data_crude_cond_Irak <- reactive({
    df_petroleum_lease |> filter(countryId == 'IRQ' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$IrakOil <- renderPlotly({
    
    viz5 <- ggplot(data_crude_cond_Irak(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = " (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz5)
  })
  
  data_crude_cond_Iran <- reactive({
    df_petroleum_lease |> filter(countryId == 'IRN' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$IranOil <- renderPlotly({
    
    viz6 <- ggplot(data_crude_cond_Iran(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Iran oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz6)
  })
  
  data_crude_cond_China <- reactive({
    df_petroleum_lease |> filter(countryId == 'CHN' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$ChinaOil <- renderPlotly({
    
    viz7 <- ggplot(data_crude_cond_China(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "China oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz7)
  })
  
  data_crude_cond_Canada <- reactive({
    df_petroleum_lease |> filter(countryId == 'CAN' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$CanadaOil <- renderPlotly({
    
    viz8 <- ggplot(data_crude_cond_Canada(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Canada oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz8)
  })
  
  data_crude_cond_UAE <- reactive({
    df_petroleum_lease |> filter(countryId == 'ARE' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$UAEOil <- renderPlotly({
    
    viz9 <- ggplot(data_crude_cond_UAE(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "UAE oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz9)
  })
  
  data_crude_cond_Kuwait <- reactive({
    df_petroleum_lease |> filter(countryId == 'KWT' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$KuwaitOil <- renderPlotly({
    
    viz10 <- ggplot(data_crude_cond_Kuwait(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Kuwait oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz10)
  })
  
  data_crude_cond_Brazil <- reactive({
    df_petroleum_lease |> filter(countryId == 'BRA' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$BrazilOil <- renderPlotly({
    
    viz11 <- ggplot(data_crude_cond_Brazil(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Brazil oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz11)
  })
  
  data_crude_cond_Colombia <- reactive({
    df_petroleum_lease |> filter(countryId == 'COL' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$ColombiaOil <- renderPlotly({
    
    viz12 <- ggplot(data_crude_cond_Colombia(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Colombia oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz12)
  })
  
  data_crude_cond_Mexico <- reactive({
    df_petroleum_lease |> filter(countryId == 'MEX' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$MexicoOil <- renderPlotly({
    
    viz13 <- ggplot(data_crude_cond_Mexico(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Mexico oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz13)
  })
  
  data_crude_cond_Nigeria <- reactive({
    df_petroleum_lease |> filter(countryId == 'NGA' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$NigeriaOil <- renderPlotly({
    
    viz14 <- ggplot(data_crude_cond_Nigeria(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Nigeria oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz14)
  })
  
  data_crude_cond_Angola <- reactive({
    df_petroleum_lease |> filter(countryId == 'AGO' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$AngolaOil <- renderPlotly({
    
    viz15 <- ggplot(data_crude_cond_Angola(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Angola oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz15)
  })
  
  data_crude_cond_Norway <- reactive({
    df_petroleum_lease |> filter(countryId == 'NOR' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$NorwayOil <- renderPlotly({
    
    viz16 <- ggplot(data_crude_cond_Norway(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Norway oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz16)
  })
  
  data_crude_cond_Kazakhstan <- reactive({
    df_petroleum_lease |> filter(countryId == 'KAZ' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$KazakhstanOil <- renderPlotly({
    
    viz17 <- ggplot(data_crude_cond_Kazakhstan(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Kazakhstan oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz17)
  })
  
  data_crude_cond_Qatar <- reactive({
    df_petroleum_lease |> filter(countryId == 'QAT' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$QatarOil <- renderPlotly({
    
    viz18 <- ggplot(data_crude_cond_Qatar(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Qatar oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz18)
  })
  
  data_crude_cond_Algeria <- reactive({
    df_petroleum_lease |> filter(countryId == 'DZA' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$AlgeriaOil <- renderPlotly({
    
    viz19 <- ggplot(data_crude_cond_Algeria(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Algeria oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz19)
  })
  
  data_crude_cond_Oman <- reactive({
    df_petroleum_lease |> filter(countryId == 'OMN' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$OmanOil <- renderPlotly({
    
    viz20 <- ggplot(data_crude_cond_Oman(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Oman oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz20)
  })
  
  data_crude_cond_Libya <- reactive({
    df_petroleum_lease |> filter(countryId == 'LBY' & month >= input$dates[[1]] & month <= input$dates[[2]])
  })
  
  output$LibyaOil <- renderPlotly({
    
    viz21 <- ggplot(data_crude_cond_Libya(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = "Libya oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd")
    ggplotly(viz21)
  })
  
  data_facets <- reactive({
    df_petroleum_lease |> filter(month >= input$dates[[1]] & month <= input$dates[[2]] & countryId != 'WORL' )
  })
  
  output$FACETSOil <- renderPlot({
    
    viz22 <- ggplot(data_facets(), aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      facet_wrap(~ countryName, scales = "free_y") +
      theme_ft_rc(strip_text_size = 10, axis_text_size = 10) +
      labs(title = "oil (crude + condensate) production by country - kbpd", x = "month-year", y = "production volume - kbpd")
    viz22
  })
}

# Run the application
shinyApp(ui = ui, server = server)

smartse · Answer 1 · 2023-08-02T08:32:02.177

Your app takes ages to load and it's probably because you are rendering all of those graphs even though you only have one visible at a time. That kind of defeats the point of shiny i.e. reactivity.

Why not do something like this instead which just creates one graph for whichever country is selected? If you're absolutely certain you want the choice to be from the tab rather than radioButtons, that is also possible - see e.g. How do I access/print/track the current tab selection in a Shiny app? but you'll need to rearrange the UI so that the plot is outside of the tab in order to see it regardless of the selected tab.

ui <- fluidPage(
uiOutput("country_choice"),
plotlyOutput("plot"))

server <- function(input, output) {      
output$country_choice <- renderUI({
    countries <- unique(df_petroleum_lease$countryId)
    radioButtons("country",label='Choose country',choices=countries)
  })
    
  
  output$plot <- renderPlotly({
    
    subset <- df_petroleum_lease |> filter(countryId == input$country & month >= input$dates[[1]] & month <= input$dates[[2]])
    
    viz <- ggplot(subset, aes(x = month, y = volume)) +
      geom_line(colour = "red", linewidth = 0.2) + # geom_point(size = 0.3) +
      geom_line(aes(y = movmean), colour = "white", alpha = 0.8, linetype = "twodash") +
      theme_ft_rc() +
      labs(title = paste0(input$country," oil (crude + cond) production - kbpd + 12 month moving average", x = "month-year", y = "production volume - kbpd"))
    ggplotly(viz)
    
  })
}

Thanks for the feedback. Yes, i would have probably gone for that solution (maybe with a `SelectInput` instead of `radioButtons`) hadn't i preferred the tab layout. But i followed your link to allow for a tab layout while using your proposal above. However, that did not improve the loading time, what did the trick though was using `range_speedread` inseatd of `read_sheet` to read the gsheet. Here is the [app](https://rb2110.shinyapps.io/EIA_oil_stats/) again. The loading time is now a third of what it was (still long though). — Romain, Aug 05 '23 at 18:37

shiny code optimization avoid repeating renderPlotly... maybe with a loop

1 Answers1