WSC hydrograph

NAMESPACE

@@ -36,8 +36,9 @@ export(ch_get_ECDE_metadata)
 export(ch_get_peaks)
 export(ch_get_url_data)
 export(ch_get_wscstation)
+export(ch_gg_hydrographs)
 export(ch_high_Grubbs_test)
-export(ch_hydrograph_plot)
+export(ch_model_hydrograph)
 export(ch_polar_plot)
 export(ch_polar_plot_peaks)
 export(ch_polar_plot_prep)
@@ -73,6 +74,9 @@ export(ch_wbt_removesinks)
 export(ch_wtr_yr)
 import(TeachingDemos)
 import(circular)
+import(dplyr)
+import(ggplot2)
+import(tidyhydat)
 importFrom(Kendall,MannKendall)
 importFrom(MGBT,MGBT)
 importFrom(dplyr,left_join)

R/Visualization_functions.R

@@ -4,11 +4,14 @@
 #' some analyses may also be done.
 #' \describe{
 #'  \item{ch_booth_plot}{Plot of peaks over a threshold}
+#'  \item{ch_ffa_screen_plot}{FFA screening plot}
 #'  \item{ch_flow_raster}{Raster plot of streamflows}
 #'  \item{ch_flow_raster_qa}{Raster plot of streamflows with WSC quality flags}
+#'  \item{ch_gg_hydrographs}{ggplot2 hydrographs of WSC flows}
 #'  \item{ch_flow_raster_trend}{Raster plot and simple trends of observed streamflows}
-#'  \item{ch_hydrograph_plot}{Plots hydrographs and/or precipitation}
+#'  \item{ch_model_hydrograph}{Plots hydrographs and/or precipitation}
 #'  \item{ch_polar_plot}{Polar plot of daily streamflows}
+#'  \item{ch_qa_hydrograph}{Plots a hydrograph with the data quality symbols}
 #'  \item{ch_regime_plot}{Plots the regime of daily streamflows}
 #' }
 NULL

R/ch_gg_hydrographs.R

@@ -0,0 +1,205 @@
+#' Hydrographs for WSC stations using \pkg{ggplot2}
+#' 
+#' @description
+#' Acquires and plots values for WSC streamflows, using \pkg{ggplot2}. The existing 
+#' functions \code{ch_qa_hydrograph} and
+#' \code{ch_model_hydrograph} use basic \R plotting, require other functions to 
+#' assemble the values, and only plot
+#' values for a single station. This function is
+#' able to plot hydrographs for more than one station, which may be useful, particularly 
+#' when comparing responses for several streams in the same region.
+#' @param WSC_stations Required. A vector of WSC station numbers.
+#' @param daily Optional. If TRUE, mean daily streamflows are plotted as stair-steps.
+#' @param instantaneous Optional. If TRUE, annual instantaneous peak flows are plotted as points.
+#' @param facets Optional. If TRUE, the plot is faceted by station number.
+#' @param common_dates Optional. If TRUE, a common date range is used for all 
+#' time series.
+#' @param start_date Optional. If specified (format = yyyy-mm-dd), only values on 
+#' or following the date are plotted.
+#' @param end_date Optional. If specified (format = yyyy-mm-dd), only values on or 
+#' before the date are plotted.
+#' @param hydat_path Optional. Path to the HYDAT database. Usually omitted unless 
+#' you want to use a specific database file.
+#' @param inst_colour Optional. Colour to be used for annual instantaneous peaks, 
+#' if either facetted or only a single station is plotted. Default is "black".
+#' @param daily_colour Optional. Colour to be used for daily flows, 
+#' if either facetted or only a single station is plotted. Default is "black".
+#' @param ... Other parameters for the \pkg{ggplot} facets, if specified.
+#' @author Kevin Shook
+#' @seealso  \code{\link{ch_qa_hydrograph}}  \code{\link{ch_model_hydrograph}} 
+#' @returns Returns a \code{ggplot2} object of the hydrographs.
+#' @export
+#' @import ggplot2 dplyr tidyhydat
+#'
+#' @examples {
+#' # plot a single station
+#' stations <- c("05HH003")
+#' p <- ch_gg_hydrographs(stations, daily = TRUE, instantaneous = TRUE)
+#' 
+#' # plot a group of stations in a region, as all appear to be responding to the same event
+#' stations <-  c("05CC001", "05CC011", "05CD006", "05CD007", "05CE002", "05CE006", 
+#' "05CE010", "05CE012", "05CE018", "05CE020", "05CG004", "05CG006")
+#' 
+#' p <- ch_gg_hydrographs(stations, daily = TRUE, instantaneous = FALSE, 
+#' common_dates = FALSE, start_date = "2011-06-01", end_date = "2011-06-30", 
+#' facets = TRUE, scales = "free_y", ncol= 3)
+#' }
+
+ch_gg_hydrographs <- function(WSC_stations, 
+                               daily = TRUE, 
+                               instantaneous = FALSE, 
+                               facets = TRUE, 
+                               common_dates = FALSE,
+                               start_date = NULL, 
+                               end_date = NULL,
+                               hydat_path = NULL, 
+                               inst_colour = "black",
+                               daily_colour = "black",
+                              ...) {
+  # set up plot values
+  Datetime <- NULL 
+  Value <- NULL
+  start_year <- NULL
+  end_year <- NULL
+  STATION_NUMBER <- NULL
+
+  if (is.null(daily_colour))
+    daily_colour <- "black"
+
+  if (is.null(inst_colour))
+    inst_colour <- "black"
+
+
+  # check parameter values
+  if (!daily & !instantaneous)
+    stop("No plots selected")
+
+  if (is.null(WSC_stations) | length(WSC_stations) == 0 )
+    stop("No stations selected")
+
+  if (!is.null(start_date)) {
+    start_date_val <- as.Date(start_date, format = "%Y-%m-%d")
+    start_year <- as.numeric(format(start_date_val, format = "%Y"))
+  }
+
+  if (!is.null(end_date)) {
+    end_date_val <- as.Date(end_date, format = "%Y-%m-%d")
+    end_year <- as.numeric(format(end_date_val, format = "%Y"))
+  }
+
+  # get number of stations
+  num_stations <- length(WSC_stations)
+
+  # get WSC data for plotting and find min and max dates
+  if (daily) {
+    wsc_daily <- hy_daily_flows(WSC_stations, 
+                                start_date = start_date, 
+                                end_date = end_date)
+
+    wsc_daily$Datetime <- as.POSIXct(wsc_daily$Date, format = "%Y-%m-%d")
+    daily_min_max_dates <- wsc_daily %>% group_by(STATION_NUMBER) %>% 
+      summarise(min_Datetime = min(Datetime), max_Datetime = max(Datetime))
+
+    common_daily_min_Datetime <- max(daily_min_max_dates$min_Datetime)
+    common_daily_max_Datetime <- min(daily_min_max_dates$max_Datetime)
+  }
+
+  if (instantaneous) {
+    wsc_inst <- hy_annual_instant_peaks(WSC_stations,
+                                        start_year = start_year, 
+                                        end_year = end_year)
+
+    wsc_inst <- wsc_inst[wsc_inst$Parameter == "Flow" & wsc_inst$PEAK_CODE == "MAX",]
+
+    # remove wsc_inst values with missing datetimes
+    wsc_inst <- wsc_inst[!is.na(wsc_inst$Datetime),]
+
+    inst_min_max_dates <- wsc_inst %>% group_by(STATION_NUMBER) %>% 
+      summarise(min_Datetime = min(Datetime), max_Datetime = max(Datetime))
+    common_inst_min_Datetime <- max(inst_min_max_dates$min_Datetime)
+    common_inst_max_Datetime <- min(inst_min_max_dates$max_Datetime)
+  }
+
+  if (common_dates) {
+    if (daily & !instantaneous) {
+      common_min_Datetime <- common_daily_min_Datetime
+      common_max_Datetime <- common_daily_max_Datetime
+      wsc_daily <- wsc_daily[wsc_daily$Datetime >= common_min_Datetime,]
+      wsc_daily <- wsc_daily[wsc_daily$Datetime <= common_max_Datetime,]
+    } else if (!daily & instantaneous) {
+
+      common_min_Datetime <- as.POSIXct(paste0(format.Date(common_inst_min_Datetime, "%Y"), "-01-01 00:00:00"),
+                                        format = "%Y-%m-%d %H:%M:%S")
+      common_max_Datetime <- as.POSIXct(paste0(format.Date(common_inst_max_Datetime, "%Y"), "-12-31 23:45:00"),
+                                        format = "%Y-%m-%d %H:%M:%S")
+
+      wsc_inst <- wsc_inst[wsc_inst$Datetime >= common_min_Datetime,]
+      wsc_inst <- wsc_inst[wsc_inst$Datetime <= common_max_Datetime,]
+
+    } else {
+      common_min_Datetime <- common_daily_min_Datetime
+      common_max_Datetime <- common_daily_max_Datetime
+
+      wsc_daily <- wsc_daily[wsc_daily$Datetime >= common_min_Datetime,]
+      wsc_daily <- wsc_daily[wsc_daily$Datetime <= common_max_Datetime,]
+
+      wsc_inst <- wsc_inst[wsc_inst$Datetime >= common_min_Datetime,]
+      wsc_inst <- wsc_inst[wsc_inst$Datetime <= common_max_Datetime,]
+    }
+  }
+   # plot
+  if (daily & !instantaneous) {
+    if (!facets)
+      if(num_stations > 1)
+        p <- ggplot(wsc_daily, aes(Datetime, Value, colour = STATION_NUMBER)) +
+        geom_step(direction = "hv")
+       else
+        p <- ggplot(wsc_daily, aes(Datetime, Value)) +
+        geom_step(direction = "hv", colour = daily_colour)
+    else
+      p <- ggplot(wsc_daily, aes(Datetime, Value)) +
+        geom_step(direction = "hv", colour = daily_colour) +
+        facet_wrap(~STATION_NUMBER, ...)
+
+  } else if (!daily & instantaneous) {
+    if (!facets) {
+      if (num_stations == 1 ){
+         p <- ggplot(wsc_inst, aes(Datetime, Value)) +
+           geom_point(colour = inst_colour)
+      } else {
+          p <- ggplot(wsc_inst, aes(Datetime, Value, colour = STATION_NUMBER)) +
+            geom_point()
+      }
+    }  else {
+      # facets
+      p <- ggplot(wsc_inst, aes(Datetime, Value)) +
+        geom_point(colour = inst_colour) +
+        facet_wrap(~STATION_NUMBER, ...)
+
+    }  
+
+  } else {
+    # daily and instantaneous
+    if (!facets){
+      if (num_stations == 1){
+        p <- ggplot(wsc_daily, aes(Datetime, Value)) +
+          geom_step(direction = "hv", colour = daily_colour) +
+          geom_point(data = wsc_inst, aes(Datetime, Value),colour = inst_colour, ...)
+      } else {
+        p <- ggplot(wsc_daily, aes(Datetime, Value, colour = STATION_NUMBER)) +
+          geom_step(direction = "hv") +
+          geom_point(data = wsc_inst, aes(Datetime, Value), ...)
+      }
+    }
+    else
+      p <- ggplot(wsc_daily, aes(Datetime, Value)) +
+        geom_step(direction = "hv", colour = daily_colour) +
+        geom_point(data = wsc_inst, aes(Datetime, Value), colour = inst_colour) +
+        facet_wrap(~STATION_NUMBER, ...)
+  }
+
+  # add labels
+  p <- p + xlab("") + ylab(expression(paste("Discharge (m", ""^{ 3 }, "/s)", sep = "")))
+
+  return(p)
+}

R/ch_hydrograph_plot.R → R/ch_model_hydrograph.R

@@ -1,9 +1,9 @@
-#' @title Hydrograph plot
+#' @title Hydrograph plot for model outputs and gauged flows
 #'
 #' @description 
-#' Creates a hydrograph plot for simulated, observed, and inflow
-#' hydrograph series, including precipitation if provided. The secondary y axis 
-#' will be used to plot the precip time series.
+#' Creates a hydrograph plot for simulated and observed flows, including 
+#' precipitation if provided. The secondary y axis 
+#' is used to plot the precipitation time series.
 #' 
 #' @details
 #' Assumes that the supplied time series have the same length and
@@ -40,12 +40,13 @@
 #' small buffer for presentation. Be warned that if this option is set to
 #' TRUE, the minimum value is set to zero without checking if any flow values
 #' are less than zero. This option should not be used for reservoir stage plotting, since
-#' most reservoir stage is typically reported as an elevation.
+#' most reservoir stages are typically reported as geodetic elevations, where the
+#' minimum values are much greater than zero.
 #' 
 #' @return Returns \code{TRUE} if the function is executed properly.
 #' 
 #' @author Robert Chlumsky
-#' 
+#' @seealso  \code{\link{ch_qa_hydrograph}}  \code{\link{ch_gg_hydrographs}} 
 #' @examples
 #' # example with synthetic random data
 #' dd <- seq.Date(as.Date("2010-10-01"), as.Date("2013-09-30"),by = 1)
@@ -57,21 +58,21 @@
 #' precip <- data.frame("Date" = dd," precip" = abs(rnorm(length(dd))) * 10)
 #'
 #' # basic hydrograph plot
-#' ch_hydrograph_plot(flows = df, winter_shading = FALSE)
+#' ch_model_hydrograph(flows = df, winter_shading = FALSE)
 #'
 #' # with different labels and winter shading
-#' ch_hydrograph_plot(flows = df, winter_shading = TRUE,
+#' ch_model_hydrograph(flows = df, winter_shading = TRUE,
 #'  flow_labels = c("simulated", "observed"))
 #'
 #' # add precipitation, increase the plot ranges to separate flows and precip, and add a legend box
-#' ch_hydrograph_plot(flows = df, precip = precip, range_mult_flow = 1.7, 
+#' ch_model_hydrograph(flows = df, precip = precip, range_mult_flow = 1.7, 
 #' range_mult_precip = 2, leg_box = TRUE)
 #' 
 #' @importFrom lubridate year month day date
 #' @importFrom graphics grid lines
 #' @export
 #' 
-ch_hydrograph_plot <- function(flows = NULL, 
+ch_model_hydrograph <- function(flows = NULL, 
                             precip = NULL, 
                             prd = NULL, 
                             winter_shading = FALSE,