Merge pull request #830 from ldecicco-USGS/latest_daily

Latest daily

Author: ldecicco-USGS

.Rbuildignore

@@ -40,6 +40,7 @@ README.Rmd
 ^codecov\.yml$
 ^\.github$
 ^\.gitlab$
+^\.quarto$
 vignettes/tutorial.Rmd
 vignettes/phosData.rds
 vignettes/waterservices.png
@@ -104,3 +105,6 @@ tests/manual/*
 vignettes/qwdata_changes.Rmd
 vignettes/nwisData.rds
 vignettes/wqpData.rds
+_quarto.yml
+vignettes/basic_slides.Rmd
+vignettes/changes_slides.Rmd

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: dataRetrieval
 Type: Package
 Title: Retrieval Functions for USGS and EPA Hydrology and Water Quality Data
-Version: 2.7.21
+Version: 2.7.21.9000
 Authors@R: c(
     person("Laura", "DeCicco", role = c("aut","cre"),
             email = "[email protected]",
@@ -47,7 +47,7 @@ Copyright: This software is in the public domain because it contains materials
 Depends:
     R (>= 4.1.0)
 Imports:
-    curl (>= 6.0.0),
+    curl (>= 7.0.0),
     lubridate (>= 1.5.0),
     stats,
     utils,
@@ -67,5 +67,5 @@ Encoding: UTF-8
 BuildVignettes: true
 VignetteBuilder: knitr
 BugReports: https://github.com/DOI-USGS/dataRetrieval/issues
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -49,6 +49,7 @@ export(read_waterdata)
 export(read_waterdata_daily)
 export(read_waterdata_field_measurements)
 export(read_waterdata_latest_continuous)
+export(read_waterdata_latest_daily)
 export(read_waterdata_metadata)
 export(read_waterdata_monitoring_location)
 export(read_waterdata_parameter_codes)

NEWS

@@ -1,9 +1,15 @@
+dataRetrieval 2.7.22
+===================
+* Added read_waterdata_latest_daily to access latest daily USGS water data.
+* Added state_name and hydrologic_unit_code to read_waterdata_ts_meta
+
 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.
+* Handle waterdata empty returns better.
 
 dataRetrieval 2.7.20
 ===================

R/AAA.R

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

R/read_waterdata.R

@@ -5,8 +5,7 @@
 #' for more information.
 #' 
 #' @export
-#' @param service character, can be any existing collection such
-#' as "daily", "monitoring-locations", "time-series-metadata"
+#' @param service character, can be any existing collection.
 #' @param CQL A string in a Common Query Language format.
 #' @param convertType logical, defaults to `TRUE`. If `TRUE`, the function
 #' will convert the data to dates and qualifier to string vector.
@@ -64,9 +63,12 @@ read_waterdata <- function(service,
 
   output_id <- switch(service,
                       "daily" = "daily_id",
+                      "latest-daily" = "latest_daily_id",
                       "time-series-metadata" = "time_series_id",
                       "monitoring-locations" = "monitoring_location_id",
                       "latest-continuous" = "latest_continuous_id",
+                      "continuous" = "continuous_id",
+                      "field-measurements" = "field_measurement_id",
                       service)
 
   if(!"properties" %in% names(args)){
@@ -87,7 +89,18 @@ read_waterdata <- function(service,
 
   return_list <- walk_pages(data_req, max_results)
 
-  return_list <- deal_with_empty(return_list, args[["properties"]], service)
+  if(is.null(args[["skipGeometry"]])){
+    skipGeometry <- FALSE
+  } else if (is.na(args[["skipGeometry"]])){
+    skipGeometry <- FALSE
+  } else {
+    skipGeometry <- args[["skipGeometry"]]
+  }
+  
+  return_list <- deal_with_empty(return_list, args[["properties"]],
+                                 service, 
+                                 skipGeometry,
+                                 convertType)
 
   if(convertType) return_list <- cleanup_cols(return_list)
 

R/read_waterdata_field_measurements.R

@@ -61,6 +61,13 @@
 #'                               
 #' old_df <- read_waterdata_field_measurements(monitoring_location_id = "USGS-425957088141001", 
 #'                                               time = c("1980-01-01", NA))
+#'                                               
+#' surface_water <- read_waterdata_field_measurements(
+#'                          monitoring_location_id = c("USGS-07069000",
+#'                                                     "USGS-07064000",
+#'                                                     "USGS-07068000"),
+#'                          time = "2024-07-01T00:00:00Z/..",
+#'                          parameter_code = "00060")
 #' 
 #' 
 #' }

R/read_waterdata_latest_daily.R

@@ -0,0 +1,97 @@
+#' Get Latest USGS Daily Data
+#' 
+#' @description `r get_description("latest-daily")`
+#' 
+#' @export
+#' @param monitoring_location_id `r get_params("latest-daily")$monitoring_location_id`
+#' @param parameter_code `r get_params("latest-daily")$parameter_code`
+#' @param statistic_id `r get_params("latest-daily")$statistic_id`
+#' @param time `r get_params("latest-daily")$time`
+#' @param value `r get_params("latest-daily")$value`
+#' @param unit_of_measure `r get_params("latest-daily")$unit_of_measure`
+#' @param approval_status `r get_params("latest-daily")$approval_status`
+#' @param last_modified `r get_params("latest-daily")$last_modified`
+#' @param time_series_id `r get_params("latest-daily")$time_series_id`
+#' @param qualifier `r get_params("latest-daily")$qualifier`
+#' @param latest_daily_id `r get_params("latest-daily")$id`
+#' @param properties A vector of requested columns to be returned from the query.
+#' Available options are: 
+#' `r schema <- check_OGC_requests(endpoint = "latest-daily", 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"
+#' pcode <- "00060"
+#' dv_data_sf <- read_waterdata_latest_daily(monitoring_location_id = site,
+#'                               parameter_code = pcode)
+#'                               
+#' dv_data_last_modified <- read_waterdata_latest_daily(monitoring_location_id = site,
+#'                               parameter_code = pcode,
+#'                               last_modified = "P7D")
+#'
+#' dv_data_trim <- read_waterdata_latest_daily(monitoring_location_id = site,
+#'                           parameter_code = pcode, 
+#'                           properties = c("monitoring_location_id",
+#'                                          "value",
+#'                                          "time"))
+#'
+#' dv_data <- read_waterdata_latest_daily(monitoring_location_id = site,
+#'                            parameter_code = pcode,
+#'                            skipGeometry = TRUE)
+#' 
+#' multi_site <- read_waterdata_latest_daily(monitoring_location_id =  c("USGS-01491000",
+#'                                                           "USGS-01645000"),
+#'                               parameter_code = c("00060", "00010"))
+#' 
+#' }
+read_waterdata_latest_daily <- function(monitoring_location_id = NA_character_,
+                                 parameter_code = NA_character_,
+                                 statistic_id = NA_character_,
+                                 properties = NA_character_,
+                                 time_series_id = NA_character_,
+                                 latest_daily_id = NA_character_,
+                                 approval_status = NA_character_,
+                                 unit_of_measure = NA_character_,
+                                 qualifier = NA_character_,
+                                 value = NA,
+                                 last_modified = NA_character_,
+                                 skipGeometry = NA,
+                                 time = NA_character_,
+                                 bbox = NA,
+                                 limit = NA,
+                                 max_results = NA,
+                                 convertType = TRUE){
+  
+  service <- "latest-daily"
+  output_id <- "latest_daily_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)
+}
+
+
+

R/read_waterdata_ts_meta.R

@@ -13,6 +13,8 @@
 #' @param last_modified `r get_params("time-series-metadata")$last_modified`
 #' @param begin `r get_params("time-series-metadata")$begin`
 #' @param end `r get_params("time-series-metadata")$end`
+#' @param hydrologic_unit_code `r get_params("time-series-metadata")$hydrologic_unit_code`
+#' @param state_name `r get_params("time-series-metadata")$state_name`
 #' @param thresholds `r get_params("time-series-metadata")$thresholds`
 #' @param unit_of_measure `r get_params("time-series-metadata")$unit_of_measure`
 #' @param primary `r get_params("time-series-metadata")$primary`
@@ -55,6 +57,8 @@
 #'                                            "end",
 #'                                            "time_series_id"),
 #'                             skipGeometry = TRUE)
+#'                             
+#' meta_wi <- read_waterdata_ts_meta(state_name = "Wisconsin")
 #' }
 read_waterdata_ts_meta <- function(monitoring_location_id = NA_character_,
                               parameter_code = NA_character_,
@@ -64,6 +68,8 @@ read_waterdata_ts_meta <- function(monitoring_location_id = NA_character_,
                               last_modified = NA_character_,
                               begin = NA_character_,
                               end = NA_character_,
+                              hydrologic_unit_code = NA_character_,
+                              state_name = NA_character_,
                               unit_of_measure = NA_character_,
                               computation_period_identifier = NA_character_,
                               computation_identifier = NA_character_,

R/walk_pages.R

@@ -4,6 +4,8 @@
 #' @param properties A vector of requested columns
 #' @param service character, can be any existing collection such
 #' as "daily", "monitoring-locations", "time-series-metadata"
+#' @param skipGeometry A logical for whether to return geometry
+#' @param convertType A logical for whether to convert value to numeric
 #' 
 #' @return data.frame
 #' @noRd
@@ -17,17 +19,50 @@
 #'                                       properties = NA,
 #'                                       service = "daily")
 #' 
-deal_with_empty <- function(return_list, properties, service){
+deal_with_empty <- function(return_list, properties, service, 
+                            skipGeometry,
+                            convertType){
+  
   if(nrow(return_list) == 0){
 
     if(all(is.na(properties))){
       schema <- check_OGC_requests(endpoint = service, type = "schema")
       properties <- names(schema$properties)
     }
-    return_list <- data.frame(matrix(nrow = 0, ncol = length(properties)))
+    return_list <- data.frame(matrix(nrow = 0, 
+                                     ncol = length(properties)))
+    return_list <- lapply(return_list, as.character)
     names(return_list) <- properties
+    
+    single_params <- c("datetime", "last_modified", "begin", "end", "time")
+    
+    for(i in single_params){
+      if(i %in% names(return_list)){
+        return_list[[i]] <- as.POSIXct(as.character(), origin = "1970-01-01")
+      }
+    }
+    
+    if(convertType && service == "daily"){
+      return_list$time <- as.Date(as.character())
+    }
+    
+    if(convertType && "value" %in% names(return_list)){
+      return_list$value <- as.numeric()
+    }
+    
+    if(convertType && "contributing_drainage_area" %in% names(return_list)){
+      return_list$contributing_drainage_area <- as.numeric()
+    }
+
+    return_list <- data.frame(return_list)
+    return_list$geometry <- NULL
+    
+    if(!skipGeometry){
+      return_list <- sf::st_as_sf(return_list, geometry = sf::st_sfc())
+    }
+    
   }
-  
+
   return(return_list)
 }
 
@@ -126,6 +161,10 @@ cleanup_cols <- function(df, service = "daily"){
 
   if("contributing_drainage_area" %in% names(df)){
     df$contributing_drainage_area <- as.numeric(df$contributing_drainage_area)
+  }
+  
+  if("drainage_area" %in% names(df)){
+    df$drainage_area <- as.numeric(df$drainage_area)
   }  
 
   df
@@ -254,8 +293,7 @@ get_ogc_data <- function(args,
                          service){
 
   args[["service"]] <-  service
-  max_results <- args[["max_results"]]
-  args[["max_results"]] <- NULL
+
   args <- switch_arg_id(args, 
                         id_name = output_id, 
                         service = service)
@@ -269,9 +307,19 @@ get_ogc_data <- function(args,
 
   req <- do.call(construct_api_requests, args)
 
+  max_results <- args[["max_results"]]
+  args[["max_results"]] <- NULL
+  
   return_list <- walk_pages(req, max_results)
 
-  return_list <- deal_with_empty(return_list, properties, service)
+  if(is.na(args[["skipGeometry"]])){
+    skipGeometry <- FALSE
+  } else {
+    skipGeometry <- args[["skipGeometry"]]
+  }
+  
+  return_list <- deal_with_empty(return_list, properties, service,
+                                 skipGeometry, convertType)
 
   if(convertType) return_list <- cleanup_cols(return_list, service = service)