Field measurements

.Rbuildignore

@@ -96,6 +96,7 @@ vignettes/Wide_data_example.xlsx
 vignettes/messyData.png
 ^ci$
 ^public$
+^tutorials$
 ^docker$
 vignettes/WQX_3.Rmd
 vignettes/samples_data.Rmd

.github/workflows/R-CMD-check.yaml

@@ -27,6 +27,7 @@ jobs:
       API_USGS_PAT: ${{ secrets.API_USGS_PAT }}
       R_KEEP_PKG_SOURCE: yes
       CUSTOM_DR_UA: 'GitHub_CI'
+      _R_CHECK_DONTTEST_EXAMPLES_: false
 
     steps:
       - uses: actions/checkout@9a9194f87191a7e9055e3e9b95b8cfb13023bb08

.github/workflows/pkgdown.yaml

@@ -59,12 +59,18 @@ jobs:
             any::gridExtra
             local::.
           needs: website
-
+      - name: Create public directory
+        run: |
+          mkdir public
       - name: Build site
         run: |
-          pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE, dest_dir = "public") |
+          pkgdown::build_site(override = list(destination = "public")) |
           file.copy(from = "./public/articles/logo.png",to = "./public/reference/logo.png")
         shell: Rscript {0}
+      - name: Set up Quarto
+        uses: quarto-dev/quarto-actions/setup@v2
+      - name: Render Quarto Project
+        uses: quarto-dev/quarto-actions/render@v2
       - name: Upload artifact
         uses: actions/upload-pages-artifact@56afc609e74202658d3ffba0e8f6dda462b719fa
         with:

.gitignore

@@ -12,3 +12,8 @@ docs
 /doc/
 /Meta/
 /Temp/
+vignettes/*.html
+vignettes/*.R
+
+
+/.quarto/

.gitlab-ci.yml

@@ -23,9 +23,9 @@ variables:
   _R_CHECK_FORCE_SUGGESTS_: "true"
   _R_CHECK_DONTTEST_EXAMPLES_: "false"
   R_PROFILE: "$R_HOME/etc/Rprofile.site"
+  R_LIBS_USER: "$CI_PROJECT_DIR/ci/lib"
   APT_CACHE: "$CI_PROJECT_DIR/ci/lib/apt-cache"
   CRAN: "https://rpkg.chs.usgs.gov/prod-cran/latest"
-  R_LIBS_USER: "$CI_PROJECT_DIR/ci/lib"
   R_LIBS: "$CI_PROJECT_DIR/ci/lib"
   BUILD_LOGS_DIR: "$CI_PROJECT_DIR/ci/logs"
   NOT_CRAN: "true"
@@ -43,7 +43,6 @@ build-image:
   rules:
     - changes:
       - docker/Dockerfile
-      - .gitlab-ci.yml
   script:
     - echo ${CI_REGISTRY_PASSWORD} | docker login -u ${CI_REGISTRY_USER} --password-stdin $CI_REGISTRY
     - docker pull ${CI_REGISTRY_IMAGE}:latest || true
@@ -59,7 +58,7 @@ buildcheck:
   dependencies:
     - build-image
   script:
-    - R CMD build . --no-manual
+    - Rscript -e 'devtools::install(quick = TRUE, upgrade = "never")'
     - Rscript -e 'devtools::check(document = FALSE, args = "--no-tests", check_dir = Sys.getenv("BUILD_LOGS_DIR"), vignettes = FALSE)'
 
 unittests:
@@ -97,10 +96,15 @@ longtest:
 
 pages:
   stage: end
-  cache: []
+  dependencies:
+    - build-image
+    - buildcheck
   script:
+    - Rscript -e 'devtools::install(quick = TRUE, upgrade = "never")'
     - Rscript -e 'pkgdown::build_site(override = list(destination = "public"))'
     - Rscript -e 'file.copy(from = "./public/articles/logo.png", to = "./public/reference/logo.png")'
+    - quarto render
+
   artifacts:
     paths:
       - $PAGES_OUTDIR
@@ -119,5 +123,3 @@ Validate Inventory:
         --token "${GIT_TOKEN_CUSTOM}"
     tags:
         - chs-shared
-
-

.gitlab/issue_templates/waterdata_additions.md

@@ -0,0 +1,29 @@
+---
+name: New waterdata function
+about: Checklist for adding new USGS waterdata endpoint
+---
+
+New features should include all of the following work:
+
+* [ ] Create the `read_waterdata_` file. File should:
+  - [ ] Update endpoint name
+  - [ ] Update parameter list in Roxygen section
+  - [ ] Update arguments
+  - [ ] Update examples
+  - [ ] Think about if sorting looks right, if convertType should be used, etc.
+* [ ] Add endpoint name to AAA.R `.onLoad`
+* [ ] Add deprecate notice to corresponding NWIS function
+* [ ] Comment out or delete deprecated NWIS examples
+* [ ] Replace any NWIS tests with new waterdata function
+* [ ] Create new tests in tests/testthat folder for unique situations
+* [ ] Add example to read_waterdata_functions.Rmd vignette
+* [ ] Update Status.Rmd vignette
+* [ ] Update dataRetrieval.Rmd vignette
+* [ ] Update tutorial.Rmd vignette
+* [ ] Update NEWS
+* [ ] Update _pkgdown.yml
+* [ ] Check if README needs to be updated
+* [ ] Update version (for development, only bump up last 4 digits)
+* [ ] Create PR for "develop" branch on GitHub
+* [ ] Create and merge MR for "develop" branch on code.usgs.gov. This will generate development version of documentation.
+

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: dataRetrieval
 Type: Package
 Title: Retrieval Functions for USGS and EPA Hydrology and Water Quality Data
-Version: 2.7.20
+Version: 2.7.21
 Authors@R: c(
     person("Laura", "DeCicco", role = c("aut","cre"),
             email = "[email protected]",

NAMESPACE

@@ -47,6 +47,7 @@ export(readWQPsummary)
 export(read_USGS_samples)
 export(read_waterdata)
 export(read_waterdata_daily)
+export(read_waterdata_field_measurements)
 export(read_waterdata_latest_continuous)
 export(read_waterdata_metadata)
 export(read_waterdata_monitoring_location)

NEWS

@@ -1,3 +1,10 @@
+dataRetrieval 2.7.21
+===================
+* Added read_waterdata_field_measurements to access new USGS water data API.
+* Added deprecation warning to readNWISgwl and readNWISmeas.
+* Added parent_time_series_id to read_waterdata_ts_meta.
+* Updated some documentation.
+
 dataRetrieval 2.7.20
 ===================
 * Added id transformation to read_waterdata to match other functions

R/AAA.R

@@ -7,7 +7,8 @@ pkg.env <- new.env()
   options("dataRetrieval" = list("api_version" = "v0"))
 
   services <- c("server", "daily", "time-series-metadata",
-               "monitoring-locations", "latest-continuous")
+               "monitoring-locations", "latest-continuous",
+               "field-measurements")
   collections <- c("parameter-codes", "agency-codes", "altitude-datums", "aquifer-codes",
                    "aquifer-types", "coordinate-accuracy-codes", "coordinate-datum-codes",
                    "coordinate-method-codes", "medium-codes", 

R/constructNWISURL.R

@@ -293,7 +293,7 @@ constructNWISURL <- function(siteNumbers,
   )
 
   url <- httr2::req_headers(url,
-                     `Accept-Encoding` = c("compress", "gzip", "deflate")) 
+                     `Accept-Encoding` = c("compress", "gzip", "deflate"))
 
   return(url)
 }
@@ -426,7 +426,7 @@ constructWQPURL <- function(siteNumbers,
   }
 
   baseURL <- httr2::req_headers(baseURL,
-                                `Accept-Encoding` = c("compress", "gzip", "deflate")) 
+                                `Accept-Encoding` = c("compress", "gzip", "deflate"))
 
   return(baseURL)
 }

R/construct_api_requests.R

@@ -85,10 +85,12 @@ construct_api_requests <- function(service,
     POST = TRUE
   }
 
+  get_list <- get_list[!is.na(get_list)]
+
   time_periods <- c("last_modified", "datetime", "time", "begin", "end")
   if(any(time_periods %in% names(get_list))){
 
-    for(i in time_periods){
+    for(i in time_periods[time_periods %in% names(get_list)]){
       dates <- FALSE
       if (all(service == "daily" & i != "last_modified")){
         dates <- TRUE
@@ -299,6 +301,7 @@ switch_properties_id <- function(properties, id_name, service){
 #' 
 #' start <- c("2021-01-01", NA)
 #' dataRetrieval:::format_api_dates(start)
+#' dataRetrieval:::format_api_dates(start, TRUE)
 #' 
 #' end <- c(NA, "2021-01-01")
 #' dataRetrieval:::format_api_dates(end)
@@ -316,10 +319,12 @@ switch_properties_id <- function(properties, id_name, service){
 #'                           
 #' dataRetrieval:::format_api_dates(start_end)
 #' 
+#' # If you don't specify a timezone, it will assume UTC
 #' start_end2 <- c("2021-01-01 12:15:00", "")
 #' dataRetrieval:::format_api_dates(start_end2)
 #' 
-#' start_end2 <- c("2021-01-01T12:15:00Z", "")
+#' # If you do specify a timezone, it should maintain it, but convert to UTC:
+#' start_end2 <- c("2021-01-01T12:15:00-0500", "")
 #' dataRetrieval:::format_api_dates(start_end2)
 #' 
 format_api_dates <- function(datetime, date = FALSE){
@@ -336,18 +341,18 @@ format_api_dates <- function(datetime, date = FALSE){
         return(datetime)
       } else {
         if(date){
-          datetime <- format(datetime, "%Y-%m-%d")
+          datetime <- format(lubridate::as_datetime(datetime), "%Y-%m-%d")
         } else {
-          datetime <- lubridate::format_ISO8601(datetime, usetz = TRUE)
+          datetime <- lubridate::format_ISO8601(lubridate::as_datetime(datetime), usetz = "Z")
         }
       }
     } else if (length(datetime) == 2) {
 
       if(date){
-        datetime <- paste0(format(as.Date(datetime), "%Y-%m-%d"), collapse = "/")
+        datetime <- paste0(format(lubridate::as_datetime(datetime), "%Y-%m-%d"), collapse = "/")
       } else {
-        datetime <- paste0(lubridate::format_ISO8601(as.POSIXct(datetime), 
-                                                     usetz = TRUE), 
+        datetime <- paste0(lubridate::format_ISO8601(lubridate::as_datetime(datetime), 
+                                                     usetz = "Z"), 
                            collapse = "/")
       }
 

R/getWebServiceData.R

@@ -34,7 +34,7 @@ getWebServiceData <- function(obs_url, ...) {
   obs_url <- httr2::req_retry(obs_url,
                               backoff = ~ 5, max_tries = 3) 
   obs_url <- httr2::req_headers(obs_url,
-                                `Accept-Encoding` = c("compress", "gzip")) 
+                                `Accept-Encoding` = c("compress", "gzip"))
 
   url_method <- "GET"
   if(!is.null(obs_url$body)){

R/importWaterML1.R

@@ -450,7 +450,7 @@ check_if_xml <- function(obs_url) {
   } else if (inherits(obs_url, c("xml_node", "xml_nodeset"))) {
     returnedDoc <- obs_url
   } else {
-    doc <- getWebServiceData(obs_url, encoding = "gzip")
+    doc <- getWebServiceData(obs_url)
     if (is.null(doc)) {
       return(invisible(NULL))
     }

R/readNWISunit.R

@@ -493,23 +493,27 @@ readNWISmeas <- function(siteNumbers,
 #' @seealso [constructNWISURL()], [importRDB1()]
 #' @export
 #' @examplesIf is_dataRetrieval_user()
-#' site_id <- "434400121275801"
+#' #site_id <- "434400121275801"
 #' \donttest{
-#' data <- readNWISgwl(site_id)
-#' sites <- c("434400121275801", "375907091432201")
-#' data2 <- readNWISgwl(sites, "", "")
-#' data3 <- readNWISgwl("420125073193001", "", "")
+#' #data <- readNWISgwl(site_id)
+#' #sites <- c("434400121275801", "375907091432201")
+#' #data2 <- readNWISgwl(sites, "", "")
+#' #data3 <- readNWISgwl("420125073193001", "", "")
 #' # handling of data where date has no day
-#' data4 <- readNWISgwl("425957088141001", startDate = "1980-01-01")
+#' #data4 <- readNWISgwl("425957088141001", startDate = "1980-01-01")
 #'
-#' data5 <- readNWISgwl("263819081585801", parameterCd = "72019")
+#' #data5 <- readNWISgwl("263819081585801", parameterCd = "72019")
 #' }
 readNWISgwl <- function(siteNumbers,
                         startDate = "",
                         endDate = "",
                         parameterCd = NA,
                         convertType = TRUE, tz = "UTC") {
 
+  .Deprecated(new = "read_waterdata_field_measurements.",
+              package = "dataRetrieval", 
+              msg = "NWIS servers are slated for decommission. Please begin to migrate to read_waterdata_field_measurements.")
+
   message(new_nwis_message())
 
   url <- constructNWISURL(

R/read_waterdata_field_measurements.R

@@ -0,0 +1,101 @@
+#' Get USGS Field Measurement Water Data
+#' 
+#' @description `r get_description("field-measurements")`
+#' 
+#' @export
+#' @param monitoring_location_id `r get_params("field-measurements")$monitoring_location_id`
+#' @param parameter_code `r get_params("field-measurements")$parameter_code`
+#' @param observing_procedure_code `r get_params("field-measurements")$observing_procedure_code`
+#' @param time `r get_params("field-measurements")$time`
+#' @param value `r get_params("field-measurements")$value`
+#' @param unit_of_measure `r get_params("field-measurements")$unit_of_measure`
+#' @param approval_status `r get_params("field-measurements")$approval_status`
+#' @param last_modified `r get_params("field-measurements")$last_modified`
+#' @param qualifier `r get_params("field-measurements")$qualifier`
+#' @param field_visit_id `r get_params("field-measurements")$field_visit_id`
+#' @param observing_procedure `r get_params("field-measurements")$observing_procedure`
+#' @param vertical_datum `r get_params("field-measurements")$vertical_datum`
+#' @param measuring_agency `r get_params("field-measurements")$measuring_agency`
+#' @param properties A vector of requested columns to be returned from the query.
+#' Available options are: 
+#' `r schema <- check_OGC_requests(endpoint = "field-measurements", type = "schema"); paste(names(schema$properties), collapse = ", ")`
+#' @param bbox Only features that have a geometry that intersects the bounding
+#' box are selected.The bounding box is provided as four or six numbers, depending
+#' on whether the coordinate reference system includes a vertical axis (height or
+#' depth). Coordinates are assumed to be in crs 4326. The expected format is a numeric 
+#' vector structured: c(xmin,ymin,xmax,ymax). Another way to think of it is c(Western-most longitude,
+#' Southern-most latitude, Eastern-most longitude, Northern-most longitude).
+#' @param limit The optional limit parameter is used to control the subset of the 
+#' selected features that should be returned in each page. The maximum allowable
+#' limit is 10000. It may be beneficial to set this number lower if your internet
+#' connection is spotty. The default (`NA`) will set the limit to the maximum
+#' allowable limit for the service.
+#' @param max_results The optional maximum number of rows to return. This value
+#' must be less than the requested limit. 
+#' @param skipGeometry This option can be used to skip response geometries for
+#' each feature. The returning object will be a data frame with no spatial
+#' information.
+#' @param convertType logical, defaults to `TRUE`. If `TRUE`, the function
+#' will convert the data to dates and qualifier to string vector.
+#' @examplesIf is_dataRetrieval_user()
+#' 
+#' \donttest{
+#' site <- "USGS-02238500"
+#' field_data_sf <- read_waterdata_field_measurements(monitoring_location_id = site)
+#'
+#' groundwater <- read_waterdata_field_measurements(monitoring_location_id = "USGS-375907091432201")
+#'
+#' gwl_data <- read_waterdata_field_measurements(monitoring_location_id = "USGS-375907091432201",
+#'                            parameter_code = "72019",
+#'                            skipGeometry = TRUE)
+#'                         
+#' gwl_data_period <- read_waterdata_field_measurements(
+#'                                   monitoring_location_id = "USGS-375907091432201",
+#'                                   parameter_code = "72019",
+#'                                   time = "P20Y")
+#' 
+#' multi_site <- read_waterdata_field_measurements(
+#'                               monitoring_location_id =  c("USGS-451605097071701",
+#'                                                           "USGS-263819081585801"),
+#'                               parameter_code = c("62611", "72019"))
+#'                               
+#' old_df <- read_waterdata_field_measurements(monitoring_location_id = "USGS-425957088141001", 
+#'                                               time = c("1980-01-01", NA))
+#' 
+#' 
+#' }
+read_waterdata_field_measurements <- function(monitoring_location_id = NA_character_,
+                                             parameter_code = NA_character_,
+                                             observing_procedure_code = NA_character_,
+                                             properties = NA_character_,
+                                             field_visit_id = NA_character_,
+                                             approval_status = NA_character_,
+                                             unit_of_measure = NA_character_,
+                                             qualifier = NA_character_,
+                                             value = NA,
+                                             last_modified = NA_character_,
+                                             observing_procedure = NA_character_,
+                                             vertical_datum = NA_character_,
+                                             measuring_agency = NA_character_,
+                                             skipGeometry = NA,
+                                             time = NA_character_,
+                                             bbox = NA,
+                                             limit = NA,
+                                             max_results = NA,
+                                             convertType = TRUE){
+
+  service <- "field-measurements"
+  output_id <- "field_measurement_id"
+
+  args <- mget(names(formals()))
+  return_list <- get_ogc_data(args,
+                              output_id, 
+                              service)
+
+  return_list <- return_list[order(return_list$time, return_list$monitoring_location_id), ]
+
+  return(return_list)
+}
+
+
+