# marsRainfallPlot ------------------------------------------
# NOTES: Based on plots developed by Dwayne Myers and modified by Katie Swanson 2/4/2019
# Plots hyetographs of events processed by marsDetectEvents function
# IN: dtime_est A vector of times at which rainfall was collected in the storm
# IN: rainfall_in The depth of water that fell at each time, in inches
# OUT: Rainfall hyetograph
#' Plot hyetograph
#'
#' Return hyetograph of events processed by \code{\link{marsDetectEvents}}
#'
#' @param dtime_est vector, POSIXct datetimes representing a single rain event
#' @param rainfall_in vector, num, rainfall in inches for that rain event
#' @param event chr, label for the hyetograph for what rain gage the data came from
#' @param reverse_y logical, whether the Y axes should be reversed
#'
#' @return Output is a ggplot2 object of the hyetograph.
#'
#' @seealso \code{\link[dplyr]{mutate}}, \code{\link[dplyr]{filter}}
#'
#' @export
#'
#' @examples
#' gage_temp <- dplyr::mutate(marsSampleRain,
#' event_id = marsDetectEvents(dtime_est = marsSampleRain$dtime_est,
#' rainfall_in = marsSampleRain$rainfall_in,
#' iet_hr = 6, mindepth_in = 0.10)) %>% dplyr::filter(event_id == 2)
#'
#' marsRainfallPlot(dtime_est = gage_temp$dtime_est,
#' rainfall_in = gage_temp$rainfall_in, event = 2)
marsRainfallPlot <- function(dtime_est, rainfall_in, event, reverse_y = FALSE){
#0. check data
if(length(dtime_est) != length(rainfall_in)){
stop("Datetime and rainfall lengths must be equal")
}
if(length(event) > 1){
stop("Argument 'event' must be of length 1")
}
#1.1 Process data
rain_data <- data.frame(dtimeEST = lubridate::force_tz(dtime_est, tz = "EST"),
rainIN = rainfall_in) %>% dplyr::arrange(dtimeEST)
if(nrow(rain_data) == 0){
stop("No data loaded")
}
#1.3 Assume minimum interval
min_interval <- lubridate::minutes(15)
#1.4 Calculate cumulative rainfall
rain_data <- rain_data %>% dplyr::mutate(cumulative = cumsum(rainIN))
#1.5 Generate title block
startdate <- min(rain_data$dtimeEST) - min_interval
title_text <- paste0("Hyetograph\n| Event: ", event[1],
" | Start Date and Time: ",
scales::date_format("%Y-%m-%d %H:%M", tz = "EST")(startdate),
sep = "")
#1.6 Shift timestep to beginning of measurement interval
rain_data$dtimeEST <- rain_data$dtimeEST - min_interval
#2. Calculate plotting parameters
#2.1 Calculate plotting limits
#Calculate minimum and maximum data values
min_date <- min(rain_data$dtimeEST, na.rm = TRUE)
max_date <- max(rain_data$dtimeEST, na.rm = TRUE)
min_rain <- 0
max_rain <- max(rain_data$rain, na.rm = TRUE)
#calculate scaling factor for secondary y-axis for cumulative rainfall
max_cumulative_scaling <- max(1.1*rain_data$cumulative, na.rm = TRUE)/max_rain
#Calculate ranges in values to set axis breaks by category
event_duration <- max_date - min_date
range_rainfall <- max_rain - min_rain
if(range_rainfall < 0.1){
max_rain <- 0.1 #set minimum rainfall range to 0.1 inches
range_rainfall <- max_rain - min_rain #recalculate if necessary
max_cumulative_scaling<- max(1.1*rain_data$cumulative, na.rm = TRUE)/max_rain #recalculate scaling secondary
}
##Scale fix for events with only one measurement interval
if(nrow(rain_data)==1){
max_cumulative_scaling <- max(rain_data$cumulative, na.rm = TRUE)/max_rain #recalculate scaling secondary
}
#2.2 Calculate break intervals for y-axis
#rainfall categories: <0.15, 0.2, 0.5, >0.5
if(range_rainfall > 0.5){
rain_major_interval <- 0.2
rain_minor_interval <- 0.1
}else{
if(range_rainfall > 0.2){
rain_major_interval <- 0.1
rain_minor_interval <- 0.05
}else{
rain_major_interval <- 0.05
rain_minor_interval <- 0.01
}}
#2.3 Calculate break intervals for x-axis
if(units(event_duration) == "days" & event_duration < 4){
#if event duration is greater than 1 day, set x-axis major breaks to 12-hour intervals
x <- "12 hours"
}else{
if(units(event_duration) == "days" & event_duration >= 4){
x <- paste0(floor(event_duration/4)," days")
}else{
if(event_duration > 12){
#if event duration less 1 day and greater than 12 hours, set x-axis major breaks to 6-hour intervals
x <- "6 hours"
}else{
if(event_duration > 8){
#if event duration less than 12 hours and greater than 8 hours, set x-axis major breaks to 2-hour intervals
x <- "2 hours"
}else{
#for events shorter than 8 hours, set x-axis major breaks to 1-hour intervals
x <- "hour"
}}}}
#2.4 Calculations for dashed vertical line at day boundaries
day_strip <- lubridate::date(min_date)
day_marker <- lubridate::force_tz(seq.POSIXt(as.POSIXlt(day_strip, tz = "EST"), by = "day", length.out = 14), tz = "EST")
#2.5 Calculate axis breaks based on plotting limits
#Select major x-axis breaks based on event duration
major_date_breaks <- lubridate::force_tz(seq.POSIXt(day_marker[1], max_date, by = x), tz = "EST")
#All plots use one-hour interval for minor x-axis breaks
minor_date_breaks <- lubridate::force_tz(seq.POSIXt(day_marker[1], max_date + lubridate::hours(6), by = "hour"), tz = "EST")
#2.6 Add row for cumulative rainfall
#Note - this row forces cumulative rainfall to plot throughout full extent shown, otherwise
# the cumulative rainfall would end at the last rainfall measurement
# end <- data.frame(dtimeEST = c(max_date-min_interval,max_date),
# rainIN = c(0,0),
# cumulative = c(max(rain_data$cumulative),max(rain_data$cumulative)))
# rain_data <- rbind(rain_data, end)
#Which scale function are we using?
if(reverse_y == TRUE){
y_scale_function <- ggplot2::scale_y_reverse
}else{
y_scale_function <- ggplot2::scale_y_continuous
}
rain_data <- rain_data %>% dplyr::distinct(dtimeEST, .keep_all = TRUE)
#3. Plot
hyetograph <-
ggplot2::ggplot(data = rain_data,
ggplot2::aes(x = dtimeEST,
y = cumulative/max_cumulative_scaling)
) +
ggplot2::geom_area(ggplot2::aes(fill = " Cumulative Rainfall "),
color = "grey32",
alpha = 0.2)+
ggplot2::geom_bar(data = rain_data,
ggplot2::aes(x = dtimeEST, y = rainIN, fill = " Rainfall"),
stat = "identity") +
ggplot2::scale_fill_manual(values = c("slateblue1", "cornflowerblue"),
guide = ggplot2::guide_legend(title = NULL,
override.aes = list(
alpha = c(0.2,1))))+
#Day boundaries
ggplot2::geom_vline(xintercept = day_marker, color = "black", linetype = "dashed", linewidth = 1.2) + #date boundaries
# ggplot2::annotate("rect", xmin = day_marker-0.03*event_duration,
# xmax = day_marker - 0.01*event_duration,
# ymin = 0.7*max_rain,
# ymax = 0.9*max_rain,
# alpha = 0.8,
# fill = "white")+
ggplot2::theme_bw() + # a basic black and white theme
ggplot2::scale_x_datetime(
name = " ", # x axis label
labels = scales::date_format("%H:%M", "EST"),
limits = c(min_date - min_interval, max_date), # set x axis limits
breaks = major_date_breaks,
minor_breaks = minor_date_breaks
#expand = c(0.03,0) # control where y axis crosses - first number is fraction of plot left as white space
) +
y_scale_function(
#expand = c(0.03,0), # control where x axis crosses - first number is fraction left as white space
#limits = c(min_rain, max_rain), # set y axis limits
breaks = seq(min_rain, max_rain, by = rain_major_interval),
minor_breaks = seq(min_rain, max_rain, by = rain_minor_interval),
sec.axis = ggplot2::sec_axis(~.*max_cumulative_scaling, name = "Cumulative Rainfall (in)")
) +
ggplot2::labs(
y = "Rainfall (in)",
title = title_text
) +
ggplot2::theme(
axis.text.x = ggplot2::element_text(size = 14, color = "black"), # set font size and color of x axis text
axis.text.y = ggplot2::element_text(size = 14, color = "black"), # set font size and color of y axis text
panel.background = ggplot2::element_rect(fill = "white", colour = NA), # set white background
panel.border = ggplot2::element_rect(fill = NA, colour="black"), # set black border
panel.grid.major = ggplot2::element_line(colour = "grey70", linewidth = 0.2), # set major grid lines
panel.grid.minor = ggplot2::element_line(colour = "grey90", linewidth = 0.5), # set minor grid lines
legend.position = "bottom",
legend.text = ggplot2::element_text(size = 10),
legend.title=ggplot2::element_blank()
)
return(hyetograph)
}
# Pull legend from separate ggplots for combined plot ----------------------
# Function used for created combined legend in gridExtra
# Copied directly from this wiki (accessed May 8, 2019):
#http://www.sthda.com/english/wiki/wiki.php?id_contents=7930
#Description of the arguments:
#IN: myggplot ggplot object
#OUT: Combined legend
#' Get Legend
#'
#' Pull legend from separate ggplots for combined plot
#'
#' @param myggplot ggplot object
#'
#' @return Returns a combined legend
get_legend<-function(myggplot){
tmp <- ggplot2::ggplot_gtable(ggplot2::ggplot_build(myggplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
# marsWaterLevelPlot ----------------------------------
#' Observed and Simulated Water Level Plot
#'
#' Create a plot of observed and simulated (optional) water level
#'
#' @param event Rainfall gage event ID
#' @param structure_name SMP ID and OW Suffix
#' @param obs_datetime Vector of POSIXct datetimes for observed dataset
#' @param obs_level_ft Vector of water level data (ft), corresponding to \code{obs_datetime}
#' @param sim_datetime Vector of POSIXct datetimes for simulated dataset (optional)
#' @param sim_level_ft Vector of water level data (ft), corresponding to \code{sim_datetime} (optional)
#' @param datetime_2 Vector of POSIXct datetimes for observed dataset used for comparison
#' @param level_ft_2 Vector of water level data (ft) used for comparison
#' @param datetime_3 Vector of POSIXct datetimes for observed dataset used for comparison
#' @param level_ft_3 Vector of water level data (ft) used for comparison
#' @param datetime_4 Vector of POSIXct datetimes for observed dataset used for comparison
#' @param level_ft_4 Vector of water level data (ft) used for comparison
#' @param storage_depth_ft Maximum storage depth of system (ft)
#' @param orifice_show TRUE if user wants to include the orifice height as dashed line on plot (optional)
#' @param orifice_height_ft Orifice height, in feet (optional)
#' @param metrics_show Bool, Default FALSE. TRUE if user wants to include a table of metrics on the plot (optional)
#' @param ... additional arguments for showing metrics if metrics_show is set to TRUE. See \code{\link{marsMetricsTable}}
#'
#'
#' @return Output is a ggplot2 object of the water level plot.
#'
#' @export
marsWaterLevelPlot <- function(event,
structure_name,
storage_depth_ft,
obs_datetime,
obs_level_ft,
level_names = NA,
sim_datetime = NA,
sim_level_ft = NA,
orifice_show = FALSE,
orifice_height_ft = NULL,
datetime_2 = NA,
level_ft_2 = NA,
datetime_3 = NA,
level_ft_3 = NA,
datetime_4 = NA,
level_ft_4 = NA,
metrics_show = FALSE,
obs_RSPU,
sim_RSPU,
obs_infil_inhr,
sim_infil_inhr,
obs_draindown_hr,
sim_draindown_hr,
obs_overtopping ,
sim_overtopping){
#1 Process Data
#1.1
#Confirm that storage depth is explicitly defined
if(!is.numeric(storage_depth_ft) | is.na(storage_depth_ft)){
stop("storage_depth is not numeric.")
}
#1.2
#Set negative water levels to zero
obs_level_ft[which(obs_level_ft < 0)] <- 0
# if(!is.na(sim_level_ft[1])){
# sim_level_ft[which(sim_level_ft < 0)] <- 0
# }
#1.3
#Check that data is associated with event
if(length(obs_level_ft) == 0){
stop(paste0("No data loaded in observed Event", event, "."))
}
#1.4 QC check for observed data record
#Using code from marsDetectEvents
prepseries <- obs_datetime %>%
data.frame() %>%
dplyr::mutate(lag_time = dplyr::lag(obs_datetime, 1)) %>%
dplyr::mutate(gap_hr = difftime(obs_datetime, lag_time, units = "hours")) %>%
dplyr::filter(gap_hr > 6)
if(nrow(prepseries) > 0){
message(paste0("Warning: Missing values in observed time series."))
warning_label <- "Warning: Missing values in observed time series."
}else{
warning_label <- ""
}
#1.5
#Check is orifice should be shown
if(orifice_show == TRUE){
orifice_plot <- orifice_height_ft
orifice_lab <- paste0("orifice elevation: ",round(orifice_height_ft, 2))
}else{
orifice_plot <- 0 #line will be covered by bottom of structure if option is not selected
}
#1.6 set default names for levels if none are provided
if(is.na(level_names)){
level_names <- c("Obs. Level 1",
"Obs. Level 2",
"Obs. Level 3",
"Obs. Level 4")
}
#2. Calculate plotting parameters
#2.1 Calculate date plotting limits(x-axis)
#Calculate minimum and maximum data values
if(!is.na(sim_level_ft[1])){
min_date <- min(obs_datetime, sim_datetime, na.rm = TRUE)
max_date <- max(obs_datetime, sim_datetime, na.rm = TRUE)
}else{
min_date <- min(obs_datetime, na.rm = TRUE)
max_date <- max(obs_datetime, na.rm = TRUE) #+ hours(6)
}
#Calculate ranges in values to set axis breaks by category
event_duration <- max_date - min_date
#set date marker offset by duration
if(units(event_duration) == "days"){
marker_scale <- 0.02
day_lengths <- event_duration + 2
}else{
marker_scale <- 0.015
day_lengths <- 14
}
#2.2 Calculations for dashed vertical line at day boundaries
day_strip <- lubridate::date(min_date)
day_marker <- lubridate::force_tz(seq.POSIXt(as.POSIXlt(day_strip, tz = "EST"), by = "day", length.out = day_lengths), tz = "EST")
#2.4 Calculate axis breaks based on plotting limits
#Select major x-axis breaks based on event duration (all extend observed record by 12 hours)
major_date_breaks <- lubridate::force_tz(seq.POSIXt(day_marker[1], max_date, by = "12 hours"), tz = "EST")
#All plots use one-hour interval for minor x-axis breaks
minor_date_breaks <- lubridate::force_tz(seq.POSIXt(day_marker[1] - lubridate::hours(12), max_date + lubridate::hours(6), by = "hour"), tz = "EST")
#2.5 Generate title block
title_text <- paste0("Water Level\nSMP ID: ", structure_name,
" | Event: ", event[1],
" | Start Date and Time: ",
scales::date_format("%Y-%m-%d %H:%M", tz = "EST")(min_date),
sep = "")
# Build dataframes
obs_df <- data.frame(obs_datetime, obs_level_ft)
if(!is.na(sim_level_ft[1])){
sim_df <- data.frame(sim_datetime, sim_level_ft)
}
if(!is.na(level_ft_2[1])){
obs2_df <- data.frame(datetime_2, level_ft_2)
}
if(!is.na(level_ft_3[1])){
obs3_df <- data.frame(datetime_3, level_ft_3)
}
if(!is.na(level_ft_4[1])){
obs4_df <- data.frame(datetime_4, level_ft_4)
}
#3. Generate plot
#3.1 Water Level (observed)
level_plot <-
ggplot2::ggplot(data = obs_df) +
#Day boundaries
ggplot2::geom_vline(xintercept = day_marker, color = "black", linetype = "dashed", linewidth = 1.2) + #date boundaries
ggplot2::annotate("text", x = day_marker-marker_scale*event_duration,
y = 0.8*storage_depth_ft,
label = day_marker,
angle = 90,
size = ggplot2::rel(5))+ #5
#Warning message for data gaps in observed record
ggplot2::annotate("text", x = day_marker[1]+1,
y = 0.5*storage_depth_ft,
label = warning_label, #empty if no warning
hjust = 0,
color = "red",
size = ggplot2::rel(5))+
#Structure top and bottom
ggplot2::geom_hline(yintercept = 0, color = "black", linewidth = 1.2)+ #bottom
ggplot2::geom_hline(yintercept = storage_depth_ft, color = "orange", linewidth = 1.2) + #top
ggplot2::geom_label(x = min_date + event_duration/4,
y = storage_depth_ft*1.04,
label = "Maximum Storage Depth",
size = ggplot2::rel(5),
fill = "white",
label.size = 0) +
# ggplot2::annotate(ggplot2::aes(x = min_date + event_duration/4,
# y = storage_depth_ft*1.04,
# label = "Maximum Storage Depth"),
# size = ggplot2::rel(5),
# fill = "white",
# label.size = 0) +
#Observed water level
ggplot2::geom_line(data = obs_df,
ggplot2::aes(x = obs_datetime,
y = obs_level_ft,
color = paste(level_names[1])),
linewidth = 2
) +
#Formatting
ggplot2::theme_bw() + # a basic black and white theme
ggplot2::scale_x_datetime(
name = " ", # x axis label
labels = scales::date_format("%H:%M", "EST"),
limits = c(min_date - lubridate::minutes(15), max_date + lubridate::minutes(60)), # set x axis limits
breaks = major_date_breaks,
minor_breaks = minor_date_breaks
) +
ggplot2::scale_y_continuous(
breaks = seq(0, storage_depth_ft+1, by = if(storage_depth_ft > 2) round(storage_depth_ft/4, 0) else ceiling(storage_depth_ft/4)),
minor_breaks = seq(-0.5,2*storage_depth_ft, by = 0.1)
) +
ggplot2::scale_color_manual(values = c("#7822E0","#E0DE43","#E03838","#E12CE0","#16E050")) +
ggplot2::labs(
y = "Water Level (ft)",
title = title_text
) +
ggplot2::theme(
#text = element_text(size = rel(2)), #size previously set to 16
axis.title.y = ggplot2::element_text(size = ggplot2::rel(1.2), color = "black"),
axis.text.x = ggplot2::element_text(size = ggplot2::rel(1.2), color = "black"), # set font size and color of x axis text #size previously set to 14
axis.text.y = ggplot2::element_text(size = ggplot2::rel(1.2), color = "black"), # set font size and color of y axis text
panel.background = ggplot2::element_rect(fill = "white", colour = NA), # set white background
panel.border = ggplot2::element_rect(fill = NA, colour="black"), # set black border
panel.grid.major = ggplot2::element_line(colour = "grey70", linewidth = 0.2), # set major grid lines
panel.grid.minor = ggplot2::element_line(colour = "grey90", linewidth = 0.5), # set minor grid lines
legend.position = "bottom", #format legend (to be compiled with rainfall plot in grid.arrange())
legend.text = ggplot2::element_text(size = ggplot2::rel(.9)),
legend.title=ggplot2::element_blank())
if(!is.na(sim_level_ft[1])){
level_plot <- level_plot +
#Simulated water level
ggplot2::geom_line(data = sim_df,
ggplot2::aes(x = sim_datetime,
y = sim_level_ft,
color = "Simulated Water Level"),
linewidth = 2
)
}
if(!is.na(level_ft_2[1])){
level_plot <- level_plot +
#Simulated water level
ggplot2::geom_line(data = obs2_df,
ggplot2::aes(x = datetime_2,
y = level_ft_2,
color = paste(level_names[2])),
linewidth = 2
)
}
if(!is.na(level_ft_3[1])){
level_plot <- level_plot +
#Simulated water level
ggplot2::geom_line(data = obs3_df,
ggplot2::aes(x = datetime_3,
y = level_ft_3,
color = paste(level_names[3])),
linewidth = 2
)
}
if(!is.na(level_ft_4[1])){
level_plot <- level_plot +
#Simulated water level
ggplot2::geom_line(data = obs4_df,
ggplot2::aes(x = datetime_4,
y = level_ft_4,
color = paste(level_names[4])),
linewidth = 2
)
}
if(orifice_show == TRUE){
level_plot <- level_plot +
ggplot2::geom_hline(yintercept = orifice_plot, color = "grey", linetype = 2, linewidth = 1.2) +
ggplot2::geom_label(label = orifice_lab,
y = orifice_height_ft*1.1,
x = obs_datetime[round(0.75*length(obs_datetime))])
}
# Add metrics
if(metrics_show == TRUE){
#set missing values to ""
if( missing(obs_draindown_hr) ){obs_draindown_hr <- ""}
if( missing(sim_draindown_hr) ){sim_draindown_hr <- ""}
if( missing(obs_infil_inhr) ){obs_infil_inhr <- ""}
if( missing(sim_infil_inhr) ){sim_infil_inhr <- ""}
if( missing(obs_RSPU) ){obs_RSPU <- ""}
if( missing(sim_RSPU) ){sim_RSPU <- ""}
if( missing(obs_overtopping) ){obs_overtopping <- ""}
if( missing(sim_overtopping) ){sim_overtopping <- ""}
level_plot %<>% marsMetricsTable( obs_RSPU = obs_RSPU,
obs_infil_inhr = obs_infil_inhr,
obs_draindown_hr = obs_draindown_hr,
obs_overtopping = obs_overtopping,
sim_RSPU = sim_RSPU,
sim_infil_inhr = sim_infil_inhr,
sim_draindown_hr = sim_draindown_hr,
sim_overtopping = sim_overtopping)
}
return(level_plot)
}
# marsCombinedPlot --------------------------------------------------------
#' Plot hyetograph and water level plot on the same chart
#'
#' Return hyetograph and observed and simulated (optional) water level plot for the same rain event on the same chart
#'
#' @param event chr, rain gage event UID
#' @param structure_name chr, SMP ID and OW Suffix
#' @param obs_datetime vector, POSIXct datetimes corresponding to \code{obs_level_ft}
#' @param obs_level_ft vector, water level data (ft), corresponding to \code{obs_datetime}
#' @param sim_datetime vector, POSIXct datetimes corresponding to \code{sim_level_ft} (optional)
#' @param sim_level_ft vector, water level data (ft), corresponding to \code{sim_datetime} (optional)
#' @param storage_depth_ft num, maximum storage depth of system (ft)
#' @param orifice_show TRUE if user wants to include the orifice height as dashed line on plot (optional)
#' @param orifice_height_ft Orifice height, in feet (optional)
#' @param rainfall_datetime vector, POSIXct datetimes corresponding to \code{rainfall_in}
#' @param rainfall_in vector, num, rainfall in inches corresponding to \code{rainfall_datetime}
#' @param metrics_show bool, Default FALSE. TRUE if user wants to include a table of metrics on the plot (optional)
#' @param ... additional arguments for showing metrics (metrics_show = TRUE) and providing multiple water level time series. See \code{\link{marsMetricsTable}} and \code{\link{marsWaterLevelPlot}}
#'
#' @return Output will be a gridExtra object of the two plots
#'
#' @seealso \code{\link{marsRainfallPlot}}, \code{\link{marsWaterLevelPlot}}
#'
#' @export
marsCombinedPlot <- function(event,
structure_name,
obs_datetime,
obs_level_ft,
sim_datetime = NA,
sim_level_ft = NA,
storage_depth_ft,
orifice_show = FALSE,
orifice_height_ft = NULL,
rainfall_datetime,
rainfall_in,
metrics_show = FALSE,
obs_RSPU,
sim_RSPU,
obs_infil_inhr,
sim_infil_inhr,
obs_draindown_hr,
sim_draindown_hr,
obs_overtopping,
sim_overtopping
){
# potential to add back in; updated variable names; kept obs_peak_level_ft
# if(!is.na(obs_peak_level_ft) | !is.na(obs_infil_inhr) | !is.na(obs_percent_storage_relative) | !is.na(obs_draindown_hr)){
# metrics_caption <- paste0("Performance Metrics Obs. Sim. <br />
# Peak Level (ft) ", obs_peak_level_ft[1], " ", sim_peak_level_ft[1], "<br />
# Sat. Infil (in/hr) ", obs_infil_inhr[1], " ", sim_infil_inhr[1], "<br />
# Rel Storage Use % ", obs_RSPU[1], " ", sim_RSPU[1], "<br />
# Draindown Time (hr) ", obs_draindown_hr[1], " ", sim_draindown_hr[1])
# }else{
# metrics_caption <- ""
# }
#Add a last date so the hyetograph looks better
rainfall_in <- append(rainfall_in, 0)
if(!is.na(sim_level_ft[1])){
rainfall_datetime <- append(rainfall_datetime, max(obs_datetime, sim_datetime)) %>% lubridate::with_tz("EST")
}else{
rainfall_datetime <- append(rainfall_datetime, max(obs_datetime)) %>% lubridate::with_tz("EST")
}
#1 Run functions for individual plots
level_plot <- pwdgsi::marsWaterLevelPlot(event = event,
structure_name = structure_name,
obs_datetime = obs_datetime,
obs_level_ft = obs_level_ft,
sim_datetime = sim_datetime,
sim_level_ft = sim_level_ft,
storage_depth_ft = storage_depth_ft,
orifice_show = orifice_show,
orifice_height_ft = orifice_height_ft)
rainfall_plot <- pwdgsi::marsRainfallPlot(event = event,
dtime_est = rainfall_datetime,
rainfall_in = rainfall_in,
reverse_y = TRUE)
#2 Combine Plots
#Save out legends
level_legend <- get_legend(level_plot)
rainfall_legend <- get_legend(rainfall_plot)
#Calculate date plotting limits(x-axis)
#Calculate minimum and maximum data values
if(!is.na(sim_level_ft[1])){
min_date <- min(obs_datetime, sim_datetime, na.rm = TRUE)
max_date <- max(obs_datetime, sim_datetime, na.rm = TRUE)
}else{
min_date <- min(obs_datetime, na.rm = TRUE)
max_date <- max(obs_datetime, na.rm = TRUE) #+ hours(6)
}
#Calculate ranges in values to set axis breaks by category
event_duration <- max_date - min_date
#set date marker offset by duration
if(units(event_duration) == "days"){
marker_scale <- 0.02
}else{
marker_scale <- 0.015
}
#Calculations for dashed vertical line at day boundaries
day_strip <- lubridate::date(min_date)
day_marker <- lubridate::force_tz(seq.POSIXt(as.POSIXlt(day_strip, tz = "EST"), by = "day", length.out = 14), tz = "EST")
#Calculate axis breaks based on plotting limits
#Select major x-axis breaks based on event duration (all extend observed record by 12 hours)
major_date_breaks <- lubridate::force_tz(seq.POSIXt(day_marker[1], max_date, by = "12 hours"), tz = "EST")
#All plots use one-hour interval for minor x-axis breaks
minor_date_breaks <- lubridate::force_tz(seq.POSIXt(day_marker[1] - lubridate::hours(12), max_date + lubridate::hours(6), by = "hour"), tz = "EST")
#Title
title_text <- paste0("Water Level\nSMP ID: ", structure_name,
" | Event: ", event[1],
" | Start Date and Time: ",
scales::date_format("%Y-%m-%d %H:%M", tz = "EST")(min_date),
sep = "")
#Remove legends and titles and update axes
level_plot <- level_plot +
ggplot2::theme(legend.position = "none",
plot.title = ggplot2::element_blank(),
axis.title = ggplot2::element_text(size = ggplot2::rel(1)),
axis.text = ggplot2::element_text(size = ggplot2::rel(.95)))
rainfall_plot <- rainfall_plot +
ggplot2::theme(legend.position = "none",
plot.title = ggplot2::element_text(size = ggplot2::rel(1.35)),
axis.title.x = ggplot2::element_blank(),
axis.text.x = ggplot2::element_blank(),
axis.text.y = ggplot2::element_text(size = ggplot2::rel(1.25)),
axis.title.y = ggplot2::element_text(size = ggplot2::rel(1.25))) +
ggplot2::scale_x_datetime(
name = " ", # x axis label
labels = scales::date_format("%H:%M", "EST"),
limits = c(min_date - lubridate::minutes(15), max_date + lubridate::minutes(60)),
breaks = major_date_breaks,
minor_breaks = minor_date_breaks) +
ggplot2::labs(title = title_text)
# ggplot2::geom_label(ggplot2::aes(x = max_date - (max_date - min_date)*0.1,
# y = Inf,
# label = metrics_caption),
# # size = ggplot2::rel(5),
# size = 4.7,
# fill = "white",
# label.size = 0)
# ggplot2::annotate("richtext", y = Inf, x = max_date - (max_date - min_date)*0.01, vjust=0, hjust = 1, size = 4.7, label = metrics_caption, fill = "white")
# ggplot2::annotate("text", x = max_date - lubridate::minutes(60), y = max(rainfall_in), vjust=0, hjust = 1, label = metrics_caption)
if(metrics_show == TRUE){
#set missing values to ""
if( missing(obs_draindown_hr) ){obs_draindown_hr <- ""}
if( missing(sim_draindown_hr) ){sim_draindown_hr <- ""}
if( missing(obs_infil_inhr) ){obs_infil_inhr <- ""}
if( missing(sim_infil_inhr) ){sim_infil_inhr <- ""}
if( missing(obs_RSPU) ){obs_RSPU <- ""}
if( missing(sim_RSPU) ){sim_RSPU <- ""}
if( missing(obs_overtopping) ){obs_overtopping <- ""}
if( missing(sim_overtopping) ){sim_overtopping <- ""}
level_plot %<>% marsMetricsTable(obs_RSPU = obs_RSPU,
obs_infil_inhr = obs_infil_inhr,
obs_draindown_hr = obs_draindown_hr,
obs_overtopping = obs_overtopping,
sim_RSPU = sim_RSPU,
sim_infil_inhr = sim_infil_inhr,
sim_draindown_hr = sim_draindown_hr,
sim_overtopping = sim_overtopping)
}
#Calculate max width and set both to that value
#Grob
level_grob <- ggplot2::ggplotGrob(level_plot)
rainfall_grob <- ggplot2::ggplotGrob(rainfall_plot)
#Set max width
maxWidth = grid::unit.pmax(level_grob$widths[2:9], rainfall_grob$widths[2:9])
level_grob$widths[2:9] <- maxWidth
rainfall_grob$widths[2:9] <- maxWidth
#Arrange the plots and export
combined_plot <- gridExtra::grid.arrange(rainfall_grob, level_grob, #plots
rainfall_legend, level_legend, #legends
ncol = 1,
heights = c(1.1, 2, 0.15, 0.15),
newpage = TRUE)
return(combined_plot)
}
# marsEventCombinedPlot --------------------------------------------------------
#' Plot hyetograph and observed water level for a single plot the same chart with minimal inputs
#'
#' Return hyetograph and observed water level plot for the same rain event on the same chart
#'
#' @param con An ODBC connection to the MARS Analysis database returned by odbc::dbConnect
#' @param event_date chr or POSIXCT, day during which event occurs
#' @param source chr, rainfall source, one of 'gage'/'gauge' or 'radar'. Defaults to 'radar'
#' @param event_uid int, rain event uid. Alternate to override event_date and rain_source (optional)
#' @param smp_id chr, SMP ID
#' @param ow_suffix chr, OW Suffix
#' @param sump_correct boolean, passed to fetch monitoring date to trim data
#' @param ... additional arguments for showing metrics and overriding orifice/storage elevations. See \code{\link{marsCombinedPlot}}
#'
#' @return Output will be a gridExtra object of the two plots
#'
#' @seealso \code{\link{marsRainfallPlot}}, \code{\link{marsWaterLevelPlot}}, \code{\link{marsCombinedPlot}}
#'
#' @export
marsEventCombinedPlot <- function(con,
event_date,
source = 'radar',
event_uid,
smp_id,
ow_suffix,
sump_correct = TRUE,
orifice_show = FALSE,
orifice_height_ft = NULL,
storage_depth_ft,
metrics_show = FALSE,
obs_RSPU,
sim_RSPU,
obs_infil_inhr,
sim_infil_inhr,
obs_draindown_hr,
sim_draindown_hr,
obs_overtopping,
sim_overtopping
){
##debug
# if(debug == TRUE){
# browser()
# }
## Check DB connection
if(!odbc::dbIsValid(con)){
stop("Argument 'con' is not an open ODBC channel")
}
# Was a string supplied to source?
if( isTRUE(all.equal(source, c("gage", "radar"))) ){
stop("No argument supplied for 'source'. Provide a string of either 'gage' or 'radar'")
}
## Grabbing data from the given inputs
#get ow_uid
ow_query <- paste0("SELECT ow_uid FROM fieldwork.tbl_ow
WHERE smp_id LIKE '",smp_id,
"' AND ow_suffix LIKE '",ow_suffix, "'")
ow_uid <- DBI::dbGetQuery(con, ow_query) |> dplyr::pull()
# check if ow exists
if(length(ow_uid) == 0){
stop("OW does not exist within the fiedlwork database.")
}
if(missing(event_uid)){
#check for one day on either side of the event date
event_date %<>% as.POSIXct(format = '%Y-%m-%d')
start_date <- event_date - 86400
end_date <- event_date + 86400
# browser()
# Grab the data
mon_data <- pwdgsi::marsFetchMonitoringData(con = con,
target_id = smp_id,
ow_suffix = ow_suffix,
start_date = start_date,
source = source,
end_date = end_date,
sump_correct = sump_correct)
event_data <- mon_data$`Rain Event Data`
if(source %in% c('gage','gauge')){
event_uid <- event_data$gage_event_uid
}
if(source == 'radar'){
event_uid <- event_data$radar_event_uid
}
# Stop if no events have been found
if(nrow(event_data) == 0){
stop(paste0("There are no events on ",event_date))}
# pick closest event if multiple events
if(nrow(event_data) > 1){
min_dif <- min(abs(event_data$eventdatastart_est - event_date))
event_data <- event_data[abs(event_data$eventdatastart_est - event_date) == min_dif,]
}
} else {
# browser()
# write event query based on source
if(source %in% c('gage','gauge')){
event_query <- paste0('SELECT * FROM data.tbl_gage_event where gage_event_uid = ',event_uid)
}
if(source == 'radar'){
event_query <- paste0('SELECT * FROM data.tbl_radar_event where radar_event_uid = ',event_uid)
}
# browser()
event_data <- dbGetQuery(con, event_query)
event_date <- event_data$eventdatastart_edt %>% as.Date()
start_date <- event_data$eventdatastart_edt %>% as.Date()
end_date <- event_data$eventdataend_edt %>% as.Date()
# browser()
mon_data <- pwdgsi::marsFetchMonitoringData(con = con,
target_id = smp_id,
ow_suffix = ow_suffix,
start_date = start_date,
source = source,
end_date = end_date,
sump_correct = sump_correct)
}
# get event column name (dependent on radar/gage)
event_col <- colnames(mon_data$`Level Data`)[grep('event',colnames(mon_data$`Level Data`))]
# define individual datasets
# filter out rainfall data not associated with an event
rainfall_data <- mon_data$`Rainfall Data`[!is.na(mon_data$`Rainfall Data`[,event_col]),]
#filter to specific event
rainfall_data <- rainfall_data[rainfall_data[,event_col] == event_data[,event_col],]
# make sure we capture at least three points before the water level response
level_data <- mon_data$`Level Data`
level_data$lvl_lag <- c(diff(level_data$level_ft, 3),0,0,0)
level_data <- level_data %>% dplyr::mutate(lageql = abs(level_ft - lvl_lag)) %>%
dplyr::mutate(isevent = !is.na(level_data[,event_col])) %>%
dplyr::filter(lageql != 0 | isevent) %>%
#remove columns no longer used
dplyr::select(-lvl_lag, -lageql,-isevent)
# level_data <- mon_data$`Level Data`[!is.na(mon_data$`Level Data`[,event_col]),]
#filter to specific event
# level_data <- level_data[level_data[,event_col] == event_data[,event_col],]
#match inputs to marsCombinedPlot
rainfall_in <- rainfall_data$rainfall_in
rainfall_datetime <- rainfall_data$dtime_est
obs_level_ft <- level_data$level_ft
obs_datetime <- level_data$dtime_est
#Define values from snapshot
snapshot <- pwdgsi::marsFetchSMPSnapshot(con = con,
smp_id = smp_id,
ow_suffix = ow_suffix,
request_date = event_date)
#set NA's to 0's
if( is.na(snapshot$orificedepth_ft) ){snapshot$orificedepth_ft <- 0}
# set max storage and orifice defaults when not provided
# browser()
if( missing(orifice_show) ){
orifice_show <- if(snapshot$orificedepth_ft == 0){0}else{1}
}
if( missing(orifice_height_ft) ){
orifice_height_ft <- snapshot$orificedepth_ft
}
if( missing(storage_depth_ft) ){
storage_depth_ft <- snapshot$storage_depth_ft
}
# Combine strings for structure name
structure_name <- paste0(smp_id," | Monitoring Location: ",ow_suffix)
#Add a last date so the hyetograph looks better
rainfall_in <- append(rainfall_in, 0)
rainfall_datetime <- append(rainfall_datetime, max(obs_datetime)) %>% lubridate::with_tz("EST")
#1 Run functions for individual plots
level_plot <- pwdgsi::marsWaterLevelPlot(event = event_data$event_uid[1],
structure_name = structure_name,
obs_datetime = obs_datetime,
obs_level_ft = obs_level_ft,
storage_depth_ft = storage_depth_ft,
orifice_show = orifice_show,
orifice_height_ft = orifice_height_ft)
rainfall_plot <- pwdgsi::marsRainfallPlot(event = event_data$event_uid[1],
dtime_est = rainfall_datetime,
rainfall_in = rainfall_in,
reverse_y = TRUE)
#2 Combine Plots
#Save out legends
level_legend <- cowplot::get_legend(level_plot)
rainfall_legend <- cowplot::get_legend(rainfall_plot)
#Calculate date plotting limits(x-axis)
#Calculate minimum and maximum data values
min_date <- min(obs_datetime, na.rm = TRUE)
max_date <- max(obs_datetime, na.rm = TRUE) #+ hours(6)
#Calculate ranges in values to set axis breaks by category
event_duration <- max_date - min_date
#set date marker offset by duration
if(units(event_duration) == "days"){
marker_scale <- 0.02
}else{
marker_scale <- 0.015
}
#Calculations for dashed vertical line at day boundaries
day_strip <- lubridate::date(min_date)
day_marker <- lubridate::force_tz(seq.POSIXt(as.POSIXlt(day_strip, tz = "EST"), by = "day", length.out = 14), tz = "EST")
#Calculate axis breaks based on plotting limits
#Select major x-axis breaks based on event duration (all extend observed record by 12 hours)
major_date_breaks <- lubridate::force_tz(seq.POSIXt(day_marker[1], max_date, by = "12 hours"), tz = "EST")
#All plots use one-hour interval for minor x-axis breaks
minor_date_breaks <- lubridate::force_tz(seq.POSIXt(day_marker[1] - lubridate::hours(12), max_date + lubridate::hours(6), by = "hour"), tz = "EST")
#Title
title_text <- paste0("Water Level and Rainfall\nSMP ID: ", structure_name,
" | Event: ", event_uid,
" | Start Date and Time: ",
scales::date_format("%Y-%m-%d %H:%M", tz = "EST")(min_date),
sep = "")
#Remove legends and titles and update axes
level_plot <- level_plot +
ggplot2::theme(legend.position = "none",
plot.title = ggplot2::element_blank(),
axis.title = ggplot2::element_text(size = ggplot2::rel(1)),
axis.text = ggplot2::element_text(size = ggplot2::rel(.95)))
rainfall_plot <- rainfall_plot +
ggplot2::theme(legend.position = "none",
plot.title = ggplot2::element_text(size = ggplot2::rel(1.35)),
axis.title.x = ggplot2::element_blank(),
axis.text.x = ggplot2::element_blank(),
axis.text.y = ggplot2::element_text(size = ggplot2::rel(1.25)),
axis.title.y = ggplot2::element_text(size = ggplot2::rel(1.25))) +
ggplot2::scale_x_datetime(
name = " ", # x axis label
labels = scales::date_format("%H:%M", "EST"),
limits = c(min_date - lubridate::minutes(15), max_date + lubridate::minutes(60)),
breaks = major_date_breaks,
minor_breaks = minor_date_breaks) +
ggplot2::labs(title = title_text)
# ggplot2::geom_label(ggplot2::aes(x = max_date - (max_date - min_date)*0.1,
# y = Inf,
# label = metrics_caption),
# # size = ggplot2::rel(5),
# size = 4.7,
# fill = "white",
# label.size = 0)
# ggplot2::annotate("richtext", y = Inf, x = max_date - (max_date - min_date)*0.01, vjust=0, hjust = 1, size = 4.7, label = metrics_caption, fill = "white")
# ggplot2::annotate("text", x = max_date - lubridate::minutes(60), y = max(rainfall_in), vjust=0, hjust = 1, label = metrics_caption)
if( missing(metrics_show) ){metrics_show <- FALSE}
if(metrics_show == TRUE){
#set missing values to ""
if( missing(obs_draindown_hr) ){obs_draindown_hr <- ""}
if( missing(sim_draindown_hr) ){sim_draindown_hr <- ""}
if( missing(obs_infil_inhr) ){obs_infil_inhr <- ""}
if( missing(sim_infil_inhr) ){sim_infil_inhr <- ""}
if( missing(obs_RSPU) ){obs_RSPU <- ""}
if( missing(sim_RSPU) ){sim_RSPU <- ""}
if( missing(obs_overtopping) ){obs_overtopping <- ""}
if( missing(sim_overtopping) ){sim_overtopping <- ""}
level_plot %<>% marsMetricsTable(obs_RSPU = obs_RSPU,
obs_infil_inhr = obs_infil_inhr,
obs_draindown_hr = obs_draindown_hr,
obs_overtopping = obs_overtopping,
sim_RSPU = sim_RSPU,
sim_infil_inhr = sim_infil_inhr,
sim_draindown_hr = sim_draindown_hr,
sim_overtopping = sim_overtopping)
}
#Calculate max width and set both to that value
#Grob
level_grob <- ggplot2::ggplotGrob(level_plot)
rainfall_grob <- ggplot2::ggplotGrob(rainfall_plot)
#Set max width
maxWidth = grid::unit.pmax(level_grob$widths[2:9], rainfall_grob$widths[2:9])
level_grob$widths[2:9] <- maxWidth
rainfall_grob$widths[2:9] <- maxWidth
#Arrange the plots and export
combined_plot <- gridExtra::grid.arrange(rainfall_grob, level_grob, #plots
rainfall_legend, level_legend, #legends
ncol = 1,
heights = c(1.1, 2, 0.15, 0.15))
return(combined_plot)
}
# marsBaroRasterPlot --------------------------------------------------------
#' Barometric Pressure Raster Plot
#'
#' Create a raster plot of barometric pressures from each sensor for each day
#'
#' @param baro a dataframe with columns: \code{smp_id, baro_psi, day, year}
#'
#' @return p, a ggplot2 plot
#'
#' @export
#'
#' @examples
#' marsSampleBaro_plot %<>% dplyr::mutate("day" = yday_decimal(marsSampleBaro_plot$dtime_est),
#' "year" = lubridate::year(marsSampleBaro_plot$dtime_est))
#' marsBaroRasterPlot(marsSampleBaro_plot)
#'
marsBaroRasterPlot <- function(baro){
p <- ggplot2::ggplot(baro, ggplot2::aes(x = day, y = smp_id)) +
ggplot2::facet_grid(. ~ year) +
ggplot2::geom_tile(ggplot2::aes(fill = baro_psi)) +
ggplot2::scale_fill_gradientn(colours = rev(RColorBrewer::brewer.pal(11, "RdBu")), name = "Pressure (psi)") +
ggplot2::theme(axis.text=ggplot2::element_text(colour="black", size=15),
axis.title.x=ggplot2::element_text(colour="black", size=15),
axis.title.y=ggplot2::element_text(colour="black", size=15),
legend.text=ggplot2::element_text(size=15),
legend.title=ggplot2::element_text(size = 15),
strip.text.x = ggplot2::element_text(size = 15),
legend.background = ggplot2::element_blank(),
panel.background = ggplot2::element_blank()) +
ggplot2::xlab("Day") + ggplot2::ylab("Baro Sites")
return(p)
}
# marsOvertoppingPlot ------------------------------------------------------------
#' Add metrics to an existing water level or combined plot
#'
#' Return the gpglot object, with the metrics added to the object as a tableGrob annotation
#'
#' @param data dataframe, a data frame with a unique row each containing ow_uid, radar_event_uid, ow_suffix, eventdatastart_edt, smp_id, eventavgintensity_inhr, eventpeakintensity_inhr, eventdepth_in, and overtop
#' @param design_storm num, a numeric value fro the design stomr in inches, see \code{marsFetchSMPSnapshot}
#' @param event_dates date, a vector of dates to show up as major events in the monitoring locations history (maintenance, retrofit, etc.)
#' @param event_descriptions char, a vector of strings corresponding to labels fo each major event on the plot (eg, "pipe jetting", "filter bag replaced")
#'
#' @return Output ggplot object plotting overtopping, event peak intensity, and date
#'
#' @export
#'
marsOvertoppingPlot <- function(data,
design_storm,
event_dates = NULL,
event_descriptions = NULL){
min_date <- min(data$eventdatastart_edt)
max_date <- max(data$eventdatastart_edt)
#Typical date formats - allows for entry of either date-time or date to function
date_formats <- c(lubridate::guess_formats(data$eventdatastart_edt, "mdy HMS"),
lubridate::guess_formats(data$eventdatastart_edt, "mdy"))
if(!is.null(event_dates)){
event_dates <- event_dates %>% lubridate::as_datetime(format = date_formats)
}
#Set overtop to sizes
data$overtop_sz[data$overtop == FALSE] <- as.numeric(2)
data$overtop_sz[data$overtop == TRUE] <- as.numeric(4)
data$overtop_col[data$overtop == FALSE] <- "#899DA4"
data$overtop_col[data$overtop == TRUE] <- "#C93312"
#subset of data exceeding design storm
data_ovr_design <- data %>% dplyr::filter(eventdepth_in > design_storm)
data <- data %>% dplyr::mutate("ExceedDesignStorm" = ifelse(eventdepth_in > design_storm,"True",NA))
# y-max value
ymax_obs <- max(data$eventpeakintensity_inhr, na.rm = TRUE)
plot_x <- ggplot2::ggplot(data,
ggplot2::aes(x = eventdatastart_edt,
y = eventpeakintensity_inhr)) +
ggplot2::geom_point(ggplot2::aes(color = factor(overtop_col),
size = factor(overtop_sz))) +
ggplot2::geom_hline(yintercept = 2.5, color = "#DC863B", size = 1.5) +
ggplot2::scale_y_continuous(limits = c(0,max(3.6,ymax_obs)), minor_breaks =seq(0,max(3,ymax_obs),0.2)) +
ggplot2::scale_x_datetime(date_minor_breaks = "2 months") +
ggplot2::ylab("Event Peak Intensity (in/hr)") + ggplot2::xlab("Event Date/Time") +
ggplot2::geom_text(label = "Philadelphia 1-year, 15-minute Peak Intensity: 2.5 in/hr",
y = 2.6, color = "black", size = 12 / .pt, hjust = "left",
x = data$eventdatastart_edt[round(0.05*length(data$eventdatastart_edt))]) +
ggplot2::ggtitle(paste0("Event Peak Intensity and Overtopping vs Time for ",data$smp_id[1])) +
#add design storm values
ggplot2::geom_point(ggplot2::aes(x = eventdatastart_edt,
y = eventpeakintensity_inhr, size = factor(overtop_sz), color = factor(overtop_col), shape = factor(ExceedDesignStorm))) +
ggplot2::scale_shape_manual(name = paste0("Exceeds Design Storm Depth: ",round(design_storm,2)," in"), values = c(2), labels = c("True"), na.translate = FALSE) +
ggplot2::scale_color_manual(name = "Overtopping", values = c("#899DA4", "#C93312"), labels = c("False","True"), guide = guide_legend(reverse = TRUE)) +
ggplot2::scale_size_manual(name = "Overtopping", values = c(2,4), labels = c("False","True"), guide = guide_legend(reverse = TRUE)) +
#from pwdgsi plots
ggplot2::theme(
#text = element_text(size = rel(2)), #size previously set to 16
axis.title.y = ggplot2::element_text(size = ggplot2::rel(1.2), color = "black"),
axis.text.x = ggplot2::element_text(size = ggplot2::rel(1.2), color = "black"), # set font size and color of x axis text #size previously set to 14
axis.text.y = ggplot2::element_text(size = ggplot2::rel(1.2), color = "black"), # set font size and color of y axis text
panel.background = ggplot2::element_rect(fill = "whitesmoke", colour = NA), # set white background
panel.border = ggplot2::element_rect(fill = NA, colour="black"), # set black border
panel.grid.major = ggplot2::element_line(colour = "grey70", size = 0.5), # set major grid lines
panel.grid.minor = ggplot2::element_line(colour = "grey90", size = 0.5), # set minor grid lines
legend.position = "bottom", #format legend (to be compiled with rainfall plot in grid.arrange())
legend.text = ggplot2::element_text(size = ggplot2::rel(.9)))
if(length(event_dates) > 0 & length(event_descriptions) > 0){
for(i in 1:length(event_dates)){
plot_x <- plot_x + ggplot2::geom_vline(xintercept = event_dates[i], color = "#DC863B", size = 1.1, linetype = "dashed") +
ggplot2::geom_text(label = event_descriptions[i], angle = 90,
y = 2.7, color = "black", size = 12 / .pt, hjust = "left",
x = as.numeric(event_dates[i] + days(8)))
}
}
return(plot_x)
}
# marsMetricsTable ------------------------------------------------------------
#' Add metrics to an existing water level or combined plot
#'
#' Return the gpglot object, with the metrics added to the object as a tableGrob annotation
#'
#' @param in_plot ggplot object without annotative metrics table
#' @param obs_RSPU num, Metric: Observed relative percentage of storage used, see \code{marsPeakStorage_percent} (optional)
#' @param obs_infil_inhr num, Metric: Observed infiltration rate in inches per hour, see \code{marsInfiltrationRate_inhr} (optional)
#' @param obs_draindown_hr num, Metric: Observed draindown time in hours, see \code{marsDraindown_hr} (optional)
#' @param obs_overtopping bool, Metric: Observed overtopping boolean, see \code{marsOvertoppingCheck_bool} (optional)
#' @param sim_RSPU num, Metric: Simulated relative percentage of storage used, see \code{marsPeakStorage_percent} (optional)
#' @param sim_infil_inhr num, Metric: Simulated infiltration rate in inches per hour, see \code{marsInfiltrationRate_inhr} (optional)
#' @param sim_draindown_hr num, Metric: Simulated draindown time in hours, see \code{marsDraindown_hr} (optional)
#' @param sim_overtopping bool, Metric: Simulated overtopping boolean, see \code{marsOvertoppingCheck_bool} (optional)
#'
#' @return Output ggplot object adding metrics when necessary
#'
#' @export
#'
marsMetricsTable <- function(in_plot,
obs_RSPU,
obs_infil_inhr,
obs_draindown_hr,
obs_overtopping,
sim_RSPU,
sim_infil_inhr,
sim_draindown_hr,
sim_overtopping){
#set missing values to ""
if( missing(obs_draindown_hr) ){obs_draindown_hr <- ""}
if( missing(sim_draindown_hr) ){sim_draindown_hr <- ""}
if( missing(obs_infil_inhr) ){obs_infil_inhr <- ""}
if( missing(sim_infil_inhr) ){sim_infil_inhr <- ""}
if( missing(obs_RSPU) ){obs_RSPU <- ""}
if( missing(sim_RSPU) ){sim_RSPU <- ""}
if( missing(obs_overtopping) ){obs_overtopping <- ""}
if( missing(sim_overtopping) ){sim_overtopping <- ""}
# browser()
if( is.numeric(obs_infil_inhr) & obs_infil_inhr < 0 ){
obs_infil_inhr <- paste0("ERR: ", obs_infil_inhr)
}
if( is.numeric(sim_infil_inhr) & sim_infil_inhr < 0 ){
sim_infil_inhr <- paste0("ERR: ", sim_infil_inhr)
}
if(is.numeric(obs_draindown_hr)){ obs_draindown_hr <- round(obs_draindown_hr,2) %>% as.character}
if(is.numeric(sim_draindown_hr)){ sim_draindown_hr <- round(sim_draindown_hr,2) %>% as.character}
if(is.numeric(obs_infil_inhr)){ obs_infil_inhr <- round(obs_infil_inhr,2) %>% as.character}
if(is.numeric(sim_infil_inhr)){ sim_infil_inhr <- round(sim_infil_inhr,2) %>% as.character}
if(is.numeric(obs_RSPU)){ obs_RSPU <- round(obs_RSPU,2) %>% as.character}
if(is.numeric(sim_RSPU)){ sim_RSPU <- round(sim_RSPU,2) %>% as.character}
# browser()
#------ table version
metric_table <- as.data.frame(matrix(nrow=4))
colnames(metric_table) <- "Metrics"
metric_table$Metrics <- c("Drain down (hrs)",
"Infiltration rate (in/hr)",
"RSPU (%)",
"Overtopping (T/F)")
obs_mets <- c(obs_draindown_hr,obs_infil_inhr, obs_RSPU, obs_overtopping)
sim_mets <- c(sim_draindown_hr,sim_infil_inhr, sim_RSPU, sim_overtopping)
#add columns if obs/sim exists
if(sum(obs_mets == '') < 4){metric_table$Observed <- obs_mets}
if(sum(sim_mets == '') < 4){metric_table$Simulated <- sim_mets}
#remove rows if both are empty
remove <- c()
if(sum(metric_table[1,] == "") == ncol(metric_table)-1){ remove <- c(remove,1)}
if(sum(metric_table[2,] == "") == ncol(metric_table)-1){ remove <- c(remove,2)}
if(sum(metric_table[3,] == "") == ncol(metric_table)-1){ remove <- c(remove,3)}
if(sum(metric_table[4,] == "") == ncol(metric_table)-1){ remove <- c(remove,4)}
metric_table <- metric_table[c(1:4)[!(c(1:4) %in% remove)],]
# determine if we're working with a ggplot object or a grob
if('ggplot' %in% class(in_plot)) plot_type <- "ggplot" else plot_type <- "grob"
if(plot_type == 'ggplot'){
# get ymax value
ymax_val <- max(ggplot_build(in_plot)$layout$panel_scales_y[[1]]$range$range)
#add table to plot
out_plot <- in_plot +
ggplot2::annotation_custom (grob = gridExtra::tableGrob(metric_table,
rows = NULL,
theme = ggpp::ttheme_gtlight()),
ymin = (ymax_val*0.70),
ymax = (ymax_val*0.95),
xmin = in_plot$data$obs_datetime[round(length(in_plot$data$obs_datetime)*0.5)],
xmax = in_plot$data$obs_datetime[round(length(in_plot$data$obs_datetime))])
}
if(plot_type == 'grob'){
# add the table in the water level grob
wl_grob <- in_plot$grobs[[2]] %>% ggpubr::as_ggplot()
in_plot$grobs[[2]] <- (wl_grob +
ggplot2::annotation_custom (grob = gridExtra::tableGrob(metric_table,
rows = NULL,
theme = ggpp::ttheme_gtlight()),
ymin = .7,
ymax = .9,
xmin = 0.5,
xmax = 0.95)) %>% ggplot2::ggplotGrob()
out_plot <- in_plot
}
return(out_plot)
}
# marsSavePlot ------------------------------------------------------------
#' Wrapper function for ggsave that ensures text appears correctly for saved images of pwdgsi plots
#'
#' Return the gpglot object, with the metrics added to the object as a tableGrob annotation
#'
#' @param in_plot ggplot object without annotative metrics table
#' @param filename text, file location to save the document refer to \code{ggsave}
#' @param plot_type text, one of 'combined', 'level', or 'rain' to determine the dimensions to use
#' @param resolution text, one of 'low', 'med', or 'high'. Each consists of default options that can be overwritten with ggsave arguments.
#' @param ... overwrite assumed values of resolution. Accepts existing arguments to ggsave, see \code{ggsave} (optional)
#' @return Output ggplot object adding metrics when necessary
#'
#' @export
#'
marsSavePlot <- function(in_plot = last_plot(),
plot_type,
filename,
resolution = 'med',
...){
if(!(resolution %in% c('low','med','high'))){
stop("Must provided one of 'low', 'med', or 'high' to argument 'resolution'. Values can be overwrittn by providing ggsave arguments.")
}
#resolution options
res_df <- data.frame(name = c('low','med','high'),
dpi = c(75, 150, 250))
res_x <- res_df$dpi[res_df$name == resolution]
if(is.na(plot_type)){
stop("Must provided one of 'level', 'rain', or 'combined' to argument 'plot_type'.")
}
if(!(plot_type %in% c('level','rain','combined'))){
stop("Must provided one of 'level', 'rain', or 'combined' to argument 'plot_type'.")
}
#plot dimensions
plot_df <- data.frame(type = c('level','rain','combined'),
width = c(8, 9.56, 10.67),
height = c(4, 4,8))
width_x <- plot_df$width[plot_df$type == plot_type]
height_x <- plot_df$height[plot_df$type == plot_type]
ggplot2::ggsave(plot = in_plot,
width = width_x,
height = height_x,
dpi = res_x,
filename = filename)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.