Channel Measurements and more

.Rbuildignore

@@ -65,3 +65,5 @@ _quarto.yml
 vignettes/basic_slides.Rmd
 vignettes/changes_slides.Rmd
 vignettes/daily_data_statistics.Rmd
+vignettes/continuous_pr.Rmd
+

NAMESPACE

@@ -32,8 +32,6 @@ export(readNGWMNlevels)
 export(readNGWMNsites)
 export(readNWISdata)
 export(readNWISdv)
-export(readNWISgwl)
-export(readNWISmeas)
 export(readNWISpCode)
 export(readNWISpeak)
 export(readNWISrating)
@@ -46,9 +44,12 @@ export(readWQPqw)
 export(readWQPsummary)
 export(read_USGS_samples)
 export(read_waterdata)
+export(read_waterdata_channel)
+export(read_waterdata_combined_meta)
 export(read_waterdata_continuous)
 export(read_waterdata_daily)
 export(read_waterdata_field_measurements)
+export(read_waterdata_field_meta)
 export(read_waterdata_latest_continuous)
 export(read_waterdata_latest_daily)
 export(read_waterdata_metadata)

NEWS

@@ -12,6 +12,10 @@ request object as an attribute to the returned data frames. Setting
 options("dataRetrieval.attach_request" = FALSE) will return a data frame without
 the request attribute
 * Improved time documentation
+* Improved error handling in WQP functions
+* Added read_waterdata_field_meta, read_waterdata_combine_meta, 
+and read_waterdata_channel
+* Removed readNWISgwl and readNWISmeas as services have been turned off
 
 
 dataRetrieval 2.7.22

R/AAA.R

@@ -5,12 +5,14 @@ pkg.env <- new.env()
   pkg.env$nldi_base <- "https://api.water.usgs.gov/nldi/linked-data/"
   pkg.env$local_sf <- requireNamespace("sf", quietly = TRUE)
   options("dataRetrieval.api_version" = "v0")
+  options("dataRetrieval.api_version_stat" = "v0")
   options("dataRetrieval.attach_request" = TRUE)
 
   services <- c("server", "daily", "time-series-metadata",
                "monitoring-locations", "latest-continuous",
                "field-measurements", "latest-daily",
-               "continuous")
+               "continuous", "field-measurements-metadata",
+               "combined-metadata", "channel-measurements")
   collections <- c("parameter-codes", "agency-codes", "altitude-datums", "aquifer-codes",
                    "aquifer-types", "coordinate-accuracy-codes", "coordinate-datum-codes",
                    "coordinate-method-codes", "medium-codes", "counties",

R/constructNWISURL.R

@@ -11,10 +11,8 @@
 #' @param statCd string or vector USGS statistic code only used for daily value service.
 #' This is usually 5 digits.  Daily mean (00003) is the default.
 #' @param service string USGS service to call. Possible values are "dv" (daily values),
-#' "uv" (unit/instantaneous values),
-#' "gwlevels" (groundwater),and "rating" (rating curve),
-#' "peak", "meas" (discrete streamflow measurements),
-#' "stat" (statistics web service BETA).
+#' "uv" (unit/instantaneous values), and "rating" (rating curve),
+#' "peak", "stat" (statistics web service BETA).
 #' @param format string, can be "tsv" or "xml", and is only applicable for daily
 #' and unit value requests.  "tsv" returns results faster, but there is a possibility
 #' that an incomplete file is returned without warning. XML is slower,
@@ -55,9 +53,6 @@
 #' )
 #' url_rating <- constructNWISURL(site_id, service = "rating", ratingType = "base")
 #' url_peak <- constructNWISURL(site_id, service = "peak")
-#' url_meas <- constructNWISURL(site_id, service = "meas")
-#' url_gwl <- constructNWISURL(site_id, service = "gwlevels",
-#'                             startDate = "2024-05-01", endDate = "2024-05-30")
 constructNWISURL <- function(siteNumbers,
                              parameterCd = "00060",
                              startDate = "",
@@ -71,8 +66,8 @@ constructNWISURL <- function(siteNumbers,
                              statType = "mean") {
 
   service <- match.arg(service, c(
-    "dv", "uv", "iv", "iv_recent", "gwlevels",
-    "rating", "peak", "meas", "stat"))
+    "dv", "uv", "iv", "iv_recent", 
+    "rating", "peak", "stat"))
 
   service[service == "meas"] <- "measurements"
   service[service == "uv"] <- "iv"
@@ -212,31 +207,7 @@ constructNWISURL <- function(siteNumbers,
                                 missingData = "off")
            }
          },
-         gwlevels = {
-           url <- get_or_post(baseURL,
-                              POST = POST, 
-                              site_no = siteNumbers,
-                              .multi = "comma")
-           url <- get_or_post(url,
-                              POST = POST, 
-                              format = "rdb")
-           if (nzchar(startDate)) {
-             url <- get_or_post(url,
-                                POST = POST, 
-                                begin_date = startDate)
-           }
-           if (nzchar(endDate)) {
-             url <- get_or_post(url,
-                                POST = POST,  
-                                end_date = endDate)
-           }
-           url <- get_or_post(url,
-                              POST = POST, 
-                              group_key = "NONE",
-                              date_format = "YYYY-MM-DD",
-                              rdb_compression = "value")
-         },
-         { # this will be either dv, uv, groundwater
+         { # this will be either dv, uv
 
            format <- match.arg(format, c("xml", "tsv", "wml1", "wml2", "rdb"))
 

R/dataRetrieval-package.R

@@ -202,6 +202,23 @@ NULL
 #            "AKST", "AKDT", "HAST", "HST", "UTC", "", NA, "GMT")
 # )
 # 
+# services <- c("daily", "time-series-metadata",
+#               "monitoring-locations", "latest-continuous",
+#               "field-measurements", "latest-daily",
+#               "continuous", "field-measurements-metadata",
+#               "combined-metadata", "channel-measurements")
+# 
+# property_list <- list()
+# for(service in services){
+#   property_list[[service]] <- get_properties_for_docs(service)
+# }
+# 
+# num_cols <- c("value", "contributing_drainage_area", "drainage_area",
+#               "altitude_accuracy", "well_construction_depth",
+#               "hole_construction_depth", "channel_flow", "channel_width",
+#               "channel_area", "channel_velocity", "channel_location_distance")
+# 
 # save(countyCd, stateCd, parameterCdFile, pCodeToName,
+#      offsetLibrary, num_cols, property_list,
 #      file = "R/sysdata.rda", compress = "xz")
 # nolint end

R/getWebServiceData.R

@@ -31,8 +31,9 @@ getWebServiceData <- function(obs_url, ...) {
 
   obs_url <- httr2::req_user_agent(obs_url, default_ua())
   obs_url <- httr2::req_throttle(obs_url, rate = 30 / 60) 
-  obs_url <- httr2::req_retry(obs_url,
-                              backoff = ~ 5, max_tries = 3) 
+  obs_url <- httr2::req_retry(obs_url, 
+                              max_tries = 3, 
+                              max_seconds = 180) 
   obs_url <- httr2::req_headers(obs_url,
                                 `Accept-Encoding` = c("compress", "gzip"))
 

R/get_ogc_documentation.R

@@ -100,11 +100,14 @@ get_ogc_params <- function(service){
 #' 
 #' }
 #' 
-get_properties_for_docs <- function(service, output_id){
+get_properties_for_docs <- function(service, output_id = NA){
 
   schema <- check_OGC_requests(endpoint = service, type = "schema")
   properties <- names(schema$properties)
-  properties[properties == "id"] <- output_id
+  if(!is.na(output_id)){
+    properties[properties == "id"] <- output_id    
+  }
+
   return(paste(properties, collapse = ", "))
 
 }

R/importWQP.R

@@ -180,13 +180,11 @@ parse_WQP <- function(retval, tz = "UTC"){
 
       } else if(all(c(date_col, time_col_wqx3, tz_col_wqx3) %in% names(retval))){
         # WQX3
-        if(!all(is.na(retval[[date_col]]))){
           retval <- create_dateTime(retval, 
                                     date_col = date_col,
                                     time_col = time_col_wqx3,
                                     tz_col = tz_col_wqx3,
                                     tz = tz)
-        }        
       } else {
         # This is the legacy pattern:
         time_col <- gsub("Date", "Time.Time", date_col)

R/readNWISdata.R

@@ -19,17 +19,16 @@
 #' list of arguments can also be supplied. One important argument to include is
 #' "service". Possible values are "iv"
 #' (for instantaneous), 
-#' "dv" (for daily values), "gwlevels" (for groundwater levels),
-#' "site" (for site service), "measurement", and "stat" (for
-#' statistics service). Note: "measurement" calls go to:
-#' <https://nwis.waterdata.usgs.gov/usa/nwis> for data requests, and use different call requests schemes.
+#' "dv" (for daily values), 
+#' "site" (for site service), and "stat" (for
+#' statistics service). 
 #' The statistics service has a limited selection of arguments
 #' (see <https://waterservices.usgs.gov/docs/site-service/>).
 #' 
 #' @details This function requires users to create their own arguments
 #' based on the NWIS web services. It is a more complicated function to use
 #' compared to other NWIS functions such as [readNWISdv()], [readNWISuv()],
-#' [readNWISgwl()], etc. However, this function adds a lot of
+#' etc. However, this function adds a lot of
 #' flexibility to the possible queries. This function will also behave exactly 
 #' as NWIS when it comes to date queries. NWIS by default will only return the latest
 #' value for the daily and instantaneous services. So if you do not provide
@@ -94,22 +93,6 @@
 #'   sites = c("04025500", "040263491"),
 #'   service = "iv", parameterCd = "00060"
 #' )
-#' 
-#'
-#' GWL <- readNWISdata(site_no = c("392725077582401", 
-#'                                 "375907091432201"),
-#'                     parameterCd = "62610",
-#'                     service = "gwlevels")
-#'                     
-#' levels <- readNWISdata(stateCd = "WI", 
-#'                        service = "gwlevels",
-#'                        startDate = "2024-05-01",
-#'                        endDate = "2024-05-30") 
-#'                     
-#' meas <- readNWISdata(
-#'   state_cd = "WI", service = "measurements",
-#'   format = "rdb_expanded"
-#' )
 #'
 #' waterYearStat <- readNWISdata(
 #'   site = c("01646500"),
@@ -253,9 +236,7 @@ https://cran.r-project.org/web/packages/dataRetrieval/vignettes/qwdata_changes.h
     } else {
       retval$tz_cd <- rep(tz, nrow(retval))
     }
-  } else if("gwlevels" == service && "parameterCd" %in% names(values)){
-    retval <- retval[retval$parameter_cd %in% values[["parameterCd"]], ]
-  }
+  } 
 
   return(retval)
 }
@@ -428,8 +409,7 @@ readNWISdots <- function(...) {
   }
 
   match.arg(service, c(
-    "dv", "iv", "iv_recent", "gwlevels",
-    "site", "uv", "measurements",
+    "dv", "iv", "iv_recent", "uv", "site",
     "qwdata", "stat", "rating", "peak"
   ))
 
@@ -491,7 +471,7 @@ readNWISdots <- function(...) {
     }
   }
 
-  if (service %in% c("peak", "measurements", "gwlevels")) {
+  if (service %in% c("peak")) {
     format.default <- "rdb"
 
     names(values)[names(values) == "startDT"] <- "begin_date"
@@ -521,24 +501,20 @@ readNWISdots <- function(...) {
     values[["bbox"]] <- paste0(values[["bbox"]], collapse = ",")
   }
 
-  if (service %in% c("peak", "gwlevels") && "stateCd" %in% names(values)) {
+  if (service %in% c("peak") && "stateCd" %in% names(values)) {
     names(values)[names(values) == "stateCd"] <- "state_cd"
     values["list_of_search_criteria"] <- "state_cd"
   }
 
-  if (service %in% c("peak", "gwlevels") && "huc2_cd" %in% names(values)) {
+  if (service %in% c("peak") && "huc2_cd" %in% names(values)) {
     values["list_of_search_criteria"] <- "huc2_cd"
   }
 
-  if(service == "gwlevels" && "aquiferCd" %in% names(values)){
-    values["aquiferCd"] <- "nat_aqfr_cd"
-  }
-
-  if (service %in% c("peak", "gwlevels") && "bBox" %in% names(values)) {
+  if (service %in% c("peak") && "bBox" %in% names(values)) {
     values["list_of_search_criteria"] <- "lat_long_bounding_box"
   }
 
-  if (service %in% c("site", "gwlevels", "stat", "rating", "peak")) {
+  if (service %in% c("site", "stat", "rating", "peak")) {
     format.default <- "rdb"
   }