I have a shiny app up and running on shinyapps.io that I am trying to make load more efficiently.
The app scrapes information from 2 websites, reads in a couple of .csv files and downloads current data for one of them, and compiles this into a plot with some options.
App is accessible here: https://brian-fisher.shinyapps.io/MethowFlowCompare/
The app works fine for my purposes, but can take a longish time to load, especially if it's been a while since I updated the .csv tables stored on the server. When I run it locally, I have it set up to save the updated .csv files with current information to help it load faster in the future. Is there a way to do something similar on the server side, or other methods/best practices to help the app load more efficiently when running on the server?
I often access the app as a dashboard from my phone in areas with poor reception, the slow loading speed can be a barrier to being able to use it when the reception is poor.
When I run the app locally the web scraping is the part that takes the most time, that portion is posted below for context.
library(rvest) ## Web scraping forecast from NOAA
library(tidyverse)
library(forcats)
library(lubridate)
library(dataRetrieval) ## downloading USGS flow data
library(viridis)
library(shiny)
## Sources for web-scraped data
url = "https://www.nwrfc.noaa.gov/station/flowplot/textPlot.cgi?id=WTHW1&pe=HG"
url2 = "https://www.nwrfc.noaa.gov/station/flowplot/textPlot.cgi?id=PATW1&pe=HG"
table.xpath = "/html/body/table"
Gauges <- tibble( Name = c("Methow River @ Winthrop", "Twisp River", "Chewuch River", "Andrews Creek" , "Methow River @ Twisp", "Methow River @ Pateros", "Methow River @ Goat Creek"),
ID = c("12448500" , "12448998" , "12448000","12447390", "12449500","12449950" , "12447383")
)%>%
mutate(Station = readNWISsite(ID)$station_nm)
Site <- Gauges$ID
### Web scraping
prediction.winthrop = url %>%
read_html() %>%
html_nodes(xpath = table.xpath ) %>%
html_table(header = TRUE,
fill = TRUE)
prediction.winthrop = prediction.winthrop[[1]]
cnames = as.character(prediction.winthrop[1,1:3])
cnames[1] = "Date/Time"
observed = prediction.winthrop[2:nrow(prediction.winthrop), 1:3]
colnames(observed) = cnames
predicted = prediction.winthrop[2:nrow(prediction.winthrop), 4:6]
colnames(predicted) = cnames
predicted = predicted %>%
mutate(Category = "Prediction",
`Date/Time` = ymd_hm(`Date/Time`),
Stage = as.numeric(Stage),
Discharge = as.numeric(Discharge)
)%>%
filter(Discharge >0)
observed = observed %>%
mutate(Category = "Observed",
`Date/Time` = ymd_hm(`Date/Time`),
Stage = as.numeric(Stage),
Discharge = as.numeric(Discharge)
)
And reading in and updated data table
# Read in Site data ----------------------------------------------------
DailyQ<- read_csv("MethowR_daily.csv") ## Daily data used in plot. This table will be updated to make current
DailyStats <- read_csv("MethowR_USGS_Stats.csv") ## Stats are pre-computed and summarized for display
current_year <- year(now())
name.file = paste0("MethowRiver_obs_", year(today()),".csv")
first_day = ymd(paste0(current_year,"-01-01"))
day.filter = first_day
if(file.exists(name.file)) {
current_obs = read_csv(name.file)
last_obs = as_date(max(current_obs$`Date/Time`))
day.filter = last_obs - days(14)
}
start_date = if_else(day.filter > first_day, day.filter, first_day) ## included to handle end of year issues.
new.obs <- readNWISuv(Site, "00060",
startDate = start_date)[,c(2:4)] ## Using dataRetrieval package
names(new.obs) <- c("Gauge", "dateTime", "Q_cfs")
new.obs$dateTime <- format(new.obs$dateTime, tz="America/Los_Angeles",usetz=TRUE)
new.obs$Year <- year(new.obs$dateTime)
new.obs$date.graph <- ymd_hms(new.obs$dateTime)
year(new.obs$date.graph) <- 1904
new.obs = mutate(new.obs, `Date/Time` = as.POSIXct(dateTime))
this_year <- current_obs %>%
filter(`Date/Time`< day.filter) %>%
rbind(., new.obs)
# write_csv(this_year, name.file) ## File updates not persistent on server.