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

98 Views Asked by At

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 = "[email protected]")

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)


1

There are 1 best solutions below

1
On

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)
    
  })
}