Search code examples
rshinyplotlysubplotdt

R shiny app to display plots and tabular data


I am completely lost on how to build an R Shiny app that displays both graphical and tabular data. The goal is to 1. scrap USGS data, 2. build a plot panel of the flow data, and 3. have a tab with a table of the data. Below is the working script that scrapes USGS data and successfully builds the plot panel. I need to move the data frame development for the table and plot (same data, just displayed in different ways) to a reactive function outside of the plot-building server loop but I have not been able to figure it out.

library(shiny)
library(shinythemes)
library(dplyr)
library(dataRetrieval)
library(plotly)
library(lubridate)
library(DT)

C_site_numbers <- list("10308200", "10309000")
C_site_names <- list("Markleeville (cfs)", "Gardnerville (cfs)")

ui <- fluidPage(theme = shinytheme("yeti"),
                titlePanel("USGS Streamflow Data"),
                
                fluidRow(
                  column(4,
                         wellPanel(dateInput("start_date", "Start Date:", value = Sys.Date() - 7), width = 10)),
                  column(4, 
                         wellPanel(dateInput("end_date", "End Date:", value = Sys.Date()), width = 10)),
                  mainPanel(
                    tabsetPanel(
                      tabPanel("Carson Basin", plotlyOutput("C_plot_panel", width = "100%", height = ceiling(length(C_site_numbers)) * 400)),
                      tabPanel("Carson Tablular", dataTableOutput("Data_Tables", width = "100%", height = ceiling(length(C_site_numbers)) * 400))
                    )
                  )
                ))

server <- function(input, output) {
  
  # Define a reactive expression for the data frame
  df <- reactive({
    start_date <- ymd(input$start_date)
    end_date <- ymd(input$end_date)
    
    df <- data.frame(seq(from = start_date, to = end_date, by = 0.0069444444444444))  ##by value is equal to 5 mins intervals
    colnames(df)[1] <- 'dateTime'
    
    # Loop through each site number and download/streamflow data
    for (C_site_number in C_site_numbers) {
      n <- which(C_site_numbers == C_site_number)
      plot_n <- unlist(C_site_names[n])
      para_code = if (plot_n == 'Lahontan (acre-ft)') {'00054'} else {'00060'}
      streamflow <- readNWISuv(siteNumbers = C_site_number, parameterCd = para_code, 
                               startDate = start_date, endDate = end_date)
      attr(streamflow$dateTime, 'tzone') <- "America/Los_Angeles"
      
      # Prepare data for merging
      streamflow_df <- data.frame(
        dateTime = as.POSIXct(streamflow$dateTime, format = "%Y-%m-%d %H:%M"),
        Flow = if (plot_n == 'Lahontan (acre-ft)') {streamflow$X_00054_00000} else {streamflow$X_00060_00000}
      )
      
      # Merge data frames
      df <- merge(x = df, y = streamflow_df, by = 'dateTime', all.x = TRUE, all.y = FALSE)
    }
    
    df
  })
  
  # Carson Plot Panel
  output$C_plot_panel <- renderPlotly({
    # Create an empty list to store the individual plots
    C_plots <- list()
    
    # Loop through each site number and download/streamflow data
    for (C_site_number in C_site_numbers) {
      n <- which(C_site_numbers == C_site_number)
      plot_n <- unlist(C_site_names[n])
      streamflow_df <- df()
      
      # Create the plot using plotly
      plot <- plot_ly(data = streamflow_df, x = ~dateTime, y = ~Flow, type = "scatter", mode = "lines") %>%
        layout(yaxis = list(title = plot_n)) %>%
        layout(hovermode = "x unified", plot_bgcolor = 'rgb(212,213,214)', showlegend = FALSE)
      C_plots[[C_site_number]] <- plot
    }
    
    C_plot_panel <- subplot(C_plots, nrows = ceiling(length(C_site_numbers)), titleY = TRUE, margin = 0.07)
  })
  
  # Carson Tabular
  output$Data_Tables <- renderDataTable({
    streamflow_df <- df()
    streamflow_df
  })
}

shinyApp(ui = ui, server = server)

Thank you so much in advance! I have tried of all my resources before asking (in-depth SO searchers, chatGPT, friends). Self teaching R Shiny is not easy.


Solution

  • One way to do it is

    library(shiny)
    library(shinythemes)
    library(dplyr)
    library(dataRetrieval)
    library(plotly)
    library(lubridate)
    library(DT)
    
    C_site_numbers <- list("10308200", "10309000")
    C_site_names <- list("Markleeville (cfs)", "Gardnerville (cfs)")
    
    ui <- fluidPage(theme = shinytheme("yeti"),
                    titlePanel("USGS Streamflow Data"),
                    
                    fluidRow(
                      column(4,
                             wellPanel(dateInput("start_date", "Start Date:", value = Sys.Date() - 7), width = 10)),
                      column(4, 
                             wellPanel(dateInput("end_date", "End Date:", value = Sys.Date()), width = 10)),
                      mainPanel(
                        tabsetPanel(
                          tabPanel("Carson Basin", plotlyOutput("C_plot_panel", width = "100%", height = ceiling(length(C_site_numbers)) * 400)),
                          tabPanel("Carson Tablular", dataTableOutput("Data_Tables", width = "100%", height = ceiling(length(C_site_numbers)) * 400))
                        )
                      )
                    ))
    
    server <- function(input, output) {
      
      # Define a reactive expression for the data frame & plots
      df <- reactive({
        start_date <- ymd(input$start_date)
        end_date <- ymd(input$end_date)
        dateTime=format( seq.POSIXt(as.POSIXct(start_date), as.POSIXct(end_date), by = "5 min"),
                         "%Y-%m-%d %H:%M", tz="America/Los_Angeles")   ## 
        df <- data.frame(dateTime=as.POSIXct(dateTime))
        # Create an empty list to store the individual plots
        
        # df <- data.frame(seq(from = start_date, to = end_date, by = 0.0069444444444444))  ##by value is equal to 5 mins intervals
        # colnames(df)[1] <- 'dateTime'
        df1 <- data.frame(dateTime=as.POSIXct(start_date), Flow=NA, site=1)
        for (C_site_number in C_site_numbers) {
          n <- which(C_site_numbers == C_site_number)
          plot_n <- unlist(C_site_names[n])
          para_code = if (plot_n == 'Lahontan (acre-ft)') {'00054'} else {'00060'}
          streamflow <- readNWISuv(siteNumbers = C_site_number, parameterCd = para_code, 
                                   startDate = start_date, endDate = end_date)
          attr(streamflow$dateTime, 'tzone') <- "America/Los_Angeles"
          
          # Prepare data for merging
          streamflow_df <- data.frame( # site = C_site_names[n], 
            dateTime = as.POSIXct(streamflow$dateTime, format = "%Y-%m-%d %H:%M"),
            Flow = if (plot_n == 'Lahontan (acre-ft)') {streamflow$X_00054_00000} else {streamflow$X_00060_00000},
            site = n
          )
          
          # Merge data frames
          dfa <- merge(x = df, y = streamflow_df, by = 'dateTime', all.x = TRUE, all.y = FALSE)
          df1 <- rbind(df1,dfa)
        }
        df2 <- df1[complete.cases(df1),]  ## remove NAs for Flow
        
        C_plots <- list()
        # Loop through each site number and download/streamflow data
        lapply(C_site_numbers, function(C_site_number){
          n <- which(C_site_numbers == C_site_number)
          plot_n <- unlist(C_site_names[n])
    
          # Create the plot using plotly
          plot <- plot_ly(data = df2[df2$site==n,], x = ~dateTime, y = ~Flow, type = "scatter", mode = "lines") %>%
            layout(yaxis = list(title = plot_n)) %>%
            layout(hovermode = "x unified", plot_bgcolor = 'rgb(212,213,214)', showlegend = FALSE)
          C_plots[[C_site_number]] <<- plot
        
        })
        
        return(list(data = df2, plots = C_plots))
      })
      
      # Carson Plot Panel
      output$C_plot_panel <- renderPlotly({
        C_plots <- df()[[2]]
        C_plot_panel <- subplot(C_plots, nrows = ceiling(length(C_site_numbers)), titleY = TRUE, margin = 0.07)
      })
      
      # Carson Tabular
      output$Data_Tables <- renderDataTable({
        mydf <- df()[[1]]
        mydf %>% select(-site)
      })
    }
    
    shinyApp(ui = ui, server = server)