upstream

Merge branch 'main' of github.com:DOI-USGS/dataRetrieval into develop

# Conflicts:
#	tutorials/images/publish.png

Author: ldecicco-USGS

.Rbuildignore

@@ -104,3 +104,4 @@ tests/manual/*
 vignettes/qwdata_changes.Rmd
 vignettes/nwisData.rds
 vignettes/wqpData.rds
+_quarto.yml

NEWS

@@ -4,6 +4,7 @@ dataRetrieval 2.7.21
 * 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/read_waterdata.R

@@ -87,7 +87,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/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)
 }
 
@@ -271,7 +306,14 @@ get_ogc_data <- function(args,
 
   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)
 

tests/testthat/tests_general.R

@@ -27,6 +27,7 @@ test_that("General USGS retrievals working", {
   dv_data <- read_waterdata(service = "daily",
                             CQL = cql,
                             time = c("2023-01-01", "2024-01-01"))
+  
   expect_equal(as.Date(c("2023-01-01", "2024-01-01")), 
                range(dv_data$time))
   expect_true(all(unique(dv_data$monitoring_location_id) %in%

tests/testthat/tests_userFriendly_fxns.R

@@ -68,7 +68,7 @@ test_that("Unit value data returns correct types", {
 context("Peak, rating, meas, site")
 test_that("peak, rating curves, surface-water measurements", {
   testthat::skip_on_cran()
-  skip_on_ci()
+  testthat::skip_on_ci()
   siteNumbers <- c("01594440", "040851325")
   data <- readNWISpeak(siteNumbers)
   expect_is(data$agency_cd, "character")
@@ -120,7 +120,8 @@ test_that("peak, rating curves, surface-water measurements", {
 
 test_that("read_waterdata_daily", {
   testthat::skip_on_cran()
-
+  testthat::skip_on_ci()
+  
   siteNumber <- "USGS-04085427"
   startDate <- "2012-01-01"
   endDate <- "2012-06-30"
@@ -153,6 +154,12 @@ test_that("read_waterdata_daily", {
                                    parameter_code =  "00060",
                                    time =  c("2014-01-01", "2014-01-07"))
   expect_true(nrow(notActiveUSGS) == 0)
+  expect_type(notActiveUSGS$value, "double")
+  notActiveUSGS2 <- read_waterdata_daily(monitoring_location_id = paste0("USGS-", site),
+                                        parameter_code =  "00060",
+                                        convertType = FALSE,
+                                        time =  c("2014-01-01", "2014-01-07"))
+  expect_type(notActiveUSGS2$value, "character")
 
 })
 

vignettes/basic_slides.Rmd

@@ -12,10 +12,10 @@ editor_options:
   chunk_output_type: console
 ---
 
-Click the slide below then "f" for full screen, and "Esc" to escape full screen.
+For a direct link to the slides, go [here](https://doi-usgs.github.io/dataRetrieval/tutorials/basic_slides_deck.html). Use the arrow keys to advance the slides. Or click the slide below then "f" for full screen, and "Esc" to escape full screen.
 
 ```{=html}
-<iframe src="../tutorials/basic_slides_deck.html" width="700"
+<iframe src="../tutorials/basic_slides_deck.html" width="800"
   height="400"></iframe>
 ```
 

vignettes/changes_slides.Rmd

@@ -12,7 +12,7 @@ editor_options:
   chunk_output_type: console
 ---
 
-Click the slide below then "f" for full screen, and "Esc" to escape full screen.
+For a direct link to the slides, go [here](https://doi-usgs.github.io/dataRetrieval/tutorials/changes_slides_deck.html). Use the arrow keys to advance the slides. Or click the slide below then "f" for full screen, and "Esc" to escape full screen.
 
 ```{=html}
 <iframe src="../tutorials/changes_slides_deck.html" width="700"