Errors in Shiny app due to reactivity difficulties

Question

I am new to R and Shiny so please forgive my ignorance. I have a large data set (184,171 observations and 10 variables) as a tibble. I am trying to create a Shiny app that uses this data table. The user selects a gauge, then a variable to analyze, a range of years, and then whether they want the variable aggregated annually or monthly. Based on the inputs, it will create 3 plots and a location map for the selected gauge, along with summary statistics. I have no problems when running my user interface portion. I know the problems lie in my server. I want to know if I am using the reactive Values() and observe Event correctly.

The original data set is shinydata and I am trying to make a reactive data table that filters based on user inputs. My errors include:

Displays in the leaflet output box no applicable method for metaData applied to an object of class reactive Expr, reactive, function

Displays in the summary stats box data must be 2-dimensional (e.g. data frame or matrix) -> This I know is because I need to use a text output instead of data table for the summary stats

Displays in the box and time series plot outputs object annual1 not found

I have been struggling with this for 3 days and searching the web for answers. Any insight would be greatly appreciated!

# load libraries
library(shiny)
library(shinydashboard) 
library(lubridate) 
library(DT)
library(ggplot2) 
library(dplyr)
library(leaflet) 
library(tidyr) 

# Read in datatable/tibble that was saved and exported as RDS 
# from gauge script 
# Modify table by removing columns SWE, RAIM, MOD_RUN
# and move date column from the last row to second row

shinydata = readRDS("C:/Users/.../shinydata.rds")
shinydata2 = shinydata[-c(5,7,11)]
shinydata2 = shinydata2 %>%  relocate(DATE, .before = "YR")

> dput(head(shinydata2))
structure(list(GaugeID = c("06814000", "06814000", "06814000", 
"06814000", "06814000", "06814000"), DATE = structure(c(4018, 
4019, 4020, 4021, 4022, 4023), class = "Date"), YR = c(1981, 
1981, 1981, 1981, 1981, 1981), MNTH = c(1, 1, 1, 1, 1, 1), DY = c(1, 
2, 3, 4, 5, 6), PRCP = c(0, 0, 0, 0, 0, 0), TAIR = c(2.36, 0.71, 
-1.62, -7.365, -3.03, 0.185), PET = c(0.4185, 0.3206, 0.3215, 
0.3189, 0.3441, 0.4074), ET = c(0.4064, 0.31, 0.3102, 0.307, 
0.3308, 0.3909), OBS_RUN = c(0.0171, 0.0171, 0.0154, 0.0137, 
0.0137, 0.0154)), row.names = c(NA, -6L), class = c("tbl_df", 
"tbl", "data.frame"))

# shinydata2 with 10 variables and 184,171 observations
# Column number and header   
# 1 - GaugeID (8 digit USGS gauge number, character)
# 2 - DATE (combined YR, MNTH, DY lubridate, date)
# 3 - YR (4 digit year, 1981 - 2014, numeric)
# 4 - MNTH (1 digit month, 1 - 12, numeric)
# 5 - DY (numeric )
# 6 - PRCP (precipitation (PRCP) in mm/day)
# 7 - TAIR (mean daily air temp (TAIR) in celcius)
# 8 - PET (potential evapotranspiration (PET) in mm/day)
# 9 - ET (evapotranspiration (ET) in mm/day from SAC model)
# 10 - OBS_RUN (observed runoff (OBS_RUN) in mm/day from USGS)

# Names correspond to column headers from shinydata2 (PRCP, TAIR, PET, ET, OB_RUN), 
# columns 6 through 10, data all numeric
varNames = c("Precipitation", 
             "Air Temperature",
             "Potential ET", 
             "Actual ET", 
             "Runoff")
    
# years are from 1981 to 2014
# column 3 in shinydata2, numeric
years = unique(shinydata2$YR)

months = c("January","February","March","April","May","June",
           "July","August","September","October","November","December")

# 8 digit USGS gauge number, 15 total gauges
# column 1 in shinydata2 table, character
gaugeIds = unique(shinydata2$GaugeID)

gaugeNames = c("Turkey Creek near Seneca (06814000)",
"Soldier Creek near Delia (06889200)",
"Marais Des Cygnes River near Reading (06910800)",
"Dragoon Creek near Burlingame (06911900)",
"Chikaskia River near Corbin (07151500)",
"Cedar Creek near Cedar Point (07180500)",
"Timber Creek near Collinsville (08050800)",
"North Fork Guadalupe River near Kyle (08171300)",
"Blanco River near Kyle (08189500)",
"Mission River at Refugio (08189500)",
"East Fork White River near Fort Apache (09492400)",
"White River near Fort Apache (09494000)",
"Cibecue Creek near Chysotile (09497800)",
"Cherry Creek near Globe (09497980)",
"Los Gatos Creek near Coalinga (11224500)")

# gauge latitude values
gaugeLat = as.numeric(c(39.94778, 39.23833, 38.56701, 38.71069, 37.12891,
                        38.19645, 33.55455, 30.0641, 29.97938, 28.29195, 
                        33.82227, 33.73644, 33.84311, 33.82783, 36.21468))
# gauge longitude values
gaugeLong = as.numeric(c(-96.10862, -95.8886, -95.96163, -95.83603, -97.60144, 
                         -96.82458, -96.94723, -99.38699, -97.91, -97.27916, 
                         -109.81454, -110.16677, -110.55761, -110.85623, -120.47071))

# combine gauge id, latitude and longitude into table
gaugeLatLong = tibble(x = gaugeIds, y = gaugeLat, z = gaugeLong)

# Define user interface
ui = dashboardPage(
    
    dashboardHeader(title = "Test app"),    
    
    dashboardSidebar(
    
        # choose which of the 15 gauges to analyze
        selectizeInput(inputId = "gauge1", 
                       label = "Choose USGS Stream Gauge",
                       choices = gaugeNames),
        
        # choose one of the 5 variables
        radioButtons(inputId = "variable1", 
                     label = "Choose variable",
                     choices = varNames),
        
        # select starting year and ending year (time span) for 
        # analysis, allows for smaller window of time
        sliderInput(inputId = "yrRange1",
                    label = "Select the range of years:",
                    min = 1981, max = 2014,
                    value = c(1990, 2000)),
        
        # View outputs for the variable on an annual time scale or monthly 
        # Monthly will be for the entire year range selected, for example
        # range is 1990 - 2000, then the months will be Jan - Dec, totaled or 
        # averaged over the 10 year span   
        radioButtons(inputId = "temporal1",
                     label = "Temporal aggregation:",
                     choices = c("Annual", "Monthly"))
        
     
         ),


dashboardBody(
    
    fluidRow(
        
      # output summary statistics for the selected variable
      # THIS IS NOT DATATABLE, should be TXT, fix
        box(title = "Summary Statistics", 
            solidHeader = TRUE, 
            DT::dataTableOutput("statsTable"),
            width = 4),
        
        # output map that shows the location of the gauge selected  
        box(leafletOutput("map"), width = 8)
          ),
    
    fluidRow(
        
      # histogram plot for selected variable, over selected years annually or monthly       
        box(title = "Histogram",
            solidHeader = TRUE,
            plotOutput("histPlot"), width = 4),
     
        # boxplot for selected variable over selected range, annually or monthly           
        box(title = "Box Plot",
            solidHeader = TRUE, 
            plotOutput("boxPlot"),
                     width = 4),

        # line plot for variable over years or months (for all selected years)
        box(title = "Time Series Plot",
            solidHeader = TRUE, 
            plotOutput("timePlot"), width = 4)
 
              )
    
        )
)  

######### Server



server = function(input, output) {
   
  # create reactive datatable that will update based on user
  # inputs for gauge, variable, and time frame
    values = reactiveValues(allData = NULL)
    
    # filter datatable based on gauge selected, product table with only 
    # that gauge (based on shinydata2 table)
    observeEvent(input$gauge1, {
        values$allData = shinydata2 %>% 
            group_by(GaugeID, YR, MNTH)  %>% 
          filter(GaugeID == input$gauge1)
    })
  
    # now filter the table for the selected gauge by the variable selected, 
    # table now has the gauge and one variable      
    observeEvent(input$variable1, {
        
        if(input$variable1 == "Precipitation") {
            values$allData = values$allData %>% 
                group_by(YR, MNTH) %>% 
                select(PRCP)
            
        } else if(input$variable1 == "Air Temperature") {
            values$allData = values$allData %>% 
                group_by(YR, MNTH) %>% 
                select(TAIR)
           
        } else if(input$variable1 == "Potential ET") {
            values$allData = values$allData %>% 
                group_by(YR, MNTH) %>% 
                select(PET)
        
        } else if(input$variable1 == "Actual ET") {
            values$allData = values$allData %>% 
                group_by(YR, MNTH) %>% 
                select(ET)
            
        } else {
            values$allData = values$allData %>% 
                group_by(YR, MNTH) %>% 
                select(OBS_RUN)     
  
        }
           
      })                              
    
    # filter the data table that has 1 gauge, 1 variable and select just 
    # the range of years based on slider 
    observeEvent(input$yrRange1, {
        values$allData = values$allData %>% 
                     group_by(YR, MNTH) %>% 
                     filter(YR >= input$yrRange1[1] &
                                YR <= input$yrRange1[2])
    })
    
    # summary stats for the filtered table (one gauge, one variable, years) 
    # NOT TABLE
    output$statsTable = renderDataTable({
        summary(values$allData[[4]])
    })
    
 
    # create reactive to choose the lat/long from gaugeLatLong table
    # that corresponds to the gauge selected 
    gaugeLoc = reactive({ 
        gaugeLatLong %>% 
        filter(input$gauge1)
        
    })    
    
    # show the gauge location on the map for the selected gauge only, 
    output$map = renderLeaflet({
        
        leaflet(data = gaugeLoc) %>% 
        addProviderTiles("Jawg.Terrain") %>% 
            addMarkers(lng = ~z, lat = ~y, popup = ~x)
    })
    
    # plots
    
    # selected annual aggregation
    output$histPlot = renderPlot({
        if (input$temporal1 == "Annual") {
            annual1 = values$allData %>% 
                group_by(YR) %>% 
                summarise(yr_total = sum(values$allData[[4]]), 
                          yr_mean = mean(values$allData[[4]]))
            
            annualHistPlot = ggplot(data = annual1, aes(x = yr_total)) +
                geom_histogram()
                
            #selected monthly aggregation               
        } else {
            month1 = values$allData %>% 
                group_by(MNTH) %>% 
                summarise(mnth_total = sum(values$allData[[4]]),
                          mnth_mean = mean(values$allData[[4]]))
            
            monthHistPlot = ggplot(data = month1, aes(x = month_total)) +
                geom_histogram()
        } 
            
    })
                                                                                        
 
    
     output$timePlot = renderPlot({
         
            if (input$temporal1 == "Annual") {
                 annual1 = values$allData %>% 
                     group_by(YR) %>% 
                     summarise(yr_total = sum(values$allData[[4]]), 
                               yr_mean = mean(values$allData[[4]]))
                 
                annualTimePlot = ggplot(data = annual1, aes(x = YR)) +
                     geom_line(aes(y = yr_total))
                 
                 
             } else {
                 month1 = values$allData %>% 
                     group_by(MNTH) %>% 
                     summarise(mnth_total = sum(values$allData[[4]]),
                               mnth_mean = mean(values$allData[[4]]))
                 
                 monthTimePlot = ggplot(data = annual1, aes(x = MNTH)) +
                     geom_line(aes(y = mnth_total))
             } 
             
         })
        
     
     output$boxPlot = renderPlot({
         
         if (input$temporal1 == "Annual") {
             annual1 = values$allData %>% 
                 group_by(YR) %>% 
                 summarise(yr_total = sum(values$allData[[4]]), 
                           yr_mean = mean(values$allData[[4]]))
             
            annualboxPlot = ggplot(data = annual1, aes(x = YR, y = yr_total)) +
                geom_boxplot()
             
             
         } else {
             month1 = values$allData %>% 
                 group_by(MNTH) %>% 
                 summarise(mnth_total = sum(values$allData[[4]]),
                           mnth_mean = mean(values$allData[[4]]))
             
             
            monthboxPlot = ggplot(data = annual1, aes(x = MNTH, y = mnth_total)) +
            geom_boxplot()
         } 
         
     })
     
}

shinyApp(ui = ui, server = server)

Answer 1

Below is a working version to adapt further for your needs. One overall recommendation is to start with a small working example before adding in more components/complexity.

Some of your errors came from how the data was being filtered. For example, you have:

filter(GaugeID == input$gauge1)

But GaugeID in the data frame shinydata2 is:

[1] "06814000" "06814000" "06814000" "06814000" "06814000" "06814000" 

But input$gauge1 has values from choices in the input, that came from the gaugeNames vector:

R> gaugeNames
 [1] "Turkey Creek near Seneca (06814000)"               "Soldier Creek near Delia (06889200)"              
 [3] "Marais Des Cygnes River near Reading (06910800)"   "Dragoon Creek near Burlingame (06911900)"         
 [5] "Chikaskia River near Corbin (07151500)"            "Cedar Creek near Cedar Point (07180500)"          
 [7] "Timber Creek near Collinsville (08050800)"         "North Fork Guadalupe River near Kyle (08171300)"  
 [9] "Blanco River near Kyle (08189500)"                 "Mission River at Refugio (08189500)"              
[11] "East Fork White River near Fort Apache (09492400)" "White River near Fort Apache (09494000)"          
[13] "Cibecue Creek near Chysotile (09497800)"           "Cherry Creek near Globe (09497980)"               
[15] "Los Gatos Creek near Coalinga (11224500)" 

So they will never match exactly, and filter was never keep any rows of data.

To get around this, you can use named vectors:

gaugeNames = c("Turkey Creek near Seneca (06814000)" = "06814000",
               "Soldier Creek near Delia (06889200)" = "06889200",
               "Marais Des Cygnes River near Reading (06910800)" = "06910800",
               ...

Then, when "Turkey Creek near Seneca (06814000)" is selected from the input, you will get the value of "06814000" which will match your GaugeID in your data frame.

You can also do this with varNames and the choices in your temporal1 radioButtons (as I have done below). This will help a lot in terms of reducing unnecessary code as well.

One other recommendation is consolidate a lot of your filter and select statements, so you have one reactive expression to get the data you need for your different outputs. I made shiny_data this expression - and to reference it, you use shiny_data().

Similarly, to call gaugeLoc from renderLeaflet you need to call it as gaugeLoc(). Also, the problem with the filter there is that x is omitted, and you need:

filter(x == input$gauge1)

To simplify the plots, you can have each renderPlot use the same data from a new reactive expression plot_data. Because you will want to use the input variables in group_by and summarise, you can use .data[[input$var]] convert the input string to a symbol for use in dplyr chain.

You will likely need to do more for the plots to get them working as you would like them to. But I hope this will be helpful in moving forward. Good luck!

library(shiny)
library(shinydashboard) 
library(lubridate) 
library(DT)
library(ggplot2) 
library(dplyr)
library(leaflet) 
library(tidyr) 

shinydata2 <- structure(list(GaugeID = c("06814000", "06814000", "06814000", 
"06814000", "06814000", "06814000"), DATE = structure(c(4018, 
4019, 4020, 4021, 4022, 4023), class = "Date"), YR = c(1981, 
1982, 1983, 1984, 1985, 1986), MNTH = c(1, 1, 1, 1, 1, 1), DY = c(1, 
2, 3, 4, 5, 6), PRCP = c(0, 0, 0, 0, 0, 0), TAIR = c(2.36, 0.71, 
-1.62, -7.365, -3.03, 0.185), PET = c(0.4185, 0.3206, 0.3215, 
0.3189, 0.3441, 0.4074), ET = c(0.4064, 0.31, 0.3102, 0.307, 
0.3308, 0.3909), OBS_RUN = c(0.0171, 0.0171, 0.0154, 0.0137, 
0.0137, 0.0154)), row.names = c(NA, -6L), class = c("tbl_df", 
"tbl", "data.frame"))

# Make this a named vector
varNames = c("Precipitation" = "PRCP", 
             "Air Temperature" = "TAIR",
             "Potential ET" = "PET", 
             "Actual ET" = "ET", 
             "Runoff" = "OBS_RUN")

years = unique(shinydata2$YR)

# If you need name of months, use "month.name"

gaugeIds = unique(shinydata2$GaugeID)

# Make this a named vector
gaugeNames = c("Turkey Creek near Seneca (06814000)" = "06814000",
               "Soldier Creek near Delia (06889200)" = "06889200",
               "Marais Des Cygnes River near Reading (06910800)" = "06910800",
               "Dragoon Creek near Burlingame (06911900)" = "06911900",
               "Chikaskia River near Corbin (07151500)" = "07151500",
               "Cedar Creek near Cedar Point (07180500)" = "07180500",
               "Timber Creek near Collinsville (08050800)" = "08050800",
               "North Fork Guadalupe River near Kyle (08171300)" = "08171300",
               "Blanco River near Kyle (08189500)" = "08189500",
               "Mission River at Refugio (08189500)" = "08189500",
               "East Fork White River near Fort Apache (09492400)" = "09492400",
               "White River near Fort Apache (09494000)" = "09494000",
               "Cibecue Creek near Chysotile (09497800)" = "09497800",
               "Cherry Creek near Globe (09497980)" = "09497980",
               "Los Gatos Creek near Coalinga (11224500)" = "11224500")

gaugeLat = as.numeric(c(39.94778, 39.23833, 38.56701, 38.71069, 37.12891,
                        38.19645, 33.55455, 30.0641, 29.97938, 28.29195, 
                        33.82227, 33.73644, 33.84311, 33.82783, 36.21468))
gaugeLong = as.numeric(c(-96.10862, -95.8886, -95.96163, -95.83603, -97.60144, 
                         -96.82458, -96.94723, -99.38699, -97.91, -97.27916, 
                         -109.81454, -110.16677, -110.55761, -110.85623, -120.47071))

gaugeLatLong = tibble(x = gaugeIds, y = gaugeLat, z = gaugeLong)

# Define user interface
ui = dashboardPage(
  dashboardHeader(title = "Test app"),    
  dashboardSidebar(
    selectizeInput(inputId = "gauge1", 
                   label = "Choose USGS Stream Gauge",
                   choices = gaugeNames),
    radioButtons(inputId = "variable1", 
                 label = "Choose variable",
                 choices = varNames),
    sliderInput(inputId = "yrRange1",
                label = "Select the range of years:",
                min = 1981, max = 2014,
                value = c(1981, 2000)),
    radioButtons(inputId = "temporal1",
                 label = "Temporal aggregation:",
                 choices = c("Annual" = "YR", "Monthly" = "MNTH"))
  ),
  dashboardBody(
    fluidRow(
      box(title = "Summary Statistics", 
          solidHeader = TRUE, 
          verbatimTextOutput("statsTable"),
          width = 5),
      box(leafletOutput("map"), width = 7)
    ),
    fluidRow(
      box(title = "Histogram",
          solidHeader = TRUE,
          plotOutput("histPlot"), width = 4),
      box(title = "Box Plot",
          solidHeader = TRUE, 
          plotOutput("boxPlot"),
          width = 4),
      box(title = "Time Series Plot",
          solidHeader = TRUE, 
          plotOutput("timePlot"), width = 4)
    )
  )
)  

######### Server

server = function(input, output) {
  
  shiny_data <- reactive({
    shinydata2 %>% 
      group_by(GaugeID, YR, MNTH) %>% 
      filter(GaugeID == input$gauge1,
             YR >= input$yrRange1[1],
             YR <= input$yrRange1[2]) %>%
      select(YR, MNTH, input$variable1)
  })
  
  output$statsTable = renderPrint({
    enframe(summary(shiny_data()[[input$variable1]]))
  })
  
  gaugeLoc <- reactive({ 
    gaugeLatLong %>% 
      filter(x == input$gauge1)
  })    
  
  output$map = renderLeaflet({
    leaflet(data = gaugeLoc()) %>% 
      addProviderTiles("Stamen.Watercolor") %>% 
      addMarkers(lng = ~z, lat = ~y, popup = ~x)
  })
  
  plot_data <- reactive({
    shiny_data() %>% 
      group_by(.data[[input$temporal1]]) %>% 
      summarise(total = sum(.data[[input$variable1]]), 
                mean = mean(.data[[input$variable1]]))
  })
  
  output$histPlot = renderPlot({
    ggplot(data = plot_data(), aes(x = total)) +
      geom_histogram(binwidth = 1)
  })
  
  output$timePlot = renderPlot({
    ggplot(data = plot_data(), aes(x = .data[[input$temporal1]], y = total)) +
        geom_line()
  })
  
  output$boxPlot = renderPlot({
    ggplot(data = plot_data(), aes(x = .data[[input$temporal1]], y = total)) +
        geom_boxplot()
  })
  
}

shinyApp(ui = ui, server = server)