Getting an example together for diff stats. Added date range filter t…

…o get_nwc_wb_flow_data.

R/build_nwc_flow_dataset.R

@@ -14,7 +14,7 @@
 #' start_date <- "2008-10-01"
 #' end_date <- "2010-09-30"
 #' build_nwc_flow_dataset(hucs, start_date, end_date)
-build_nwc_flow_dataset <- function(hucs, start_date, end_date) {
+build_nwc_flow_dataset <- function(hucs, start_date="1980-10-01", end_date="2010-09-30") {
 
   if(any(nchar(hucs)!=12)) stop("Must submit 12-digit HUC ids")
 
@@ -28,7 +28,8 @@ build_nwc_flow_dataset <- function(hucs, start_date, end_date) {
   names(peak_threshold) <- hucs
 
   for(huc in hucs) {
-    streamflow <- get_nwc_wb_data(huc, local = FALSE, return_var = "discharge")
+    streamflow <- get_nwc_wb_data(huc, start_date = start_date, end_date = end_date,
+                                  local = FALSE, return_var = "discharge")
 
     fData <- dataCheck(streamflow$discharge[c("date", "data")],yearType="water")
     nwc_dataset[huc] <- list(fData)

R/build_nwis_dv_dataset.R

@@ -37,7 +37,7 @@ build_nwis_dv_dataset <- function(sites, start_date, end_date) {
 
     drainage_area_sqmi[site] <- as.numeric(readNWISsite(site)$drain_area_va)
 
-    peakFlows <- readNWISpeak(siteNumber = site,
+    peakFlows <- readNWISpeak(siteNumbers = site,
                               startDate = start_date,
                               endDate = end_date)
 

R/calculate_stats_diffs.R

@@ -3,26 +3,25 @@
 #' This function accepts observed and modeled data frames of daily flow data and returns a data frame of 
 #' calculated diff statistics
 #' 
-#' @param sites list of usgs station ids
-#' @param startdate startdate for pulling data
-#' @param enddate enddate for pulling data
-#' @param X_DATA_FUN function for pulling data from x_args
-#' @param x_args urls for pulling observed data
-#' @param DRAIN_AREA_FUN function for pulling drainage area
-#' @param drain_args url for pulling drainage area
-#' @param M_DATA_FUN function for pulling modeled data form m_args
-#' @param m_args url for pulling modeled data
+#' @param sites A two column dataframe containing site names for flow_data_a
+#' and flow_data_b flow data.
+#' @param flow_data_a A dataframe containing a NWCCompare flow dataset. 
+#' Should have been cleaned by \link[EflowStats]{dataCheck}
+#' @param flow_data_b A second NWCCompare flow dataset to be compared
+#' to flow_data_a. 
 #' @return statsout data frame of calculated statistics
-#' @import zoo
-#' @import chron
-#' @import doBy
-#' @import lmomco
 #' @importFrom stats aggregate
 #' @export
-calculate_stats_diffs<-function(sites, startdate, enddate, X_DATA_FUN, x_args, DRAIN_AREA_FUN, drain_args, M_DATA_FUN, m_args) {
-  supportedStats=getSupportedStatNames()
-  stats="GoF"
-  tempArrays<-getEmptyResultArrayNWCStats(stats, length(sites), supportedStats)
+#' @examples
+#' # https://cida.usgs.gov/nwc/#!waterbudget/achuc/031300011004
+#' nwis <- "02335757"
+#' huc <- "031300011004"
+#' sites <- data.frame(a=nwis, b=huc)
+#' flow_data_a <- build_nwis_dv_dataset(nwis, start_date = "2004-10-01", end_date = "2010-09-30")
+#' flow_data_b <- build_nwc_flow_dataset(huc, start_date = "2004-10-01", end_date = "2010-09-30")
+#' 
+#' 
+calculate_stats_diffs<-function(sites, flow_data_a, flow_data_b) {
   for (i in 1:length(sites)) {
     site = sites[i]
     m_data <- M_DATA_FUN(m_args[i])

R/get_nwc_data.R

@@ -3,6 +3,8 @@
 #' This function builds a request and returns the the data in question.
 #'
 #' @param huc The watershed of interest.
+#' @param start_date A string representation of the start date in YYYY-MM-DD format.
+#' @param end_date A string representation of the end date in YYYY-MM-DD format.
 #' @param local TRUE/FALSE to request local watershed or total upstream watershed data.
 #' @param return_var A character vector specifying which variables are of interest.
 #' Choose from "all", "et", "prcp", "discharge", and "streamflow". Discharge is
@@ -15,7 +17,7 @@
 #' @examples
 #' NWCdata<-get_nwc_wb_data(huc="031601030306")
 #'
-get_nwc_wb_data<-function(huc, local=FALSE, return_var = "all") {
+get_nwc_wb_data<-function(huc, start_date="1980-09-30", end_date="2010-10-01", local=FALSE, return_var = "all") {
   urls<-list(huc12=list(et="https://cida.usgs.gov/nwc/thredds/sos/watersmart/HUC12_data/HUC12_eta.nc",
                         prcp="https://cida.usgs.gov/nwc/thredds/sos/watersmart/HUC12_data/HUC12_daymet.nc"),
              huc12agg=list(et="https://cida.usgs.gov/nwc/thredds/sos/watersmart/HUC12_data/HUC12_eta_agg.nc",
@@ -48,8 +50,7 @@ get_nwc_wb_data<-function(huc, local=FALSE, return_var = "all") {
        (var_name %in% return_var || "all" %in% return_var)) {
 
       url<-paste0(urlList[var_name],'?request=GetObservation&service=SOS&version=1.0.0&observedProperty=',
-                var_name,'&offering=',huc)
-                # This is valid but not used now: ,'&eventTime=',startdate,'T00:00:00Z/', enddate,'T00:00:00Z'
+                var_name,'&offering=',huc,'&eventTime=',start_date,'T00:00:00Z/', end_date,'T00:00:00Z')
       ts<-parse_swe_csv(url)
 
     if (is.data.frame(ts)) {dataOut[var_name]<-list(ts)}

tests/testthat/test_build_dataset.R

@@ -1,6 +1,6 @@
-context("calculate_stats_by_group")
+context("build_nwis_dv_dataset")
 
-test_that("Original demo for hucs works", {
+test_that("nwis download works", {
   sites <- c("02177000","02178400")
   start_date <- "2008-10-01"
   end_date <- "2010-09-30"
@@ -9,11 +9,19 @@ test_that("Original demo for hucs works", {
   expect_equal(dataout, dataout_check)
 })
 
-test_that("Original demo for hucs works", {
+test_that("huc discharge works", {
   hucs <- c("031601020108","031501100104")
-  start_date <- "2008-10-01"
+  start_date <- "1980-10-01"
   end_date <- "2010-09-30"
   dataout <- build_nwc_flow_dataset(hucs, start_date, end_date)
   dataout_check <- readRDS("data/test_build_nwc_flow_dataset.rds")
   expect_equal(dataout, dataout_check)
+})
+
+test_that("huc discharge with dates", {
+  dataout <- build_nwc_flow_dataset(huc = "031300011004", 
+                         start_date = "2004-10-01", 
+                         end_date = "2010-09-30")
+  dataout_check <- readRDS("data/test_build_nwc_flow_dataset_dates.rds")
+  expect_equal(dataout, dataout_check)
 })