X qy implement

DESCRIPTION

@@ -19,7 +19,6 @@ Imports:
     graphics,
     flextable,
     bit64,
-    PearsonDS,
     caTools,
     lubridate,
     plyr,
@@ -34,3 +33,5 @@ Imports:
     sf,
     lmomco,
     e1071
+Suggests: 
+    dataRetrieval

NAMESPACE

@@ -79,7 +79,6 @@ export(water.month.default)
 export(water.month.numeric)
 export(water.year)
 export(xQy)
-import(PearsonDS)
 import(ggplot2)
 import(sqldf)
 import(stringr)

R/DFLOW_xQy.R

@@ -101,7 +101,7 @@ xQyComp <- function(xQy_ann, y){
     n <- length(logFlows)
     #Step 1: Find statistics of log distribution of dates and flows
     u <- mean(logFlows)
-    s <- sqrt(var(logFlows))
+    s <- sqrt(stats::var(logFlows))
 
     #Find skewness using the appropriate method. In DFLOW example, matches type
     #1 but SW toolbox uses type 2
@@ -153,8 +153,9 @@ xQyComp <- function(xQy_ann, y){
 #'   the next analysis year. This makes choosing the correct analysis season
 #'   very important.\cr
 #'   This is functionally equivalent to the VPDES' DFLOW R Shiny application.
-#' @param gageDataIn A data frame containing a date and flow column of daily
-#'   streamflows
+#' @param gageDataIn A data frame or 1-D zoo timeseries containing a date and
+#'   flow column of daily streamflows. If a zoo is passed in, the flowColumn
+#'   argument the flowColumn and dateColumn arguments are ignored
 #' @param flowColumn The column name in gageDataIn that contains the flow values
 #' @param dateColumn The column name in gageDataIn that contains the date
 #'   values. Will be converted to the date class.
@@ -187,24 +188,34 @@ xQyComp <- function(xQy_ann, y){
 #'   the number of days in each analysis year on a non-leap year
 #' @export xQy
 #' @examples
-#' #gageDat <- dataRetrieval::readNWISdv("01631000","00060")
-#' #gageDat <- dataRetrieval::renameNWISColumns(gageDat)
-#' #gageDat <- gageDat[!grepl("P",gageDat$Flow_cd),]
-#' #low_flows <- xQy(gageDataIn = gageDat,
-#' #   flowColumn = "Flow", dateColumn = "Date",
-#' #   AYS = "07-13", AYE = "02-15",
-#' #   startYear = NULL, endYear = NULL,
-#' #   x = 7, y = 10,
-#' #   IncludeSummerFlow = F)
-#' #low_flows$Flows
+#' gageDat <- dataRetrieval::readNWISdv("01631000","00060")
+#' gageDat <- dataRetrieval::renameNWISColumns(gageDat)
+#' gageDat <- gageDat[!grepl("P",gageDat$Flow_cd),]
+#' low_flows <- xQy(gageDataIn = gageDat,
+#'    flowColumn = "Flow", dateColumn = "Date",
+#'    AYS = "07-13", AYE = "02-15",
+#'    startYear = NULL, endYear = NULL,
+#'    x = 7, y = 10,
+#'    IncludeSummerFlow = FALSE)
+#' low_flows$Flows
 xQy <- function(gageDataIn, flowColumn = "Flow", dateColumn = "Date",
-                AYS = "10-01", AYE = "09-30",
+                AYS = "04-01", AYE = "03-31",
                 startYear = NULL, endYear = NULL,
                 x = 7, y = 10,
                 IncludeSummerFlow = FALSE){
-  #Create a simplified copy of the dataset to manipulate
-  gageData <- gageDataIn[,c(dateColumn,flowColumn)]
-  names(gageData) <- c("Date", "Flow")
+  #Is user has passed in a zoo time series, convert to data frame and ensure a
+  #flow and date column exist. This was added for backwards compatibility with
+  #existing OM summary workflows
+  if(zoo::is.zoo(gageDataIn)){
+    gageData <- as.data.frame(gageDataIn)
+    names(gageData) <- "Flow"
+    gageData$Date <- as.Date(zoo::index(gageDataIn))
+  }else{
+    #Create a simplified copy of the dataset to manipulate
+    gageData <- gageDataIn[,c(dateColumn,flowColumn)]
+    names(gageData) <- c("Date", "Flow")
+  }
+
   #Treat negative flows as missing flows, per SW toolbox
   gageData$Flow[gageData$Flow < 0] <- NA
   #Ensure date column exists
@@ -513,7 +524,7 @@ xQy <- function(gageDataIn, flowColumn = "Flow", dateColumn = "Date",
   #uses all data and is not concerned with complete analysis years. This is also
   #easier in terms of communication with external groups just checking gages
   #every day
-  flowCDF <- ecdf(gageData$Flow)
+  flowCDF <- stats::ecdf(gageData$Flow)
   out_xQy$pctg <- flowCDF(out_xQy$xQy)
   out_1Q10$pctg <- flowCDF(out_1Q10$xQy)
   out_7Q10$pctg <- flowCDF(out_7Q10$xQy)
@@ -553,12 +564,12 @@ xQy <- function(gageDataIn, flowColumn = "Flow", dateColumn = "Date",
 }
 
 ## Testing ####
-gageDat <- dataRetrieval::readNWISdv("01631000","00060")
-gageDat <- dataRetrieval::renameNWISColumns(gageDat)
-gageDat <- gageDat[!grepl("P",gageDat$Flow_cd),]
-low_flows <- xQy(gageDataIn = gageDat,
-                 flowColumn = "Flow", dateColumn = "Date",
-                 AYS = "03-01", AYE = "07-31",
-                 startYear = NULL, endYear = NULL,
-                 x = 8, y = 12,
-                 IncludeSummerFlow = F)
+# gageDat <- dataRetrieval::readNWISdv("01631000","00060")
+# gageDat <- dataRetrieval::renameNWISColumns(gageDat)
+# gageDat <- gageDat[!grepl("P",gageDat$Flow_cd),]
+# low_flows <- xQy(gageDataIn = gageDat,
+#                  flowColumn = "Flow", dateColumn = "Date",
+#                  AYS = "03-01", AYE = "07-31",
+#                  startYear = NULL, endYear = NULL,
+#                  x = 8, y = 12,
+#                  IncludeSummerFlow = F)

R/RomEntity.R

@@ -216,6 +216,7 @@ RomEntity <- R6Class(
     #' @param varkey which varkey? defaults to guess Constant and AlphanumericConstant
     #' @param data_matrix dataframe contained rows/cols
     #' @param remote look at remote datasource?
+    #' @param proptext text to set on the property
     #' @returns the property object for this entity
     set_prop = function(
     propname, propcode=NULL,propvalue=NULL,varkey=NULL,

R/TNC_IHA_Ports.R

@@ -133,14 +133,14 @@ water.year <- function (x) {
 #'@references
 #'\url{http://www.nature.org/initiatives/freshwater/conservationtools/art17004.html}
 #' @examples 
-#'# #Get data for NF Shenandoah Mount Jackson
-#'# flows <- dataRetrieval::readNWISdv("01633000",parameterCd = "00060")
-#'# flows <- dataRetrieval::renameNWISColumns(flows)
-#'# #Convert flows to zoo
-#'# flows_zoo <- zoo::as.zoo(x = flows$Flow)
-#'# zoo::index(flows_zoo) <- flows$Date
-#'# #Use group 1 to get the minimum monthly flows:
-#'# hydrotools::group1(flows_zoo,"water",FUN = min)
+#'#Get data for NF Shenandoah Mount Jackson
+#'flows <- dataRetrieval::readNWISdv("01633000",parameterCd = "00060")
+#'flows <- dataRetrieval::renameNWISColumns(flows)
+#'#Convert flows to zoo
+#'flows_zoo <- zoo::as.zoo(x = flows$Flow)
+#'zoo::index(flows_zoo) <- flows$Date
+#'#Use group 1 to get the minimum monthly flows:
+#'group1(flows_zoo,"water",FUN = min)
 #'@importFrom zoo index coredata is.zoo
 #'@importFrom lubridate year month
 #'@export
@@ -202,14 +202,14 @@ group1 <- function (
 #'@author jason.e.law@@gmail.com (imported to Hydrotools by Connor Brogan,connor.brogan@@deq.virginia.gov)
 #'@references \url{http://www.conservationgateway.org/Files/Pages/indicators-hydrologic-altaspx47.aspx}
 #'@examples 
-#'# #Get data for NF Shenandoah Mount Jackson
-#'# flows <- dataRetrieval::readNWISdv("01633000",parameterCd = "00060")
-#'# flows <- dataRetrieval::renameNWISColumns(flows)
-#'# #Convert flows to zoo
-#'# flows_zoo <- zoo::as.zoo(x = flows$Flow)
-#'# zoo::index(flows_zoo) <- flows$Date
-#'# #Use group 2 to get critical period flows and stats:
-#'# hydrotools::group2(flows_zoo,"water",mimic.tnc = TRUE)
+#' #Get data for NF Shenandoah Mount Jackson
+#' flows <- dataRetrieval::readNWISdv("01633000",parameterCd = "00060")
+#' flows <- dataRetrieval::renameNWISColumns(flows)
+#' #Convert flows to zoo
+#' flows_zoo <- zoo::as.zoo(x = flows$Flow)
+#' zoo::index(flows_zoo) <- flows$Date
+#' #Use group 2 to get critical period flows and stats:
+#' group2(flows_zoo,"water",mimic.tnc = TRUE)
 #'@importFrom plyr ddply '.'
 #'@importFrom zoo coredata index
 #'@importFrom lubridate year

R/cia_utils.R

@@ -10,7 +10,8 @@
 #' @export om_find_dh_elid
 om_find_dh_elid <- function(elid, ds) {
 
-  model_search_elid <- fn$sqldf(
+  model_search_elid <- sqldf(
+    paste0(
     "select a.name, a.hydrocode, 
    CASE 
      WHEN a.hydroid IS NULL THEN 'model' 
@@ -36,8 +37,7 @@ om_find_dh_elid <- function(elid, ds) {
      and b.entity_type = 'dh_properties'
    )
    where e.propname = 'om_element_connection'
-   and e.propvalue = $elid
-  ",
+   and e.propvalue = ",elid),
     connection = ds$connection
   )
   if (nrow(model_search_elid) == 0) {
@@ -400,7 +400,7 @@ fn_ALL.upstream <- function(
     getAllSegmentsOnly = TRUE
 ){
   #AllSegList should be a data frame and must contain a river segment column:
-  if(class(AllSegList) != "data.frame" || 
+  if(!inherits(AllSegList, "data.frame") || 
      length(AllSegList$riverseg) == 0){
     stop("The input DATA.FRAME for AllSegList must contain a column
     with the name of \"riverseg\". This column MUST contain all river segments
@@ -431,7 +431,7 @@ fn_ALL.upstream <- function(
   #fn_upstream()
   if(!is.null(riv.seg) &&
      length(riv.seg) > 0 && 
-     class(riv.seg) == 'character'
+     inherits(riv.seg, 'character')
   ){
     #Get only river segments specified by user
     segDataFrame <- segDataFrame[segDataFrame$riverseg %in% riv.seg,]
@@ -609,7 +609,7 @@ fn_downstream <- function(riv.seg, AllSegList) {
   SegDownstream <- ModelSegments$Downstream[SegDownstream]
   SegDownstream <- strsplit(as.character(SegDownstream), "\\+")
   SegDownstream <- try(SegDownstream[[1]], silent = TRUE)
-  if (class(SegDownstream)=='try-error') {
+  if (inherits(SegDownstream, 'try-error')) {
     SegDownstream <- NA
   }
   return(SegDownstream)
@@ -679,38 +679,44 @@ om_ts_diff <- function(df1, df2, col1, col2, op = "<>") {
 
 
 # fn_iha_7q10 
-#'
 #' @name fn_iha_7q10
 #' @title fn_iha_7q10
-#' @description provide the 7q10 from a given flow timeseries
-#' @param zoots a timeseries flormatted in zoo (required by IHA)
-#' @return singel numeric value for 7q10
-#' @import PearsonDS
+#' @description Calculate the 7Q10 from a flow timeseries
+#' @details
+#' This function was originally inspired by the Nature Conservancy's IHA package
+#' and relied on \code{group2()}. However, now this function is just a simple
+#' wrapper of \code{xQy()} to ensure consistency with the rest of DEQ. It takes
+#' in a data frame or zoo timeseries and outputs the 7Q10 as a single value
+#' numeric.
+#' @param zoots a timeseries formatted in zoo or a data frame that contains a
+#'   date and flow column, to be specified by user
+#' @param flowColumnIn If a dataframe is provided to the function, this is the
+#'   name of the column that contains the flow data for analysis. Ignored if a
+#'   zoo timeseries was provided.
+#' @param dateColumnIn If a dataframe is provided to the function, this is the
+#'   name of the column that contains the dates. Ignored if a zoo timeseries was
+#'   provided
+#' @return single numeric value for 7Q10
 #' @export fn_iha_7q10
-#' @examples NA
-#' @seealso NA
-fn_iha_7q10 <- function(zoots) {
-  g2 <- group2(zoots) 
-  #print("Group 2, 7-day low flow results ")
-  #print(g2["7 Day Min"])
-  x <- as.vector(as.matrix(g2["7 Day Min"]))
-  # fudge 0 values
-  # correct for zeroes?? If so, use this loop:
-  # This is not an "approved" method - we need to see how the GS/other authorities handles this
-  for (k in 1:length(x)) {
-    if (x[k] <= 0) {
-      x[k] <- 0.00000001
-      print (paste("Found 0.0 average in year", g2["year"], sep = " "))
-    }
-  }
-  x <- log(x)
-  if (length(x) <= 1) {
-    return(exp(x[1]))
-  } else {
-    pars <- PearsonDS:::pearsonIIIfitML(x)
-    x7q10 <- exp(qpearsonIII(0.1, params = pars$par))
-    return(x7q10);
-  }
+#' @examples
+#' flows <- dataRetrieval::readNWISdv("01631000","00060")
+#' flows <- dataRetrieval::renameNWISColumns(flows)
+#' #Convert flows to zoo
+#' flows_zoo <- zoo::as.zoo(x = flows$Flow)
+#' zoo::index(flows_zoo) <- flows$Date
+#' fn_iha_7q10(flows_zoo)
+#' @seealso xQy
+fn_iha_7q10 <- function(zoots, flowColumnIn = "Flow", dateColumnIn = "Date") {
+  #Calculate critical low flows from the zoo time series
+  low_flows <- xQy(gageDataIn = zoots, flowColumn = flowColumnIn, 
+                   dateColumn = dateColumnIn,
+                   AYS = "04-01", AYE = "03-31",
+                   startYear = NULL, endYear = NULL,
+                   x = 7, y = 10,
+                   IncludeSummerFlow = FALSE)
+  #Return the 7Q10
+  out_7Q10 <- low_flows$Flows$n7Q10
+  return(out_7Q10)
 }
 
 
@@ -732,7 +738,7 @@ fn_iha_mlf <- function(zoots, targetmo, q=0.5) {
   # calculates the 50th percentile - this is the August Low Flow
   # August Low Flow = median flow of the annual minimum flows in August for a chosen time period
   message("Performing quantile analysis")
-  x <- quantile(g1vec, q, na.rm = TRUE);
+  x <- stats::quantile(g1vec, q, na.rm = TRUE);
   return(as.numeric(x));
 }
 
@@ -755,7 +761,7 @@ fn_iha_flow_extreme <- function(flows, metric, stat='min', wyear_type='calendar'
   } else if (stat == 'max') {
     ndx = which.max(as.numeric(metric_flows[,metric]));
   } else if (stat == 'median') {
-    ndx = which(as.numeric(metric_flows[,metric]) == median(as.numeric(metric_flows[,metric])))
+    ndx = which(as.numeric(metric_flows[,metric]) == stats::median(as.numeric(metric_flows[,metric])))
   }
 
   metric_flows_Qout = round(g2flows[ndx,metric],6);

R/dHVariablePluginDefault.R

@@ -553,6 +553,8 @@ dHOMwaterSupplyModelNode <- R6Class(
 
       return(export)
     },
+    #' @param entity The object to find impoundmnet on
+    #' @return FALSE, not yet implemented
     get_impoundment = function(entity) {
       message("Warning: get_impoundment() not yet implemented.")
       # check for full model impoundment, sub-comp impoundment, or link to feature model
@@ -588,11 +590,17 @@ dHOMWaterSystemTieredFlowBy <- R6Class(
 
       return(export)
     },
+    #'@param l The list to convert to matrix
+    #'@return A matrix of values from the list, with one value per row
     list2matrix = function(l) {
       matrix_vals = data.frame(matrix(unlist(l), nrow = length(l), byrow = TRUE)) |>
         setNames(names(l[[1]]))
       return(matrix_vals)
     },
+    #'@param entity The object to store the translated JSON on via set_matrix()
+    #'@param om_json The JSON to translate to a matrix and set on entity
+    #'@return The entity, but the method is primarily designed to set useful
+    #'  values on entity not return anything useful
     translateOMtoDH = function(entity, om_json) {
       matrix_vals = self$list2matrix(om_json$processors$flowby$rule_matrix$matrix_rowcol)
       entity$set_matrix(matrix_vals)

R/fac_utils.R

@@ -44,7 +44,7 @@ om_flow_table <- function(df2sum, q_col = "Qout", mo_col = "month", rdigits = 1)
   for (i in index(month.abb)) {
     moname <- month.abb[i]
     drows <- df2sum[df2sum[,mo_col] == i,]
-    q_drows <- quantile(drows[,q_col], probs=c(0,0.05,0.1,0.25, 0.3, 0.5), na.rm=TRUE)
+    q_drows <- stats::quantile(drows[,q_col], probs=c(0,0.05,0.1,0.25, 0.3, 0.5), na.rm=TRUE)
     q_mean <- mean(drows[,q_col])
     intake_summary_tbl[i,'Min'] <- round(as.numeric(q_drows["0%"]),rdigits)
     intake_summary_tbl[i,"fivep"] <- round(as.numeric(q_drows["5%"]),rdigits)

R/imp_utils.R

@@ -22,24 +22,24 @@ fn_plot_impoundment_flux <- function(
   ymn <- 1
   ymx <- 100
   # par(mar = c(5,5,2,5))
-  par(mar = c(8.8,5,0.5,5))
+  graphics::par(mar = c(8.8,5,0.5,5))
   plot(
     dat[,pur_col] * 100.0,
     ylim=c(ymn,ymx),
     ylab="Reservoir Usable Storage (%)",
     xlab=paste("Model Flow Period",min(index(dat)),"to",max(index(dat)))
   )
-  par(new = TRUE)
+  graphics::par(new = TRUE)
   plot(dat[,Qin_col],col='blue', axes=FALSE, xlab="", ylab="")
-  lines(dat[,Qout_col],col='green')
-  lines(dat[,wd_col] * 1.547,col='red')
+  graphics::lines(dat[,Qout_col],col='green')
+  graphics::lines(dat[,wd_col] * 1.547,col='red')
   graphics::axis(side = 4)
-  mtext(side = 4, line = 3, 'Flow/Demand (cfs)')
+  graphics::mtext(side = 4, line = 3, 'Flow/Demand (cfs)')
   if (legend_on == TRUE) {
-    legend("bottom",inset=-0.36, xpd=TRUE, c("Reservoir Usable Storage","Inflow","Outflow","Demand"),
-           col = c("black", "blue", "green","red"),
-           lty = c(1,1,1,1),
-           bg='white',cex=0.8) 
+    graphics::legend("bottom",inset=-0.36, xpd=TRUE, c("Reservoir Usable Storage","Inflow","Outflow","Demand"),
+                      col = c("black", "blue", "green","red"),
+                      lty = c(1,1,1,1),
+                      bg='white',cex=0.8) 
   }
 }
 

R/om_get_rundata.R

@@ -47,7 +47,7 @@ om_get_rundata <- function(elid, runid, site='http://deq2.bse.vt.edu',
   edate <- as.POSIXct(edate,tz = "EST")
 
   #Get the window of interest from the timeseries
-  dat <- window(dat, start = sdate, end = edate);
+  dat <- stats::window(dat, start = sdate, end = edate);
   #Change mode of zoo to numeric e.g. Convert all fields to numeric
   mode(dat) <- 'numeric'